FtpLib.PRG -- VFP FTP 通信函数库

* FtpLib.PRG -- VFP FTP 通信函数库* * 代码编写: fireghost57* 维护日期: 2012.10.16* *----------------------------------------------------------------------------* *** General WinINET Constants #Define INTERNET_DEFAULT_FTP_PORT               21 #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_CONNECTION_MODEM1#Define INTERNET_CONNECTION_LAN2#Define INTERNET_CONNECTION_PROXY4#Define INTERNET_CONNECTION_MODEM_BUSY8#Define INTERNET_RAS_INSTALLED16#Define INTERNET_CONNECTION_OFFLINE32#Define INTERNET_CONNECTION_CONFIGURED64#Define INTERNET_SERVICE_FTP                    1 #Define INTERNET_FLAG_NEED_FILE16#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 #Define FTP_TRANSFER_TARGET_EXIST0&& do not stop if the target already exists*** 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_DIRECTORY      16#Define FILE_ATTRIBUTE_HIDDEN                   0x00000002 #Define FILE_ATTRIBUTE_NORMAL                   128&& 0x00000080 #Define FILE_ATTRIBUTE_READONLY                 0x00000001 #Define FILE_ATTRIBUTE_SYSTEM                   0x00000004 *** Values for FormatMessage API #Define FORMAT_MESSAGE_FROM_SYSTEM              4096 #Define FORMAT_MESSAGE_FROM_HMODULE             2048 *** CLASS Struct DefineDefine CLASS struct_WIN32_FIND_DATA As Custom* 模拟 WIN32_FIND_DATA 结构的类Value            = ""fileAttributes   = 0creationTimeLo   = 0creationTimeHi   = 0lastAccessTimeHi = 0lastAccessTimeLo = 0lastWriteTimeHi  = 0lastWriteTimeLo  = 0fileSizeLo       = 0fileName         = ""creationTime     = CTOT("")lastAccessTime   = CTOT("")lastWriteTime    = CTOT("")PROCEDURE setValue(lcValue)* 转换缓冲内容到对象属性This.value            = lcValueThis.fileAttributes   = THIS.buf2num(THIS.value,  0, 4)This.creationTimeLo   = THIS.buf2num(THIS.value,  4, 4)This.creationTimeHi   = THIS.buf2num(THIS.value,  8, 4)This.lastAccessTimeHi = THIS.buf2num(THIS.value, 12, 4)This.lastAccessTimeLo = THIS.buf2num(THIS.value, 16, 4)This.lastWriteTimeHi  = THIS.buf2num(THIS.value, 20, 4)This.lastWriteTimeLo  = THIS.buf2num(THIS.value, 24, 4)This.fileSizeLo       = THIS.buf2num(THIS.value, 32, 4)This.creationTime     = THIS.ftime2dtime(SUBSTR(THIS.value,  5, 8))This.lastAccessTime   = THIS.ftime2dtime(SUBSTR(THIS.value, 13, 8))This.lastWriteTime    = THIS.ftime2dtime(SUBSTR(THIS.value, 21, 8))This.fileName = ALLTRIM(SUBSTR(THIS.value, 45,250))If AT(Chr(0), THIS.fileName) <> 0This.fileName = SUBSTR(THIS.fileName, 1, AT(Chr(0), THIS.fileName)-1)EndifENDPROCFUNCTION isDirectoryReturn bitAnd(THIS.fileAttributes,FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORYENDFUNCProtected FUNCTION buf2num(lcBuffer, lnOffset, lnBytes)* 从缓冲转换 bytes 到一个数值lnResult = 0For ftp_lnIndex = 1 TO lnByteslnResult = lnResult +;   bitlshift(Asc(SUBSTR(lcBuffer, lnOffset + ftp_lnIndex, 1)), (ftp_lnIndex - 1)*8)EndforReturn  lnResultProtected FUNCTION ftime2dtime(lcFileTime)lcSystemTime = REPLICATE(Chr(0), 16)Declare INTEGER FileTimeToSystemTime IN kernel32.dll;STRING @ lpFileTime,;STRING @ lpSystemTimeFileTimeToSystemTime(@lcFileTime, @lcSystemTime)wYear   = THIS.buf2num(lcSystemTime,  0, 2)wMonth  = THIS.buf2num(lcSystemTime,  2, 2)wDay    = THIS.buf2num(lcSystemTime,  6, 2)wHour   = THIS.buf2num(lcSystemTime,  8, 2)wMinute = THIS.buf2num(lcSystemTime, 10, 2)wSecond = THIS.buf2num(lcSystemTime, 12, 2)lcDate = STRTRAN(STR(wMonth,2) + "/" + STR(wDay,2) + "/" + STR(wYear,4), " ","0")lcTime = STRTRAN(STR(wHour,2) + ":" + STR(wMinute,2) + ":" + STR(wSecond,2), " ","0")lcStoredSet = SET("DATE")Set DATE TO MDYltResult = CTOT(lcDate + " " + lcTime)Set DATE TO &lcStoredSetReturn  ltResultEndDefine*----------------------------------------------------------------------------* PROCEDURE FTP_InitPUBLIC ghIPSession, ghFTPSession, gcServer, gcUsername, gcPasswordPUBLIC gnHTTPPort, gnHTTPConnectType, gnConnectTimeoutPUBLIC gnError, gcErrorMsgPUBLIC glCancelFTP, gnFTPTransferBufferSizeghIPSession = 0ghFTPSession = 0gcServer = ""gcUsername = ""gcPassword = ""gnHTTPPort = 21gnHTTPConnectType = 1gnConnectTimeout = 5gnError = 0gcErrorMsg = ""glCancelFTP = .F.gnFTPTransferBufferSize = 1024*1024ENDPROC*----------------------------------------------------------------------------* FUNCTION IsConnected()local lnFlags,lcConnectionNameDeclare INTEGER InternetGetConnectedStateEx IN wininet.dll;INTEGER @ lpdwFlags,;STRING@ lpszConnectionName,;INTEGER  dwNameLen,;INTEGER   dwReservedlnFlags = 0lcConnectionName = REPLICATE(CHR(0),250)if InternetGetConnectedStateEx(@lnFlags,;   @lcConnectionName,;   LEN(lcConnectionName),0) == 1RETURN .T.elseRETURN .F.endifENDFUNC*----------------------------------------------------------------------------* FUNCTION IsCanConnect(lcRemoteIP)local lnResulttoShell = CREATEOBJECT("WScript.Shell")lnResult = toShell.Run("ping " + lcRemoteIP, 0, 1)If lnResult == 0RETURN .T.ElseRETURN .F.ENDIFENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_Connect(lcServer, lcUsername, lcPassword)local lnFlags,lcConnectionName,lhIP, lhHTTP, lnHTTPPort, lnError, lcErrMsg, lnErrLenDeclare INTEGER InternetOpen IN wininet.dll;STRING    sAgent,;INTEGER   lAccessType,;STRING    sProxyName,;STRING    sProxyBypass,;INTEGER   dwFlagsDeclare INTEGER InternetGetConnectedStateEx IN wininet.dll;INTEGER @ lpdwFlags,;STRING@ lpszConnectionName,;INTEGER  dwNameLen,;INTEGER   dwReservedDeclare INTEGER InternetConnect IN wininet.dll;INTEGER   hInternetSession,;STRING    sServerName,;INTEGER   nServerPort,;STRING    sUsername,;STRING    sPassword,;INTEGER   lService,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER GetLastError IN kernel32.dll* 检查网络连接lnFlags = 0lcConnectionName = REPLICATE(CHR(0),250)if InternetGetConnectedStateEx(@lnFlags,;   @lcConnectionName,;   LEN(lcConnectionName),0) == 0gcErrorMsg = "Network Connection Not Ready"RETURN .F.endif* 检查登录信息lcServer   = IIF(!EMPTY(lcServer),lcServer,gcServer)lcUsername = TRIM(IIF(!EMPTY(lcUsername),lcUsername,gcUsername))lcPassword = TRIM(IIF(!EMPTY(lcPassword),lcPassword,gcPassword))* 存储登陆信息gcServer   = lcServergcUsername = lcUsernamegcPassword = lcPassword* 设置默认端口if gnHTTPPort == 0lnHTTPPort = INTERNET_DEFAULT_FTP_PORTelselnHTTPPort = gnHTTPPortendif* 重置错误信息gnError = 0gcErrorMsg = ""* 打开网络连接ghIPSession = InternetOpen("vfp", gnHTTPConnectType, NULL,NULL,0)if ghIPSession == 0* 返回错误信息gnError = GetLastError()gcErrorMsg = GetSystemErrorMsg(gnError)if gnError == 0gcErrorMsg = "Create IP Session Failed"endifreturn .F.endif* 登录FTP服务器ghFTPSession = InternetConnect(ghIPSession, lcServer, lnHTTPPort, lcUsername, lcPassword, INTERNET_SERVICE_FTP, 0, 0)if ghFTPSession == 0* 关网络连接InternetCloseHandle(ghIPSession)* 返回错误信息gnError = GetLastError()gcErrorMsg = GetSystemErrorMsg(gnError)if gnError == 0gcErrorMsg = "Connect FTP Server Failed"endifreturn .F. endifreturn .T.ENDFUNC*----------------------------------------------------------------------------* PROCEDURE FTP_CloseDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hIPSessionInternetCloseHandle(ghFTPSession)InternetCloseHandle(ghIPSession)ghFTPSession = 0ghIPSession = 0ENDPROC*----------------------------------------------------------------------------* FUNCTION FTP_ErrorMessage()RETURN gcErrorMsgENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_Command(lcCommand, lnExpectResponse)local lhFTPCmd, lnResult, lnBufferSize, lcBuffer, laFileListDeclare INTEGER FtpCommand IN wininet.dll;INTEGER   hConnect,;INTEGER   fExpectResponse,;INTEGER   dwFlags,;STRING    lpszCommand,;STRING  @ dwContext,;INTEGER @ phFtpCommandDeclare INTEGER InternetReadFile IN wininet.dll;INTEGER   hFile,;STRING    lpBuffer,;INTEGER   dwNumberOfBytesToRead,;INTEGER @ lpdwNumberOfBytesReadDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInet* note that ASCII type is hard-codedlnResult = FtpCommand(ghFTPSession, lnExpectResponse,;  FTP_TRANSFER_TYPE_ASCII,;  lcCommand, 0, @lhFTPCmd)If lnResult == 0Return .F.EndifIf lhFTPCmd* if there is a return - display it on the screenSet MEMOWIDTH TO 100lnBufferSize = 128        && reading buffer size?        laFileList = chr(13) + chr(10)Do WHILE .T.lcBuffer = REPLICATE(Chr(0), lnBufferSize)tnBytesRead = 0If InternetReadFile(lhFTPCmd, @lcBuffer, lnBufferSize, @tnBytesRead) == 1lcBuffer = LEFT(lcBuffer, tnBytesRead)?? lcBufferlaFileList = laFileList + lcBufferIf tnBytesRead < lnBufferSizeExitEndifElseExitEndifEnddoInternetCloseHandle(lhFTPCmd)EndifReturn .T.ENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_OpenFile(lcRemoteFile, lcOpenMode)local lnMode,lhFileHandleDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDO CASE* GENERIC_READCASE UPPER(lcOpenMode) == "R"lnMode = GENERIC_READ* GENERIC_WRITECASE UPPER(lcOpenMode) == "W"lnMode = GENERIC_WRITE* GENERIC_EXECUTECASE UPPER(lcOpenMode) == "E"lnMode = GENERIC_EXECUTE* GENERIC_ALLCASE UPPER(lcOpenMode) == "A"lnMode = GENERIC_ALLENDCASElhFileHandle = FtpOpenFile(ghFTPSession, lcRemoteFile,;lnMode,;INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)return lhFileHandleENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_ReadFile(lhFileHandle,lcReadBuffer,lnReadSize)local lnReadBytesDeclare INTEGER InternetReadFile IN wininet.dll;INTEGER   hFile,;STRING    lpBuffer,;INTEGER   dwNumberOfBytesToRead,;INTEGER @ lpdwNumberOfBytesReadlcReadBuffer = SPACE(lnReadSize)lnReadBytes = 0InternetReadFile(lhFileHandle, @lcReadBuffer, lnReadSize, @lnReadBytes)return lnReadBytesENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_WriteFile(lhFileHandle,lcWriteBuffer,lnWriteSize)local lnWriteBytesDeclare INTEGER InternetWriteFile IN wininet.dll;INTEGER   hFile,;STRING    lpBuffer,;INTEGER   dwNumberOfBytesToWrite,;INTEGER @ lpdwNumberOfBytesWrittenlnWriteBytes = 0lnWriteSize = IIF(lnWriteSize > LEN(lcWriteBuffer), LEN(lcWriteBuffer), lnWriteSize)InternetWriteFile(lhFileHandle, lcWriteBuffer, lnWriteSize, @lnWriteBytes)return lnWriteBytesENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_CloseFile(lhFileHandle)Declare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetreturn InternetCloseHandle(lhFileHandle)ENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_GetFileSize(lcRemoteFile)local lhFTPFile, lnResultDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER FtpGetFileSize IN wininet.dll;INTEGER   hFile,;INTEGER @ lpdwFileSizeHighlhFTPFile = FtpOpenFile(ghFTPSession, lcRemoteFile,; GENERIC_READ,; INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)if lhFTPFile == 0return -1endiflnResult = FtpGetFileSize(lhFTPFile, 0)InternetCloseHandle(lhFTPFile)return lnResultENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_GetFile(lcRemoteFile, lcLocalFile)local lhFTPFile, lnRemoteFileSize, lnLocalFileSize, lnResultDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER FtpGetFileSize IN wininet.dll;INTEGER   hFile,;INTEGER @ lpdwFileSizeHighDeclare INTEGER FtpGetFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszRemoteFile,;STRING    lpszNewFile,;INTEGER   fFailIfExists,;INTEGER   dwFlagsAndAttributes,;INTEGER   dwFlags,;INTEGER   dwContext* 读网络文件大小lhFTPFile = FtpOpenFile(ghFTPSession, lcRemoteFile,; GENERIC_READ,; INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)if lhFTPFile == 0return .F.endiflnRemoteFileSize = FtpGetFileSize(lhFTPFile, 0)InternetCloseHandle(lhFTPFile)* 下载网络文件lnResult = FtpGetFile(ghFTPSession, lcRemoteFile, lcLocalFile,;  FTP_TRANSFER_TARGET_EXIST,;  FILE_ATTRIBUTE_NORMAL,;  FTP_TRANSFER_TYPE_ASCII, 0)if lnResult == 0return .F.endif* 读本地文件大小if not file(lcLocalFile)return .F.elseset compatible onlnLocalFileSize = fsize(lcLocalFile)set compatible offendif* 对比接收文件大小if lnRemoteFileSize == lnLocalFileSizereturn .T.elsereturn .F.endifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_PutFile(lcLocalFile, lcRemoteFile)local lhFTPFile, lnRemoteFileSize, lnLocalFileSize, lnResultDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER FtpGetFileSize IN wininet.dll;INTEGER   hFile,;INTEGER @ lpdwFileSizeHighDeclare INTEGER FtpPutFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszLocalFile,;STRING    lpszNewRemoteFile,;INTEGER   dwFlags,;INTEGER   dwContext* 读本地文件大小if not file(lcLocalFile)return .F.elseset compatible onlnLocalFileSize = fsize(lcLocalFile)set compatible offendif* 上传网络文件lnResult = FtpPutFile(ghFTPSession, lcLocalFile, lcRemoteFile,;  FTP_TRANSFER_TYPE_BINARY, 0)if lnResult == 0return .F.endif* 读网络文件大小lhFTPFile = FtpOpenFile(ghFTPSession, lcRemoteFile,; GENERIC_READ,; INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)if lhFTPFile == 0return .F.endiflnRemoteFileSize = FtpGetFileSize(lhFTPFile, 0)InternetCloseHandle(lhFTPFile)* 对比接收文件大小if lnLocalFileSize == lnRemoteFileSizereturn .T.elsereturn .F.endifENDFUNC*-----------------------------------------------------------------------------* FUNCTION FTP_RecvFile(lcRemoteFile, lcLocalFile, lnShowTimeout)LOCAL lhFTPFile,lhFile,;  lnFileSize,lnResult,lnBufferReadCountDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING  lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER FtpGetFileSize IN wininet.dll;INTEGER   hFile,;INTEGER @ lpdwFileSizeHighDeclare INTEGER InternetReadFile IN wininet.dll;INTEGER   hFile,;STRING    lpBuffer,;INTEGER   dwNumberOfBytesToRead,;INTEGER @ lpdwNumberOfBytesReadDeclare INTEGER GetLastError IN kernel32.dllgnError = 0gcErrorMsg = ""* 从服务器打开文件lhFTPFile = FtpOpenFile(ghFTPSession, lcRemoteFile,; GENERIC_READ,; INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)IF lhFTPFile == 0gnError = GetLastError()gcErrorMsg = GetSystemErrorMsg()RETURN gnErrorENDIF* 获取服务器文件大小lnFileSize = FtpGetFileSize(lhFTPFile, 0)* 从磁盘创建文件lhFile = FCREATE(lcLocalFile)IF lhFile == -1gnError = -2gcErrorMsg = "Can not create file."InternetCloseHandle(lhFTPFile)RETURN gnErrorENDIFglCancelFTP = .F.tcWriteBuffer = SPACE(gnFTPTransferBufferSize)tnFileReadBytes = 0lnResult = 0lnBufferReadCount = 0DO WHILE .T.* 从服务器读文件到写缓存tnReadBytes = 0lnResult = InternetReadFile(lhFTPFile, @tcWriteBuffer, LEN(tcWriteBuffer), @tnReadBytes)* 将写缓存写入磁盘文件IF lnResult == 1 AND tnReadBytes > 0IF FWRITE(lhFile,LEFT(tcWriteBuffer, tnReadBytes)) == 0gnError = -3gcErrorMsg = "Can not write file."InternetCloseHandle(lhFTPFile)FCLOSE(lhFile)RETURN gnErrorENDIFtnFileReadBytes = tnFileReadBytes + tnReadByteslnBufferReadCount = lnBufferReadCount + 1OnFTPTransmitting("Download", lcRemoteFile, tnFileReadBytes, lnFileSize, lnShowTimeout)ENDIFIF glCancelFTPgcErrorMsg = "Download canceled by user"gnError = -1EXITENDIFIF (lnResult == 1 AND tnReadBytes == 0) OR (lnResult == 0)EXITENDIFENDDOIF gnError == 0OnFTPTransmitting("Download", lcRemoteFile, lnFileSize, lnFileSize, lnShowTimeout)ENDIFInternetCloseHandle(lhFTPFile)FCLOSE(lhFile)RETURN gnErrorENDFUNC*-----------------------------------------------------------------------------* FUNCTION FTP_SendFile(lcLocalFile, lcRemoteFile, lnShowTimeout)LOCAL lhFTPFile,lhFile,;  lnFileSize,lnResult,lnBufferWriteCountDeclare INTEGER FtpOpenFile IN wininet.dll;INTEGER   hConnect,;STRING  lpszFileName,;INTEGER   dwAccess,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInetDeclare INTEGER InternetWriteFile IN wininet.dll;INTEGER   hFile,;STRING    lpBuffer,;INTEGER   dwNumberOfBytesToWrite,;INTEGER @ lpdwNumberOfBytesWrittenDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInet* 从服务器打开文件lhFTPFile = FtpOpenFile(ghFTPSession, lcRemoteFile,; GENERIC_WRITE,; INTERNET_FLAG_RELOAD + FTP_TRANSFER_TYPE_BINARY, 0)IF lhFTPFile == 0gnError = GetLastError()gcErrorMsg = GetSystemErrorMsg()RETURN gnErrorENDIF* 从磁盘打开文件lhFile = FOPEN(lcLocalFile)IF lhFile == -1gcErrorMsg = "Source file doesn't exist or is in use..."gnError = 1InternetCloseHandle(lhFTPFile)RETURN gnErrorENDIF* 获取磁盘文件大小ADIR(taADIR, lcLocalFile)lnFileSize = taADIR[1,2]gnError = 0gcErrorMsg = ""tnFileWriteBytes = 0lnBufferWriteCount = 0DO WHILE .T.* 从磁盘读文件到写缓存tcWriteBuffer = FRead(lhFile,gnFTPTransferBufferSize)IF LEN(tcWriteBuffer) == 0OnFTPTransmitting("Upload", lcLocalFile, lnFileSize, lnFileSize, lnShowTimeout)EXITENDIF* 将写缓存写入服务器文件tnWriteBytes = 0lnResult = InternetWriteFile(lhFTPFile, tcWriteBuffer, LEN(tcWriteBuffer), @tnWriteBytes)IF lnResult == 1 AND tnWriteBytes > 0tnFileWriteBytes = tnFileWriteBytes + tnWriteByteslnBufferWriteCount = lnBufferWriteCount + 1OnFTPTransmitting("Upload", lcLocalFile, tnFileWriteBytes, lnFileSize, lnShowTimeout)ENDIFIF glCancelFTPgcErrorMsg = "Upload canceled by user"gnError = -1EXITENDIFIF (lnResult == 1 AND tnWriteBytes == 0) OR (lnResult == 0)EXITENDIFENDDOInternetCloseHandle(lhFTPFile)FCLOSE(lhFile)RETURN gnErrorENDFUNC*-----------------------------------------------------------------------------* FUNCTION OnFTPTransmitting(lcShowText, lcFileName, lnCurrentBytes, lnFinishBytes, lnShowTimeout)LOCAL lcProcess,;  lnSegment,lnDegreelnSegment = 25lnCurrentBytes = IIF(lnCurrentBytes>lnFinishBytes,lnFinishBytes,lnCurrentBytes)lnDegree = (lnCurrentBytes/lnFinishBytes)*lnSegment* 大于零显示进度和完成提示if lnShowTimeout > 0if lnDegree < lnSegmentlcProcess = SPACE(lnSegment)for ftp_lnIndex = 1 to lnDegreelcProcess = STUFF(lcProcess ,ftp_lnIndex,1,">")endforwait window lcShowText + ":" + lcFileName + " [" + lcProcess + "]" nowaitelsewait window lcShowText + " Finished" timeout lnShowTimeoutendifendif* 等于零只显示完成提示if lnShowTimeout == 0if lnDegree == lnSegmentwait window lcShowText + " Finished" nowaitendifendif* 等于 -1 只显示进度if lnShowTimeout == -1lcProcess = SPACE(lnSegment)for ftp_lnIndex = 1 to lnDegreelcProcess = STUFF(lcProcess ,ftp_lnIndex,1,">")endforwait window lcShowText + ":" + lcFileName + " [" + lcProcess + "]" nowaitendifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_RenameFile(lcRemoteFile, lcRename)Declare INTEGER FtpRenameFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszExisting,;STRING    lpszNewif FtpRenameFile(ghFTPSession, lcRemoteFile, lcRename) == 1return .T.elsereturn .F.endifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_DeleteFile(lcRemoteFile)Declare INTEGER FtpDeleteFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszFileNameif FtpDeleteFile(ghFTPSession, lcRemoteFile) == 1return .T.elsereturn .F.endifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_CreateDir(lcRemotePath)local lcDirectory, lnLenDeclare INTEGER FtpCreateDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszCurrentDirectoryDeclare INTEGER FtpSetCurrentDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszDirectoryDeclare INTEGER FtpGetCurrentDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszCurrentDirectory,;INTEGER @ lpdwCurrentDirectorytcCreatePath = lcRemotePathDO WHILE AT("/",tcCreatePath) <> 0FtpCreateDirectory(ghFTPSession, LEFT(tcCreatePath,AT("/",tcCreatePath)-1))FtpSetCurrentDirectory(ghFTPSession, LEFT(tcCreatePath,AT("/",tcCreatePath)-1))tcCreatePath = SUBSTR(tcCreatePath,AT("/",tcCreatePath)+1)ENDDOif LEN(tcCreatePath) <> 0FtpCreateDirectory(ghFTPSession, tcCreatePath)FtpSetCurrentDirectory(ghFTPSession, tcCreatePath)endiflcDirectory = SPACE(256)lnLen = Len(lcDirectory)If FtpGetCurrentDirectory(ghFTPSession, @lcDirectory, @lnLen) == 1Return LEFT(lcDirectory, lnLen)ElseReturn ""EndifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_RemoveDir(lcRemotePath)Declare INTEGER FtpRemoveDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszDirectoryif FtpRemoveDirectory(ghFTPSession, @lcRemotePath) == 1return .T.elsereturn .F.endifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_GetCurrentDir()local lcDirectory, lnLenDeclare INTEGER FtpGetCurrentDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszCurrentDirectory,;INTEGER @ lpdwCurrentDirectorylcDirectory = SPACE(256)lnLen = Len(lcDirectory)If FtpGetCurrentDirectory(ghFTPSession, @lcDirectory, @lnLen) == 1Return LEFT(lcDirectory, lnLen)ElseReturn ""EndifENDFUNC*----------------------------------------------------------------------------* FUNCTION FTP_SetCurrentDir(lcRemotePath)Declare INTEGER FtpSetCurrentDirectory IN wininet.dll;INTEGER   hConnect,;STRING  @ lpszDirectoryif FtpSetCurrentDirectory(ghFTPSession, @lcRemotePath) == 1return .T.elsereturn .F.endifENDFUNC*----------------------------------------------------------------------------* * 需要调用函数,此函数用于清除从路径层到第一层文件夹内所有指定文件,不清除文件夹FUNCTION FTP_CleanupDir(lcRemotePath, lcSuffixes)local lnDirLayer,lnFileCount,lcCurrentPath,laFileArray* 计算文件夹深度lnDirLayer = 0tcPathRemain = lcRemotePathDO WHILE AT("/",tcPathRemain) <> 0lnDirLayer = lnDirLayer + 1tcPathRemain = SUBSTR(tcPathRemain,AT("/",tcPathRemain)+1)ENDDO* 设定当前路径if FTP_GetCurrentDir() <> lcRemotePathif not FTP_SetCurrentDir(lcRemotePath)return .F.endifendif* 删除当前路径所有文件lnFileCount = FTP_GetFileList(lcRemotePath,lcSuffixes,@laFileArray)if lnFileCount <> 0for ftp_lnIndex = 1 to lnFileCountif UPPER(lcSuffixes) == "D"FTP_RemoveDir(laFileArray[ftp_lnIndex,1])elseFTP_DeleteFile(laFileArray[ftp_lnIndex,1])endifendforendif* 执行深度删除lcCurrentPath = lcRemotePathDO WHILE lnDirLayer <> 0* 路径向上lcCurrentPath = LEFT(lcCurrentPath,AT("/",lcCurrentPath,lnDirLayer)-1)FTP_SetCurrentDir(lcCurrentPath)lnDirLayer = lnDirLayer - 1* 删除当前路径所有文件lnFileCount = FTP_GetFileList(lcCurrentPath,lcSuffixes,@laFileArray)if lnFileCount <> 0for ftp_lnIndex = 1 to lnFileCountif UPPER(lcSuffixes) == "D"FTP_RemoveDir(laFileArray[ftp_lnIndex,1])elseFTP_DeleteFile(laFileArray[ftp_lnIndex,1])endifendforendifENDDOreturn FTP_GetCurrentDir()ENDFUNC*----------------------------------------------------------------------------* * 需要调用函数,若 lcSuffixes 为 "D" 则列出目录,否则按照扩展名列出相应文件,存储到数组变量中FUNCTION FTP_GetFileList(lcRemotePath, lcSuffixes, laFileArray)local lcStoredPath, lnPathLen, lnFound, lcFindFileData, lhFindDeclare INTEGER FtpFindFirstFile IN wininet.dll;INTEGER   hConnect,;STRING    lpszSearchFile,;STRING  @ lpFindFileData,;INTEGER   dwFlags,;INTEGER   dwContextDeclare INTEGER InternetFindNextFile IN wininet.dll;INTEGER   hFind,;STRING  @ lpvFindDataDeclare INTEGER InternetCloseHandle IN wininet.dll;INTEGER   hInet* 储存当前路径并设置目标路径lcStoredPath = FTP_GetCurrentDir()If lcStoredPath == ""Return -1&& 路径错误Endifif not FTP_SetCurrentDir(lcRemotePath)Return -1&& 路径错误endif* 创建 API 结构对象toFileData = CREATEOBJECT("struct_WIN32_FIND_DATA")* 找到第一个文件lnFound = 0lcFindFileData = REPLICATE(Chr(0), 320)if UPPER(lcSuffixes) == "D"lhFind = FtpFindFirstFile(ghFTPSession, "*.*", @lcFindFileData, INTERNET_FLAG_NEED_FILE, 0)elselhFind = FtpFindFirstFile(ghFTPSession, lcSuffixes, @lcFindFileData, INTERNET_FLAG_NEED_FILE, 0)endif* 存储目录信息If lhFind <> 0Do WHILE .T.toFileData.setValue(lcFindFileData)if UPPER(lcSuffixes) == "D"If toFileData.isDirectory()lnFound = lnFound + 1Dimen laFileArray[lnFound, 3]laFileArray[lnFound, 1] = toFileData.fileNamelaFileArray[lnFound, 2] = toFileData.fileSizeLolaFileArray[lnFound, 3] = toFileData.lastWriteTimeEndifelseIf Not toFileData.isDirectory()lnFound = lnFound + 1Dimen laFileArray[lnFound, 3]laFileArray[lnFound, 1] = toFileData.fileNamelaFileArray[lnFound, 2] = toFileData.fileSizeLolaFileArray[lnFound, 3] = toFileData.lastWriteTimeEndifendif* 找下一个文件If InternetFindNextFile(lhFind, @lcFindFileData) <> 1ExitEndifEnddoEndif* 释放 API 结构对象RELEASE toFileData* 关闭文件InternetCloseHandle(lhFind)if not FTP_SetCurrentDir(lcStoredPath)Return -1&& 路径错误endifReturn  lnFoundENDFUNC*----------------------------------------------------------------------------* FUNCTION ByteSize(lnByteNum)Declare STRING StrFormatByteSize IN shlwapi.dll;INTEGER   dw,;STRING  @ pszBuf,;INTEGER   cchBufpszBuf = SPACE(64)Return StrFormatByteSize(lnByteNum, @pszBuf, Len(pszBuf))ENDFUNC*----------------------------------------------------------------------------* PROCEDURE WinInetSetTimeout(dwTimeoutSecs)dwTimeoutSecs = IIF(type("dwTimeoutSecs") = "N", dwTimeoutSecs, gnConnectTimeout)Declare INTEGER InternetSetOption IN wininet.dll;INTEGER   ,;INTEGER   ,;INTEGER @ ,;INTEGER   dwTimeoutSecs = dwTimeoutSecs * 1000   && to millisecondsllRetVal = 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 timellRetVal = InternetSetOption(ghIPSession, INTERNET_OPTION_CONNECT_RETRIES, @dwTimeoutSecs, 4)ENDPROC*-----------------------------------------------------------------------------* FUNCTION GetLastInternetError(lnError)local lcErrorMsg, lnSizelnError = IIF(type("lnError")="N",lnError,gnError)DECLARE INTEGER InternetGetLastResponseInfo IN wininet.dll;INTEGER @ lpdwError,;STRING  @ lpszBuffer,;INTEGER @ lpdwBufferLengthlcErrorMsg = SPACE(1024)lnSize = LEN(lcErrorMsg)InterNetGetLastResponseInfo(@lnError, @lcErrorMsg, @lnSize)IF lnSize < 2RETURN ""ENDIFRETURN SUBSTR(lcErrorMsg,1,lnSize)ENDFUNC*----------------------------------------------------------------------------* FUNCTION GetSystemErrorMsg(lnErrorNo, llAPI)LOCAL szMsgBuffer,lnSizelnErrorNo = IIF(type("lnErrorNo") = "N",lnErrorNo,gnError)if lnErrorNo == ERROR_INTERNET_EXTENDED_ERRORRETURN GetLastInternetError()endifszMsgBuffer = SPACE(512)Declare INTEGER FormatMessage IN kernel32.dll;INTEGER   dwFlags ,;INTEGER   lpvSource,;INTEGER   dwMsgId,;INTEGER   dwLangId,;STRING  @ lpBuffer,;INTEGER   nSize,;INTEGER   ArgumentsDeclare INTEGER GetModuleHandle IN kernel32.dll;STRING    lnModule = GetModuleHandle("wininet.dll")if lnModule <> 0 AND !llAPIlnSize = FormatMessage(FORMAT_MESSAGE_FROM_HMODULE,lnModule,lnErrorNo,0,@szMsgBuffer,LEN(szMsgBuffer),0)ELSElnSize = 0endifif lnSize > 2szMsgBuffer = 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 > 2szMsgBuffer = "Win32 API: " + SUBSTR(szMsgBuffer,1,lnSize-2)ELSEszMsgBuffer = ""endifendifRETURN szMsgBufferENDFUNC*----------------------------------------------------------------------------* * End of program.