OPTION Explicit

Global intXferStop AS INTEGER

'ini file management
DECLARE FUNCTION GetPrivateProfileString Lib "Kernel" (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpDefault AS STRING, BYVAL lpReturnedString AS STRING, BYVAL nSize AS INTEGER, BYVAL lpFileName AS STRING) AS INTEGER
DECLARE FUNCTION WritePrivateProfileString Lib "Kernel" (BYVAL lpApplicationName AS STRING, BYVAL lpKeyName AS STRING, BYVAL lpString AS STRING, BYVAL lplFileName AS STRING) AS INTEGER
Global intMachineCnt AS INTEGER

FUNCTION ftpcommand (CtlData AS STRING) AS INTEGER
    ON ERROR RESUME NEXT
   
    IF GetField(CtlData, 1, " ") = "PASS" THEN
        frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & "<local>PASS " & STRING$(LEN(CtlData) - 5, "*")
    ELSE
        frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & "<local>" & CtlData
    END IF
    frmClient.txtStatus.SelStart = LEN(frmClient.txtStatus.Text)

    'append a carriage return and linefeed to the data
    CtlData = CtlData & CHR$(13) & CHR$(10)
    'set the transmit buffer length to the length of the string
    frmClient.Socket1.SendLen = LEN(CtlData)
    'send the data
    frmClient.Socket1.SendData = CtlData

    'check for errors
    IF ERR <> 0 THEN
        ftpcommand = False
    ELSE
        ftpcommand = True
    END IF

END FUNCTION

FUNCTION FTPConnect (HostName AS STRING)
    DIM CtlData AS STRING, Reply AS INTEGER

    FTPConnect = False
    IF HostName = "" THEN EXIT FUNCTION

    'internet address family
    frmClient.Socket1.AddressFamily = AF_INET
    'internet protocol
    frmClient.Socket1.Protocol = IPPROTO_IP
    'streaming socket (most reliable way to send data)
    frmClient.Socket1.TYPE = SOCK_STREAM
    'connect to ftp port on remote host (port 21)
    frmClient.Socket1.RemotePort = IPPORT_FTP
    'set remote host name
    frmClient.Socket1.HostName = HostName
    'transfer data in ascii
    frmClient.Socket1.BINARY = False
    'use 1024 byte packets to pass data
    frmClient.Socket1.BufferSize = 1024
    'turn on socket block (synchronous transmission)
    'will not return control to caller until process is complete
    frmClient.Socket1.Blocking = True

    ON ERROR RESUME NEXT
    'call the socket connect
    frmClient.Socket1.Action = SOCKET_CONNECT
    IF ERR THEN
        MsgBox ERROR$
        EXIT FUNCTION
    END IF

    'get the results from the connect
    Reply = FTPResult(CtlData)
   
    'if connect resulted in 220 then fine,
    'otherwise close the socket
    IF Reply = 220 THEN
        FTPConnect = True
    ELSE
        frmClient.Socket1.Action = SOCKET_CLOSE
    END IF

END FUNCTION

SUB FTPGetDirectory ()
    DIM CtlData AS STRING
    DIM Buffer AS STRING
    DIM intRC AS INTEGER
    DIM intLpCnt AS INTEGER
    DIM intDirCnt AS INTEGER
    DIM strLine AS STRING
    DIM strPerm AS STRING
    DIM strFName AS STRING
    DIM strFSize AS STRING
   
    'clear the list and caption
    frmClient.lstRemFiles.CLEAR
    frmClient.lblRemPath.Caption = ""

    'send the command PWD (Present Working Directory) to remote
    IF NOT ftpcommand("PWD") THEN EXIT SUB
    'code 257 - got directory
    IF LEFT$(STR$(FTPResult(CtlData)), 3) <> " 25" THEN EXIT SUB

    'parse directory out of returned string
    CtlData = MID$(CtlData, 2, INSTR(CtlData, " ") - 3)
    frmClient.lblRemPath.Caption = CtlData
   
    'If ftpcommand("SYST") Then intRC = FTPResult(CtlData)

    'get the file list
    IF NOT FTPListen(0) THEN EXIT SUB 'listen in ascii
    IF NOT ftpcommand("LIST") THEN EXIT SUB
    'code 150 - starting transfer
    IF LEFT$(Str(FTPResult(CtlData)), 2) <> " 1" THEN
        frmClient.Socket2.Action = SOCKET_CLOSE
        EXIT SUB
    END IF
    'start accepting listing in second socket
    frmClient.Socket2.Action = SOCKET_ACCEPT
    ON ERROR RESUME NEXT
   
    IF ERR THEN
        MsgBox ERROR$
        frmClient.Socket2.Action = SOCKET_CLOSE
        EXIT SUB
    END IF
    Buffer = ""
    DO
        'size of packet to recieve
        frmClient.Socket2.RecvLen = 4092
