查看新闻/公告--[备忘]自制“快速上传图片并发帖”的vbscript程序

'----------------接收参数-----------------------
Set oArgs = WScript.Arguments
filepath = oArgs(0)

title = InputBox("输入标题","快速贴图","图")
if trim(title) = "" then
    title = "图" & NOW()
end if

Set oArgs = Nothing
'------------------------------------------------------------
'XML Upload Class
Class XMLUpload
    Private xmlHttp
    Private objTemp
    Private adTypeBinary, adTypeText
    Private strCharset, strBoundary

    Private Sub Class_Initialize()
        adTypeBinary = 1
        adTypeText = 2
        Set xmlHttp = CreateObject("Msxml2.XMLHTTP")
        Set objTemp = CreateObject("ADODB.Stream")
        objTemp.Type = adTypeBinary
        objTemp.Open
        strCharset = "utf-8"
        strBoundary = GetBoundary()
    End Sub

    Private Sub Class_Terminate()
        objTemp.Close
        Set objTemp = Nothing
        Set xmlHttp = Nothing
    End Sub

    '指定字符集的字符串转字节数组
    Public Function StringToBytes(ByVal strData, ByVal strCharset)
        Dim objFile
        Set objFile = CreateObject("ADODB.Stream")
        objFile.Type = adTypeText
        objFile.Charset = strCharset
        objFile.Open
        objFile.WriteText strData
        objFile.Position = 0
        objFile.Type = adTypeBinary
        If UCase(strCharset) = "UNICODE" Then
        objFile.Position = 2 'delete UNICODE BOM
        ElseIf UCase(strCharset) = "UTF-8" Then
        objFile.Position = 3 'delete UTF-8 BOM
        End If
        StringToBytes = objFile.Read(-1)
        objFile.Close
        Set objFile = Nothing
    End Function

    '获取文件内容的字节数组
    Private Function GetFileBinary(ByVal strPath)
        Dim objFile
        Set objFile = CreateObject("ADODB.Stream")
        objFile.Type = adTypeBinary
        objFile.Open
        objFile.LoadFromFile strPath
        GetFileBinary = objFile.Read(-1)
        objFile.Close
        Set objFile = Nothing
    End Function

    '获取自定义的表单数据分界线
    Private Function GetBoundary()
        Dim ret(12)
        Dim table
        Dim i
        table = "abcdefghijklmnopqrstuvwxzy0123456789"
        Randomize
        For i = 0 To UBound(ret)
        ret(i) = Mid(table, Int(Rnd() * Len(table) + 1), 1)
        Next
        GetBoundary = "---------------------------" & Join(ret, Empty)
    End Function

    '设置上传使用的字符集
    Public Property Let Charset(ByVal strValue)
        strCharset = strValue
    End Property

    '添加文本域的名称和值
    Public Sub AddForm(ByVal strName, ByVal strValue)
        Dim tmp
        tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""\r\n\r\n$3"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        tmp = Replace(tmp, "$2", strName)
        tmp = Replace(tmp, "$3", strValue)
        objTemp.Write StringToBytes(tmp, strCharset)
    End Sub

    '设置文件域的名称/文件名称/文件MIME类型/文件路径或文件字节数组
    Public Sub AddFile(ByVal strName, ByVal strFileName, ByVal strFileType, ByVal strFilePath)
        Dim tmp
        tmp = "\r\n--$1\r\nContent-Disposition: form-data; name=""$2""; filename=""$3""\r\nContent-Type: $4\r\n\r\n"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        tmp = Replace(tmp, "$2", strName)
        tmp = Replace(tmp, "$3", strFileName)
        tmp = Replace(tmp, "$4", strFileType)
        objTemp.Write StringToBytes(tmp, strCharset)
        objTemp.Write GetFileBinary(strFilePath)
    End Sub

    '设置multipart/form-data结束标记
    Private Sub AddEnd()
        Dim tmp
        tmp = "\r\n--$1--\r\n"
        tmp = Replace(tmp, "\r\n", vbCrLf)
        tmp = Replace(tmp, "$1", strBoundary)
        objTemp.Write StringToBytes(tmp, strCharset)
        objTemp.Position = 2
    End Sub

    '上传到指定的URL，并返回服务器应答
    Public Function Upload(ByVal strURL)
        Call AddEnd
        xmlHttp.Open "POST", strURL, False
        xmlHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & strBoundary
        'xmlHttp.setRequestHeader "Content-Length", objTemp.size
        xmlHttp.Send objTemp
        Upload = xmlHttp.responseText
    End Function
