|
发信人: goodfrd(supervisor) 整理人: foxzz(2002-10-19 10:39:13), 站内信件 |
| * 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. ---- 欢迎光临良友程序库:http://0d0a.126.com http://f12.my163.com,免费提供我的各种Source Code  兄弟我抛出几块砖，有玉的赶紧亮出来啊！ |
|
[关闭][返回] |