'
' FD_FILE_RECEIVER : a Server by Jacques Philippe  -  July 2001
'
' This Software receives files Sent by FD_FILESENDER.EXE/BAS
' 
'  !!!!!!!!  this Server Accepts Only ONE SINGLE Client  !!!!!!!!
'
' It Uses and Tests the Windows Messages (FD_XXXX) sent by the System -Windows-
' to manage the connection. There are no 'local' timers involved anymore and
' no IsServerReady, IsClientReady, If Transfered = 0 ... either
'
' NOTE : socket.WMessage and socket.LParam dont seem to work with Servers in rapidQ ????
'        It looks like the WMessage and LParam are not inherited from master server socket
'        by Accepted Socket in QSocket ???  So we here use API function WSAAsyncSelect !
'
' A ?good? help is the Winsock function  WSAAsyncSelect  documentation (see below)
' 
'
' Hand Shaking :
'
' TX : connect
' Tx : "****SaveThisFile "<filename> <filelength>       'space separator
' Rx : "****OK You Can Upload The File"
' TX : sends the file
' Rx : "****OK File Received"              ' when it has received filelength bytes
' TX : disconnect
'
' Tx is the client transmitting the file and Rx the server receiving it
'

$APPTYPE GUI
$ESCAPECHARS ON
$TYPECHECK ON
$INCLUDE "RAPIDQ.INC"

' API Winsock Declarations
Declare Function WSAAsyncSelect Lib "wsock32.dll" Alias "WSAAsyncSelect" (s As Long, hwnd As Long, wMsg As Long, lEvent As Long) As Long
Declare Function WSAGetLastError Lib "WSOCK32" Alias "WSAGetLastError" () As Long
' API
DECLARE FUNCTION Setfocus Lib "user32" Alias "SetFocus"(hwnd As Long) As Long

Declare Sub FormWndProc (Hwnd as Long, uMsg as Long, wParam as long, lParam as Long)
Declare Sub OnClic_btnDisConnect
Declare Sub AddToRxWin (sText as string)
Declare Sub SendFile
Declare Sub ReInitialise
Declare Sub GetFileNameAndLength (sText As String)

' You may change these two constants
CONST WM_SOCK = 100696         ' Make sure it's > 1024, whatever you want
CONST TEST_PORT = "88"

' WSA Constants  defining type of messages
CONST FD_READ = 1    '   001h   there is something to read on the socket
CONST FD_WRITE = 2   '   002h   one sent on connect, and one **AFTER** a WSAEWOULDBLOCK error had occured
                     '          as soon as the send buffer is free again.
                     '          The way FD_WRITE works is not easy to understand ! Not "intuitive"                  
CONST FD_OOB  = 4    '   004h   dont wanna know :)  OUT OF BAND datas
CONST FD_ACCEPT = 8  '   008h   for servers only, a connection request has been received : Accept it ? Or Not ?
CONST FD_CONNECT = 16'   010h   not used
CONST FD_CLOSE  = 32 '   020h   socket is now closed (by remote host)

CONST WSAEWOULDBLOCK = 10035    '  Used for/by FD_WRITE  : occurs on a Send, means that Not enough space in send buffer,
                                ' nothing done, wait for the next FD_WRITE msg to RESEND these datas

CONST PACKETMAXLENGTH = 984     ' 

' Global Variables                            
Dim numActiveSck as Long        '  The "Number" Of The "Active" Socket : the one on which datas are exchanged
Dim numFileReceiverMasterServer as Long     '  The "Number" of The Master Server Socket                              
Dim RxWinText As String          '  A buffer to rchRxWin.Text (The receiving Window)
Dim receivedFile as QFileStream  '  
Dim sFilename as String          '  a variable for the selected filename
Dim iFileLength As Long
Dim iBytesReceived As Long
Dim transferStartTime As Single  ' to measure the file transfer time
Dim transferEndTime As Single


