求：vfp中使用internet transfer control控件实现的ftp上传程序。100不够再加100

[locateangel]

那位前辈能提供vfp中使用internet transfer control控件实现的ftp上传程序？

[philozz]

**************************************************
*-- Class: ftp1 (d:\program files\microsoft visual studio\vfp98\test\test.vcx)
*-- ParentClass: form
*-- BaseClass: form
*-- 时间戳: 10/30/02 04:33:12 PM
*
DEFINE CLASS ftp1 AS form


Top = 18
Left = 31
Height = 251
Width = 433
DoCreate = .T.
Caption = "Form1"
Name = "Form1"


ADD OBJECT olecontrol1 AS olecontrol WITH ;
Top = 192, ;
Left = 36, ;
Height = 37, ;
Width = 37, ;
Name = "Olecontrol1"


ADD OBJECT command1 AS commandbutton WITH ;
Top = 143, ;
Left = 36, ;
Height = 37, ;
Width = 85, ;
Caption = "OPENURL", ;
Name = "COMMAND1"


ADD OBJECT command2 AS commandbutton WITH ;
Top = 143, ;
Left = 131, ;
Height = 37, ;
Width = 85, ;
Caption = "SENDFILE", ;
Name = "Command2"


ADD OBJECT command3 AS commandbutton WITH ;
Top = 142, ;
Left = 227, ;
Height = 37, ;
Width = 85, ;
Caption = "DOWNLOAD", ;
Name = "Command3"


ADD OBJECT command4 AS commandbutton WITH ;
Top = 143, ;
Left = 323, ;
Height = 37, ;
Width = 85, ;
Caption = "QUIT", ;
Name = "Command4"


ADD OBJECT text1 AS textbox WITH ;
Value = "ftp://ftp.microsoft.com", ;
Height = 25, ;
Left = 132, ;
Top = 24, ;
Width = 241, ;
Name = "Text1"


ADD OBJECT text2 AS textbox WITH ;
Value = "README.TXT", ;
Height = 25, ;
Left = 132, ;
Top = 60, ;
Width = 241, ;
Name = "Text2"


ADD OBJECT text3 AS textbox WITH ;
Value = "sqlnet.log", ;
Height = 25, ;
Left = 132, ;
Top = 96, ;
Width = 241, ;
Name = "Text3"


ADD OBJECT label1 AS label WITH ;
FontSize = 12, ;
Caption = "ftp地址：", ;
Height = 23, ;
Left = 44, ;
Top = 26, ;
Width = 71, ;
Name = "Label1"


ADD OBJECT label3 AS label WITH ;
FontSize = 12, ;
Caption = "上传文件：", ;
Height = 23, ;
Left = 48, ;
Top = 96, ;
Width = 71, ;
Name = "Label3"


ADD OBJECT label2 AS label WITH ;
FontSize = 12, ;
Caption = "下载文件：", ;
Height = 23, ;
Left = 48, ;
Top = 62, ;
Width = 71, ;
Name = "Label2"


PROCEDURE Init
PUBLIC lConnected
lConnected =.f.

&& =SYS(2333,0) &&VFP6.0不需要这一句
APPLICATION.AutoYield=.F. &&一定要加这一句,否则DO WHILE循环时会是死循环

THISFORM.TEXT1.VALUE="ftp://localhost"
THISFORM.TEXT2.VALUE="INDEX1.HTM"
THISFORM.TEXT3.VALUE="index0.htm"
ENDPROC


PROCEDURE olecontrol1.StateChanged
*** ActiveX 控件事件 ***
LPARAMETERS state
DO CASE
CASE state=0
wait wind nowait "0_未报告状态icHostResolvingHost"
CASE state=1
wait wind nowait "1_控件正在寻找指定主机的IP地址icHostResolved"
CASE state=2
wait wind nowait "2_控件已成功找到指定主机的IP地址icConnecting"
CASE state=3
wait wind nowait "3_控件正在与指定主机进行连接icConnected"
CASE state=4
wait wind nowait "4_控件已成功与指定主机连接icRequesting"
CASE state=5
wait wind nowait "5_控件正在向主机发出请求icRequestSent"
CASE state=6
wait wind nowait "6_控件已成功向主机发出请求icReceivingResponse"
CASE state=7
wait wind nowait "7_控件正在从主机接收反馈信息icResponseReceived"
CASE state=8
wait wind nowait "8_控件已成功从主机接受反馈信息icDisconnecting"
CASE state=9
wait wind nowait "9_控件正在与主机断开icDisconnected"
CASE state=10
wait wind nowait "10_控件已与主机断开icError"
LCANCEL=.T.
CASE state=11
wait wind nowait "11_在与主机通信的过程中发生了错误icResponseComp leted"
CASE state=12
wait wind nowait "12_请求结束且数据已经接收到"
OTHERWISE
wait wind nowait "??_未知状态"
ENDCASE
ENDPROC


PROCEDURE command1.Click
local m_urlname
M_urlname=thisform.text1.value

thisform.olecontrol1.url=M_URLNAME
thisform.olecontrol1.username="anonymous"
thisform.olecontrol1.password="anonymous"
THISFORM.olecontrol1.requesttimeout=30
THISFORM.olecontrol1.Protocol=2 &&-icFTP
THISFORM.olecontrol1.RemotePort=21
ENDPROC


PROCEDURE command2.Click
local M_urlname,M_FILENAME,m_sendcommand,m_return
M_urlname=thisform.text1.value
M_FILENAME=thisform.text2.value
M_SENDCOMMAND="put "+M_FILENAME+" "+M_FILENAME

lConnected=.F. &&每条EXECUTE方法之前加上此句
m_return=thisform.olecontrol1.EXECUTE(,M_SENDCOMMAND)
DO WHILE !lConnected
lConnected = THISFORM.OLECONTROL1.StillExecuting
DOEVENTS
ENDDO
ENDPROC


PROCEDURE command3.Click
local M_urlname,M_FILENAME,m_downcommand,m_return
M_urlname=thisform.text1.value
M_FILENAME=thisform.text3.value
m_downcommand="GET "+m_FILENAME+" C:\TEMPtest\README.TXT"

lConnected=.F. &&每条EXECUTE方法之前加上此句
m_return=THISFORM.OLECONTROL1.EXECUTE(M_URLNAME,M_DOWNCOMMAND)
DO WHILE !lConnected
lConnected = THISFORM.OLECONTROL1.StillExecuting
DOEVENTS
ENDDO
ENDPROC


PROCEDURE command4.Click
local urlname
urlname=alltrim(thisform.text1.value)

DO WHILE !lConnected
lConnected = THISFORM.OLECONTROL1.StillExecuting
DOEVENTS
ENDDO

PUBL LCANCEL
LCANCEL=.F.
THISFORM.OLECONTROL1.EXECUTE(urlname,"CLOSE")
DO WHILE !LCANCEL
DOEVENTS
ENDDO

thisform.release
ENDPROC


ENDDEFINE
*
*-- EndDefine: ftp1
**************************************************

[xiefred]

请问在哪儿可找到 internet transfer control控件

[locateangel]

多谢啦，测试通过一定给分。

[philozz]

运行环境 vfp6(sp4) + nt40(sp6)