'To keep this VB6 example simple, we are going to use
'only a single file transfer per direction at a time


Dim CallHandle As Long  'Handle to the calling socket
Dim UpSock As Long      'Handle to the uploading socket
Dim DownSock As Long    'Handle to the downloading socket
Dim UpFile As Long      'Handle to the uploaded file
Dim DownFile As Long    'Handle to the downloaded file
Dim UpCount As Long     'Number of the uploaded bytes so far
Dim DownCount As Long   'Number of the downloaded bytes so far
Dim UpSize As Long      'Size of the uploaded file
Dim DownSize As Long    'Size of the downloaded file
Dim UpName As String    'Name of the uploaded file
Dim DownName As String  'Name of the downloaded file
Dim DownPath As String  'Path to the downloaded file


Const pcALERT = 10           'Alert message ID
Const pcCHAT = 20            'Chat message ID
Const pcHAVE_FILE_HEAD = 30  'This is a file header
Const pcGIVE_FILE_BODY = 31  'Ask for file data
Const pcHAVE_FILE_BODY = 32  'This is file data
Const pcSTOP_UPLOAD = 33     'Stop the uploading transfer
Const pcSTOP_DOWNLOAD = 34   'Stop the downloading transfer
Const pcBUSY_DOWNLOAD = 35   'The download channel is taken


Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long



Private Sub ShowMessage(ByVal aText As String, ByVal aCaption As String)
  Call MessageBox(0&, aText, aCaption, &H1000&)
End Sub


Private Function DirExists(ByRef aDir As String) As Boolean
Dim sResult As String
On Error Resume Next
sResult = Dir(aDir, vbDirectory)
On Error GoTo 0
DirExists = sResult <> ""
End Function