'        frmClient.Socket2.RecvLen = 512
        'receive the data packet
        Buffer = Buffer & frmClient.Socket2.RecvData
        IF ERR THEN
            MsgBox ERROR$
            EXIT DO
        END IF
        IF frmClient.Socket2.RecvLen = 0 THEN EXIT DO
        'permit other system operations
        DoEvents
    LOOP
    'close the secondary socket
    frmClient.Socket2.Action = SOCKET_CLOSE
    'wait for close verification
    intRC = FTPResult(CtlData)

    intDirCnt = CountOf(Buffer, CHR$(13))
    FOR intLpCnt = 1 TO intDirCnt
        strLine = StringCompress(GetField(Buffer, intLpCnt, CHR$(13) & CHR$(10)), " ")
        strPerm = GetField(strLine, 1, " ")
        IF LEN(strPerm) = 10 AND (MID$(strPerm, 2, 1) = "-" OR MID$(strPerm, 2, 1) = "r") THEN
        'buffer is a unix type ls -l output
'drwx------   4 owner      group         512 Aug 11 11:25 DiretoryName
'-rwxr-xr-x   1 owner      group         501 Jun 26 09:09 FileName
            strFName = GetField(strLine, 9, " ")
            strFSize = GetField(strLine, 5, " ")
            IF strFName <> "." THEN 'ignore present directory
                IF UCase(LEFT$(strPerm, 1)) = "D" THEN
                    'put brackets around directories
                    frmClient.lstRemFiles.AddItem "<" & strFName & ">"
                ELSE
                    frmClient.lstRemFiles.AddItem strFName
                    frmClient.lstRemFiles.ItemData(frmClient.lstRemFiles.NewIndex) = strFSize
                END IF
            END IF
        ELSE
        'buffer is something else
            IF NOT (strPerm = "total" AND GetField(strLine, 3, " ") = "") THEN
                strFName = GetField(strLine, 1, " ")
                'take the heading off of it
                intRC = INSTR(strFName, ".")
                IF intRC <> 0 THEN
                    strFName = MID$(strFName, intRC + 1, LEN(strFName))
                END IF
                strFSize = GetField(strLine, 6, " ")
                frmClient.lstRemFiles.AddItem strFName
                frmClient.lstRemFiles.ItemData(frmClient.lstRemFiles.NewIndex) = strFSize
            END IF
        END IF
        IF intLpCnt MOD 5 = 0 THEN
            frmClient.lstRemFiles.TopIndex = intLpCnt - 5
            frmClient.lstRemFiles.Refresh
        END IF
    NEXT intLpCnt
    frmClient.lstRemFiles.TopIndex = 0
END SUB

