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

来源:百度知道 编辑:互助问答吧 时间:2021/12/08 05:17:31
VB中如何实现上传文件的功能,主要是要实现如用CommonDialog1.ShowOpen后得到的文件上传(复制)到程序运行的目录下的指定目录中(如app.path\content\).

用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

Dim InPutFile As String
Dim OutPutFile As String

Private Sub cmdChoose_Click()
CommonDialog1.ShowOpen
InPutFile = CommonDialog1.FileName
txtFileLoad.Text = InPutFile
End Sub

Private Sub cmdExit_Click()
End
End Sub

Private Sub cmdUpload_Click()
If InPutFile = "" Then
MsgBox "Choose a File first!"
Exit Sub
End If
OutPutFile = GetNameFromFilePath(InPutFile)
FileCopy InPutFile, App.Path & "\" & OutPutFile & ""
MsgBox "The File has already uploaded!"
End Sub

Private Sub Form_Load()
InPutFile = ""
txtFileLoad.Text = "Choose The File"
cmdChoose.Caption = "Choose"
cmdUpload.Caption = "Upload"
cmdExit.Caption = "Exit"

txtFileLoad.Enabled = False
End Sub

Public Function GetNameFromFilePath(ByVal strFullPath As String, Optional ByVal strSplitor As String = "\") As String
Dim thePath As String

thePath = Left$(strFullPath, InStrRev(strFullPath, strSplitor, , vbTextCompare))
GetNameFromFilePath = Mid(InPutFile, Len(thePath) + 1, Len(InPutFile))
End Function
====================
我这个程序只能算是复制文件,复制的文件放在程序目录下

因为我也在找这个问题,所以和你一同在等.还请别生气.