' Form
CREATE frmFileReceiver AS QForm
  Width = 750
  Height = 300
  Center
  Caption = "Hellionor FILE RECEIVER : Server Version 1.0.1  (accepts only one client)"
  Autoscroll = false
  'Color = &HC39459
  CREATE sckFileReceiver AS QSocket
  END CREATE
  CREATE btnDisConnect AS QButton
    Left = frmFileReceiver.ClientWidth - 120 
    Top = 5 
    Width = 116 
    Height = 25
    Font.Bold = True
    Caption = "DIS&Connect"
    OnClick = OnClic_btnDisConnect
  END CREATE
  CREATE btnRestartServer AS QButton ' To Set New Port
    Left = 63
    Top = 5 
    Width = 110
    Height = 25 
    Font.Bold = True
    Caption = "&Restart Server"
    OnClick = ReInitialise 
  END CREATE
  CREATE edtPort AS QEdit  ' the HOSTNAME or IP ADDRESS to Connect
    Left = 3
    Top = 5
    Width = 50
    Height = 25
    ShowHint = True
    Hint = " Enter here a Port Number \n Then Clic Restart Server To Set The New Port Number \n ex : TELNET 23, CHAT 87, CONVERS 3600 "
    Text = TEST_PORT
  END CREATE
  CREATE rchRxWin AS QRichEdit  ' will disply the received datas
    Top = 35
    Left = 3
    Font.Name = "courier"    
    Width = frmFileReceiver.ClientWidth - 6
    Height = frmFileReceiver.ClientHeight - 40 ' ?
    ReadOnly = True
    WordWrap = False
    ScrollBars = ssBoth
    HideSelection = False 
  END CREATE
  WndProc = FormWndProc
END CREATE

'  Creates necessary directories
MkDir "rxFiles"       ' for rxFile


DefStr strTmp
' Opened as a Server on start
strTmp = edtPort.Text
strTmp = strTmp - " "
numFileReceiverMasterServer = sckFileReceiver.Open(Val(strTmp))
' only accept FD_MESSAGE for now
If WSAASyncSelect (numFileReceiverMasterServer, frmFileReceiver.Handle, WM_SOCK, FD_ACCEPT) <> 0 Then
     ShowMessage ("Error While Opening Server WSA error = " & Str$(WSAGetLastError) & "\n\n ANY KEY TO END/EXIT")
     END          
End If

' Some Help Text :) 
AddToRxWin (Time$ & " , " & Date$ & "\n\n*** FD_FILE_RECEIVER is now ON, WAITING for a Connection on Port " & (edtPort.Text - " ") & _
    "\n***     at IpAddress : " & sckFileReceiver.GetHostIp & "  .....  WAITING .....\n")

SetFocus (rchRxWin.Handle)

'   ********************************************************************
frmFileReceiver.ShowModal
'   ********************************************************************

' This sub receives the Window Messages
SUB FormWndProc (Hwnd as Long, uMsg as Long, wParam as Long, lParam as Long)
    Dim Line as String
    Dim sTmp As String
    Dim LowLparam as Long
    Dim HighLparam as Long
    LowLParam = LParam and &H0000FFFF             ' contain the message Type  FD_XXXX
    HighLParam = (LParam and &HFFFF0000)/&H10000  ' may contain Error Code, Not Used For Now
    IF uMsg = WM_SOCK THEN       ' filters the message WM_SOCK (= OURS)
        Select Case LowLParam    ' contains the type of message
            Case FD_READ         '=1 : there is something new to read on the socket  OK
               Line = sckFileReceiver.Read(numActiveSck, PACKETMAXLENGTH) 
               ' detect hand shaking
               If Left$ (Line, 8) = "****Save"  Then ' avoid long check at each frame
                   GetFileNameAndLength (Line)                           
                   receivedFile.Open ("rxFiles\\" & sFileName, fmCreate)
                   sTmp = "****OK You Can Upload The File"
                   sckFileReceiver.Write (numActiveSck, sTmp, Len(sTmp))
                   AddToRxWin ("*** RECEIVING FILE : \"" & sFileName & "\" of Length = " & Str$(iFileLength) & "\n")
                   transferStartTime = Timer
               Else   ' Receives the file
                      receivedFile.Write(Line)
                      iBytesReceived = iBytesReceived + sckFileReceiver.Transferred
                      btnRestartServer.Caption = Str$(iBytesReceived) & " xmit"
                      If iBytesReceived = iFileLength Then
                           sTmp = "****OK File Received"
                           sckFileReceiver.Write (numActiveSck, sTmp, Len(sTmp))
                           transferEndTime = Timer
                           AddToRxWin ("*** FILE \"" & sFileName & "\" of length " & Str$(iFileLength) & "  RECEIVED and SAVED\n" _
                           & "***    in " & Str$(transferEndTime - transferStartTime) _
                           & " seconds,  bit rate of " & Str$(iFileLength * 8/(transferEndTime - transferStartTime))  & "\n")
                           btnRestartServer.Caption = "&Restart Server"
                          
                           receivedFile.Close                           
                      End If
               End If
            Case FD_ACCEPT ' 8    '=8  The Server has received a Connection Request : Accept Y/N
                numActiveSck = sckFileReceiver.Accept(numFileReceiverMasterServer)
                If WSAASyncSelect (numActiveSck, frmFileReceiver.Handle, WM_SOCK, FD_READ & FD_WRITE & FD_CLOSE) <> 0 Then
                     ShowMessage ("*** ERROR : WSA Error = " & Str$(WSAGetLastError) & Str$(WSAGetLastError) & "\n\n ANY KEY TO END/EXIT")
                     End
                End If 
                ' socket.WMessage and socket.LParam dont seem to work with Servers ????
                ' It looks like the WMessage and LParam are not inherited from
                ' master server in QSocket ???  So I use WSAAsyncSelect
                
                ' Welcome Msg To Conecting Client
                AddToRxWin ("*** SERVER ACCEPT a Client\n")
            Case FD_CLOSE        '=32   connection closed by remote host (???or error???)
                AddToRxWin ("*** DISCONNECTED By Remote Host !\n")
                ReInitialise
        End Select
    END IF