Private Function ExtractFileName(ByVal vStrFullPath As String) As String
    Dim intPos As Integer
    intPos = InStrRev(vStrFullPath, "\")
    ExtractFileName = Mid$(vStrFullPath, intPos + 1)
End Function


Private Function ExtractFilePath(ByVal vStrFullPath As String) As String
    Dim intPos As Integer
    intPos = InStrRev(vStrFullPath, "\")
    ExtractFilePath = Left$(vStrFullPath, intPos)
End Function


'Update the button state and the status text
Private Sub UpdateStatus()
  Dim St As String
  Dim LI As ListItem
  Dim i, Sk, ConCnt As Long
  
  'Buttons
  If CallHandle > 0 Then
    'a call is in progress
    btnConnect.Enabled = False
    btnCancel.Enabled = True
  Else
    'a new call can be initiated
    btnConnect.Enabled = True
    btnCancel.Enabled = False
  End If
  
  
  btnBrowse.Enabled = False
  btnUpload.Enabled = False
  txtUpload.Enabled = False
  txtUpload.BackColor = &H80000000
  
  If lvPeers.SelectedItem Is Nothing Then
    btnRemove.Enabled = False
    btnChat.Enabled = False
    btnAlert.Enabled = False
  Else
    btnRemove.Enabled = True
    btnChat.Enabled = SockLib.SessionOpen(lvPeers.SelectedItem.Tag)
    btnAlert.Enabled = SockLib.SessionOpen(lvPeers.SelectedItem.Tag)
    If SockLib.SessionOpen(lvPeers.SelectedItem.Tag) And (UpFile = 0) Then
      'we can start a new upload process
      btnBrowse.Enabled = True
      btnUpload.Enabled = True
      txtUpload.Enabled = True
      txtUpload.BackColor = &H80000005
    End If
  End If
  
  If UpFile <> 0 Then
    'an upload process is in progress
    btnAbortUp.Enabled = True
    btnUpload.Enabled = False
  Else
    'no active upload process
    btnAbortUp.Enabled = False
  End If
  
  If DownFile <> 0 Then
    'a download process is in progress
    btnAbortDown.Enabled = True
  Else
    'no active download process
    btnAbortDown.Enabled = False
  End If
  
  
   
  'Status bar
  
  If fSettings.txtKey.Text > "" Then
    StatusBar.Panels.Item(1).Text = "Encryption: ON"
  Else
    StatusBar.Panels.Item(1).Text = "Encryption: OFF"
  End If
  
  If fSettings.chkCompress.Value = 1 Then
    StatusBar.Panels.Item(2).Text = "Compression: ON"
  Else
    StatusBar.Panels.Item(2).Text = "Compression: OFF"
  End If
  
  If fSettings.chkServer.Value = 1 Then
    StatusBar.Panels.Item(3).Text = "Server: ON"
  Else
    StatusBar.Panels.Item(3).Text = "Server: OFF"
  End If
  
  If lvPeers.ListItems.Count = 0 Then
    St = "No active connection"
  Else
    St = Str(lvPeers.ListItems.Count) + " connected peer(s)"
  End If
  StatusBar.Panels.Item(4).Text = St
  
End Sub



'Set the component properties
Private Sub SetProperties()
  If fSettings.txtKey.Text > "" Then
    SockLib.SecurityMode = 2  'shared secret key
    SockLib.SecretKey = fSettings.txtKey.Text
  Else
    SockLib.SecurityMode = 0  'no encryption
  End If

  SockLib.UseCompression = fSettings.chkCompress.Value
  SockLib.StopListening
  
  If fSettings.chkServer.Value = 1 Then
    SockLib.StartListening (Val(fSettings.txtListenPort.Text))
  End If
End Sub



'An alert message is available
Private Sub HaveAlert(ByVal aHandle As Long)
  Dim Line As String
  
  Line = "From " + SockLib.GetRemoteAddress(aHandle) + " at " + Format(Now, "hh:mm:ss") + Chr(13) + Chr(13)
  Line = Line + SockLib.TextFromBuffer(aHandle)
  Call ShowMessage(Line, "Alert")
  
End Sub



'A chat message is available
Private Sub HaveChat(ByVal aHandle As Long)
  Dim Line As String
  If txtChatLog.Text > "" Then
    Line = Chr(13) + Chr(10)
  End If
  Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Peer: "
  Line = Line + SockLib.TextFromBuffer(aHandle)
'  txtChatLog.Text = txtChatLog.Text + Line
  txtChatLog.SelStart = Len(txtChatLog.Text)
  txtChatLog.SelText = Line
End Sub



'Downloaded file header is coming
Private Sub HaveFileHead(ByVal aHandle As Long)
  On Error Resume Next
  
  If DownFile > 0 Then
    'download is already in progress
    Call SockLib.SendPacket(aHandle, pcBUSY_DOWNLOAD)
    Exit Sub
  End If
  
  DownPath = App.Path + "\Download"
  If Not DirExists(DownPath) Then
    MkDir (DownPath)
  End If
  If Not DirExists(DownPath) Then
    Call ShowMessage("Cannot create the directory " + DownPath, "Error")
    Exit Sub
  End If
  
  
  DownName = SockLib.TextFromBuffer(aHandle)
  DownSize = SockLib.IntegerFromBuffer(aHandle)

  DownFile = FreeFile()
  Open DownPath + "\" + DownName For Binary As DownFile
  If Err <> 0 Then
    txtDownload.Text = "Cannot open " + DownPath + "\" + DownName
    Call SockLib.SendPacket(aHandle, pcSTOP_DOWNLOAD)
    DownFile = 0
    Exit Sub
  End If
  
  DownSock = aHandle
  DownCount = 0
  Call SockLib.SendPacket(aHandle, pcGIVE_FILE_BODY)

  UpdateStatus

End Sub
  
  
  
'Uploaded file data must go
Private Sub GiveFileBody(ByVal aHandle As Long)
  If UpFile = 0 Then Exit Sub

  Dim L As Long
  Dim VarBytes As Variant
  Dim ArrBytes() As Byte
  
  If UpCount >= UpSize Then
    'the file is done
    txtUpload.Text = UpName + " Done."
    FinishUpload
  Else
    L = UpSize - UpCount
    If L > SockLib.GetFreeRoom(UpSock) Then
      L = SockLib.GetFreeRoom(UpSock)
    End If

    ReDim ArrBytes(L - 1)
    Get UpFile, , ArrBytes
    If Err <> 0 Then
      Call ShowMessage("Error reading " + UpName, "Error")
      Call SockLib.SendPacket(aHandle, pcSTOP_UPLOAD)
      FinishUpload
      Exit Sub
    End If

    VarBytes = ArrBytes
    Call SockLib.BytesToBuffer(UpSock, VarBytes)
    UpCount = UpCount + L
    Call SockLib.SendPacket(UpSock, pcHAVE_FILE_BODY)
    
  End If

End Sub



'Downloaded file data is available
Private Sub HaveFileBody(ByVal aHandle As Long)
  If DownFile = 0 Then Exit Sub
  
  Dim VarBytes As Variant
  Dim ArrBytes() As Byte
  
  VarBytes = SockLib.BytesFromBuffer(DownSock)
  ArrBytes = VarBytes
  
  Put DownFile, , ArrBytes
  If Err <> 0 Then
    txtDownload.Text = "Error writing to " + DownName
    Call SockLib.SendPacket(aHandle, pcSTOP_DOWNLOAD)
    FinishDownload
    Exit Sub
  End If
  
  DownCount = DownCount + UBound(ArrBytes) + 1
  If DownCount >= DownSize Then
    'the file is done
    txtDownload.Text = DownName + " Done."
    FinishDownload
  End If
End Sub
  

'Peer upload is canceled
Private Sub StopUpload()
  txtDownload.Text = "Canceled"
  FinishDownload
End Sub


'Peer download is canceled
Private Sub StopDownload()
  txtUpload.Text = "Canceled"
  FinishUpload
End Sub


'Not able to accept download
Private Sub BusyDownload()
  FinishUpload
  Call ShowMessage("The download channel is taken", "Error")
End Sub


'Upload is done
Private Sub FinishUpload()
  If UpFile <> 0 Then
    Close UpFile
  End If
  UpFile = 0
  txtUpload.Enabled = True
  UpdateStatus
End Sub


'Download is done
Private Sub FinishDownload()
  If DownFile = 0 Then Exit Sub
  Close DownFile
  DownFile = 0
  UpdateStatus
End Sub



Private Sub btnAbortDown_Click()
  Call SockLib.SendPacket(DownSock, pcSTOP_DOWNLOAD)
  FinishDownload
  txtDownload.Text = "Canceled"
End Sub


Private Sub btnAbortUp_Click()
  Call SockLib.SendPacket(UpSock, pcSTOP_UPLOAD)
  FinishUpload
  txtUpload.Text = "Canceled"
End Sub



Private Sub btnBrowse_Click()
  On Error GoTo IsCanceled
   
  OpenDlg.FileName = ""
  OpenDlg.ShowOpen
  
  txtUpload.Text = OpenDlg.FileName
  UpdateStatus
  
IsCanceled:
End Sub

'*** Event handlers


'A chat message will be sent
Private Sub btnChat_Click()
  Dim Line As String
  
  Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtChatMsg.Text)     'Store the message
  Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcCHAT)                'Send the chat message
  Line = ""
  If txtChatLog.Text > "" Then
    Line = Chr(13) + Chr(10)
  End If
  Line = Line + "[" + Format(Now, "hh:mm:ss") + "] Me: " + txtChatMsg.Text
  txtChatMsg.Text = ""
  txtChatLog.Text = txtChatLog.Text + Line
