'
' FD_FILE_SENDER : a Client by Jacques Philippe  -  July 2001
'
' This Software Sends Files received ***ONLY*** by FD_FILERECEIVER.EXE/BAS
' 
' 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
'
' A ?good? help is the Winsock function  WSAAsyncSelect  documentation (see below)
' 
' Tx is the client transmitting the file and Rx the server receiving it
'
' Hand Shaking :
' ------------
'       Tx : connect
'       Tx : "****SaveThisFile "<filename> <filelength>  ' space separator
'       Rx : "****OK You Can Send The File"
'       Tx : sends the file
'       Rx : "****OK File Received"          ' when it has received filelength bytes
'       TX : disconnect
'

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

' API Winsock Declarations
'Declare Function WSAGetLastError Lib "wsock32.dll" Alias "WSAGetLastError" () As Long
' API
'Declare Function Setfocus Lib "user32" Alias "SetFocus"(hwnd As Long) As Long
' Subs & Functions
Declare Sub FormWndProc (Hwnd as Long, uMsg as Long, wParam as long, lParam as Long)
Declare Sub OnClic_btnUploadFile
Declare Sub AddToRxWin (sText as string)
Declare Sub SendFile
Declare Sub ReInitialise
Declare Function ExtractFileName (sPath as String) as String


' you may change these three constants
CONST WM_SOCK = 10696         ' Make sure it's > 1024, whatever you want
CONST TEST_ADDRESS = "192.168.0.16" ' "ilcar.net"
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
CONST FD_CONNECT = 16'   010h   socket is now connected to remote host
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 StringToSend As String    '  The content of rchTxWin.Text to send, or a "slice"/"packet" of a file to send or ...
Dim RxWinText As String       '  A buffer to rchRxWin.Text (The receiving Window)
Dim OpenDialog As QOpenDialog '  Used to select the file to transfer  
OpenDialog.Caption = "Choose a ***TEXT*** File To Upload" 
OpenDialog.InitialDir ="C:\" 
Dim flagLastNotSent As Long   '  flag for "slice"/"Packet" not sent : on WSAEWOULDBLOCK error
flagLastNotSent = False
Dim sentFile As QFileStream     ' File To Upload
Dim sFilename As String         ' a variable for the selected filename
Dim sFileLength As String       ' selected filelength 
Dim flagTransferingFile As Long     ' a file is currently transfered
flagTransferingFile = False     
Dim transferStartTime As Single  ' to measure the file transfer time
Dim transferEndTime As Single

' Form
CREATE frmFileSender AS QForm
  Width = 750
  Height = 300
  Center
  Caption = "FD_FILE_SENDER Version 1.0.1" 
  Autoscroll = false
  'Color = &HC39459
  CREATE sckFileSender AS QSocket
      WMessage = WM_SOCK
      LParam = FD_CONNECT
  END CREATE
  CREATE btnDisConnect AS QButton
    Left = frmFileSender.ClientWidth - 120 '160
    Top = 5
    Width = 116 '156
    Height = 25
    Font.Bold = True
    Caption = "&DISConnect"
    OnClick = ReInitialise
  END CREATE
  CREATE btnUploadFile AS QButton
    Left = frmFileSender.ClientWidth - 260 '320
    Top = 5
    Width = 136
    Height = 25
    Font.Bold = True
    Caption = "&Upload File"
    OnClick = OnClic_btnUploadFile 
  END CREATE
  CREATE edtHost AS QEdit  ' the HOSTNAME or IP ADDRESS to Connect
    Left = 3
    Top = 5
    Width = 200
    Height = 25
    ShowHint = True
    Hint = " Enter here the HostName or the \n IP Address of the File Receiver Host"
    Text = TEST_ADDRESS
  END CREATE
  CREATE edtPort AS QEdit  ' the HOSTNAME or IP ADDRESS to Connect
    Left = 220
    Top = 5
    Width = 50
    Height = 25
    ShowHint = True
    Hint = " Enter here a 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 = frmFileSender.ClientWidth - 6
    Height = frmFileSender.ClientHeight - 40
    ReadOnly = True
    WordWrap = False
    ScrollBars = ssBoth
    HideSelection = False 
  END CREATE
  WndProc = FormWndProc
END CREATE

' Some Help Text :) 
AddToRxWin (Time$ & " , " & Date$ & "\n\n*** FD_FILE_SENDER On Port " & (edtPort.Text - " ") & ", IpAddress : " & sckFileSender.GetHostIp _
    &  "\n\nSet the RECEIVER IPADDRESS, its PORT and then Clic Button 'UpLoad File'\n\n")

SetFocus (rchRxWin.Handle)