END SUB

' Btn  Connect/Disconnect  ...  CLIENT MODE
SUB OnClic_btnDisConnect
        AddToRxWin ("*** DISCONNECTED By Local Host\n")
        ReInitialise  ' Restarts the Server
        SetFocus (rchRxWin.Handle)
END SUB


' Add a Text To The rchRxWin (Displaying received text Upper richText One)
Sub AddToRxWin (sText as String)
    RxWinText = RxWinText & sText
    If Len(RxWinText) > 10000 Then RxWinText = Right$(RxWinText, 8000) ' limits the length of rchRxWin.Text
    rchRxWin.Text = RxWinText
    rchRxWin.SelStart = Len (RxWinText) ' AutoScroll Up of RxWindow
End Sub

' ReInitialises in Server Mode
Sub ReInitialise
    sckFileReceiver.Close (numFileReceiverMasterServer)
    sckFileReceiver.Close (numActiveSck)

    iBytesReceived = 0
    iFileLength = 0

    numFileReceiverMasterServer = sckFileReceiver.Open(Val(edtPort.Text - " "))
    If WSAASyncSelect (numFileReceiverMasterServer, frmFileReceiver.Handle, WM_SOCK, FD_ACCEPT) <> 0 Then
        ShowMessage ("Error While Opening Server WSA error = " & Str$(WSAGetLastError) & "\n\n ANY KEY TO END/EXIT")
        END          
            End If
    AddToRxWin ("\n*** FD_FILE_RECEIVER REINITIALISED, SERVER WAITING for a Connection\n" _
        & "***    on PORT " & (edtPort.Text - " ") & " at IPADDRESS : " & sckFileReceiver.GetHostIp & "  .....  WAITING .....\n")
    SetFocus (rchRxWin.Handle)
End Sub


Sub GetFileNameAndLength (sText As String)
    DefInt iTmp
    iTmp = Rinstr (sText, " ")
    sFileName = Mid$(sText, 18, iTmp - 18)
    iFileLength = Val(Right$ (sText, Len(sText) - iTmp))
End Sub

' SOME DOCS
' ---------
'
'  RAPIDQ  DOC
' ------------------
' WndProc	SUB (Hwnd%, Msg%, wParam%, lParam%)	Messages posted/sent to form
'     only one WndProc per Form is allowed. So if you have multiple forms, only one may be able to
'     receive messages at a time. (Future consideration to correct this) 				
'
' Hwnd = yourForm.Handle  that have received the message
' Msg = the number your have chosen for your messages  WM_SOCK here
' wParam = the number of the socket on which the events has happened
' lParam = Low byte : the type of event (FD_XXXX) High Byte : ?? an eventual error code ???
'
' For more info, search the web with   WSAAsyncSelect & FD_ACCEPT
'