End Sub



'An alert message will be sent
Private Sub btnAlert_Click()
  Call SockLib.TextToBuffer(lvPeers.SelectedItem.Tag, txtAlertMsg.Text)   'Store the message
  Call SockLib.SendPacket(lvPeers.SelectedItem.Tag, pcALERT)   'Send an alert message
  txtAlertMsg.Text = ""
End Sub




'Modify the settings
Private Sub btnSettings_Click()
  fSettings.Show 1, Me
  If fSettings.Canceled Then Exit Sub
  SetProperties
  UpdateStatus
End Sub



'Initializations
Private Sub Form_Load()
  CallHandle = 0
  SetProperties
  UpdateStatus
End Sub



'Terminate on form closing
Private Sub Form_Unload(Cancel As Integer)
  End
End Sub



'A list view item is clicked
Private Sub lvPeers_ItemClick(ByVal Item As MSComctlLib.ListItem)
  UpdateStatus
End Sub






'A new session is opened due to an incoming call
Private Sub SockLib_OnSessionInvoked(ByVal aHandle As Long)
  Dim LI As ListItem
  
  Set LI = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
  LI.SubItems(1) = SockLib.GetRemotePort(aHandle)
  LI.SubItems(2) = Format(Now, "hh:mm:ss")
  LI.Tag = aHandle
  
  UpdateStatus
End Sub



'Successful call
Private Sub SockLib_OnSessionCreated(ByVal aHandle As Long)
  Dim LI As ListItem
  
  Set LI = lvPeers.ListItems.Add(, , SockLib.GetRemoteAddress(aHandle))
  LI.SubItems(1) = SockLib.GetRemotePort(aHandle)
  LI.SubItems(2) = Format(Now, "hh:mm:ss")
  LI.Tag = aHandle
  CallHandle = 0
  
  If lvPeers.SelectedItem Is Nothing Then
    lvPeers.SelectedItem = LI
  End If
  
  UpdateStatus
End Sub