'   ********************************************************************
frmFileSender.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 iTmp As Long
    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 = sckFileSender.Read(numActiveSck, PACKETMAXLENGTH)
               ' detect the handshaking 
               If Left$(Line, 14) = "****OK You Can"  Then   ' handshaking
                          flagTransferingFile = True
                          sentFile.Open (sFileName, fmOpenRead) 
                          sTmp = "*** UPLOADING the File \"" & sFileName & "\"\n***    file length = " & Str$ (sentFile.Size) & " Bytes\n"
                          AddToRxWin (sTmp)
                          transferStartTime = Timer
                          ' transfer    
                          SendFile
               ElseIf Left$(Line, 14) = "****OK File Re"  Then   ' handshaking
                          flagTransferingFile = False
                          sckFileSender.Close (numActiveSck)
                          sckFileSender.Lparam = FD_CONNECT ' Anding Set The Relative Bits In lParam
                          AddToRxWin ("*** DISCONNECTED by Local Host\n")
                          ReInitialise
               End If 
            Case FD_WRITE        '=2 : the Socket TxBuffer that was Full -when WSAEWOULBLOCK error occured-, is now empty 
                If flagTransferingFile = True Then
                    SendFile 
                End If
            Case FD_CONNECT      '=16  success on a connection request
                ' THIS IS  a  **VERY**  IMPORTANT LINE
                numActiveSck = sckFileSender.MySocket
                AddToRxWin ("*** FD_FILE_SENDER Connected to " & edtHost.Text & "\n")    
                sTmp = ExtractFileName (sFileName)
                sTmp = "****SaveThisFile " & sTmp & " " & sFileLength
                sckFileSender.Write (numActiveSck, sTmp, Len (sTmp))                
            Case FD_CLOSE        '=32   connection closed by remote host (???or error???)
                AddToRxWin ("*** DISCONECTED By Remote Host !\n")
                ReInitialise
        End Select
    END IF
END SUB


' btn UpLoad a File To the Remote Host
Sub OnClic_btnUploadFile
    If flagTransferingFile = True Then
        AddToRxWin ("*** ERROR : ALREADY Transfering a file. Nothing Done")
        Exit Sub
    End If
    Dim sTmp As String
    If OpenDialog.Execute = False Then
        AddToRxWin( "*** ERROR : Cannot Get File, OpenDialog Fails or Aborted\n")
        SetFocus (rchRxWin.Handle)
        Exit Sub
    End If     
    sFileName = OpenDialog.FileName
    sentFile.Open (sFileName, fmOpenREad)
    sFileLength = Str$(sentFile.Size)
    sentFile.Close
    sckFileSender.Lparam = FD_READ & FD_WRITE & FD_CONNECT & FD_CLOSE ' Anding Set The Relative Bits In lParam
    numActiveSck = sckFileSender.Connect (edtHost.Text, Val(edtPort.Text - " "))        
    AddToRxWin ("*** CONNECTION REQUEST Sent ... now Connecting ... \n")
    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


' Send a File Using  FD_WRITE  messages and  WSAEWOULDBLOCK error
' the file is cut in packets of 984 bytes (1024 - 40), but could be anything else
Sub SendFile
     Dim iLength as Long
     Dim sTmp as String
     Do
         If flagLastNotSent = false Then
             iLength = sentFile.Size - sentFile.Position
             If iLength > (PACKETMAXLENGTH - 1) Then   ' 983
                 StringToSend = sentFile.ReadBinStr(PACKETMAXLENGTH)  ' 984
                 iLength = PACKETMAXLENGTH ' 984
             Else
                 'iLength = iLength   ' + 1 or - 1 ????
                 StringToSend = sentFile.ReadBinStr(iLength)
             End If    
         End If
         sckFileSender.Write (numActiveSck, StringToSend, iLength)
         btnUploadFile.Caption= Str$(sentFile.Position) & " xmit"
         Select Case WsaGetLastError
             Case WSAEWOULDBLOCK
                 flagLastNotSent = True                 
                 Exit Sub   ' Exit Loop only on sentFile.Eof  and Error
             Case 0
                 flagLastNotSent = False                                              
             Case Else
                 AddToRxWin ("*** ERROR : Socket Error N° " & Str$(WsaGetLastError) & "\n File Transfer Aborted")
                 ReInitialise
                 Exit Do
         End Select
         DoEvents
     Loop Until sentfile.Eof
     transferEndTime = Timer
     btnUploadFile.Caption = "&Upload File"
     sTmp = "*** UPLOADING the File is FINISHED. \"" & sFileName & "\"\n" _
          & "***    file length " & Str$ (sentFile.Size) & " Bytes\n" _
          & "***    transfered In " & Str$(transferEndTime - transferStartTime) & " seconds\n" _
          & "***    Bit Rate " & Str$(sentFile.Size * 8/(transferEndTime - transferStartTime)) & " bps\n"
     AddToRxWin (sTmp)
     sentFile.Close
End Sub


' ReInitialises in Server Mode
Sub ReInitialise
    StringToSend = ""
    OpenDialog.Caption = "Choose a ***TEXT*** File To Upload" 
    OpenDialog.InitialDir ="C:\" 
    flagLastNotSent = False
    flagTransferingFile = False     
 
    sckFileSender.Close (numActiveSck)    
    sckFileSender.Lparam = FD_CONNECT ' Anding Set The Relative Bits In lParam
    
    AddToRxWin ("\n*** FD_FILE_SENDER  REINITIALISED on PORT " & (edtPort.Text - " ") & ", IPADDRESS : " & sckFileSender.GetHostIp _
              &  "\nSet the RECEIVER IPADDRESS, its PORT and then Clic Button 'UpLoad File'\n")

    SetFocus (rchRxWin.Handle)
End Sub

Function ExtractFileName (sPath as String) as String
    DefInt iTmp
    iTmp = Rinstr (sPath, "\\")
    ExtractFileName = Right$(sPath, Len(sPath) - iTmp)
End Function

' 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 infos, search the web with   WSAAsyncSelect & FD_ACCPET
'