'
'  PROJECT:  srvSocket.exe
'            In conjunction with cliSocket, TEST socket comms
'            Uses QSocketEx.inc (parts of RSocket.inc added)
'  COPYME:
'            This code is provided "free" to be used by anyone
'            provided that it, or any derivative works, is NOT SOLD
'            OR TRADED FOR FINANCIAL GAIN OF ANY KIND.
'            This source code, AND any derivative works based on this
'            source code, may be modified and/or distributed freely
'            providing that this notice is included in, or with,
'            such distribution.
'
'  DISCLAIMER:
'            As this is "free" source code, NO liabilty of ANY KIND WHATSOEVER,
'            can be placed on the original author.
' 
'  CREDITS:  EL SUPREMO ... William YU
'            AND a heap of others?
'
'  AUTHOR:   d_homans@yahoo.com.au
'  DATE:     05/06/2007
'  VERSION:  0.0003
'
'  NOTES:    The application layer protocol for this demo has been kept ultra simple.
'            Client alternates with one of two requests:
'                  "GET TEXT" or "GET DATA" (8 bytes)
'            Server responds with a header block (14 bytes)
'                  ascii file size (6 bytes) + ascii timestamp (8 bytes)
'            Then sends either the text or data (bmp) file.  
'            I test with two files of size about 30k each.
' 
$APPTYPE GUI
$TYPECHECK ON
$OPTIMIZE ON
$ESCAPECHARS OFF

$INCLUDE "Rapidq2.inc"
$INCLUDE "QSocketEx.inc"                                           ' With additional fns

CONST VERS="v0.0003"                                               ' Nearly there!
CONST CRLF=CHR$(13)+CHR$(10)
CONST DEFAULTPORT=2000                                             ' Anything above 1023?
CONST PACKETMAXLENGTH=1024                                         ' Arbitrary value selected
'
' SET THE PATH+FILE for transfers in this simplified demo
'
CONST tFile1=Application.Path+"/Test1.txt"                         ' Any text data file
CONST tFile2=Application.Path+"/Test2.bmp"                         ' Any binary data file
'
CONST tFile3=application.Path+"/ValidClients.txt"                  ' List of trusted client IPs
'
' Some forward declarations
DECLARE SUB Initialise
DECLARE SUB LoadValidClients                                       ' From a text file
DECLARE SUB ShowClients                                            ' Just checking!
DECLARE SUB Control                                                ' Start/stop server
DECLARE SUB MainLoop                                               ' Main comms loop
DECLARE FUNCTION IsValidClient(ipaddr AS string) AS integer        ' Returns True/False
DECLARE SUB SendData(fName AS string)                              ' Send data on request
DECLARE SUB Cleanup                                                ' Exit program
'
DIM Keepgoing AS integer                                           ' General Purpose flag
DIM mem1 AS QMEMORYSTREAM                                          ' GP Storage
DIM ValidClients AS QSTRINGLIST                                    ' List of valid IPs
DIM MyTimer AS QTIMER                                              ' Not used ATT
'
DIM MyServer AS QSocketEx                                          ' With added fns
DIM ServerPort AS integer                                          ' SINGLE port monitored
DIM ServerSocket AS integer
DIM ClientSocket AS integer
DIM LastError AS long

CREATE Form AS QFORM
    Height=300
    Width=400
    Center
    DelBorderIcons(2)                                              ' Disable maximize button
    BorderStyle=1                                                  ' Fixed size form
    Caption=Application.Title+" "+VERS
    OnClose=Cleanup                                                ' Tidy up your own mess!
    CREATE TxtBox AS QRICHEDIT
        Height=200
        Width=380
        Top=5
        Left=5
        PlainText=True
        ReadOnly=True
        ScrollBars=ssVertical
        HideSelection=False
    END CREATE
    CREATE but1 AS QBUTTON
        Top=230
        Left=Form.ClientWidth\3-but1.Width\2
        Caption="Start"
        OnClick=Control
    END CREATE
    CREATE but2 AS QBUTTON
        Top=230
        Left=Form.ClientWidth*2\3-but2.Width\2
        Caption="EXIT"
        OnClick=Cleanup                                            ' Close this app!
    END CREATE
END CREATE

Initialise

Form.ShowModal
'
'============================= Initialisation stuff ========================================
'
SUB Initialise
DIM tstr AS string

    TxtBox.Clear
    ClientSocket=-1
    LastError=0
    ServerPort=DEFAULTPORT    
    ServerSocket=MyServer.Open(ServerPort)
    IF ServerSocket=-1 THEN
        MessageBox("Server Socket failure on port "+str$(ServerPort),Application.Title+" "+VERS,&H10)
        Application.Terminate                                      ' EXIT PROGRAM
    ELSE
        TxtBox.AddString "Server initialised"
    END IF
    IF FileExists(tFile3)=False THEN
        tstr="NO client file exists"+CRLF+"defaulting to localhost [127.0.0.1]"
        MessageBox(tstr,Application.Title+" "+VERS,&H20)
    END IF
    'This makes the main form correctly minimise
    SetWindowLong Form.Handle, -8, 0
    SetWindowLong Application.Handle, -8, Form.Handle

END SUB
'
'============================= The Reason for Existence =====================================
'
SUB Control
    IF but1.Caption="Start" THEN
        LoadValidClients                                         ' Ensure this is current
'        ShowClients                                              ' Just checking!
        but1.Caption="Stop"
        Keepgoing=True
        MainLoop
    ELSE                                                         ' NB If data being sent ..
        Keepgoing=False                                          ' .. will stop after the last
    END IF                                                       ' data byte has gone!