End Class
'---------------------upload image-------------------------------
Dim UploadData
Set UploadData = New XMLUpload
UploadData.Charset = "utf-8"
UploadData.AddForm "__VIEWSTATE", "/wEPDwULLTE0MDI0NzI3NjQPZBYCAgMPFgIeB2VuY3R5cGUFE211bHRpcGFydC9mb3JtLWRhdGEWAgIBD2QWAgIBDw8WAh4EVGV4dAUG5LiK5LygZGRkLQz15QgYWkxHD2FAxisnscJtYtE=" '文本域的名称和内容
UploadData.AddForm "uploadfile1:startup","上传"
UploadData.AddFile "uploadfile1:filefield1", "test.jpg", "image/jpg", filepath

xxx = UploadData.Upload("http://xxxxxxx.com/bbs/web/uploadfile.aspx")
set UploadData = nothing

yyy = right(xxx,200)
aa = instr(yyy,"<script>loadfileInner('")
if aa<1 then
    msgbox "上传图片失败." & yyy
    wscript.quit
end if
bb = instr(aa+30,yyy,"','")
httpFilePath = mid(yyy,aa+23,bb-aa-23)
'WScript.Echo  httpFilePath
'--------------------------发帖------------------------------------------

Function urlencode(str)
    Dim i,c,s,length
    length = Len(str)
    For i = 1 To length
        s = Mid(str,i,1)
        c = "&H" & Hex(AscW(Mid(str,i,1)))
        If ( c >= AscW("A") And c <= AscW("Z") ) Or _
            ( c >= AscW("a") And c <= AscW("z") ) Or _
            ( c >= AscW("0") And c <= AscW("9") ) Or _
            ( c = AscW("-") Or c = AscW("_") Or c = AscW(".") ) Then
            urlencode = urlencode & s
        ElseIf c = AscW(" ") Then
            urlencode = urlencode & "+"
        Else
            If c >= &H0001 And c <= &H007F Then
                urlencode = urlencode & s
            ElseIf c > &H07FF Then
                urlencode = urlencode & "%" & Hex(&HE0 Or (c\(2^12) And &H0F))
                urlencode = urlencode & "%" & Hex(&H80 Or (c\(2^6) And &H3F))
                urlencode = urlencode & "%" & Hex(&H80 Or (c\(2^0) And &H3F))
            Else
                urlencode = urlencode & "%" & Hex(&HC0 Or (c\(2^6) And &H1F))
                urlencode = urlencode & "%" & Hex(&H80 Or (c\(2^0) And &H3F))
            End If
        End If
    Next
End Function
'--------------------------发帖------------------------------------------
Set xmlHttp2 = CreateObject("Msxml2.XMLHTTP")
strURL = "http://xxxxxxxx.com/bbs/web/newbbs/NewForumPost.aspx?MinorTopicTypeID=19"
xmlHttp2.Open "POST", strURL, False
xmlHttp2.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

xmlHttp2.setRequestHeader "Referer", "http://xxxxxxx.com/bbs/web/newbbs/NewForumPost.aspx?MinorTopicTypeID=19"
'实际上，设置Referer不好使，安全上的考虑，xmlhttp组件屏蔽了这个功能.
'还好，服务端没有验证referer.