'Unsuccessful call
Private Sub SockLib_OnSessionRejected(ByVal aHandle As Long)
  CallHandle = 0
  UpdateStatus
  Call ShowMessage("Cannot connect to " + txtIP.Text + ":" + txtPort.Text, "Error")
End Sub




'The socket is disconnected
Private Sub SockLib_OnSessionClosed(ByVal aHandle As Long)
  Dim i As Long
  For i = 1 To lvPeers.ListItems.Count
    If lvPeers.ListItems.Item(i).Tag = aHandle Then
      lvPeers.ListItems.Remove (i)
    End If
  Next i
  UpdateStatus
End Sub






'A new packet is available
Private Sub SockLib_OnPacketReceived(ByVal aHandle As Long)
Select Case SockLib.GetRcvdCmnd(aHandle)
  Case pcALERT
    Call HaveAlert(aHandle)  'alert message
  Case pcCHAT
    Call HaveChat(aHandle)   'chat message
    
  Case pcHAVE_FILE_HEAD
    Call HaveFileHead(aHandle)
  Case pcGIVE_FILE_BODY
    Call GiveFileBody(aHandle)
  Case pcHAVE_FILE_BODY
    Call HaveFileBody(aHandle)
  Case pcSTOP_UPLOAD
    Call StopUpload
  Case pcSTOP_DOWNLOAD
    Call StopDownload
End Select

End Sub



Private Sub SockLib_OnPacketSent(ByVal aHandle As Long)
  If SockLib.GetSentCmnd(UpSock) = pcHAVE_FILE_BODY Then
    GiveFileBody (aHandle)
  End If
End Sub










'Show my IP address
Private Sub btnIP_Click()
  Call ShowMessage(SockLib.IPAddress, "Information")
End Sub



'Terminate the application
Private Sub btnExit_Click()
  End
End Sub



'Initiate a call
Private Sub btnConnect_Click()
 
  'start the call operation
  CallHandle = SockLib.CreateSession(txtIP.Text, Val(txtPort.Text))
  If CallHandle = 0 Then
    Call ShowMessage("Cannot initiate a call", "Error")
    CallHandle = 0
  End If

  UpdateStatus
End Sub



'Cancel a call operation
Private Sub btnCancel_Click()
  If CallHandle > 0 Then
    SockLib.TerminateSession (CallHandle)
    CallHandle = 0
    UpdateStatus
  End If
End Sub



'Remove the selected connection
Private Sub btnRemove_Click()
  If lvPeers.SelectedItem Is Nothing Then
    Exit Sub
  End If
  SockLib.TerminateSession (lvPeers.SelectedItem.Tag)
  lvPeers.ListItems.Remove (lvPeers.SelectedItem.Index)
  lvPeers.SelectedItem = Nothing
End Sub


'Update file transfer info
Private Sub Timer_Timer()
  
  If UpFile > 0 Then
    txtUpload.Text = UpName + " " + Str(UpCount) + "/" + Str(UpSize)
  End If
  
  If DownFile > 0 Then
    txtDownload.Text = DownName + " " + Str(DownCount) + "/" + Str(DownSize)
  End If

End Sub




'Hide the focus from the chat box
Private Sub txtChatLog_GotFocus()
  helper.SetFocus
End Sub




Private Sub btnUpload_Click()
  On Error Resume Next
  
  If UpFile > 0 Then
'    ShowMessage ("An uploading process is already in progress")
    Call ShowMessage("An uploading process is already in progress", "My caption")
    Exit Sub
  End If
  
  If txtUpload.Text = "" Then
    Call ShowMessage("Please specify a file name", "Error")
    Exit Sub
  End If
  
  UpSize = -1
  UpSize = FileLen(txtUpload.Text)
  If UpSize < 0 Then
    Call ShowMessage("The file doesn't exist", "Error")
    Exit Sub
  End If

  UpFile = FreeFile()
  Open txtUpload.Text For Binary As UpFile
  If Err <> 0 Then
    Call ShowMessage("Cannot open the file", "Error")
    UpFile = 0
    Exit Sub
  End If
  
  UpCount = 0
  UpSock = lvPeers.SelectedItem.Tag
  UpName = ExtractFileName(txtUpload.Text)
  Call SockLib.TextToBuffer(UpSock, UpName)
  Call SockLib.IntegerToBuffer(UpSock, UpSize)
  Call SockLib.SendPacket(UpSock, pcHAVE_FILE_HEAD)
  
  UpdateStatus
  txtUpload.Text = UpName + ": handshaking"
  txtUpload.Enabled = False
  
End Sub