VBScript - multipart/form-data

VBScriptでMsxml2.XMLHTTPを利用してmultipart/form-dataを送信する。

テキストだけ、ファイルだけの送信ならほかを当たってください（ぉぃ

「テキストとファイルを同時にアップする。」

ほかにBASP21.DLLを利用する方法もあります。

DLLのインストールが出来るならその方がスクリプトはすっきりします。（＾＾

送信する側のサーバをいじりたくなかったのでVBScriptだけで送信する必要がありました。
 
VBならバイト型で宣言して、データを取り込んで、sendすればお終いです。

VBScriptでのバイト型の変数が作れなかったんだか代入出来なかったんだか？

一度バイナリデータをファイル化し、 それを取り込んで「まるっと」送信しています。

「もっといい方法があるよ。」という方はこっそり教えてください。

Option Explicit Dim strFileName 'スクリプトのある、フォルダ以下でファイルを指定する '例： strFileName = "Sample.jpg" , strFileName = "jpg\Sample.jpg"     strFileName = "sample.jpg"     Call FileUpLoad(strFileName) Wscript.Quit     Private Sub FileUpLoad(strFileName)         Dim strPostData(10,1) ' As String ' パラメータ             strPostData(0,0)="dlkey"   :strPostData(0,1)="12345" 'ダウンロードパスワード             strPostData(1,0)="pass"    :strPostData(1,1)="12345" '削除用パスワード             strPostData(2,0)="comment" :strPostData(2,1)="借ります"             strPostData(3,0)="jcode"   :strPostData(3,1)="漢字"         Dim URL ' As String             URL = "http://www.dotup.org/upload.cgi"         Dim strLogFileName ' As String 'ログを書き出すファイル             strLogFileName = Replace(WScript.ScriptFullName, WScript.ScriptName, "up_log.txt")         Dim strTmpFileName ' As String '一時ファイル             strTmpFileName = Replace(WScript.ScriptFullName, WScript.ScriptName, "up_tmp.txt")         Dim strOutFileName ' As String 'アップロードするファイル             strOutFileName = Replace(WScript.ScriptFullName, WScript.ScriptName, strFileName)         'これ以下は変更しない         'Copyright おとり         Dim fso             Set fso = CreateObject("Scripting.FileSystemObject")         If fso.FileExists(strOutFileName) Then             Dim strBoundary                 'データ中に有り得ない文字を指定する。                 strBoundary = "-------------------------" & "xxBounxxdaryxx"             '送信パラメータ作成             Dim i                 i = 0             Dim strKey ' AS String                 strKey = ""                 While(strPostData(i,0)<>"")                     strKey = strKey & "--" & strBoundary & _                         vbCrLf & "Content-Disposition: form-data; name=""" & _                         strPostData(i,0) & """" & vbCrLf & vbCrLf & _                     strPostData(i,1) & vbCrLf                     i = i + 1                 Wend             'ヘッダ,フッタの作成             Dim SendDataHeader,SendDataFooter                 SendDataHeader = "--" & strBoundary & vbCrLf                 SendDataHeader = SendDataHeader & _                     "Content-Disposition: form-data; name=""upfile""; filename=""" & _                     strFileName & """" & vbCrLf                 SendDataHeader = SendDataHeader & _                     "Content-Type: application/octet-stream" & vbCrLf & vbCrLf                 SendDataFooter = vbCrLf & vbCrLf & _                     "--" & strBoundary & "--" & vbCrLf             '送信用バイナリデータ作成 VBではbyte型で宣言するだけなのですが、、             'VBSの場合は型指定が出来ないので無理くり作ってます。             Dim sIn, sOut, SendBinary, SendBinary1, SendBinary2, SendBinary3                 Set sOut = CreateObject("ADODB.Stream")                 Set sIn = CreateObject("ADODB.Stream")                 sOut.charset = "shift-jis" '今回のパラメータはシフトJISでアップします。                 sOut.Type = 2                 sOut.Open                 sOut.WriteText strKey & SendDataHeader                 sOut.SaveToFile strTmpFileName, 2                 sOut.Close                 sIn.Type = 1                 sIn.Open                 sIn.LoadFromFile(strTmpFileName)                 SendBinary1 = sIn.read()                 sIn.Close                 sIn.Type = 1                 sIn.Open                 sIn.LoadFromFile(strOutFileName)                 SendBinary = sIn.read()                 sIn.Close                 sOut.charset = "shift-jis" '今回のパラメータはシフトJISでアップします。                 sOut.Type = 2                 sOut.Open                 sOut.WriteText SendDataFooter                 sOut.SaveToFile strTmpFileName, 2                 sOut.Close                 sIn.Type = 1                 sIn.Open                 sIn.LoadFromFile(strTmpFileName)                 SendBinary2 = sIn.read()                 sIn.Close                 sOut.Type = 1                 sOut.Open                 sOut.Write SendBinary1                 sOut.Write SendBinary                 sOut.Write SendBinary2                 sOut.SaveToFile strTmpFileName, 2                 sOut.Close                 sIn.Type = 1                 sIn.Open                 sIn.LoadFromFile(strTmpFileName)                 SendBinary3 = sIn.read()                 sIn.Close             'オブジェクト作成             Dim HttpRequest ' As Object             Set HttpRequest = Nothing                 On Error Resume Next                 'Set HttpRequest = CreateObject("MSXML2.ServerXMLHTTP.4.0")                 Set HttpRequest = CreateObject("Msxml2.XMLHTTP")                 If HttpRequest Is Nothing Then                     Set HttpRequest = CreateObject("Microsoft.XMLHTTP.5.0")                 Else                 'httpsで送信する場合はServerXMLHTTPで。                 'サーバー証明書を無視する                 'setOption SXH_OPTION_IGNORE_SERVER_SSL_CERT_ERROR_FLAGS, _                     SXH_SERVER_CERT_IGNORE_ALL_SERVER_ERRORS                 '    HttpRequest.setOption 2,13056                 '    URL = "https:" & URL                 End If                 On Error Goto 0                 If HttpRequest Is Nothing Then                     Set HttpRequest = Nothing                     WriteLOGFile strLogFileName , Date & " " & Time & _                         " Microsoft.XMLHTTPオブジェクトが作成出来ません。" & vbNewLine                 Else                     HttpRequest.open "POST", URL, False                     HttpRequest.setRequestHeader "Content-Type", _                         "multipart/form-data; boundary=" & strBoundary                     HttpRequest.setRequestHeader "Content-Length", _                         LenB(SendBinary3)                     HttpRequest.send SendBinary3                                         WriteLOGFile strLogFileName , Date & " " & Time & _                         " " & HttpRequest.Status & vbNewLine                 End If         ELse             WriteLOGFile strLogFileName , Date & " " & Time & _                 " " & strFileName & " ファイルが見つかりません。" & vbNewLine         End If     End Sub