postTitle = title '标题
postContent = "<img src='" & httpFilePath & "'>" '内容
sendStr = "__EVENTTARGET=&__EVENTARGUMENT=&__VIEWSTATE=%2FwEPDwUJMTA0Nzc4ODAyD2QWAmYPZBYcAgEPZBYGAgIPDxYCHghJbWFnZVVybAUXLi4vaW1hZ2VzL2JudF9sb2dpbi5qcGdkZAIDDxYCHglpbm5lcmh0bWwFjQLmrKLov44g546L5rSq5b2xMTAxMTUyMDYmbmJzcDt8Jm5ic3A7PGEgdGFyZ2V0PSdfYmxhbmsnIGhyZWY9Li4vTmV3QkJTL0ZvcnVtTXlQb3N0LmFzcHg%2FZW1wbG95ZWVfbm89MTAxMTUyMDYgY2xhc3M9J25hdl9sZWZ0Jz7kuKrkurrkuK3lv4M8L2E%2BJm5ic3A7fCZuYnNwOzxhIHRhcmdldD0nX2JsYW5rJyBocmVmPSdodHRwOi8vYmxvZy56dGUuY29tLmNuL2Jsb2cvc3BhY2UvMjAxMDA5MTAxMTUyMDYnIGNsYXNzPSduYXZfbGVmdCc%2B6L%2Bb5YWl5Liq5Lq65Y2a5a6iPC9hPmQCBA8PFgIeBFRleHQFBuazqOmUgGRkAgUPZBYCZg8WAh4LXyFJdGVtQ291bnQCChYUZg9kFgRmDxUCLkxpc3RGb3J1bVBvc3RCaWdUeXBlLmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yNjEP5YWs5ZGK5L%2Bh5oGv5qCPZAIBDxYCHwMCBRYKZg9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI2MwhJVOWFrOWRimQCAQ9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI2NwzlkI7li6TmnI3liqFkAgIPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yNzAM5YWs5Y%2B46YCa55%2BlZAIDD2QWAmYPFQImTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTQM5YaF6YOo5oub6IGYZAIED2QWAmYPFQImTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MjcM5a6J5YWo5YWs5ZGKZAIBD2QWBGYPFQIuTGlzdEZvcnVtUG9zdEJpZ1R5cGUuYXNweD9NaW5vclRvcGljVHlwZUlEPTg0MRXkuLrlhazlj7jlj5HlsZXlu7roqIBkAgEPFgIfAwIGFgxmD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9ODYxEuaetuaehOa1geeoi%2BS8mOWMlmQCAQ9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTk2MhLliJvmipXln7rph5HorrrlnZtkAgIPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTQxD1pUReWIm%2BaWsOaymem%2BmWQCAw9kFgJmDxUCKExpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTEyNDES6JCl6ZSA6aG555uu566h55CGZAIED2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MjQxDOaIkOacrOiuuuWdm2QCBQ9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTk2MRLliJvmipXln7rph5HorrrlnZtkAgIPZBYEZg8VAixMaXN0Rm9ydW1Qb3N0QmlnVHlwZS5hc3B4P01pbm9yVG9waWNUeXBlSUQ9NQzln47luILkuqTmtYFkAgEPFgIfAwIKFhRmD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9Mjc1Bua3seWcs2QCAQ9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI3NgbljZfkuqxkAgIPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yNzcG6KW%2F5a6JZAIDD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9Mjc4BuS4iua1t2QCBA9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI3OQbljJfkuqxkAgUPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yODAG5aSp5rSlZAIGD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MjgxBuS4ieS6mmQCBw9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI4MgbmiJDpg71kAggPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yODMG6YeN5bqGZAIJD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9OTgxBuatpuaxiWQCAw9kFgRmDxUCL0xpc3RGb3J1bVBvc3RCaWdUeXBlLmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTIxDOa0u%2BWKqOS4k%2BWMumQCAQ8WAh8DAgIWBGYPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTIyEuS4reWFtOa8q%2BeUu%2BW%2BgembhmQCAQ9kFgJmDxUCKExpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTExNjES6ZSA5ZSu5pGE5b2x5aSn6LWbZAIED2QWBGYPFQIuTGlzdEZvcnVtUG9zdEJpZ1R5cGUuYXNweD9NaW5vclRvcGljVHlwZUlEPTc2MRLnrqHnkIblubLpg6jlm63lnLBkAgEPFgIfA2ZkAgUPZBYEZg8VAixMaXN0Rm9ydW1Qb3N0QmlnVHlwZS5hc3B4P01pbm9yVG9waWNUeXBlSUQ9NgznlJ%2FmtLvkv6Hmga9kAgEPFgIfAwIMFhhmD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MjcxD%2Ba3seWcs%2BWuieWxheaIv2QCAQ9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI3Mg%2FljZfkuqzlronlsYXmiL9kAgIPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0yNzMM5paw5ZOB5Lqk5piTZAIDD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MzQxDOivu%2BS5puWbreWcsGQCBA9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTQ4MQzmloflj7LmnK3orrBkAgUPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMDAxDOe%2Bjumjn%2BWkqeS4i2QCBg9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTEzD0VBUOW%2Fg%2BeBtempv%2BermWQCBw9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTE1Cem5iuahpeWdimQCCA9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTE3DOS6jOaJi%2BW4guWcumQCCQ9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTYxDOWBpeW6t%2BWFu%2BeUn2QCCg9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTgxDOaIv%2BWxi%2BS%2FoeaBr2QCCw9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTEyMQzkurLlrZDorrrlnZtkAgYPZBYEZg8VAixMaXN0Rm9ydW1Qb3N0QmlnVHlwZS5hc3B4P01pbm9yVG9waWNUeXBlSUQ9NwzmlofkvZPlqLHkuZBkAgEPFgIfAwIIFhBmD2QWAmYPFQIoTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTAyMQlaVEXova7mu5FkAgEPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTAyD%2BiKseiNieS4juWuoOeJqWQCAg9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTE5DOi0tOWbvuS4k%2BWMumQCAw9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTIwDOmptOihjOWkqeS4i2QCBA9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTIxDOmfs%2BS5kOauv%2BWggmQCBQ9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTIyDOW8gOW%2Fg%2BS5kOWbrWQCBg9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTgyDOW9seinhuS6pOa1gWQCBw9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTEwMgzmiJHniLHop4bpopFkAgcPZBYEZg8VAi1MaXN0Rm9ydW1Qb3N0QmlnVHlwZS5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MjUM5Lqk5rWB5Y2P5LyaZAIBDxYCHwMCChYUZg9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTQwMQznkIPlj4vlpKnlnLBkAgEPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD01ODEM5oqA5pyv5Lqk5rWBZAICD2QWAmYPFQIoTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTA2MQzkuabnlLvkuqTmtYFkAgMPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTAxDOaXtuWwmui%2FkOWKqGQCBA9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTIzDOWkluivreWtpuS5oGQCBQ9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTI2DOaRhOW9seiuuuWdm2QCBg9kFgJmDxUCJkxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTQxCEE35Y2V6L2mZAIHD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTAxDFpURei9puWPi%2BS8mmQCCA9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTE0MQzoiJ7ouYjljY%2FkvJpkAgkPZBYCZg8VAihMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD0xMTgxEumhueebrueuoeeQhuWunui3tWQCCA9kFgRmDxUCLkxpc3RGb3J1bVBvc3RCaWdUeXBlLmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD02NDEV5Y2T6LaK5paH5YyW5aSn6K6o6K66ZAIBDxYCHwMCBBYIZg9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTY0MhLljZPotormgJ3nu7TmqKHlvI9kAgEPZBYCZg8VAidMaXN0Rm9ydW1Qb3N0LmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD02NjEP5Y2T6LaK5L2T5b6B5paHZAICD2QWAmYPFQInTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9NjgxD%2BWNk%2Bi2iueahOWumuS5iWQCAw9kFgJmDxUCJ0xpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTcwMQ%2Fpg6jpl6jorqjorrrljLpkAgkPZBYEZg8VAixMaXN0Rm9ydW1Qb3N0QmlnVHlwZS5hc3B4P01pbm9yVG9waWNUeXBlSUQ9NAzmnKznq5nns7vnu59kAgEPFgIfAwIDFgZmD2QWAmYPFQImTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTAM56uZ5Yqh5LiT5Yy6ZAIBD2QWAmYPFQImTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTEM5paw5omL5biu5YqpZAICD2QWAmYPFQImTGlzdEZvcnVtUG9zdC5hc3B4P01pbm9yVG9waWNUeXBlSUQ9MTIM54mI6Z2i55Sz6K%2B3ZAIHDxYCHwEFigE8YSBocmVmPUxpc3RGb3J1bVBvc3RCaWdUeXBlLmFzcHg%2FTWlub3JUb3BpY1R5cGVJRD03PuaWh%2BS9k%2BWoseS5kDwvYT4gJmd0OyA8YSBocmVmPUxpc3RGb3J1bVBvc3QuYXNweD9NaW5vclRvcGljVHlwZUlEPTE5Pui0tOWbvuS4k%2BWMujwvYT5kAgkPDxYCHwIFCeaWsOW7uuW4lmRkAgsPFgIeB1Zpc2libGVoFgRmD2QWAmYPDxYCHwIFDOagj%2BebruWQjeensGRkAgEPZBYCAgEPEA8WAh4LXyFEYXRhQm91bmRnZBAVDQzmnKznq5nns7vnu58M5Z%2BO5biC5Lqk5rWBDOeUn%2Ba0u%2BS%2FoeaBrwzmlofkvZPlqLHkuZAM5LyR6Zey5aix5LmQDOa0u%2BWKqOS4k%2BWMugzkuqTmtYHljY%2FkvJoV5Li65YWs5Y%2B45Y%2BR5bGV5bu66KiAD%2BWFrOWRiuS%2FoeaBr%2BagjxLnrqHnkIblubLpg6jlm63lnLAHTXkgWlRFIAnot6jmlofljJYV5Y2T6LaK5paH5YyW5aSn6K6o6K66FQ0BNAE1ATYBNwMzMjUEMTEyMQIyNQM4NDEDMjYxAzc2MQMzMDEDMzAzAzY0MRQrAw1nZ2dnZ2dnZ2dnZ2dnFgECA2QCDQ8WAh8EaBYEZg9kFgJmDw8WAh8CBQzkuLvpopjliIbnsbtkZAIBD2QWAgIBDxAPFgIfBWdkEBUIDOi0tOWbvuS4k%2BWMugzlvbHop4bkuqTmtYEM6am06KGM5aSp5LiLDOmfs%2BS5kOauv%2BWgggzlvIDlv4PkuZDlm60P6Iqx6I2J5LiO5a6g54mpDOaIkeeIseinhumikQlaVEXova7mu5EVCAIxOQI4MgIyMAIyMQIyMgQxMTAyAzEwMgQxMDIxFCsDCGdnZ2dnZ2dnFgFmZAIPDw8WAh8CBQbpgInpoblkZAIRDxAPFgIfAgUJ5LiN5YWs5byAZGRkZAITDxAPFgIfAgUS5Zue5biW6YKu5Lu26YCa55%2BlZGRkZAIVDw8WAh8CBQbmoIfpophkZAIbDxAPFgIfAgUG5YWs5ZGKZGRkZAIfDxYCHgV2YWx1ZQUG5L%2Bd5a2YZAIhDxYCHwYFBuaaguWtmGQCIw8WAh8GBQzlj5HooajkuLvpophkGAEFHl9fQ29udHJvbHNSZXF1aXJlUG9zdEJhY2tLZXlfXxYBBQ51Y1RvcDpidG5Mb2dpbgAJFY0ru3ZIqTDYB5oBL7A%2FY%2FVV&ucTop%3AhiddenIsDisplayS=&ucTop%3AhiddenIsDisplayW=1&txtTitle="& urlencode(postTitle) & "&postBodyEditor=" & urlencode(postContent) & "&btnSubmit=%E5%8F%91%E8%A1%A8%E4%B8%BB%E9%A2%98"
xmlHttp2.setRequestHeader "Content-Length", lenb(sendStr)
xmlHttp2.Send sendStr
yyy = xmlHttp2.responseText

Set xmlHttp2 = nothing

if instr(yyy,"refresh")>1 then
    msgbox "ok"
else
    msgbox "发帖失败."
end if