File "PB_FTP.INC"
Path: /zrok launcher/inc/PB_FTP.INC
File size: 28.94 KB
MIME-type: text/plain
Charset: utf-8
'
' pb_ftp.bas
'
' 32-bit PowerBasic ftp routines
' Copyright 1999-2001
' Don Dickinson
' ddickinson@usinternet.com
'
'
' The following are needed by, but not $included in this module:
' win32api.inc Power Basic's Win API declaraions
'
' The following are need by and $included within
' wsconst.inc WinSock Constants
' ftp_cons.inc FTP Constants and error message routines
' ftp_help.bas FTP helper routines
'
' =======================================
' Routines available in this module
' =======================================
' Function ftpChangeDir (ByVal hSocket As Long, sDir As String) As Long
' Function ftpConnect (sServer As String, sUser As String, sPW As String) As Long
' Function ftpDeleteFile (ByVal hSocket As Long, remoteFile As String) As Long
' Function ftpCurDir (ByVal hSocket As Long) As String
' Function ftpGetDirList (ByVal hSocket As Long, sServer As String, sDirs() As String) As Long
' Function ftpGetFile (ByVal hSocket As Long, ByVal hStatus As Long, sServer As String, _
' remoteFile As String, localFile As String) As Long
' Function ftpGetFileToMemory(ByVal hSocket As Long, ByVal hStatus As Long, sServer As String, _
' remoteFile As String, fileData As String) As Long
' Function ftpGetFileList (ByVal hSocket As Long, sServer As String, sFiles() As String) As Long
' Function ftpGetList (ByVal hSocket As Long, sServer As String, sList() As String) As Long
' Function ftpMakeDir (ByVal hSocket as Long, sDir as String) as Long
' Function ftpPutFile (ByVal hSocket As Long, ByVal hStatus As Long, _
' remoteFile As String, localFile As String) As Long
' Sub ftpQuit (ByVal hSocket As Long)
' Function ftpMoveOrRename (ByVal hSocket as Long, oldFile as String, newFile as String) as Long
' Sub ftpSetAscii (ByVal hSocket As Long)
' Sub ftpSetBinary (ByVal hSocket As Long)
'
' Function ftpGetLastStatusCode as Long
' Function ftpGetLastStatusMsg as String
' Function ftpTranslateErrorCode (ByVal errorCode As Long) As String
'
' =======================================
' How the library works - Important Notes
' =======================================
'
' > Call ftpConnect first - this connects to the server. It returns
' a valid socket handle if successful - Pass this handle to all the
' other calls. If it fails it returns %INVALID_SOCKET
'
' > Call any other commands you wish to.
'
' > Most functions return %True if successful or %False if not.
' If you need more detail about why the call failed, you can
' use ftpGetLastStatusCode to return the last status code
' returned from the ftp server (or a dos error code if one occurred)
' The text error message can be retrieved by calling ftpGetLastStatusMsg
'
' > When you're done, call ftpQuit to clean up.
'
' > You should never need to call ftpSetBinary or ftpSetAscii
' as all file operations are done in binary mode. The module calls
' ftpSetBinary as needed. These will likely not be exported from
' the final DLL version of this library.
'
'==============================================================================
'=============================================================================
' Required Include Files
'==============================================================================
$INCLUDE "inc\wsconst.inc"
$INCLUDE "inc\ftp_cons.inc"
$INCLUDE "inc\ftp_help.inc"
GLOBAL g_pbFTPReturn AS STRING
'=============================================================================
' ftpParseFileName
' This function doesn't do any communications, it simply
' returns the file name from the formatted line as return
' by the ftp LIST command. NOT EXPORTED
'==============================================================================
FUNCTION ftpParseFileName(BYVAL incoming AS STRING) AS STRING
DIM i AS LONG
DIM iFields AS LONG
DIM sAccum AS STRING
IF (incoming = ".") OR (incoming = "..") THEN
FUNCTION = incoming
EXIT FUNCTION
END IF
FOR i = 15 TO 1 STEP -1
REPLACE SPACE$(i) WITH " " IN incoming
NEXT i
iFields = PARSECOUNT(incoming, CHR$(32))
IF iFields < 9 THEN
FUNCTION = ""
ELSE
sAccum = ""
FOR i = 9 TO iFields
sAccum = sAccum + PARSE$(incoming, CHR$(32), i) + " "
NEXT i
FUNCTION = RTRIM$(sAccum)
END IF
END FUNCTION
'=============================================================================
' ftpGetLastStatusCode
' Returns the FTP status code for the last command sent
' These correspond to the %FTP_ constants in ftp_cons.inc
'==============================================================================
FUNCTION ftpGetLastStatusCode ALIAS "ftpGetLastStatusCode" EXPORT AS LONG
FUNCTION = gLastErr
END FUNCTION
'=============================================================================
' ftpGetLastStatusMsg
' Returns the text message returned by the ftp server
' during the last communication.
'==============================================================================
FUNCTION ftpGetLastStatusMsg ALIAS "ftpGetLastStatusMsg" EXPORT AS STRING
FUNCTION = gLastMsg
END FUNCTION
'=============================================================================
' ftpDeleteFile
' Deletes the file specified from the current working directory of the server
'==============================================================================
FUNCTION ftpDeleteFile ALIAS "ftpDeleteFile" _
(BYVAL hSocket AS LONG, BYVAL remoteFile AS STRING) Export AS LONG
DIM buffer AS STRING
TCP PRINT hSocket, "DELE " + remoteFile
TCP LINE hSocket, buffer
set_last_status buffer
IF buffer_status(buffer) = %FTP_ACTION_COMPLETED THEN
FUNCTION = %True
ELSE
FUNCTION = %False
END IF
END FUNCTION
'=============================================================================
' ftpMakeDir
' Creates a directory.
'==============================================================================
FUNCTION ftpMakeDir ALIAS "ftpMakeDir" (BYVAL hSocket AS LONG, BYVAL sDir AS STRING) EXPORT AS LONG
DIM buffer AS STRING
TCP PRINT hSocket, "MKD " + sDir
TCP LINE hSocket, buffer
set_last_status buffer
IF buffer_status(buffer) = %FTP_DIRECTORY_OK THEN
FUNCTION = %True
ELSE
FUNCTION = %False
END IF
END FUNCTION
'=============================================================================
' ftpRemoveDir
' Deletes a directory
'==============================================================================
FUNCTION ftpRemoveDir ALIAS "ftpRemoveDir" (BYVAL hSocket AS LONG, BYVAL sDir AS STRING) EXPORT AS LONG
DIM buffer AS STRING
TCP PRINT hSocket, "RMD " + sDir
TCP LINE hSocket, buffer
set_last_status buffer
IF buffer_status(buffer) = %FTP_ACTION_COMPLETED THEN
FUNCTION = %True
ELSE
FUNCTION = %False
END IF
END FUNCTION
'=============================================================================
' ftpMoveOrRename
' Renames or moves a file
'==============================================================================
FUNCTION ftpMoveOrRename ALIAS "ftpMoveOrRename" (BYVAL hSocket AS LONG, _
BYVAL oldFile AS STRING, BYVAL newFile AS STRING) Export AS LONG
DIM buffer AS STRING
'- Rename From
TCP PRINT hSocket, "RNFR " + oldFile
TCP LINE hSocket, buffer
IF buffer_status(buffer) = %FTP_ACTION_PENDING THEN
'- Rename To
TCP PRINT hSocket, "RNTO " + newFile
TCP LINE hSocket, buffer
IF buffer_status(buffer) = %FTP_ACTION_COMPLETED THEN
FUNCTION = %True
ELSE
FUNCTION = %False
END IF
ELSE
FUNCTION = %False
END IF
set_last_status buffer
END FUNCTION
'=============================================================================
' ftpSetAscii
' turns on ascii transfer mode
'==============================================================================
SUB ftpSetAscii ALIAS "ftpSetAscii" (BYVAL hSocket AS LONG) EXPORT
DIM buffer AS STRING
TCP PRINT hSocket, "TYPE A"
TCP LINE hSocket, buffer
set_last_status buffer
END SUB
'=============================================================================
' ftpSetBinary
' turns on binary transfer mode
'==============================================================================
SUB ftpSetBinary ALIAS "ftpSetBinary" (BYVAL hSocket AS LONG) EXPORT
DIM buffer AS STRING
TCP PRINT hSocket, "TYPE I"
TCP LINE hSocket, buffer
set_last_status buffer
END SUB
'=============================================================================
' ftpCurDir
' returns the current working directory on the server
' returns "" if an error occurs
'==============================================================================
FUNCTION ftpCurDir ALIAS "ftpCurDir" (BYVAL hSocket AS LONG) EXPORT AS STRING
DIM buffer AS STRING
TCP PRINT hSocket, "PWD"
TCP LINE hSocket, buffer
set_last_status buffer
IF buffer_status(buffer) = 257 THEN
FUNCTION = PARSE$(buffer, CHR$(34), 2)
ELSE
FUNCTION = ""
END IF
END FUNCTION
'=============================================================================
' ftpChangeDir
' Returns %True if it can change the directory
' Returns %False if not.
'==============================================================================
FUNCTION ftpChangeDir ALIAS "ftpChangeDir" (BYVAL hSocket AS LONG, _
BYVAL sDir AS STRING) Export AS LONG
DIM buffer AS STRING
TCP PRINT hSocket, "CWD " + TRIM$(sDir)
TCP LINE hSocket, buffer
set_last_status buffer
IF buffer_status(buffer) = 250 THEN
FUNCTION = %True
ELSE
FUNCTION = %False
END IF
END FUNCTION
'==============================================================================
' ftpGetFileToMemory
' Retrieves the file's contents and puts it in the string "incomingData"
'==============================================================================
FUNCTION ftpGetFileToMemory ALIAS "ftpGetFileToMemory" _
( BYVAL hSocket AS LONG, _
BYVAL hStatus AS LONG, BYVAL sServer AS STRING, _
BYVAL remoteFile AS STRING, incomingData AS STRING) Export AS LONG
DIM hData AS LONG
DIM iProgress AS LONG
DIM iTotal AS LONG
DIM zText AS ASCIIZ * 200
DIM buffer AS STRING
incomingData = ""
'- Make sure that we are doing a binary transfer
ftpSetBinary hSocket
'- Open a passive-mode connection to the server.
hData = get_passive_handle(hSocket, sServer)
IF hData = %INVALID_SOCKET THEN
buffer = FORMAT$(gLastErr, "000") + " " + gLastMsg
FUNCTION = %False
ELSE
'- Request the file
TCP PRINT hSocket, "RETR " + remoteFile
TCP LINE hSocket, buffer
'If buffer_status(buffer) <> 150 Then
IF buffer_status(buffer) > 299 THEN
FUNCTION = %False
ELSE
'- The total bytes to retrieve is inside
' of parenthesis in the returned buffer.
'
iTotal = INT(VAL(PARSE$(buffer, ANY "()", 2)))
iProgress = 0
'- Read in blocks until we have the whole file.
DO
IF read_data_block(hData, buffer) < 1 THEN EXIT DO
incomingData = incomingData + buffer
iProgress = iProgress + LEN(buffer)
zText = FORMAT$(iProgress) + " of " + FORMAT$(iTotal)
'- Progress is passed back via a window-handle
IF hStatus <> 0 THEN
SetWindowText hStatus, zText
END IF
LOOP
TCP LINE hSocket, buffer
FUNCTION = %True
END IF
CLOSE hData
END IF
set_last_status buffer
END FUNCTION
'=============================================================================
' ftpGetFile
' Opens a binary mode connection and downloads the requested file.
' Returns %True if successful and %False if not.
' If hStatus is non-zero it is assumed to be a windows handle. As the
' status of the download changes the caption of this window is changed to
' be the percent complete of the transfer. If the file already exists then
' it will be erased and replaced by the downloaded file.
' Note that this function ALWAYS operates in passive mode - that is, it will
' always connect to the server's data socket, it doesn't create it's own.
'==============================================================================
FUNCTION ftpGetFile ALIAS "ftpGetFile" (BYVAL hSocket AS LONG, _
BYVAL hStatus AS LONG, BYVAL sServer AS STRING, _
BYVAL remoteFile AS STRING, BYVAL localFile AS STRING) Export AS LONG
DIM hData AS LONG
DIM iFF AS LONG
DIM iProgress AS LONG
DIM iTotal AS LONG
DIM zText AS ASCIIZ * 200
DIM buffer AS STRING
ON ERROR RESUME NEXT
iFF = FREEFILE
KILL localFile
ERRCLEAR
IF DIR$(localFile) <> "" THEN
buffer = FORMAT$(ERR, "000") + " Local File Can't be deleted"
FUNCTION = %False
EXIT FUNCTION
END IF
ON ERROR RESUME NEXT
OPEN localFile FOR BINARY LOCK READ WRITE AS #iFF
IF ERR THEN
buffer = FORMAT$(ERR, "000") + " Local File Open Error"
FUNCTION = %False
EXIT FUNCTION
END IF
'- Make sure that we are doing a binary transfer
ftpSetBinary hSocket
'- Open a passive-mode connection to the server.
hData = get_passive_handle(hSocket, sServer)
IF hData = %INVALID_SOCKET THEN
buffer = FORMAT$(gLastErr, "000") + " " + gLastMsg
FUNCTION = %False
ELSE
'- Request the file
TCP PRINT hSocket, "RETR " + remoteFile
TCP LINE hSocket, buffer
IF buffer_status(buffer) > 299 THEN
FUNCTION = %False
ELSE
'- The total bytes to retrieve is inside
' of parenthesis in the returned buffer.
'
iTotal = INT(VAL(PARSE$(buffer, ANY "()", 2)))
iProgress = 0
'- Read in blocks until we have the whole file.
DO
IF read_data_block(hData, buffer) < 1 THEN EXIT DO
PUT #iFF,, buffer
iProgress = iProgress + LEN(buffer)
zText = FORMAT$(iProgress) + " of " + FORMAT$(iTotal)
'- Progress is passed back via a window-handle
IF hStatus <> 0 THEN
SetWindowText hStatus, zText
END IF
LOOP
TCP LINE hSocket, buffer
FUNCTION = %True
END IF
CLOSE hData
END IF
CLOSE #iFF
set_last_status buffer
END FUNCTION
'=============================================================================
' ftpPutFile
' Opens a binary mode connection and uploads the specified file to the
' current working directory on the server.
' It returns %True on success or %False on failure.
' hStatus is assumed to be a status window handle if non-zero. As the status
' of the upload changes, the caption of this window is changed to be the
' percent complete of the transfer
'==============================================================================
FUNCTION ftpPutFile ALIAS "ftpPutFile" (BYVAL hSocket AS LONG, BYVAL hStatus AS LONG, _
BYVAL sServer AS STRING, BYVAL remoteFile AS STRING, _
BYVAL localFile AS STRING) Export AS LONG
DIM iLoop AS LONG
DIM iFF AS LONG
DIM iTotal AS LONG
DIM iBlocks AS LONG
DIM iLeft AS LONG
DIM iAbort AS LONG
DIM hData AS LONG
DIM buffer AS STRING
DIM zText AS ASCIIZ * 100
'- If the local file doesn't exist, there's
' no point in continuing.
'
IF DIR$(localFile) = "" THEN
buffer = "001 Local File Not Found"
FUNCTION = %False
ELSE
'- Open the local file and check for error
iFF = FREEFILE
OPEN localFile FOR BINARY AS #iFF
IF ERR THEN
Buffer = FORMAT$(ERR, "000") + " Local File Access Error"
FUNCTION = %False
ELSE
'- Open a data socket
ftpSetBinary hSocket
hData = get_passive_handle(hSocket, sServer)
IF hData = %INVALID_SOCKET THEN
buffer = FORMAT$(gLastErr, "000") + " " + gLastMsg
FUNCTION = %False
ELSE
'- Request the upload
TCP PRINT hSocket, "STOR " + remoteFile
TCP LINE hSocket, buffer
'- I have seen this as 150 and 125 - everything under 300 should be ok.
IF (buffer_status(buffer) < 100) OR (buffer_status(buffer) > 299) THEN
CLOSE hData
FUNCTION = %False
ELSE
'- Send the file in chunks
iTotal = LOF(iFF)
iBlocks = iTotal \ %FTP_BLOCK_SIZE
iLeft = iTotal MOD %FTP_BLOCK_SIZE
iAbort = %False
FOR iLoop = 1 TO iBlocks
buffer = SPACE$(%FTP_BLOCK_SIZE)
GET #iFF,, buffer
IF ERR THEN
iAbort = %True
EXIT FOR
END IF
IF write_data_block(hData, buffer) = %False THEN
iAbort = %True
EXIT FOR
END IF
zText = FORMAT$(iLoop * %FTP_BLOCK_SIZE) + " of " + FORMAT$(iTotal)
IF hStatus > 0 THEN
SetWindowText hStatus, zText
END IF
'Tcp Print hSocket, "NOOP"
'Tcp Line hSocket, buffer
NEXT i
'- Send the last piece
IF (iAbort = %False) AND (iLeft > 0) THEN
buffer = SPACE$(iLeft)
GET #iFF,, buffer
IF ERR THEN
iAbort = %True
ELSE
IF write_data_block(hData, buffer) = %False THEN
iAbort = %True
END IF
END IF
END IF
CLOSE hData
'- Cleanup and return
IF iAbort THEN
FUNCTION = %False
ELSE
TCP LINE hSocket, buffer
IF buffer_status(buffer) = 226 THEN
FUNCTION = %True
ELSE
Buffer = FORMAT$(buffer_status(buffer), "000") + " Unable to upload file."
FUNCTION = %False
END IF
END IF
END IF
END IF
CLOSE #iFF
END IF
END IF
set_last_status buffer
END FUNCTION
'=============================================================================
' ftpGetList
' Fills sList() with all of the file info returned
' by a LIST command. Returns the number of lines
' returned. (same as ubound(sList))
'==============================================================================
FUNCTION ftpGetList ALIAS "ftpGetList" (BYVAL hSocket AS LONG, _
BYVAL sServer AS STRING, sList() AS STRING) Export AS LONG
DIM iCount AS LONG
DIM hData AS LONG
DIM buffer AS STRING
REDIM sList(0 TO 2) AS STRING
'- Get a passive mode socket handle
hData = get_passive_handle(hSocket, sServer)
IF hData = %INVALID_SOCKET THEN
buffer = FORMAT$(gLastErr, "000") + " " + gLastMsg
FUNCTION = 0
ELSE
'- Request the directory list
ON ERROR RESUME NEXT
ftpSetAscii hSocket
TCP PRINT hSocket, "LIST"
TCP LINE hSocket, buffer
iCount = 2
DO
TCP LINE hData, buffer
IF TRIM$(buffer) = "" THEN
EXIT DO
ELSEIF ERR THEN
EXIT DO
END IF
IF (RIGHT$(buffer, 3) <> " ..") AND (RIGHT$(buffer, 2) <> " .") THEN
iCount = iCount + 1
REDIM PRESERVE sList(0 TO iCount) AS STRING
sList(iCount) = buffer
END IF
LOOP
sList(1) = "."
sList(2) = ".."
TCP LINE hSocket, buffer
CLOSE hData
FUNCTION = iCount
END IF
set_last_status buffer
END FUNCTION
'=============================================================================
' ftpGetFileList2
' Fills the array - sFiles() with a list of all the files in
' the current directory. Directories are not included in the
' list. The list is dimmed from 0 to the number of files in
' the directory. The 0 element is ignored. The function returns
' ubound(sFiles)
'==============================================================================
FUNCTION ftpGetFileList2 ALIAS "ftpGetFileList2" (BYVAL hSocket AS LONG, _
BYVAL sServer AS STRING, sFiles() AS STRING) Export AS LONG
DIM i AS LONG
DIM iList AS LONG
DIM sList() AS STRING
REDIM sList(0 TO 0) AS STRING
REDIM sFiles(0 TO 0) AS STRING
iList = ftpGetList(hSocket, sServer, sList())
IF iList > 0 THEN
FOR i = 1 TO iList
IF LEFT$(sList(i), 1) = "-" THEN
REDIM PRESERVE sFiles(0 TO UBOUND(sFiles) + 1) AS STRING
sFiles(UBOUND(sFiles)) = sList(i)
END IF
NEXT i
END IF
FUNCTION = UBOUND(sFiles)
END FUNCTION
'=============================================================================
' ftpGetFileList
' Same as ftpGetFileList but showing the file names only
'==============================================================================
FUNCTION ftpGetFileList ALIAS "ftpGetFileList" (BYVAL hSocket AS LONG, _
BYVAL sServer AS STRING, sFiles() AS STRING) Export AS LONG
DIM iCount AS LONG
DIM i AS LONG
iCount = ftpGetFileList2(hSocket, sServer, sFiles())
IF iCount > 0 THEN
FOR i = 1 TO iCount
sFiles(i) = ftpParseFileName(sFiles(i))
NEXT i
END IF
FUNCTION = UBOUND(sFiles)
END FUNCTION
'=============================================================================
' ftpGetDirList2
' Fills the sDirs() array with a list of all the directories
' in the current directory on the ftp server. It returns the
' number of elements in sDirs. The array is dimensioned from
' 0 through the number of directories found. The 0 element
' is left empty and should be ignored.
'==============================================================================
FUNCTION ftpGetDirList2 ALIAS "ftpGetDirList2" _
(BYVAL hSocket AS LONG, BYVAL sServer AS STRING, sDirs() AS STRING) Export AS LONG
DIM i AS LONG
DIM iList AS LONG
DIM sList() AS STRING
REDIM sList(0 TO 0) AS STRING
REDIM sDirs(0 TO 0) AS STRING
iList = ftpGetList(hSocket, sServer, sList())
IF iList > 0 THEN
FOR i = 1 TO iList
IF UCASE$(LEFT$(sList(i), 1)) = "D" THEN
REDIM PRESERVE sDirs(0 TO UBOUND(sDirs) + 1) AS STRING
sDirs(UBOUND(sDirs)) = sList(i)
END IF
NEXT i
END IF
FUNCTION = UBOUND(sDirs)
END FUNCTION
'=============================================================================
' ftpGetDirList
' Same as ftpGetDirList2 but showing the directory names only
'==============================================================================
FUNCTION ftpGetDirList ALIAS "ftpGetDirList" _
(BYVAL hSocket AS LONG, BYVAL sServer AS STRING, sDirs() AS STRING) Export AS LONG
DIM i AS LONG
DIM iList AS LONG
iList = ftpGetDirList2(hSocket, sServer, sDirs())
IF iList > 0 THEN
FOR i = 1 TO iList
sDirs(i) = ftpParseFileName(sDirs(i)) + "/"
NEXT i
END IF
FUNCTION = UBOUND(sDirs)
END FUNCTION
'=============================================================================
' connect to ftp server
' if successful, a valid socket handle is return
' if not, %INVALID_SOCKET
'==============================================================================
FUNCTION ftpConnect ALIAS "ftpConnect" (BYVAL sServer AS STRING, _
BYVAL sUser AS STRING, BYVAL sPW AS STRING) Export AS LONG
DIM hPort AS LONG
DIM hSocket AS LONG
DIM buffer AS STRING
'- Connect to port
ERRCLEAR
ON ERROR RESUME NEXT
hSocket = FREEFILE
IF INSTR(sServer, ":") > 0 THEN
hPort = VAL(MID$(sServer, INSTR(sServer, ":") + 1))
sServer = LEFT$(sServer, INSTR(sServer, ":") - 1)
ELSE
hPort = %IPPORT_FTP
END IF
TCP OPEN PORT hPort AT sServer AS hSocket
IF ERR THEN
set_last_status FORMAT$(ERR, "000") + " Unable to open socket"
FUNCTION = %INVALID_SOCKET
'============
EXIT FUNCTION
'============
END IF
'- What does the server have to say
DO
TCP LINE hSocket, buffer
IF buffer_status(buffer) <> 220 THEN
set_last_status buffer
CLOSE hSocket
FUNCTION = %INVALID_SOCKET
'============
EXIT FUNCTION
'============
END IF
IF MID$(buffer, 4, 1) <> "-" THEN EXIT DO
LOOP
'- Login with user and password
TCP PRINT hSocket, "USER " + sUser
TCP LINE hSocket, buffer
'- Send the password if requested.
IF buffer_status(buffer) = 331 THEN
TCP PRINT hSocket, "PASS " + sPW
END IF
DO
TCP LINE hSocket, buffer
IF MID$(buffer, 4, 1) <> "-" THEN EXIT DO
LOOP
set_last_status buffer
IF buffer_status(buffer) <> 230 THEN
CLOSE hSocket
FUNCTION = %INVALID_SOCKET
'============
EXIT FUNCTION
'============
END IF
FUNCTION = hSocket
END FUNCTION
'=============================================================================
' ftpQuit
' Closes an FTP connection
'==============================================================================
SUB ftpQuit ALIAS "ftpQuit" (BYVAL hSocket AS LONG) EXPORT
DIM buffer AS STRING
TCP PRINT hSocket, "QUIT"
TCP LINE hSocket, buffer
DO UNTIL MID$(buffer, 4, 1) <> "-"
TCP LINE hSocket, buffer
LOOP
set_last_status buffer
CLOSE hSocket
hSocket = %INVALID_SOCKET
END SUB
'=============================================================================
' ftpTranslateErrorCode
' Translates an error code returned from an FTP server into
' a common text interpretation ofthe error. It's usually better
' to just read the string returned by the server instead of using
' this function.
'=============================================================================
FUNCTION ftpTranslateErrorCode ALIAS "ftpTranslateErrorCode" (BYVAL errorCode AS LONG) AS STRING
DIM e AS STRING
SELECT CASE errorCode
CASE %FTP_RESTART_MARKER_REPLY
e = "Restart Marker Reply"
CASE %FTP_SERVICE_READY_SOON
e = "Service available soon:
CASE %FTP_OPEN_STARTING_TRANSFER
e = "Data Connection Open. Starting Transfer"
CASE %FTP_FILE_READY
e = "File ready. About to open data connection."
CASE %FTP_OK
e = "Success"
CASE %FTP_COMMAND_NOT_IMPLEMENTED
e = "Command Not Implemented"
CASE %FTP_SYSTEM_STATUS
e = "System Status"
CASE %FTP_DIRECTORY_STATUS
e = "Directory Status"
CASE %FTP_FILE_STATUS
e = "File Status"
CASE %FTP_HELP_MESSAGE
e = "Help Message"
CASE %FTP_SYSTEM_TYPE_NAME
e = "System Type Name"
CASE %FTP_SERVICE_READY
e = "Service Ready"
CASE %FTP_CONNECTION_CLOSING
e = "Connection Closing. Operation Aborted"
CASE %FTP_OPEN_NO_CURRENT_TRANSFER
e = "Connection Open. No transfer in progress."
CASE %FTP_TRANSFER_COMPLETE
e = "Transfer completed successfully."
CASE %FTP_ENTERING_PASSIVE_MODE
e = "Entering Passive Mode"
CASE %FTP_USER_LOGGED_IN
e = "User Logged In"
CASE %FTP_ACTION_COMPLETED
e = "Action Completed Successfully"
CASE %FTP_DIRECTORY_OK
e = "Directory Created Ok or Current Directory is Ok."
CASE %FTP_PASSWORD_NEEDED
e = "User Ok, but password needed."
CASE %FTP_ACCOUNT_NEEDED
e = "Account needed"
CASE %FTP_ACTION_PENDING
e = "Action Pending Further Information"
CASE %FTP_SERVICE_UNAVAILABLE
e = "Service Unavailable"
CASE %FTP_DATA_CONN_NOT_OPENED
e = "Data Connection Not Opened."
CASE %FTP_DATA_CONN_CLOSED
e = "Data Connection Closed"
CASE %FTP_FILE_UNAVAILABLE
e = "File unavailable"
CASE %FTP_LOCAL_PROCESSING_ERROR
e = "Local Processing Error"
CASE %FTP_NOT_ENOUGH_DISK_SPACE
e = "Not Enough Disk Space"
CASE %FTP_COMMAND_NOT_RECOGNIZED
e = "Command Not Recognized"
CASE %FTP_BAD_PARAMETERS
e = "Syntax Error: Invalid parameters or arguments"
CASE %FTP_NOT_IMPLEMENETED
e = "Not Implemented"
CASE %FTP_BAD_COMMAND_SEQUENCE
e = "Bad Command Sequence"
CASE %FTP_COMMAND_UNAVAILABLE
e = "Command Unavailable"
CASE %FTP_USER_NOT_LOGGED_IN
e = "User Not Logged In"
CASE %FTP_ACCOUNT_NEEDED_TO_STORE
e = "Account Needed to Store Files"
CASE %FTP_ACCESS_DENIED
e = "Access Denied"
CASE %FTP_PAGE_TYPE_UNKNOWN
e = "Page Type Unknown"
CASE %FTP_STORAGE_LIMIT_EXCEEDED
e = "Storage Limit Exceeded"
CASE %FTP_BAD_FILE_NAME
e = "Bad File Name"
CASE ELSE
e = "FTP error " + FORMAT$(errorCode)
END SELECT
FUNCTION = e
END FUNCTION