VB中如何实现上传文件的功能?

用script脚本 直接调用 FTP 命令实现上传文件到FTP服务器。

代码如下：

'定义API函数

Const SYNCHRONIZE = &H100000

Const INFINITE = &HFFFFFFFF

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Sub Command1_Click()

Dim filename As String

Dim ftp As String

Dim uname As String

Dim upin As String

ftp = InputBox("请输入服务器地址")

uname = InputBox("请输入帐号", , "anonymous")

upin = InputBox("请输入密码", , "IE@User")

filename = Timer() '取时间为文件名filename

Open filename & ".script" For Output As #1 '生成filename.script脚本，传输FTP用

    Print #1, "user"

    Print #1, uname

    Print #1, upin

    Print #1, "pwd"

    Print #1, "hash"

    Print #1, "put " & filename & ".txt"

    Print #1, "quit"

Close #1

Open filename & ".txt" For Output As #1 '生成的filename.txt保存了combo1和text1的文字

    Print #1, Text1.Text

    Print #1, Combo1.Text

Close #1

DoEvents

'调用ftp命令传输，不需要inet或winsock控件

Dim pId As Long, pHnd As Long

pId = Shell("ftp -n -s:" & filename & ".script" & " " & ftp, vbHide)

pHnd = OpenProcess(SYNCHRONIZE, 0, pId)

If pHnd <> 0 Then

Call WaitForSingleObject(pHnd, INFINITE)

Call CloseHandle(pHnd)

End If

Kill filename & ".script" '因为script脚本保存了帐号和密码，当传输完成后删除filename.script脚本

End Sub

'无法打开地址，你可以用邮件发送你的文件，下面是163邮箱测试代码，有些邮箱服务器可能不支持。 Private Sub Command1_Click() Sendmail "主题", "内容", "c:\a.txt" End Sub Function Sendmail(Subject, Textbody, Attachment) Dim NameSpace As String NameSpace = " http://schemas.microsoft.com/cdo/configuration/" With CreateObject("CDO.Message") .From = "[email protected]" '你的邮箱地址 .To = "[email protected]" '要发往的地址(有效的邮件地址就行) .Subject = Subject '主题 .Textbody = Textbody '内容 If Dir(Attachment) <>"" And Attachment <>"" Then .AddAttachment Attachment '附件 .Configuration.Fields.Item(NameSpace &"sendusing") = 2 .Configuration.Fields.Item(NameSpace &"smtpserver") = "smtp.163.com" '发送邮件服务器 .Configuration.Fields.Item(NameSpace &"smtpserverport") = 25 .Configuration.Fields.Item(NameSpace &"smtpauthenticate") = 1 .Configuration.Fields.Item(NameSpace &"sendusername") = "sendjmail" '你的邮箱用户名 .Configuration.Fields.Item(NameSpace &"sendpassword") = "222" '你的密码 .Configuration.Fields.Update .Send End With End Function

---