呵呵这么麻烦？
用tms WebCopy 几条语句搞定 简单的很
下在后用vclzip or winrar.dll 解压缩.
还有一个 vfp api ftp up and down with progress 例子：
VFP FTP上传/下载/删除文件通用函数/过程
* FP_FTP.PRG --- VFP FTP 通用函数、过程
*
* Modification History:
* 2000.12.01 M.L.Y Program Created, V1.0
*
*-----------------------------------------------------------------------------*
*** General WinINET Constants
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE INTERNET_OPTION_CONNECT_TIMEOUT 2
#DEFINE INTERNET_OPTION_CONNECT_RETRIES 3
#DEFINE INTERNET_OPTION_DATA_SEND_TIMEOUT 7
#DEFINE INTERNET_OPTION_DATA_RECEIVE_TIMEOUT 8
#DEFINE INTERNET_OPTION_LISTEN_TIMEOUT 11
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE INTERNET_DEFAULT_FTP_PORT 21
#DEFINE ERROR_INTERNET_EXTENDED_ERROR 12003
*** FTP WinInet Service Flags
#DEFINE INTERNET_FLAG_RELOAD 2147483648
#DEFINE INTERNET_FLAG_SECURE 8388608
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2
*** Win32 API Constants
#DEFINE ERROR_SUCCESS 0
*** Access Flags
#DEFINE GENERIC_READ 0x80000000
#DEFINE GENERIC_WRITE 0x40000000
#DEFINE GENERIC_EXECUTE 0x20000000
#DEFINE GENERIC_ALL 0x10000000
*** File Attribute Flags
#DEFINE FILE_ATTRIBUTE_NORMAL 0x00000080
#DEFINE FILE_ATTRIBUTE_READONLY 0x00000001
#DEFINE FILE_ATTRIBUTE_HIDDEN 0x00000002
#DEFINE FILE_ATTRIBUTE_SYSTEM 0x00000004
*** values for FormatMessage API
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 4096
#DEFINE FORMAT_MESSAGE_FROM_HMODULE 2048
*-----------------------------------------------------------------------------*
PROCEDURE FTP_Init
PUBLIC ghIPSession, ghFTPSession, gcServer, gcUsername, gcPassword
PUBLIC gnHTTPPort, gnHTTPConnectType, gnConnectTimeout
PUBLIC gnError, gcErrorMsg, glCancelFTP, gnFTPWorkBufferSize
ghIPSession = 0
ghFTPSession = 0
gcServer = ""
gcUsername = ""
gcPassword = ""
gnHTTPPort = 21
gnHTTPConnectType = 1
gnConnectTimeout = 5
gnError = 0
gcErrorMsg = ""
glCancelFTP = .F.
gnFTPWorkBufferSize = 4096
RETURN
*-----------------------------------------------------------------------------*
FUNCTION FTP_Close
DECLARE INTEGER InternetCloseHandle ;
IN WININET.DLL ;
INTEGER hIPSession
=InternetCloseHandle(ghFTPSession)
=InternetCloseHandle(ghIPSession)
ghFTPSession=0
ghIPSession=0
RETURN
*-----------------------------------------------------------------------------*
FUNCTION FTP_Connect
LPARAMETER lcServer, lcUsername, lcPassword
LOCAL lhIP, lhHTTP, lnError, lnHTTPPort
lcServer=IIF(!EMPTY(lcServer),lcServer,gcServer)
lcUsername=TRIM(IIF(!EMPTY(lcUsername),lcUsername,gcUsername))
lcPassword=TRIM(IIF(!EMPTY(lcPassword),lcPassword,gcPassword))
*** Assign Default Ports
IF gnHTTPPort = 0
lnHTTPPort = INTERNET_DEFAULT_FTP_PORT
ELSE
lnHTTPPort = gnHTTPPort
ENDIF
gcServer = lcServer
gnError=0
gcErrorMsg=""
DECLARE INTEGER InternetCloseHandle ;
IN WinInet.DLL ;
INTEGER
*!* DECLARE INTEGER GetLastError;
*!* IN WIN32API
DECLARE INTEGER GetLastError;
IN KERNEL32.DLL
DECLARE INTEGER InternetOpen ;
IN WININET.DLL ;
STRING,;
INTEGER,;
STRING, STRING, INTEGER
hInetConnection=;
InternetOpen("West Wind Web Connection 3.00",;
gnHTTPConnectType,;
NULL,NULL,0)
IF hInetConnection = 0
gnError=GetLastError()
gcErrorMsg=GetSystemErrorMsg(gnError)
RETURN gnError
ENDIF
ghIPSession=hInetConnection
= WinInetSetTimeout()
DECLARE INTEGER InternetConnect ;
IN WININET.DLL ;
INTEGER hIPHandle,;
STRING lpzServer,;
INTEGER dwPort, ;
STRING lpzUserName,;
STRING lpzPassword,;
INTEGER dwServiceFlags,;
INTEGER dwReserved,;
INTEGER dwReserved
lhFTPSession=;
InternetConnect(hInetConnection,;
lcServer,;
lnHTTPPort,;
lcUsername,;
lcPassword,;
INTERNET_SERVICE_FTP,;
0,0)
IF (lhFTPSession = 0)
lnError = 0
lcErrMsg = SPACE(256)
lnErrLen = LEN(lcErrMsg)
DECLARE INTEGER InternetGetLastResponseInfo ;
IN WININET.DLL ;
INTEGER @dwError,;
STRING @szBuffer,;
INTEGER @dwBufferLength
lnResult = InternetGetLastResponseInfo(@lnError,@lcErrMsg,@lnErrLen)
=InternetCloseHandle(hInetConnection)
gnError = GetLastError()
IF gnError = 0
gcErrorMsg = lcErrMsg
gnError = 1
ELSE
gcErrorMsg = GetSystemErrorMsg()
ENDIF
RETURN gnError
ENDIF
ghIPSession = hInetConnection
ghFTPSession = lhFTPSession
RETURN 0
*-----------------------------------------------------------------------------*
FUNCTION FTP_DeleteFile
LPARAMETERS lcfile
DECLARE INTEGER FtpDeleteFile ;
IN WinInet.dll ;
INTEGER hFTPSession,;
STRING cFileName
IF FtpDeleteFile(ghFTPSession,lcFile) = 0
gnError = GetLastError()
gcErrorMsg = GetSystemErrorMsg()
RETURN gnError
ENDIF
RETURN 0
*-----------------------------------------------------------------------------*
FUNCTION FTP_GetFile
LPARAMETERS lcFTPServer, lcSource, lcTarget, lnBinary, lcUsername, lcPassword
lnBinary=IIF(EMPTY(lnBinary),FTP_TRANSFER_TYPE_BINARY,lnBinary)
lnResult = FTP_Connect(lcFTPServer,lcUserName,lcPassWord)
IF lnResult # 0
RETURN lnResult
ENDIF
DECLARE Integer FtpGetFile ;
IN WinInet.dll ;
Integer dwIPSession,;
String cSource,;
String cTarget, ;
Integer bNoOverwrite,;
INTEGER nAttributes, ;
Integer nFlags, ;
Integer nContext
lnResult = FtpGetFile(ghFTPSession,lcSource,;
lcTarget,0,FILE_ATTRIBUTE_NORMAL,;
lnBinary + INTERNET_FLAG_RELOAD,0)
IF lnResult = 0
gnError = GetLastError()
gcErrorMsg = GetSystemErrorMsg()
= FTP_Close()
RETURN gnError
ENDIF
= FTP_Close()
RETURN 0
*-----------------------------------------------------------------------------*
FUNCTION FTP_GetFileEx
LPARAMETER lcSourceFile, lcTargetFile
DECLARE INTEGER FtpOpenFile ;
IN WININET.DLL ;
INTEGER hIPSession,;
STRING @lpszFileName,;
INTEGER dwAcessFlags,;
INTEGER dwServiceFlags,;
INTEGER dwContext
DECLARE INTEGER InternetReadFile ;
IN WININET.DLL ;
INTEGER hFTPHandle,;
STRING lcBuffer,;
INTEGER cbBuffer,;
INTEGER @cbBuffer
hFTPFile = FtpOpenFile(ghFTPSession,lcSourceFile,;
GENERIC_READ,;
INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY,0)
IF hFTPFile = 0
gnError = GetLastError()
gcErrorMsg = GetSystemErrorMsg()
RETURN gnError
ENDIF
gnError = 0
gcErrorMsg = ""
*** Build the buffer dynamically
glCancelFTP = .F.
tcBuffer = ""
tnSize = 0
tnBufferSize = 0
lnRetVal = 0
lnBytesRead = 1
lnBufferReads = 0
DO WHILE .t.
lcReadBuffer = SPACE(gnFTPWorkBufferSize)
lnBytesRead = 0
lnSize = LEN(lcReadBuffer)
lnRetval=InternetReadFile(hFTPFile,;
@lcReadBuffer,;
lnSize,;
@lnBytesRead)
IF lnRetVal = 1 AND lnBytesRead > 0
*** Update the input parameters - result buffer and size of buffer
tcBuffer = tcBuffer + LEFT(lcReadBuffer, lnBytesRead)
tnBufferSize = tnBufferSize + lnBytesRead
lnBufferReads = lnBufferReads + 1
= OnFTPBufferUpdate("Download",tnBufferSize,lnBufferReads, ;
@lcReadBuffer)
ENDIF
IF glCancelFTP
tcBuffer = "Error: Download canceled"
tnBufferSize = LEN(tcBuffer)
gcErrorMsg = "Download canceled by user"
gnError = -1
EXIT
ENDIF
IF (lnRetVal = 1 AND lnBytesRead = 0) OR (lnRetVal = 0)
EXIT
ENDIF
ENDDO
lnBufferSize = tnBufferSize
IF gnError = 0
= OnFTPBufferUpdate("Download",0,-1,"")
ENDIF
*** Write out the file to disk
lnHandle=FCREATE(lcTargetFile)
IF lnHandle=-1
gnError = -2
gcErrorMsg = "Can not create file."
RETURN gnError
ENDIF
lnRetVal=FWRITE(lnHandle,tcBuffer)
*IF lnRetVal=0
* gnError = -3
* gcErrorMsg = "Can not write file."
* = FCLOSE(lnHandle)
* RETURN gnError
*ENDIF
IF !FCLOSE(lnHandle)
gnError = -4
gcErrorMsg = "Can not close file."
RETURN gnError
ENDIF
RETURN gnError
*-----------------------------------------------------------------------------*
FUNCTION FTP_SendFileEx
LPARAMETER lcSourceFile, lcTargetFile
LOCAL lhFile, lnRetVal, lnBytesRead, lnBufferReads, lcWriteBuffer, hFTPFile
DECLARE INTEGER FtpOpenFile ;
IN WININET.DLL ;
INTEGER hIPSession,;
STRING @lpszFileName,;
INTEGER dwAcessFlags,;
INTEGER dwServiceFlags,;
INTEGER dwContext
DECLARE INTEGER InternetWriteFile ;
IN WININET.DLL ;
INTEGER hFTPHandle,;
STRING lcBuffer,;
INTEGER cbBuffer,;
INTEGER @cbBuffer
hFTPFile = FtpOpenFile(ghFTPSession,lcTargetFile,;
GENERIC_WRITE,;
INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY,0)
IF hFTPFile = 0
gnError = GetLastError()
gcErrorMsg = GetSystemErrorMsg()
RETURN gnError
ENDIF
*** Read the file from disk
lhFile = FOPEN(lcSourceFile)
IF lhFile = -1
gcErrorMsg = "Source file doesn't exist or is in use..."
gnError = 1
RETURN gnError
ENDIF
gnError = 0
gcErrorMsg = ""
tnBufferSize = 0
lnBufferReads = 0
DO WHILE .T.
*** Read one chunk at a time
lcWriteBuffer = FRead(lhFile,gnFTPWorkBufferSize)
IF LEN(lcWriteBuffer) = 0
= OnFTPBufferUpdate("Upload",0,-1,"")
EXIT
ENDIF
*** And write out each chunk
lnSize=LEN(lcWriteBuffer)
lnBytesRead = 0
lnRetval=InternetWriteFile(hFTPFile,;
lcWriteBuffer,;
lnSize,;
@lnBytesRead)
IF lnRetVal = 1 AND lnBytesRead > 0
*** Update the input parameters - result buffer and size of buffer
tnBufferSize = tnBufferSize + lnBytesRead
lnBufferReads = lnBufferReads + 1
= OnFTPBufferUpdate("Upload", tnBufferSize,lnBufferReads,"")
ENDIF
IF glCancelFTP
gcErrorMsg = "Upload canceled by user"
gnError = -1
EXIT
ENDIF
IF (lnRetVal = 1 AND lnBytesRead = 0) OR (lnRetVal = 0)
EXIT
ENDIF
ENDDO
= FCLOSE(lhFile)
= InternetCloseHandle(ghFTPSession)
RETURN gnError
*-----------------------------------------------------------------------------*
FUNCTION OnFTPBufferUpdate
LPARAMETERS lcUpDownLoad, lnBytesXfered,lnBufferReads,lcCurrentChunk
DO CASE
CASE lnBufferReads > 0
wait window lcUpDownLoad + "ed: " + STR(lnBytesXfered)+ ;
" bytes (Alt-X to cancel)" nowait
CASE lnBufferReads = -1
wait window "FTP transfer finished..." timeout 2
ENDCASE
RETURN
*-----------------------------------------------------------------------------*
FUNCTION GetLastInternetError
LPARAMETERS lnError
lnError=IIF(type("lnError")="N",lnError,gnError)
DECLARE INTEGER InternetGetLastResponseInfo ;
IN WININET.DLL ;
INTEGER @lpdwError,;
STRING @lpszBuffer,;
INTEGER @lpcbSize
lcErrorMsg=SPACE(1024)
lnSize=LEN(lcErrorMsg)
=InterNetGetLastResponseInfo(@lnError,@lcErrorMsg,@lnSize)
IF lnSize < 2
RETURN ""
ENDIF
RETURN SUBSTR(lcErrorMsg,1,lnSize)
*-----------------------------------------------------------------------------*
FUNCTION GetSystemErrorMsg
LPARAMETERS lnErrorNo, llAPI
LOCAL szMsgBuffer,lnSize
lnErrorNo=IIF(type("lnErrorNo")="N",lnErrorNo,gnError)
IF lnErrorNo = ERROR_INTERNET_EXTENDED_ERROR
RETURN GetLastInternetError()
ENDIF
szMsgBuffer=SPACE(500)
*!* DECLARE INTEGER FormatMessage ;
*!* IN WIN32API ;
DECLARE INTEGER FormatMessage ;
IN KERNEL32.DLL ;
INTEGER dwFlags ,;
INTEGER lpvSource,;
INTEGER dwMsgId,;
INTEGER dwLangId,;
STRING @lpBuffer,;
INTEGER nSize,;
INTEGER Arguments
*!* DECLARE INTEGER GetModuleHandle ;
*!* IN WIN32API ;
*!* STRING
DECLARE INTEGER GetModuleHandle ;
IN KERNEL32.DLL ;
STRING
lnModule=GetModuleHandle("wininet.dll")
IF lnModule # 0 AND !llAPI
lnSize=FormatMessage(FORMAT_MESSAGE_FROM_HMODULE,lnModule,lnErrorNo,;
0,@szMsgBuffer,LEN(szMsgBuffer),0)
ELSE
lnSize=0
ENDIF
IF lnSize > 2
szMsgBuffer=SUBSTR(szMsgBuffer,1, lnSize -2 )
ELSE
*** REtry with 12000 less - WinInet return Windows API file error codes
lnSize=FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,0,lnErrorNo,;
0,@szMsgBuffer,LEN(szMsgBuffer),0)
IF lnSize > 2
szMsgBuffer="Win32 API: " + SUBSTR(szMsgBuffer,1, lnSize-2 )
ELSE
szMsgBuffer=""
ENDIF
ENDIF
RETURN szMsgBuffer
*-----------------------------------------------------------------------------*
PROCEDURE WinInetSetTimeout
LPARAMETERS dwTimeoutSecs
dwTimeoutSecs=IIF(type("dwTimeoutSecs")="N",;
dwTimeoutSecs,gnConnectTimeout)
DECLARE INTEGER InternetSetOption ;
IN WININET.DLL ;
INTEGER,;
INTEGER,;
INTEGER @,;
INTEGER
dwTimeoutSecs=dwTimeoutSecs * 1000 && to milliseconds
llRetVal=InternetSetOption(ghIPSession,;
INTERNET_OPTION_CONNECT_TIMEOUT,;
@dwTimeoutSecs,4)
llRetVal=InternetSetOption(ghIPSession,;
INTERNET_OPTION_DATA_RECEIVE_TIMEOUT,;
@dwTimeOutSecs,4)
llRetVal=InternetSetOption(ghIPSession,;
INTERNET_OPTION_DATA_SEND_TIMEOUT,;
@dwTimeOutSecs,4)
dwTimeoutSecs=1 &&// Retry only 1 time
llRetVal=InternetSetOption(ghIPSession,;
INTERNET_OPTION_CONNECT_RETRIES,;
@dwTimeoutSecs,4)
RETURN
*** End of program.
[此贴子已经被作者于2003-3-19 15:00:02编辑过]
----------------------------------------------
[IIImg]http://www.myf1.net/bbs/UploadFile/2003329993791761.gif[/img]
---------------------------------------------------------------------------------
---demo--
* VFP5FTP.PRG --- FTP get/put file for VFP 5.0
* M.L.Y 2000.12
SET TALK OFF
SET ESCAPE OFF
SET CONFIRM ON
SET SYSMENU TO
SET SYSMENU AUTOMATIC
*** General WinINET Constants
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE INTERNET_OPTION_CONNECT_TIMEOUT 2
#DEFINE INTERNET_OPTION_CONNECT_RETRIES 3
#DEFINE INTERNET_OPTION_DATA_SEND_TIMEOUT 7
#DEFINE INTERNET_OPTION_DATA_RECEIVE_TIMEOUT 8
#DEFINE INTERNET_OPTION_LISTEN_TIMEOUT 11
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE INTERNET_DEFAULT_FTP_PORT 21
#DEFINE ERROR_INTERNET_EXTENDED_ERROR 12003
*** FTP WinInet Service Flags
#DEFINE INTERNET_FLAG_RELOAD 2147483648
#DEFINE INTERNET_FLAG_SECURE 8388608
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2
*** Win32 API Constants
#DEFINE ERROR_SUCCESS 0
*** Access Flags
#DEFINE GENERIC_READ 0x80000000
#DEFINE GENERIC_WRITE 0x40000000
#DEFINE GENERIC_EXECUTE 0x20000000
#DEFINE GENERIC_ALL 0x10000000
*** File Attribute Flags
#DEFINE FILE_ATTRIBUTE_NORMAL 0x00000080
#DEFINE FILE_ATTRIBUTE_READONLY 0x00000001
#DEFINE FILE_ATTRIBUTE_HIDDEN 0x00000002
#DEFINE FILE_ATTRIBUTE_SYSTEM 0x00000004
*** values for FormatMessage API
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM 4096
#DEFINE FORMAT_MESSAGE_FROM_HMODULE 2048
g_hIPSession = 0
g_hFTPSession = 0
g_cServer = ""
g_cUsername = ""
g_cPassword = ""
g_nHTTPPort = 21
g_nHTTPConnectType = 1
g_nConnectTimeout = 5
g_nError = 0
g_cErrorMsg = ""
g_lCancelFTP = .F.
g_nFTPWorkBufferSize = 4096
_SCREEN.WINDOWSTATE = 2
_SCREEN.Caption = "使用VFP5.0实现FTP"
CLEAR
cFTP_Server = SPACE(60)
cUsername = SPACE(30)
cPassword = SPACE(30)
cGetPut = "GET"
cRemoteFile = SPACE(80)
cLocalFile = SPACE(80)
DO WHILE .T.
DO WHILE .T.
@ 1, 2 SAY "使用VFP5.0实现FTP M.L.Y 2000.12"
@ 3, 2 SAY "FTP服务器名或 IP" GET cFTP_Server
@ 5, 2 SAY "用户名" GET cUsername
@ 7, 2 SAY "密码" GET cPassword
@ 9, 2 SAY "GET还是PUT" GET cGetPut
@ 11, 2 SAY "服务器文件名(完整路径)" GET cRemoteFile
@ 13, 2 SAY "本地文件名(完整路径)" GET cLocalFile
READ
RC = MESSAGEBOX("上述输入正确与否(取消则退出程序)？",3+32,"?")
IF RC = 6
IF UPPER(cGetPut) <> "GET" AND UPPER(cGetPut) <> "PUT"
LOOP
ENDIF
EXIT
ENDIF
IF RC = 2
RETURN
ENDIF
ENDDO
gcFTP_Server = ALLTRIM(cFTP_Server)
gcUsername = ALLTRIM(cUsername)
gcPassword = ALLTRIM(cPassword)
gcGetPut = ALLTRIM(cGetPut)
gcRemoteFile = ALLTRIM(cRemoteFile)
gcLocalFile = ALLTRIM(cLocalFile)
wait window nowait "Alt-x to abort download/upload..."
ON KEY LABEL ALT-X g_lCancelFTP = .T.
IF FTP_Connect(gcFTP_Server, gcUsername, gcPassword) # 0
=MESSAGEBOX("Error
"+STR(g_nError)+") "+g_cErrorMsg)
= FTP_Close()
*RETURN
LOOP
ENDIF
IF UPPER(gcGetPut) = "GET"
RC = Ftp_GetFileEx(gcRemoteFile,gcLocalFile)
ELSE
RC = FTP_SendFileEx(gcLocalFile,gcRemoteFile)
ENDIF
IF RC # 0
=MESSAGEBOX("Error
"+STR(g_nError)+") "+g_cErrorMsg)
= FTP_Close()
*RETURN
LOOP
ENDIF
= FTP_Close()
ON KEY LABEL ALT-X
ENDDO
RETURN
----------------------------------------------
[IIImg]http://www.myf1.net/bbs/UploadFile/2003329993791761.gif[/img]