END SUB
'
' NB Comms uses Read/Write BINARY text/data ONLY - for safer control??
' No "extras" added on TX and no reliance on <CR> and/or <LF> terminated
' strings on RX! (what you get is what you see?)
'
SUB MainLoop
DIM ipstr AS string
DIM str AS string

    TxtBox.AddString TIME$+"STATUS: Server started. Listening on port "+STR$(ServerPort)
    
    WHILE Keepgoing=True                                           ' Loop while True
        IF MyServer.ConnectionReady(ServerSocket)=True THEN        ' Connection pending?
            ClientSocket=MyServer.Accept(ServerSocket)             ' Accept client connection
            ipstr=MyServer.GetPeerName(ClientSocket)               ' Which IP is calling us?
            str=MyServer.NameByAddr(ipstr)                         ' Identify it by name
            IF str="" THEN str="?"
$IFDEF DBG
            ' Testing AddrByName code - appears to work ok!
            IF str<>"?" THEN
                ' Check we can get the IP address from the peer computer name
                TxtBox.AddString TIME$+" DBG: Client "+str+" = "+MyServer.AddrByName(str)
            END IF
$ENDIF  
            IF IsValidClient(ipstr) THEN                           ' Is it in our list of valid IPs?
                TxtBox.AddString TIME$+" STATUS: Client "+ipstr+" ["+str+"] connected"
                str=MyServer.Read(ClientSocket,8)                  ' Get the message (text data)
                SELECT CASE Left$(str,8)
                    CASE "GET TEXT"                                ' MY client prog requests data
                        SendData(tFile1)                           ' Send text as binary data
                    CASE "GET DATA"
                        SendData(tFile2)                           ' Send binary as ....duh!
                    CASE ELSE
                        TxtBox.AddString TIME$+" ERROR: Unknown req from client ("+str+")" 
                END SELECT
            ELSE
                ' Not interested, so terminate! and log?
                TxtBox.AddString TIME$+" ERROR: Unknown client IP ("+ipstr+")" 
            END IF
            IF LastError<>0 THEN
                TxtBox.AddString TIME$+" ERROR: #"+STR$(LastError)+" Client "+STR$(ipstr) 
            END IF
            MyServer.Close(ClientSocket)
            ClientSocket=-1
            TxtBox.AddString TIME$+" STATUS: Client "+ipstr+" disconnected"
            ipstr=""
            str=""
        END IF
        DoEvents                                                    ' Check for events
        Sleep.MS 10                                                 ' Take a break!
    WEND

    but1.Caption="Start"                                            ' Stop button clicked
    TxtBox.AddString TIME$+" STATUS: Server stopped"

END SUB

FUNCTION IsValidClient(ipaddr) AS integer
DIM i AS integer

    Result=False
    IF ValidClients.ItemCount>0 THEN
        FOR i=0 TO ValidClients.ItemCount-1
            IF ipaddr=LTRIM$(RTRIM$(ValidClients.Item(i))) THEN
                Result=True
                EXIT FOR
            END IF
        NEXT i
    END IF
    
END FUNCTION

SUB SendData(fName)
DIM File AS QFILESTREAM
DIM Size AS long
DIM hdr AS string
DIM chunk AS string

    File.Open(fName,fmOPENREAD)                                     ' Get the data file
    Size=File.Size
    mem1.Position=0                                                 ' Reset memorystream
    mem1.CopyFrom(File,0)                                           ' Copy file to stream
    File.Close
    hdr=Format$("%6.6d",Size)                                       ' Header info - size 6 bytes
    hdr=hdr+TIME$                                                   ' Plus Time stamp 8 bytes
    TxtBox.AddString "    TX: Sending binary header data"
    LastError=MyServer.WriteEx(ClientSocket,hdr,14)                 ' Send the header
    IF LastError>0 THEN EXIT SUB

    DoEvents
    TxtBox.AddString "    TX: Sending binary file data"
    mem1.Position=0
    LastError=0
    WHILE Size>PACKETMAXLENGTH AND LastError=0
        chunk=mem1.ReadBinStr(PACKETMAXLENGTH)
        Size-=PACKETMAXLENGTH
        LastError=MyServer.WriteEx(ClientSocket,chunk,PACKETMAXLENGTH)     ' Send chunks of memorystream
        DoEvents
        Sleep.MS 10
    WEND
    IF LastError=0 THEN
        chunk=mem1.ReadBinStr(Size)
        LastError=MyServer.WriteEx(ClientSocket,chunk,Size)         ' Send remainder
    END IF
    
END SUB
'
'============================= Housekeeping stuff ==========================================
'
' NB You can edit the file then stop/start the server to re-read the data
'    while clients are still running (just may be delayed a little)
SUB LoadValidClients
    ValidClients.Clear                                              ' Ensure empty
    IF FileExists(tFile3) THEN
        ValidClients.LoadFromFile(tFile3)                           ' Reload them
    ELSE
        ValidClients.AddItems "127.0.0.1"                           ' Default entry localhost
    END IF
END SUB

SUB Cleanup
    Keepgoing=False
    MyTimer.Enabled=False
    IF ClientSocket<>-1 THEN
        MyServer.Close(ClientSocket)
    END IF
    MyServer.Close(ServerSocket)
    Application.Terminate
END SUB

SUB ShowClients
DIM i AS integer
DIM tstr AS string

    IF ValidClients.ItemCount>0 THEN
        FOR i=0 TO ValidClients.ItemCount-1
            tstr=tstr+LTRIM$(RTRIM$(ValidClients.Item(i)))+CRLF
        NEXT i
        ShowMessage tstr
    ELSE
        ShowMessage "No valid clients?"
    END IF

END SUB