Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

don dickinson's rserver2 altered to be used for downloading a single file

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • don dickinson's rserver2 altered to be used for downloading a single file

    this program is a file server and client used to download files from the server only
    credit has to go to don dickinson
    i hope he approves of this project and list here.
    i made some modifications to the server by left much of the code along,
    because there are features in the code that maybe used later to possibly upload
    rather than download which is what i was interested in.

    to use this code
    you will have to download the rserver2 files from don dickinson's website
    the you will substitute the rserver program below for his or just make another file
    to compile.

    i made a copy of the rstest.bas program then edited it calling the program rget.bas
    which is the last listing.
    once the rserver program is running you can run the rget program with a command like
    rget www.myserver.com:12069 c:\somedirectory\filenanme.ext to retrieve the file from the server.
    or retrieve a directory from the rserver like
    rget www.myserver.com:12069 c:\somedirectory\DIRECTORY
    it is that simple.
    and like don says
    use at your own risk.
    use my program listed else where called WNDWHIDE to hide to server to keep someone
    from stopping the rserver program accidently.


    the new rserver.bas listed below
    i compiled this with pbwin v8.03
    -----------------------------------------------------
    Code:
     
     
    '
    '  rserver.bas
    '
    '  multi-threaded, multi-homed, tcp-based, remote binary data server
    '
    '  By Don Dickinson
    '  [email protected]
    '  dickinson.basicguru.com
    '
    '  Hereby Public Domain
    '  Use implies that you hold the author, Don Dickinson, harmless from any
    '  responsibility for effects or side-effects of using this code. It is
    '  provided in good faith by the auther - you are using it at your own
    '  risk.
    '
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  Compiler Directives
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #COMPILE EXE
    '#Dim All
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  Included files
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    #INCLUDE "win32api.inc"          'windows api, constants, structures
    #INCLUDE "wsconst.inc"           'winsock structures and constants
    #INCLUDE "pb_file.bas"           'various file and directory routines
    #INCLUDE "pb_ini.bas"            '.ini file handling
    #INCLUDE "rserver.inc"           'rserver specific constants and structures
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  Constants
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    %LOG_DETAILED = %False
     
    '- Main Screen
    %labIP      = 801
    %labPort    = 802
    %labDate    = 803
    %labHits    = 804
    %labActive  = 805
    %labAction  = 806
    %btnSetup   = 807
    %timer1     = 808
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  Globals
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    GLOBAL gDlgMain AS LONG          'handle for main dialog window
    GLOBAL gLog  AS LONG             'handle to log file
    GLOBAL gShutdown AS LONG         'flag telling system to abort and close conns
    GLOBAL gSock() AS LONG           'array of client connection sockets
    GLOBAL gMainSock() AS LONG       'array of listening sockets
    GLOBAL gThread() AS LONG         'array of running threads
    GLOBAL gThreadRunning() AS LONG  'array that indicates if a thread has finished
    GLOBAL gActive AS LONG           'number of active connections
    GLOBAL gHits AS LONG             'total hits
    GLOBAL gPort AS LONG             'connection port
    GLOBAL gIPAddr() AS LONG         'array of ip addresses being listed to
    GLOBAL gIPCount AS LONG          'count of ip addresses being listed to
    GLOBAL gCS AS CRITICAL_SECTION   'critical section structure
    GLOBAL gIniFile AS STRING        'ini file name and path
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  tcpSafeReceive
    '  Specify a length of data to wait for and this function
    '  retrieves data until all data has filled the buffer or
    '  an error occurs.
    '  Returns: %True on success, %False on error
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION tcpSafeReceive(BYVAL hSocket AS LONG, BYVAL iBufferLen AS LONG, _
                            recBuff AS STRING) AS LONG
     
       DIM iLeft AS LONG
       DIM sBuffer AS STRING
     
       recBuff = ""
       iLeft = iBufferLen
     
       DO
          sBuffer = SPACE$(iLeft)
     
          ON ERROR RESUME NEXT
          sBuffer = SPACE$(iBufferLen)
          TCP RECV hSocket, iLeft, sBuffer
          IF ERR THEN
             FUNCTION = %False
             EXIT FUNCTION
          END IF
     
          recBuff = recBuff + sBuffer
          IF LEN(recBuff) >= iBufferLen THEN
             EXIT DO
          END IF
          iLeft = iBufferLen - LEN(recBuff)
          SLEEP 5
       LOOP
       FUNCTION = %True
     
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  FormatIP
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION FormatIP(RawAddr AS LONG) AS STRING
     
       DIM sAddr AS STRING
     
       sAddr = MKL$(RawAddr)
       FUNCTION = FORMAT$(ASC(MID$(sAddr, 1, 1))) + "." + _
                  FORMAT$(ASC(MID$(sAddr, 2, 1))) + "." + _
                  FORMAT$(ASC(MID$(sAddr, 3, 1))) + "." + _
                  FORMAT$(ASC(MID$(sAddr, 4, 1)))
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  LogEvent
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB LogEvent(BYVAL buffer AS STRING)
     
       IF gLog THEN
          PRINT #gLog, DATE$ + " " + TIME$ + " " + Buffer
       END IF
     
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  EnterCritical
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB EnterCritical
       EnterCriticalSection gCS
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  LeaveCritical
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB LeaveCritical
       LeaveCriticalSection gCS
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  DisplayEvent
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB DisplayEvent(BYVAL buffer AS STRING)
     
       gHits = gHits + 1
       IF gHits > 2000000000 THEN
          gHits = 1
       END IF
     
       CONTROL SET TEXT gDlgMain, %labAction, TIME$ + "  " + Buffer
       CONTROL SET TEXT gDlgMain, %labActive, FORMAT$(gActive)
       CONTROL SET TEXT gDlgMain, %labHits, FORMAT$(gHits)
     
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  ThreadCleanup
    '  If a thread has finished executing, but the thread handle
    '  has not been closed, I close it here. This is called by a
    '  timer that goes off every %TIMER_INTERVAL milliseconds
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB ThreadCleanup()
     
       DIM i AS LONG
       DIM foo AS LONG
     
       FOR i = 1 TO %MAX_CONNECTIONS
          IF gThread(i) THEN
             IF gThreadRunning(i) = %False THEN
                THREAD CLOSE gThread(i) TO foo
                gThread(i) = 0
             END IF
          END IF
       NEXT i
     
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  InitListen
    '  Starts all ip ports listening
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB InitListen()
     
       DIM i AS LONG
     
       FOR i = 1 TO %MAX_IP_WAIT
          IF gIPAddr(i) <> 0 THEN
             gMainSock(i) = FREEFILE
             TCP OPEN SERVER ADDR gIPAddr(i) PORT gPort AS gMainSock(i) TIMEOUT %TCP_TIMEOUT
             IF ERR THEN
                MSGBOX "Unable to listen to " + FormatIP$(gIPAddr(i)) + _
                       " Err=" + FORMAT$(ERR)
             ELSE
                TCP NOTIFY gMainSock(i), ACCEPT TO gDlgMain AS %TCP_CONNECT
             END IF
          END IF
       NEXT i
     
    END SUB
     
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  rsCommand
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION rsCommand (BYVAL iCurrentSocket AS LONG, rIn AS XFER_BUFFER_TYPE, _
                       sInBuffer AS STRING) AS LONG
     
       DIM i AS LONG
       DIM iMoreLeft AS LONG
       DIM iLen AS LONG
       DIM sFile AS STRING
       DIM sReturn AS STRING
       DIM sBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM NEWFILE AS STRING
       DIM DIRLIST AS STRING
       DIM JUNK AS STRING
       DIM MAINDIR AS STRING
       DIM hfile2 AS LONG
     
     
       iMoreLeft = %True
     
       SELECT CASE rIn.iCommand
     
          '-------- OPEN FILE FOR SHARED ACCESS
          CASE %RSERVER_OPEN_FILE
     
             '- The length of the file name is the first
             '  two bytes (integer) after the structure.
             '  The file name follows it's length
             '
             sFile = TRIM$(MID$(sInBuffer, 3, CVI(MID$(sInBuffer, 1, 2))))
             LogEvent "OPEN " + sFile
             DisplayEvent "Open File " + sFile
     
             '- Open the file. If there's an error, the error
             '  is stored in the iResult member. Otherwise,
             '  the file handle is given to the iFile member.
             '
             EnterCritical
             ON ERROR RESUME NEXT
             rOut.iFile = FREEFILE
     REM START OF CHANGED CODE HERE BY PAUL
     REM -------------------------------------------
        newfile$=" "+STRREVERSE$(sFile)
        FOR i&=1 TO LEN(newfile$)
            IF INSTR(UCASE$(MID$(newfile$,i&,1)),ANY "[email protected]~$ 0123456789        ")=0 THEN
                newfile$=MID$(newfile$,1,(i&-1))
                newfile$=TRIM$(STRREVERSE$(newfile$))
                EXIT FOR
            END IF
        NEXT i&
     
     IF UCASE$(newfile$)="DIRECTORY" THEN
                        DIRLIST$=LEFT$((" "+sfile),(LEN(sfile)-LEN(newfile$)+1))
                        DIRLIST$=TRIM$(DIRLIST$)
                        MAINDIR$=CURDIR$
                        sfile=MAINDIR$+"\DIRECTORY.LST"
                        TRY
                        CHDIR DIRLIST$
                        CATCH
                        junk$=CURDIR$(MAINDIR$)
                        KILL "DIRECTORY.LST"
                        hFILE2&=FREEFILE
                        OPEN "DIRECTORY.LST" FOR OUTPUT AS #hFILE2&
                        PRINT #hfile2&,"the directory "+DIRLIST$
                        PRINT #hfile2&,"on the remote machine as of = "+DATE$+" "+TIME$
                        PRINT #hfile2&,"--------------------------------------------------------"
                        PRINT #hfile2&,"no directory was found"
                        PRINT #hfile2&,
                        CLOSE #hfile2&
                        EXIT TRY
                        FINALLY
                        KILL maindir$+"\DIRECTORY.LST"
                        hFILE2&=FREEFILE
                        OPEN maindir$+"\DIRECTORY.LST" FOR OUTPUT AS #hFILE2&
                        PRINT #hfile2&,"the directory "+CURDIR$
                        PRINT #hfile2&,"on the remote machine as of = "+DATE$+" "+TIME$
                        PRINT #hfile2&,"------------------files inside directory-----------------------"
                        FILES&=0
                        SUBDIRECTORIES&=1
                        A$ = DIR$("*.*", (0 OR 1 OR 2 OR 3 OR 4 OR 32))
                        WHILE LEN(A$)
                        IF A$<>"DIRECTORY.LST" THEN FILES&=1:PRINT #hfile2&,A$
                        A$ = DIR$
                        WEND
                        IF FILES&=0 THEN PRINT #hfile2&,"no files found"
                        PRINT #hfile2&,"------------------subdirectories inside directory--------------"
                        A$ = DIR$("*.*",16)
                        WHILE LEN(A$)
                        IF A$<>"DIRECTORY.LST" THEN
                        IF (GETATTR(A$) AND 16) THEN SUBDIRECTORIES&=1:PRINT #hfile2&,"<DIR> "+A$
                        END IF
                        A$ = DIR$
                        WEND
                        IF SUBDIRECTORIES&=0 THEN PRINT #hfile2&,"no subdirectories found"
                        PRINT #hfile2&,"------------------end of directory listing --------------------"
                        CLOSE #hfile2&
                        junk$=CURDIR$(MAINDIR$)
                        EXIT TRY
                        END TRY
     END IF
     
                       TRY
                       OPEN sFile FOR INPUT SHARED AS #rOut.iFile
                       CATCH
                       rOut.iFile = 0
                       rOut.iResult = ERR
                       rOut.iDataLen = 0
                       EXIT TRY
                       FINALLY
                       CLOSE #rOut.iFile
                       OPEN sFile FOR BINARY SHARED AS #rOut.iFile
                       EXIT TRY
                       END TRY
     REM END OF CHANGED CODE HERE BY PAUL
     REM -------------------------------------------
     
             LeaveCritical
     
             '- Send back the results structure
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             TCP SEND iCurrentSocket, sReturn
     
          '-------- CLOSE FILE
          CASE %RSERVER_CLOSE_FILE
             LogEvent "CLOSE FILE " + FORMAT$(rIn.iFile)
             DisplayEvent "CLOSE " + FORMAT$(rIn.iFile)
             TEMP$=FILENAME$(rIn.iFile)
             CLOSE #rIn.iFile
             IF LEN(TEMP$)>12 THEN
                IF RIGHT$(UCASE$(TEMP$),13)="DIRECTORY.LST" THEN KILL TEMP$
             END IF
             rOut.iResult = 0
             rOut.iDataLen = 0
             rOut.iFile = 0
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             TCP SEND iCurrentSocket, sReturn
     
          '-------- GET DATA FROM FILE
          CASE %RSERVER_GET
             DisplayEvent "GET " + FORMAT$(rIn.iFile)
     
             '- How much data do they want?
             iLen = CVL(LEFT$(sInBuffer, 4))
     
             '- Retrieve the data from the file
             ON ERROR RESUME NEXT
             sBuffer = SPACE$(iLen)
             GET #rIn.iFile,, sBuffer
             IF ERR THEN
                sBuffer = ""
                rOut.iDataLen = 0
             ELSE
                rOut.iDataLen = LEN(sBuffer)
             END IF
             rOut.iResult = ERR
             rOut.iFile = rIn.iFile
     
             '- Send back the response with the data
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             sReturn = sReturn + sBuffer
     
             TCP SEND iCurrentSocket, sReturn
     
          '-------- WRITE DATA TO FILE
          CASE %RSERVER_PUT
             DisplayEvent "PUT " + FORMAT$(rIn.iFile)
             ON ERROR RESUME NEXT
             PUT #rIn.iFile,, sInBuffer
             rOut.iResult = ERR
             rOut.iFile = rIn.iFile
             rOut.iDataLen = 0
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             TCP SEND iCurrentSocket, sReturn
     
          '-------- SEEK A POSITION IN THE FILE
          CASE %RSERVER_SEEK
             DisplayEvent "SEEK " + FORMAT$(rIn.iFile)
             ON ERROR RESUME NEXT
             SEEK #rIn.iFile, CVL(LEFT$(sInBuffer, 4))
             rOut.iFile = rIn.iFile
             rOut.iResult = ERR
             rOut.iDataLen = 0
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             TCP SEND iCurrentSocket, sReturn
     
          '-------- GET LENGTH OF THE FILE
          CASE %RSERVER_LOF
             DisplayEvent "LOF " + FORMAT$(rIn.iFile)
             ON ERROR RESUME NEXT
             i = LOF(rIn.iFile)
             IF ERR THEN
                rOut.iDataLen = 0
                sBuffer = ""
             ELSE
                rOut.iDataLen = 4
                sBuffer = MKL$(i)
             END IF
             rOut.iFile = rIn.iFile
             rOut.iResult = ERR
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             sReturn = sReturn + sBuffer
             TCP SEND iCurrentSocket, sReturn
     
          '----------- No more to come
          CASE %RSERVER_QUIT
             iMoreLeft = %False
     
          '----------- UNKNOWN instruction
          CASE ELSE
             LogEvent "UNKNOWN INSTRUCTION:" + STR$(rIn.iCommand)
             DisplayEvent "Unknown Instruction:" + STR$(rIn.iCommand)
             rOut.iResult = 0
             rOut.iFile = 0
             rOut.iDataLen = 0
             sReturn = SPACE$(LEN(rOut))
             LSET sReturn = rOut
             TCP SEND iCurrentSocket, sReturn
     
       END SELECT
     
       FUNCTION = iMoreLeft
     
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  tcpHandleConnection
    '  This function is called to create a new thread.  It sits in a loop
    '  responding to requests until the socket is closed (this generates an
    '  error an the loop bails out. When it finishes, it closes the socket.
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION tcpHandleConnection( BYVAL iWhich AS LONG ) AS LONG
     
       DIM i AS LONG
       DIM iCurrentSocket AS LONG
       DIM iLen AS LONG
       DIM sFile AS STRING
       DIM sResult AS STRING
       DIM sBuffer AS STRING
       DIM sInBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rIn AS XFER_BUFFER_TYPE
     
       gThreadRunning(iWhich) = %True
     
       iCurrentSocket = gSock(iWhich)
       DO
     
          '- If this fails, then there was a tcp error
          IF tcpSafeReceive(iCurrentSocket, LEN(rIn), sBuffer) = %False THEN
             EXIT DO
     
          '- Monitor the global shutdown flag
          ELSEIF gShutdown THEN
             EXIT DO
     
          '- Process the data
          ELSE
             LSET rIn = sBuffer
     
             '- Get the variable portion of the buffer
             IF rIn.iDataLen > 0 THEN
                tcpSafeReceive iCurrentSocket, rIn.iDatalen, sInBuffer
             END IF
     
             '- This returns %False if the client sent a disconnect
             IF rsCommand(iCurrentSocket, rIn, sInBuffer) = %False THEN
                EXIT DO
             END IF
          END IF
          SLEEP 5
       LOOP
     
       TCP CLOSE gSock(iWhich)
       gSock(iWhich) = %INVALID_SOCKET
       gThreadRunning(iWhich) = %False
     
       gActive = gActive - 1
       DisplayEvent "Disconnect: " + FORMAT$(iWhich)
     
       FUNCTION = %True
     
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gDlgMain_WinProc
    '  This is the event loop for the application
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    CALLBACK FUNCTION gDlgMain_WinProc
     
       DIM i AS LONG
       DIM iFound AS LONG
       DIM iCurrentSocket AS LONG
       DIM iCount AS LONG
       DIM iEmpty AS LONG
       DIM iMain AS LONG
     
       SELECT CASE CBMSG
     
          CASE %WM_INITDIALOG
             InitListen
     
             '- Create a timer to handle thread cleanup
             SetTimer gDlgMain, %timer1, %CLEANUP_TIMER_INTERVAL, BYVAL %NULL
     
          CASE %WM_TIMER
             IF CBWPARAM = %timer1 THEN
                ThreadCleanup
             END IF
     
          CASE %TCP_CONNECT
     
             '- wparam contains the handle of the socket (FileAttr(hSock, 2) from accept event)
             SELECT CASE LOWRD(CBLPARAM)
     
                '- Someone is attempting to connect to the server
                CASE %FD_ACCEPT
     
                   EnterCritical
                   iFound = 0
     
                   '- Find an empty connection
                   iEmpty = 0
                   FOR i = 1 TO %MAX_CONNECTIONS
                      IF gSock(i) = %INVALID_SOCKET THEN
                         iEmpty = i
                         EXIT FOR
                      END IF
                   NEXT i
     
                   '- Figure out which socket this is coming in on.
                   iMain = 0
                   FOR i = 1 TO %MAX_IP_WAIT
                      IF FILEATTR(gMainSock(i), 2) = CBWPARAM THEN
                         iMain = i
                      END IF
                   NEXT i
     
                   '- Now we know which socket the connect request is coming
                   '  in on and which one we should assign it to,
                   '  so accept the connection and specify the notify events
                   '
                   IF (iMain > 0) AND (iEmpty > 0) THEN
     
                      '- Accept the connection
                      gSock(iEmpty) = FREEFILE
                      TCP ACCEPT gMainSock(iMain) AS gSock(iEmpty)
                      'Tcp Notify gSock(iEmpty), To gDlgMain As %TCP_CONNECT
                      DisplayEvent "FD_ACCEPT: " + STR$(gSock(iEmpty)) + " " + STR$(gMainSock(iMain))
                      LogEvent "CONNECT"
                      gActive = gActive + 1
     
                      THREAD CREATE tcpHandleConnection(iEmpty) TO gThread(iEmpty)
     
                   END IF
     
                   LeaveCritical
     
             END SELECT
             FUNCTION = 1
     
          CASE %WM_SYSCOMMAND
             IF CBWPARAM = %SC_CLOSE THEN
                KillTimer gDlgMain, %timer1
             END IF
     
          CASE %WM_DESTROY
     
             IF gLog THEN
                PRINT #gLog, "----------------------------------------------"
                PRINT #gLog, "SHUT DOWN " + DATE$ + "  " + TIME$
                PRINT #gLog, "  Active Clients:" + STR$(gActive)
                PRINT #gLog, "      Total Hits:" + STR$(gHits)
                PRINT #gLog, "**********************************************"
             END IF
     
       END SELECT
     
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  StopButton
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    CALLBACK FUNCTION btnStop_Click()
     
       DIALOG END gDlgMain, 0
       FUNCTION = 1
     
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  Initialize
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION Initialize() AS LONG
     
       DIM i AS LONG
     
       '- The configuration file is called rserver.ini
       '  and must be in the same directory as rserver.exe
       '
       gIniFile = TRIM$(ExtractPath(GetExeName()))
       IF RIGHT$(gIniFile, 1) <> "\" THEN
          gIniFile = gIniFile + "\"
       END IF
       gIniFile = gIniFile + "rserver.ini"
     
       '- This is a multi-threaded application.
       '  I use a critical section to resolve thread conflicts
       '
       InitializeCriticalSection gCS
     
       '- This program can be set to be multi-homed - that is,
       '  listen on more than one IP address. The IP addresses
       '  are specified in the rserver.ini file required to be
       '  in the same directory as rserver.exe. If it is not
       '  there, then the default IP address for this computer
       '  is assumed. This is based on what is returned
       '  by Host ADDR "" To
       '
       gIPCount = 0
       REDIM gIPAddr(%MAX_IP_WAIT) AS LONG
       FOR i = 1 TO %MAX_IP_WAIT
          gIPAddr(i) = INT(VAL(GetIni(gIniFile, "server", "IPAddr" + FORMAT$(i), "0")))
          IF gIPAddr(i) <> 0 THEN
             INCR gIPCount
          END IF
       NEXT i
     
       REDIM gMainSock(%MAX_IP_WAIT) AS LONG
     
       '- Set the default if none were found in the .ini
       IF gIPCount < 1 THEN
          gIPCount = 1
          HOST ADDR "" TO gIPAddr(1)
       END IF
     
       '- The port is an .ini setting. There is a constant
       '  for the default.
       '
       gPort = INT(VAL(GetIni(gIniFile, "server", "port", FORMAT$(%DEFAULT_PORT))))
     
       '- These are our connection place holders. Fill up the list with
       '  invalid connections.
       '
       REDIM gSock(1 TO %MAX_CONNECTIONS) AS LONG
       FOR i = 1 TO %MAX_CONNECTIONS
          gSock(i) = %INVALID_SOCKET
       NEXT i
     
       '- There will be on thread ID per connection
       REDIM gThread(1 TO %MAX_CONNECTIONS) AS LONG
       REDIM gThreadRunning(1 TO %MAX_CONNECTIONS) AS LONG
     
       gShutdown = %False
     
       '- Open the log file
       ON ERROR RESUME NEXT
       gLog = FREEFILE
       OPEN "rserver.log" FOR APPEND AS #gLog
       IF ERR THEN
          MSGBOX "Unable to create log file. Error =" + STR$(ERR)
          gLog = 0
       ELSE
          PRINT #gLog, ""
          PRINT #gLog, "**********************************************"
          PRINT #gLog, "START UP " + DATE$ + "  " +TIME$
          PRINT #gLog, "----------------------------------------------"
       END IF
     
       FUNCTION = %True
    END FUNCTION
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  ShutDown
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB ShutDown()
     
       DIM i AS LONG
       DIM foo AS LONG
     
       '- All threads monitor this flag and
       '  will bail as soon as possible after
       '  seeing this.
       '
       gShutdown = %True
       SLEEP 100
     
       '- Make sure to clean up any open sockets
       '  By closing a socket, the blocking tcp calls
       '  will stop blocking and error out. This
       '  allows the threads to finish executing.
       '
       FOR i = 1 TO %MAX_CONNECTIONS
          IF gSock(i) <> %INVALID_SOCKET THEN
             TCP CLOSE gSock(i)
             gSock(i) = %INVALID_SOCKET
          END IF
       NEXT i
     
       '- Free any running threads
       FOR i = 1 TO %MAX_CONNECTIONS
          IF gThread(i) <> 0 THEN
     
             THREAD CLOSE gThread(i) TO foo
     
             '- Wait for the thread to finish running
             '  When a thread finishes running, it sets its
             '  gThreadRunning() variable to be zero
             '
             DO UNTIL gThreadRunning(i) = %False
                SLEEP 10
             LOOP
     
          END IF
       NEXT i
     
     
       '- Close any open files
       IF gLog THEN
          CLOSE #gLog
          gLog = 0
       END IF
     
       CLOSE
     
       DeleteCriticalSection gCS
     
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  gDlgMain_Create()
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    SUB gDlgMain_Create()
     
       DIM i AS LONG
       DIM ipa AS STRING
     
       '- Get a list of the IP addresses for display purposes
       FOR i = 1 TO gIPCount
          IF ipa = "" THEN
             ipa = FormatIP(gIPAddr(i))
          ELSE
             ipa = ipa + "; " + FormatIP(gIPAddr(i))
          END IF
       NEXT i
     
       '- Create the main screen.
       DIALOG NEW 0, "Binary Data Server on Port " + FORMAT$(%DEFAULT_PORT),,, _
                  200, 200, %WS_MINIMIZEBOX OR %WS_CAPTION OR %WS_SYSMENU, 0 TO gDlgMain
     
       CONTROL ADD LABEL, gDlgMain, -1, "Server IP(s)", 17, 10, 40, 8, %SS_RIGHT
       CONTROL ADD LABEL, gDlgMain, -1, "Port", 17, 25, 40, 8, %SS_RIGHT
       CONTROL ADD LABEL, gDlgMain, -1, "Started", 17, 40, 40, 8, %SS_RIGHT
       CONTROL ADD LABEL, gDlgMain, -1, "Total Hits", 17, 55, 40, 8, %SS_RIGHT
       CONTROL ADD LABEL, gDlgMain, -1, "Active Clients", 17, 70, 40, 8, %SS_RIGHT
       CONTROL ADD LABEL, gDlgMain, -1, "Last Action", 17, 85, 40, 8, %SS_RIGHT
     
       CONTROL ADD LABEL, gDlgMain, %labIP, ipa, 65, 10, 80, 8, %SS_LEFT
       CONTROL ADD LABEL, gDlgMain, %labPort, FORMAT$(gPort), 65, 25, 80, 8, %SS_LEFT
       CONTROL ADD LABEL, gDlgMain, %labDate, DATE$ + "   " + TIME$, 65, 40, 80, 8, %SS_LEFT
       CONTROL ADD LABEL, gDlgMain, %labHits, "0", 65, 55, 80, 8, %SS_LEFT
       CONTROL ADD LABEL, gDlgMain, %labActive, "0", 65, 70, 80, 8, %SS_LEFT
       CONTROL ADD LABEL, gDlgMain, %labAction, "", 65, 85, 135, 8, %SS_LEFT
     
       CONTROL ADD BUTTON, gDlgMain, %IDCANCEL, "&Stop", 150, 177, 40, 15, 0 CALL btnStop_Click
     
    END SUB
     
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    '  PBMain
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    FUNCTION PBMAIN AS LONG
     
       Initialize
       gDlgMain_Create
       DIALOG SHOW MODAL gDlgMain CALL gDlgMain_WinProc
       Shutdown
     
    END FUNCTION



    [This message has been edited by paul d purvis (edited August 01, 2007).]
    p purvis

  • #2
    here is the rget.bas listing
    i compiled this with pbcc 4.0
    ---------------------------------------------------

    Code:
    '
    '  changed rstest.bas
    '  test program for the rserver remote binary file server
    '  Requires pb-dll 6 to compile
    '
    #COMPILE EXE
    '#DIM ALL
    #REGISTER NONE
    #INCLUDE "win32api.inc"
    %DEFAULT_PORT              = 12069     'port
    %MAX_CONNECTIONS           = 1000      'max simultaneous connections
    %MAX_IP_WAIT               = 5         'home many tcp interfaces can we listen on
    %TCP_TIMEOUT               = 10000     'how long before tcp timeout
    %CLEANUP_TIMER_INTERVAL    = 2000      'how often to call the thread cleanup (milliseconds)
    
    %BTS_MAX_LENGTH            =  1024
    %INVALID_COMMAND           = -2000
    
    %RSERVER_OPEN_FILE         = 1
    %RSERVER_CLOSE_FILE        = 2
    %RSERVER_GET               = 3
    %RSERVER_PUT               = 4
    %RSERVER_SEEK              = 5
    %RSERVER_LOF               = 6
    %RSERVER_QUIT              = 99
    
    TYPE XFER_BUFFER_TYPE
       iCommand AS LONG           'Used only when sending to the server
       iResult AS LONG            'Used only when receiving from the server
       iFile AS LONG              'File handle
       iEncrypted AS LONG         'Is data buffer encrypted (not yet implemented)
       iCompressed AS LONG        'Is data buffer compressed (not yet implemented)
       iDataLen AS LONG           'variable length data size
       iCheckSum AS LONG          'checksum of this structure
       iDataCS AS LONG            'checksum of variable length data
    END TYPE
    
    #IF NOT %DEF(%True)
    %True = -1
    %False = 0
    #ENDIF
    
    
    DECLARE FUNCTION rsConnect   (returnSocket AS LONG, BYVAL iPort AS LONG, zServer AS STRING ) AS LONG
    DECLARE SUB rsDisconnect     (BYVAL hSocket AS LONG)
    DECLARE FUNCTION rsOpen      (BYVAL hSocket AS LONG, zFile AS STRING) AS LONG
    DECLARE SUB rsClose          (BYVAL hSocket AS LONG, BYVAL hFile AS INTEGER)
    DECLARE FUNCTION rsPut       (BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL sData AS STRING ) AS LONG
    DECLARE FUNCTION rsGet       (BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL iLength AS LONG, sDataBuffer AS STRING ) AS LONG
    DECLARE FUNCTION rsLof       (BYVAL hSocket AS LONG, BYVAL hFile AS LONG ) AS LONG
    DECLARE SUB rsSeek           (BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL iPos AS LONG)
    
    
    FUNCTION rsConnect ( returnSocket AS LONG, BYVAL iPort AS LONG, zServer AS STRING )  AS LONG
    
       DIM hSocket AS LONG
       ON ERROR RESUME NEXT
       hSocket = FREEFILE
       TCP OPEN PORT iPort AT zServer AS hSocket
       returnSocket = hSocket
       IF ERR THEN
          STDOUT "Error: " + FORMAT$(ERR)
          FUNCTION = %False
       ELSE
          FUNCTION = %True
       END IF
    
    END FUNCTION
    
    SUB rsDisconnect ( BYVAL hSocket AS LONG)
    
       DIM sOut AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_QUIT
       rOut.iDataLen = 0
       sOut = SPACE$(LEN(rOut))
       LSET sOut = rOut
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       TCP CLOSE hSocket
    
    END SUB
    
    FUNCTION rsOpen (  BYVAL hSocket AS LONG, zFile AS STRING) AS LONG
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM sFile AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       sFile = TRIM$(zFile)
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_OPEN_FILE
       rOut.iFile = 0
       rOut.iDataLen = LEN(sFile) + 2
       sOut = SPACE$(LEN(rOut))
       LSET sOut = rOut
       sOut = sOut + MKI$(LEN(sFile)) + sFile
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       '- Process the result
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
    
       LSET rResp = sResp
    
       '- Process Response and return
       '  It returns Positive if it could
       '  open the file OR negative if there
       '  was an error. The abs of the return
       '  indicates the DOS error code.
       '
       IF rResp.iResult = 0 THEN
          FUNCTION = rResp.iFile
       ELSE
          FUNCTION = -1 * rResp.iResult
       END IF
    
    END FUNCTION
    
    SUB rsClose (  BYVAL hSocket AS LONG, BYVAL hFile AS INTEGER)
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_CLOSE_FILE
       rOut.iFile = hFile
       rOut.iDataLen = 0
       sOut = SPACE$(LEN(rOut))
       LSET sOut = rOut
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       '- Process the result
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
    
    END SUB
    
    FUNCTION rsPut (  BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL sData AS STRING ) AS LONG
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM sReturnBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_PUT
       rOut.iFile = hFile
       rOut.iDataLen = LEN(sData)
       sOut = SPACE$(LEN(rOut))
    
       LSET sOut = rOut
       sOut = sOut + sData
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
    
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
       LSET rResp = sResp
    
       FUNCTION = rResp.iResult
    
    END FUNCTION
    
    FUNCTION rsGet (  BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL iLength AS LONG, sDataBuffer AS STRING ) AS LONG
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM sReturnBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_GET
       rOut.iFile = hFile
       rOut.iDataLen = 4
       sOut = SPACE$(LEN(rOut))
    
       LSET sOut = rOut
       sOut = sOut + MKL$(iLength)
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
       LSET rResp = sResp
    
       IF rResp.iDataLen > 0 THEN
          sDataBuffer = SPACE$(rResp.iDataLen)
          TCP RECV hSocket, rResp.iDataLen, sDataBuffer
       END IF
    
       FUNCTION = rResp.iResult
    
    END FUNCTION
    
    FUNCTION rsLof (BYVAL hSocket AS LONG, BYVAL hFile AS LONG ) AS LONG
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM sReturnBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_LOF
       rOut.iFile = hFile
       rOut.iDataLen = 0
       sOut = SPACE$(LEN(rOut))
    
       LSET sOut = rOut
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
       LSET rResp = sResp
    
       IF rResp.iDataLen > 0 THEN
          sReturnBuffer = SPACE$(rResp.iDataLen)
          TCP RECV hSocket, rResp.iDataLen, sReturnBuffer
          FUNCTION = CVL(LEFT$(sReturnBuffer, 4))
       ELSE
          FUNCTION = rResp.iResult
       END IF
    
    END FUNCTION
    
    SUB rsSeek (  BYVAL hSocket AS LONG, BYVAL hFile AS LONG, BYVAL iPos AS LONG)
    
       DIM sOut AS STRING
       DIM sResp AS STRING
       DIM sReturnBuffer AS STRING
       DIM rOut AS XFER_BUFFER_TYPE
       DIM rResp AS XFER_BUFFER_TYPE
    
       '- Prepare the send buffer
       rOut.iCommand = %RSERVER_SEEK
       rOut.iFile = hFile
       rOut.iDataLen = 4
       sOut = SPACE$(LEN(rOut))
       LSET sOut = rOut
       sOut = sOut + MKL$(iPos)
    
       '- Send Data and wait for response
       TCP SEND hSocket, sOut
    
       sResp = SPACE$(LEN(rResp))
       TCP RECV hSocket, LEN(sResp), sResp
       LSET rResp = sResp
    
    END SUB
    
    
    FUNCTION PBMAIN
    
       DIM iRet AS LONG
       DIM loftemp AS LONG
       DIM hSocket AS LONG
       DIM hFile AS LONG
       DIM shfile AS LONG
       DIM sReturn AS STRING
    
       temp$=COMMAND$
       TEMP$=TRIM$(TEMP$)+" "
       I&=INSTR(TEMP$," ")
       IF I&=0 THEN
       STDOUT "bad command tail used"
       STDOUT "WWW.MYSERVER.COM:PORT NUMBER  C:\FILENAME"
       FUNCTION=1
       EXIT FUNCTION
       END IF
       LOCATION$=MID$(TEMP$,1,I&-1)
       FILEGET$=TRIM$(RIGHT$(TEMP$,(LEN(TEMP$)-I&)))
       IF LEN(FILEGET$)=0 THEN
       STDOUT "bad command tail used"
       STDOUT "WWW.MYSERVER.COM:PORT NUMBER  C:\FILENAME"
       FUNCTION=1
       EXIT FUNCTION
       END IF
       LOCATION$=" "+LOCATION$+" "
       I&=INSTR(LOCATION$,":")
       IF I&>0 THEN
       PORTNUMBER$=TRIM$(RIGHT$(LOCATION$,(LEN(LOCATION$)-I&)))
       LOCATION$=TRIM$(LEFT$(LOCATION$,I&-1))
       END IF
    
       IF LEN(PORTNUMBER$)>0 THEN
         SERVERPORT&=VAL(PORTNUMBER$)
         ELSE
         SERVERPORT&=%DEFAULT_PORT
       END IF
       IF LEN(LOCATION$)>0 THEN
       servername$=LOCATION$
       ELSE
       SERVERNAME$=""
       END IF
    
       STDOUT "trying to connect to remote machine "+servername$+" on port:"+TRIM$(STR$(serverport&))+"  waiting"
       '- Attemp to connect
      IF rsConnect(hSocket, SERVERPORT&, servername$) = %False THEN
       STDOUT "cannot find the remote machine"
       FUNCTION=2
       EXIT FUNCTION
       ELSE
          hFile = rsOpen(hSocket, fileget$)
          IF hFile < 0 THEN
          STDOUT "cannot find file "+fileget$+" on the remove machine"
          FUNCTION=3
          GOTO stopconnection
          EXIT FUNCTION
          END IF
       END IF
    
       iRet = rsLof(hSocket, hFile)
    
       IF iRet < 0 THEN
              STDOUT "Unable to determine the file length. DOS error =" + STR$(ABS(iRet))
              FUNCTION=3
              GOTO stopconnection
              EXIT FUNCTION
       END IF
       ' IF iRet = 0 THEN
       '       STDOUT "the file length returned from server is zero, so assumming no file exist"
       '       STDOUT "so aborting program"
       '       FUNCTION=3
       '       GOTO stopconnection
       '       EXIT FUNCTION
       'END IF
    
    
        shfile=FREEFILE
        newfile$=" "+STRREVERSE$(fileget$)
        FOR i&=1 TO LEN(newfile$)
            IF INSTR(UCASE$(MID$(newfile$,i&,1)),ANY "[email protected]~$ 0123456789          ")=0 THEN
                newfile$=MID$(newfile$,1,(i&-1))
                newfile$=TRIM$(STRREVERSE$(newfile$))
                EXIT FOR
            END IF
        NEXT i&
        IF UCASE$(NEWFILE$)="DIRECTORY" THEN
            NEWFILE$="REMOTE_DIRECTORY.LST"
            STDOUT "retrieving a remote machines directory inside a file named REMOTE_DIRECTORY.LST"
        END IF
        STDOUT "transferring file "+newfile$+" on "+DATE$+" at "+TIME$
        STDOUT "the length of file at the remote computer is:" + STR$(iRet)
    
        startoftime&=TIMER
        OPEN newfile$+".part" FOR BINARY ACCESS WRITE AS #shfile
         rsSeek hSocket, hFile, 1
    loftemp=iret
    
    
    getagain:
    
    IF loftemp>5808 THEN
         iRet = rsGet(hSocket, hFile, 5808, sReturn)
       ELSE
        iRet = rsGet(hSocket, hFile, loftemp, sReturn)
    END IF
    
    IF iRet <> 0 THEN
               CLOSE  shfile
               KILL newfile$+".part"
               STDOUT "Error reading remote file. DOS error =" + STR$(iRet)
               FUNCTION=3
               GOTO STOPCONNECTION
    END IF
    
    PUT$ #shfile,sreturn
    
    loftemp=loftemp-5808
    IF loftemp>0 THEN
        GOTO getagain
    END IF
    
    CLOSE shfile
    KILL newfile$
    NAME newfile$+".part" AS newfile$
    STDOUT fileget$+" file retreived on "+DATE$+" at "+TIME$
    STDOUT "transfer time in seconds is "+STR$(TIMER-startoftime&)
    FUNCTION=0
    STOPCONNECTION:
          rsClose hSocket, hFile
          rsDisconnect hSocket
    END FUNCTION



    [This message has been edited by paul d purvis (edited August 01, 2007).]
    p purvis

    Comment


    • #3
      i see a potential problem in the server program where the remote request
      a directory listing.
      it is where several request for a directory is asked the same time.
      my program will kill any the file "DIRECTORY.LST" immediately, so if another request was
      running on the remote asking for a directory listing, the server would erase the file "DIRECTORY.LST"
      that the first remote request asked for. anyways, asking for a directory listing by multiple request at the same time
      could cause who knows what kind of problems on the server side and client side.
      this program was meant to transfer known files from the beginning of my programming anyway.
      the reason for a directory listing was just for verifying or viewing files that existed for problem solving.
      at this time i am not going to change(make any corrections).
      because i might screwup the program due to the fact i have had little experience with threads.
      but if i can do some kind of testing in the future or make changes i hope to list those here.




      ------------------
      p purvis

      Comment


      • #4
        I misspelled Don Dickinson's name

        I have been referring to Mr Don Dickinson as Don Dickerson as some kindly pointed out and i want to correct that for many reasons, mostly as i use his code every single day, and wanted to show respect.
        I could not find a way to edit the previous posting after the change to the new forum plateform.
        sorry Don
        paul
        p purvis

        Comment


        • #5
          > I could not find a way to edit the previous posting after the change to the new forum plateform.

          Bottom right of your post, Paul - but you must be logged in.

          I know, I shouldn't respond here.

          Comment

          Working...
          X