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

在VB中实现文件上传

VisualBasic作为一个集应用程序开发、测试、查错功能于一体的集成式开发环境,越来越受到程序员的青睐。笔者在开发某数据库维护系统的过程中,选择了VB5.0作为开发平台,Unix作为服务器端 *** 作系统,Informix作为服务器数据库。

问题的出现

在开发该维护系统的过程中,注意到Informix数据库的字段类型CLOB填入数据时需要函数FILETOCLOB("FILENAME","SERVER"),其中的"FILENAME"需要指出文件路径和文件名称。然而,在维护过程中此文件是在客户端执行的,这样就要求即时将文件传输到服务器端。

解决办法

1.FTP传输工具

我们首先使用FTP传输工具,用VB5.0中SHELL命令调用DOS批处理文件来实现传输的需要。

Shell调用格式:

Shell(pathname[,windowstyle])

例子:Shell("c:\windows\upload.bat")

批处理文件upload.bat的内容:

c:\windows\ftphostname

username

password

sendc:\zrh\upload.txtupload.txt

bye

该命令实现了文件"upload.txt"的传输要求。在使用完毕之后,再调用命令把该文件删除。

例子:Shell("c:\windows\del_up.bat")

批处理文件del_up.bat的内容:

c:\windows\ftphostname

username

password

deleupload.txt

bye

这样,文件"upload.txt"被删除。

但是,另一个问题出现了。由于Shell函数的运行机制是与其它程序同步执行,也就是说,当调用Shell函数的子程序还没有执行完毕之前,Shell函数后面的语句已经执行。在大批量添加数据的过程中,就会出现某个记录的文件还没有传到,而下一个插入语句(Insert)已经开始调用。这样,ODBC调用就会出现错误。

2.INET控件

InternetTransfer控件提供了Internet上最常使用的两种协议:HTTP和FTP。使用HTTP协议可以连接到WWW服务器上来下载文件使用FTP协议则可以登录到FTP服务器。一般的FTP命令,例如CD、GET都可以通过Execute方法实现。

下面是一个设置INET控件属性的例子。

inet1.URL=ftp://username:password@hostname/document

inet1.Protocol=2-icFTP

inet1.RemoteHost=hostname

inet1.RemotePort=21

inet1.Username=username

inet1.Password=password

执行文件传输:

Inet1.Execute"ftp://username:password@hostname",_

"PUT"&local_filename&"UPLOAD1.TXT"

right1=Inet1.StillExecuting

DoWhileright1

right1=Inet1.StillExecuting

DoEvents

Loop

这样便实现了文件的上载。

*SINET控件的优点

INET控件与Shell()函数的不同之处在于INET控件通过调用语句

right1=Inet1.StillExecuting

DoWhileright1

right1=Inet1.StillExecuting

DoEvents

Loop来控制语句执行的顺序。在文件传输工作未完成之前,程序不会执行其它语句,自然也就不会出现调用Shell函数所出现的问题。变量right1用来测试inet1的执行状态,如果进程中仍在进行文件传输的工作,则调用过程DoEvents给系统空闲时间来做文件传输工作,这样便成功地执行了文件上载的功能。该文件使用完毕之后将被删除。

Inet1.Execute"ftp://informix:informix@rd",_

"DELETEUPLOAD1.TXT"

right1=Inet1.StillExecuting

DoWhileright1

right1=Inet1.StillExecuting

DoEvents

Loop

将上载的文件删除是为了避免占用服务器端磁盘空间。

*S利用StateChanged事件提示信息

服务器在执行inet1.execute的同时也激活了Inet1_StateChanged事件,进程可以根据捕获到的状态进行动作。

object_StateChanged(ByValStateAsInteger)

State:整数类型Integer

下面是状态的说明。

常数值 描述icNone

0 未报告状态icHostResolvingHost

1 控件正在寻找指定主机的IP地址icHostResolved

2 控件已成功找到指定主机的IP地址icConnecting

3 控件正在与指定主机进行连接icConnected

4 控件已成功与指定主机连接icRequesting

5 控件正在向主机发出请求icRequestSent

6 控件已成功向主机发出请求icReceivingResponse

7 控件正在从主机接收反馈信息icResponseReceived

8 控件已成功从主机接受反馈信息icDisconnecting

9 控件正在与主机断开icDisconnected

10 控件已与主机断开icError

11 在与主机通信的过程中发生了错误icResponseCompleted

12 请求结束且数据已经接收到

下面是一个例子。

PrivateSubInet1_StateChanged(ByValStateAsInteger)

'RetrieveserverresponseusingtheGetChunk

'methodwhenState=12.Thisexampleassumesthe

'dataistext.

SelectCaseState

'...Othercasesnotshown.

CaseicResponseReceived'12

DimvtDataAsVariant'Datavariable.

DimstrDataAsString:strData=""

DimbDoneAsBoolean:bDone=False

'Getfirstchunk.

vtData=Inet1.GetChunk(1024,icString)

DoWhileNotbDone

strData=Data&vtData

'Getnextchunk.

vtData=Inet1.GetChunk(1024,icString)

IfLen(vtData)=0Then

bDone=True

EndIf

Loop

txtData.Text=strData

EndSelect

EndSub->

---