FUNCTION FTPGetFile (RemoteFile AS STRING, LocalFile AS STRING)
    DIM CtlData AS STRING, Buffer AS STRING
    DIM Result AS INTEGER
    DIM intMode AS INTEGER
    DIM lngFSize AS LONG
    DIM lngXSize AS LONG
    DIM intLpCnt AS INTEGER
    DIM strFHold AS STRING

    FTPGetFile = False

    IF REMoteFile = "" Or LocalFile = "" Then Exit Function
    'do not permit exit or refresh at this time
    'frmClient.MousePointer = MOUSE_HOURGLASS
    frmClient.cmdLocRef.Enabled = False
    frmClient.cmdRemRef.Enabled = False
    frmClient.FileMenu.Enabled = False
    frmClient.mnuSession.Enabled = False
    intXferStop = False
    frmClient.lblXferText.Caption = "Retrieving file '" & REMoteFile & "' ( ? bytes)"
    frmClient.pnlXferGauge.FloodPercent = 0
    frmClient.pnlXferStat.Visible = True
    'start listening for the remote machine connection
    IF frmClient.rdoAscii.Value THEN
        intMode = 0
    ELSE
        intMode = 1
    END IF
    IF NOT FTPListen(intMode) THEN
        frmClient.cmdLocRef.Enabled = True
        frmClient.cmdRemRef.Enabled = True
        frmClient.FileMenu.Enabled = True
        frmClient.mnuSession.Enabled = True
        frmClient.pnlXferStat.Visible = False
        frmClient.MousePointer = MOUSE_DEFAULT
        MsgBox "Could not get remote system to respond."
        EXIT FUNCTION
    END IF
    'tell the remote host which file we want to retrieve
    IF NOT ftpcommand("RETR " & REMoteFile) Then
        frmClient.cmdLocRef.Enabled = True
        frmClient.cmdRemRef.Enabled = True
        frmClient.FileMenu.Enabled = True
        frmClient.mnuSession.Enabled = True
        frmClient.pnlXferStat.Visible = False
        frmClient.MousePointer = MOUSE_DEFAULT
        frmClient.Socket2.Action = SOCKET_CLOSE
        MsgBox "Could not open file on remote system. - No transfer"
        EXIT FUNCTION
    END IF
    'code 150 - starting transfer
    IF LEFT$(Str(FTPResult(CtlData)), 2) <> " 1" THEN
        frmClient.cmdLocRef.Enabled = True
        frmClient.cmdRemRef.Enabled = True
        frmClient.FileMenu.Enabled = True
        frmClient.mnuSession.Enabled = True
        frmClient.pnlXferStat.Visible = False
        frmClient.MousePointer = MOUSE_DEFAULT
        frmClient.Socket2.Action = SOCKET_CLOSE
        MsgBox "Could not initiate transfer from remote system."
        EXIT FUNCTION
    END IF
   
    frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & "<Comment>Opening retrieval socket."
    frmClient.txtStatus.SelStart = LEN(frmClient.txtStatus.Text)
    'give remote time to initiate transfer
    SLEEP (1)
    'start accepting file in second socket
    frmClient.Socket2.Action = SOCKET_ACCEPT
    DoEvents
    IF NOT frmClient.Socket2.Connected THEN
        frmClient.cmdLocRef.Enabled = True
        frmClient.cmdRemRef.Enabled = True
        frmClient.FileMenu.Enabled = True
        frmClient.mnuSession.Enabled = True
        frmClient.pnlXferStat.Visible = False
        frmClient.MousePointer = MOUSE_DEFAULT
        frmClient.Socket2.Action = SOCKET_ABORT
        frmClient.pnlXferStat.Visible = False
        MsgBox "Remote system is not accepting file requests."
        EXIT FUNCTION
    END IF
    ON ERROR RESUME NEXT
    frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & "<Comment>Retrieving file length."
    frmClient.txtStatus.SelStart = LEN(frmClient.txtStatus.Text)
    'look up file size
    strFHold = GetField(RemoteFile, (CountOf(RemoteFile, "/") + 1), "/")
    strFHold = GetField(strFHold, (CountOf(strFHold, "\") + 1), "\")
    lngFSize = 1
    FOR intLpCnt = 0 TO frmClient.lstRemFiles.ListCount - 1
        IF strFHold = frmClient.lstRemFiles.LIST(intLpCnt) THEN
            lngFSize = frmClient.lstRemFiles.ItemData(intLpCnt)
            EXIT FOR
        END IF
    NEXT intLpCnt
    lngXSize = 0
    frmClient.lblXferText.Caption = "Retrieving file '" & REMoteFile & "' (" & lngFSize & " bytes)"
    frmClient.pnlXferGauge.FloodPercent = lngXSize
    frmClient.pnlXferStat.Visible = True
   
    'open file for writing
    OPEN LocalFile FOR BINARY AS #1
    IF ERR THEN
        MsgBox ERROR$
        frmClient.Socket2.Shutdown = 0
        frmClient.Socket2.Action = SOCKET_CLOSE
        frmClient.pnlXferStat.Visible = False
        EXIT FUNCTION
    END IF

    FTPGetFile = True
   
    'loop through loading file
    DO
        'size of packet to recieve
        frmClient.Socket2.RecvLen = 4096
        'receive the data packet
        Buffer = frmClient.Socket2.RecvData
        lngXSize = lngXSize + LEN(Buffer)
        IF INT((lngXSize / lngFSize) * 100) < 101 THEN
            frmClient.pnlXferGauge.FloodPercent = INT((lngXSize / lngFSize) * 100)
        END IF
        IF ERR THEN
            FTPGetFile = False
            MsgBox ERROR$
            EXIT DO
        END IF
        IF intXferStop THEN
            FTPGetFile = False
            'if they exit, stop the transaction
            MsgBox "Transfer stopped by user."
            'frmClient.Socket1.Action = SOCKET_ABORT
            frmClient.Socket2.Shutdown = 0
            frmClient.Socket2.Action = SOCKET_ABORT
            EXIT DO
        END IF
        'did we hit EOF?
        IF frmClient.Socket2.RecvLen = 0 THEN EXIT DO
        'append packet to file
        PUT #1, , Buffer
        'permit other system operations
        DoEvents
    LOOP

    'close the data file
    CLOSE #1
    'if user cancelled, destroy partial file
    IF intXferStop THEN
        KILL LocalFile
    ELSE
        frmClient.pnlXferGauge.FloodPercent = 100
    END IF
    'close the secondary socket
    frmClient.Socket2.Action = SOCKET_CLOSE
    'wait for close verification
    Result = FTPResult(CtlData)

    'turn controls on
        frmClient.cmdLocRef.Enabled = True
        frmClient.cmdRemRef.Enabled = True
        frmClient.FileMenu.Enabled = True
        frmClient.mnuSession.Enabled = True
        frmClient.pnlXferStat.Visible = False
        frmClient.MousePointer = MOUSE_DEFAULT
END FUNCTION

FUNCTION FTPListen (intMode AS INTEGER)
    DIM Port AS INTEGER, Address AS STRING
    DIM Reply AS INTEGER, CtlData AS STRING
    DIM I AS INTEGER, P AS INTEGER

    'connect a second socket to the remote host
    'to listen for and execute remote commands
    'in essence, set up a server connection
    FTPListen = False
   
    'internet address
    frmClient.Socket2.AddressFamily = AF_INET
    'will be receiveing in binary
    frmClient.Socket2.BINARY = True
    'synchronous connection
    frmClient.Socket2.Blocking = True
    'do not buffer data
    frmClient.Socket2.BufferSize = 0
    'accept from any remote address
    frmClient.Socket2.HostAddress = INADDR_ANY
    'connect to any available port
    frmClient.Socket2.LocalPort = IPPORT_ANY
    'internet protocol
    frmClient.Socket2.Protocol = IPPROTO_TCP
    'set timeout for 60 seconds
    frmClient.Socket2.Timeout = 200000
    'streaming socket
    frmClient.Socket2.TYPE = SOCK_STREAM
    'start listening
    frmClient.Socket2.Action = SOCKET_LISTEN

    'listen will set these two to valid port and address
    Port = frmClient.Socket2.LocalPort
    'we use the address from the first socket, they should be the same
    Address = frmClient.Socket1.LocalAddress

    'convert . to , in address
    FOR I = 1 TO 3
        P = INSTR(Address, ".")
        IF P <> 0 THEN MID$(Address$, P, 1) = ","
    NEXT I
   
    'tell remote system which port gets the data
    CtlData = "PORT " & Address & "," & (Port  256) & "," & (Port MOD 256)
    IF NOT ftpcommand(CtlData) THEN GOTO OpenFailed
   
    'code 200 -command understood
    IF FTPResult(CtlData) <> 200 THEN GOTO OpenFailed
   
    'transfer in binary or ascii?
    IF intMode = 1 THEN
        CtlData = "TYPE I"  'binary
    ELSE
        CtlData = "TYPE A"  'ascii
    END IF
   
    IF NOT ftpcommand(CtlData) THEN GOTO OpenFailed
    'code 2?? -command understood
    IF LEFT$(STR$(FTPResult(CtlData)), 2) <> " 2" THEN GOTO OpenFailed
   
    FTPListen = True
    EXIT FUNCTION

OpenFailed:
    'disconnect new socket on error
    IF frmClient.Socket2.Listening THEN frmClient.Socket2.Action = SOCKET_CLOSE
    EXIT FUNCTION
END FUNCTION

FUNCTION FTPLogin (Username AS STRING, Password AS STRING) AS INTEGER
    DIM CtlData AS STRING, Reply AS INTEGER
    DIM Counter AS INTEGER
   
    FTPLogin = False

    'check receive buffer
    IF frmClient.Socket1.IsReadable THEN
        Reply = FTPResult(CtlData)
    END IF

    'clear all connect messages out of receive buffer
    WHILE Reply = 220 AND frmClient.Socket1.IsReadable
        Reply = FTPResult(CtlData)
    WEND

    'send the user command with the user id to remote host
    CtlData = "USER " & Username
    IF NOT ftpcommand(CtlData) THEN EXIT FUNCTION
    'check the response from remote host
    Reply = FTPResult(CtlData)

    'code 331 means ready for password
    IF Reply = 331 THEN
        'send the pass command and the password
        CtlData = "PASS " & Password
        IF NOT ftpcommand(CtlData) THEN EXIT FUNCTION
        'check the response
        Reply = FTPResult(CtlData)
    END IF
   
    'get all login messages out of receive buffer
    WHILE Reply = 230 AND frmClient.Socket1.IsReadable
        Reply = FTPResult(CtlData)
    WEND

    'code 230 - logon accepted
    IF Reply = 230 THEN
        FTPLogin = True
    ELSE
        MsgBox "Invalid user name or password"
    END IF

END FUNCTION

FUNCTION FTPPutFile (LocalFile AS STRING, REMoteFile As String)
    DIM CtlData AS STRING, Buffer AS STRING * 4096
    DIM Result AS INTEGER, Size AS LONG
    DIM intMode AS INTEGER
    DIM lngXSize AS LONG, lngFSize AS LONG

    'write the file onto the remote host

    FTPPutFile = False

    IF REMoteFile = "" Or LocalFile = "" Then Exit Function
    'start listening for remote host
    IF frmClient.rdoAscii.Value THEN
        intMode = 0
    ELSE
        intMode = 1
    END IF
    ERR = 0
    IF NOT FTPListen(intMode) THEN EXIT FUNCTION
    intXferStop = False
    'do not permit exit or refresh at this time
    frmClient.cmdLocRef.Enabled = False
    frmClient.cmdRemRef.Enabled = False
    frmClient.FileMenu.Enabled = False
    frmClient.mnuSession.Enabled = False
    Size = FileLen(LocalFile)
    lngFSize = Size
    lngXSize = 0
    frmClient.lblXferText.Caption = "Sending file '" & LocalFile & "' (" & lngFSize & " bytes)"
    frmClient.pnlXferGauge.FloodPercent = lngXSize
    frmClient.pnlXferStat.Visible = True
    SLEEP (3)
    'tell remote host to store this file
    IF NOT ftpcommand("STOR " & REMoteFile) Then
        GOSUB scrn_Reset
        EXIT FUNCTION
    END IF
    'If intXferStop Then
    '    GoSub scrn_Reset
    '    Exit Function
    'End If
    SLEEP (3)
    'code 150 -command accepted
    IF LEFT$(Str(FTPResult(CtlData)), 2) <> " 1" THEN
        GOSUB scrn_Reset
        EXIT FUNCTION
    END IF
    'If intXferStop Then
    '    GoSub scrn_Reset
    '    Exit Function
    'End If
   
    ON ERROR RESUME NEXT
    'start accepting commands from remote host
    frmClient.Socket2.Action = SOCKET_ACCEPT
   
    IF ERR THEN
        frmClient.Socket2.Action = SOCKET_CLOSE
        MsgBox ERROR$
        EXIT FUNCTION
    END IF
   
    'open the file for reading
    OPEN LocalFile FOR BINARY AS #1

    IF ERR THEN
        frmClient.Socket2.Action = SOCKET_CLOSE
        MsgBox ERROR$
        EXIT FUNCTION
    END IF

    FTPPutFile = True
    'send file in 4096 byte packets (buffer)
    DO
        GET #1, , Buffer
        'set transmit length to size of packet
        IF Size < LEN(Buffer) THEN
            frmClient.Socket2.SendLen = Size
            Size = 0
        ELSE
            frmClient.Socket2.SendLen = LEN(Buffer)
            Size = Size - LEN(Buffer)
        END IF
        'send packet
        frmClient.Socket2.SendData = Buffer
        IF ERR > 0 THEN
            FTPPutFile = False
            MsgBox ERROR$
            EXIT DO
        END IF
        lngXSize = lngXSize + LEN(Buffer)
        frmClient.pnlXferGauge.FloodPercent = INT((lngXSize / lngFSize) * 100)
        IF intXferStop THEN
            FTPPutFile = False
            MsgBox "Transfer stopped by user."
            Size = 0
        END IF
        'if file is empty, we're done
        IF Size = 0 THEN EXIT DO
        'allow other system events to fire
        DoEvents
    LOOP
    IF NOT intXferStop THEN
        frmClient.pnlXferGauge.FloodPercent = 100
    END IF

    'close local file
    CLOSE #1
    frmClient.cmdLocRef.Enabled = True
    frmClient.cmdRemRef.Enabled = True
    frmClient.FileMenu.Enabled = True
    frmClient.mnuSession.Enabled = True
    frmClient.pnlXferStat.Visible = False
    'close secondary socket
    frmClient.Socket2.Action = SOCKET_CLOSE
    'verify socket close
    Result = FTPResult(CtlData)
EXIT FUNCTION
scrn_Reset:
    frmClient.cmdLocRef.Enabled = True
    frmClient.cmdRemRef.Enabled = True
    frmClient.FileMenu.Enabled = True
    frmClient.mnuSession.Enabled = True
    frmClient.pnlXferStat.Visible = False
    'frmClient.Socket2.Shutdown = 1
    'frmClient.Socket2.Action = SOCKET_FLUSH
    'frmClient.Socket2.Action = SOCKET_ABORT
    ERR = 0
    'frmClient.Socket2.Action = SOCKET_CLOSE
RETURN
END FUNCTION

FUNCTION FTPResult (CtlData AS STRING) AS INTEGER
    DIM SockData AS STRING, Reply AS INTEGER

    'receive 255 bytes at a time
    frmClient.Socket1.RecvLen = 255
    'load sockdata with data from socket
    SockData = frmClient.Socket1.RecvData
    'print the data to the status window
    frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & SockData
    frmClient.txtStatus.SelStart = LEN(frmClient.txtStatus.Text)

    'reply is the first 3 characters (should be numeric)
    Reply = VAL(LEFT$(SockData, 3))
    IF MID$(SockData, 4, 1) = "-" THEN
        DO
            frmClient.Socket1.RecvLen = 255
            'check for longer warning message and clear the buffer
            SockData = frmClient.Socket1.RecvData
            IF VAL(LEFT$(SockData, 3)) = Reply THEN EXIT DO
            frmClient.txtStatus.Text = frmClient.txtStatus.Text & CHR$(13) & CHR$(10) & SockData
            frmClient.txtStatus.SelStart = LEN(frmClient.txtStatus.Text)
        LOOP
    END IF
    CtlData = RIGHT$(SockData, LEN(SockData) - INSTR(SockData, " "))
   
    FTPResult = Reply
END FUNCTION