'Visual Basic .NET example of secure file sharing server
'To keep this VB.NET example simple, we are going to implement
'only the main file operations and one predefined user account



Option Strict Off
Option Explicit On
Friend Class CfMain
  Inherits System.Windows.Forms.Form
#Region "Windows Form Designer generated code "



  'To keep this VB .NET example simple, we are going to implement
  'only the basic file operations

  Dim fSettings As CfSettings


  'Initializations
  Private Sub fMain_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
    fSettings = New CfSettings      'create settings form
    SetProperties()
    UpdateStatus()
  End Sub




Const MyUsername = "test"
Const MyPassword = "test"



' *** General ***


  Public Function App_Path() As String
    Return System.AppDomain.CurrentDomain.BaseDirectory()
  End Function



'Insert a leading slash
Private Function PreSlash(ByVal aPath As String) As String
  If Mid(aPath, 1, 1) = "\" Then
    PreSlash = aPath
  Else
    PreSlash = "\" + aPath
  End If
End Function




Private Function GetUsername(ByVal aHandle As Long) As String
  GetUsername = FileSrv.GetUserName(aHandle)
  If GetUsername = "" Then
    GetUsername = "Default"
  End If
  GetUsername = "User " + GetUsername
End Function




' *** Working ***




  'Update the status text
  Private Sub UpdateStatus()
    If FileSrv.Running Then
      StatusBar.Panels.Item(0).Text = "Started"
      btnStart.Enabled = False
      btnStop.Enabled = True
    Else
      StatusBar.Panels.Item(0).Text = "Stopped"
      btnStart.Enabled = True
      btnStop.Enabled = False
    End If

    If lvClients.Items.Count = 0 Then
      StatusBar.Panels.Item(1).Text = "No active connection"
    Else
      StatusBar.Panels.Item(1).Text = Str(lvClients.Items.Count) + " connection(s)"
    End If

    btnRemove.Enabled = lvClients.SelectedItems.Count > 0
  End Sub



  'Set the component properties
  Private Sub SetProperties()
    FileSrv.ListeningPort = fSettings.txtPort.Text
    FileSrv.CryptoKey = fSettings.txtKey.Text
    FileSrv.UseCompression = fSettings.chkCompress.Checked
  End Sub



  'Record a log message 
  Private Sub LogMsg(ByVal aMsg As String)
    Dim Line As String
    If txtLog.Text > "" Then
      Line = Chr(13) & Chr(10)
    End If
    Line = Line & "[" & VB6.Format(Now, "hh:mm:ss") & "]: "
    Line = Line & aMsg
    txtLog.SelectionStart = Len(txtLog.Text)
    txtLog.SelectedText = Line
  End Sub



  Private Function ItemFromHandle(ByVal aHandle As Long) As ListViewItem
    'iterate on the list
    Dim i As Integer
    For i = 0 To lvClients.Items.Count - 1
      If lvClients.Items(i).Tag = aHandle Then
        ItemFromHandle = lvClients.Items(i)
        Exit Function
      End If
    Next i
    ItemFromHandle = Nothing
  End Function




  '*** Event handlers



  'Modify the settings
  Private Sub btnSettings_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnSettings.Click
    If fSettings.ShowDialog <> DialogResult.OK Then Exit Sub
    SetProperties()
    UpdateStatus()
  End Sub



  'The crypto key match is changed
  Private Sub SockLib_OnKeyChanged(ByVal eventSender As System.Object, ByVal eventArgs As AxbsSocketLibrary.IBSSockLibXEvents_OnKeyChangedEvent)
    UpdateStatus()
  End Sub



  'Show my IP address
  Private Sub btnIP_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnIP.Click
    MsgBox(FileSrv.LocalIP)
  End Sub


  'Terminate the application
  Private Sub btnExit_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
    End
  End Sub


  'Start the server
  Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
    If FileSrv.Start Then
      LogMsg("Server started")
    Else
      Call MsgBox("Cannot start the server!", , "Error")
    End If
    UpdateStatus()
  End Sub


  'Stop the server
  Private Sub btnStop_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStop.Click
    Dim LI As ListViewItem
    Dim i As Integer

    FileSrv.Stop()

    For i = lvClients.Items.Count - 1 To 0 Step -1
      FileSrv.RemoveClient(lvClients.Items(i).Tag)
      lvClients.Items.Remove(lvClients.Items(i))
    Next i

    UpdateStatus()
    LogMsg("Server stopped")
  End Sub



  'Remove a client connection
  Private Sub btnRemove_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRemove.Click
    If lvClients.SelectedItems.Count = 0 Then Exit Sub
    FileSrv.RemoveClient(lvClients.SelectedItems(0).Tag)
    lvClients.Items.Remove(lvClients.SelectedItems(0))
    UpdateStatus()
  End Sub



  'Clear the log
  Private Sub btnClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnClear.Click
    txtLog.Text = ""
  End Sub









' *** FileSrv events ***



  'A new connection is available
  Private Sub FileSrv_OnNewClient(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNewClientEvent) Handles FileSrv.OnNewClient
    Dim LI As ListViewItem

    LI = lvClients.Items.Add("Not signed in")
    LI.Tag = e.aHandle
    LI.SubItems.Add(FileSrv.GetClientAddress(e.aHandle))
    LI.SubItems.Add(FileSrv.GetClientPort(e.aHandle))
    LI.SubItems.Add(VB6.Format(Now, "hh:mm:ss"))
    LI.SubItems.Add("Connected")

    UpdateStatus()
    LogMsg("New connection from " + LI.SubItems.Item(0).Text + ":" + LI.SubItems.Item(1).Text)
  End Sub


  'A connection is broken
  Private Sub FileSrv_OnClientDisconnected(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnClientDisconnectedEvent) Handles FileSrv.OnClientDisconnected
    Dim LI As ListViewItem
    LI = ItemFromHandle(e.aHandle)
    If LI Is Nothing Then Exit Sub
    LogMsg("Disconnected " + LI.Text + " " + FileSrv.GetClientAddress(e.aHandle) + ":" + FileSrv.GetClientPort(e.aHandle))
    lvClients.Items.Remove(LI)
  End Sub


  'The key matching is changed
  Private Sub FileSrv_OnKeyChanged(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnKeyChangedEvent) Handles FileSrv.OnKeyChanged
    Dim LI As ListViewItem

    LI = ItemFromHandle(e.aHandle)
    If LI Is Nothing Then Exit Sub
    LogMsg("Key changed for " + GetUsername(e.aHandle) + " " + FileSrv.GetClientAddress(e.aHandle) + ":" + FileSrv.GetClientPort(e.aHandle))
    If FileSrv.WrongKey(e.aHandle) Then
      LI.SubItems.Item(4).Text = "Wrong key"
    Else
      LI.SubItems.Item(4).Text = "Connected"
    End If
  End Sub

  'A request for a password
  Private Sub FileSrv_OnNeedPassword(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedPasswordEvent) Handles FileSrv.OnNeedPassword
    If e.aUsername = MyUsername Then
      'this is our user
      e.aOkay = True
      e.aPassword = MyPassword
    Else
      'Unknown user
      e.aOkay = False
    End If
  End Sub


  'An user is signed-in
  Private Sub FileSrv_OnSignin(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnSigninEvent) Handles FileSrv.OnSignin
    Dim S As String
    Dim LI As ListViewItem

    S = GetUsername(e.aHandle)
    LI = ItemFromHandle(e.aHandle)
    If Not (LI Is Nothing) Then
      LI.Text = S
    End If

    S = S + " " + FileSrv.GetClientAddress(e.aHandle) + ":" + FileSrv.GetClientPort(e.aHandle)
    If e.aCode = 0 Then
      S = S + " signed in successfully"
    Else
      S = S + " failed sign-in"
    End If

    LogMsg(S)
  End Sub



  'A request to list the folder contents
  Private Sub FileSrv_OnNeedListFolder(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedListFolderEvent) Handles FileSrv.OnNeedListFolder
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": list folder " + PreSlash(e.aPath))
  End Sub


  'A request to create a folder
  Private Sub FileSrv_OnNeedCreateFolder(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedCreateFolderEvent) Handles FileSrv.OnNeedCreateFolder
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": create folder " + PreSlash(e.aPath))
  End Sub


  'A request to rename a folder
  Private Sub FileSrv_OnNeedRenameFolder(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedRenameFolderEvent) Handles FileSrv.OnNeedRenameFolder
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": rename folder " + PreSlash(e.aPath))
  End Sub


  'A request to rename a file
  Private Sub FileSrv_OnNeedRenameFile(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedRenameFileEvent) Handles FileSrv.OnNeedRenameFile
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": rename file " + PreSlash(e.aPath))
  End Sub


  'A request to delete a folder
  Private Sub FileSrv_OnNeedDeleteFolder(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedDeleteFolderEvent) Handles FileSrv.OnNeedDeleteFolder
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": delete folder " + PreSlash(e.aPath))
  End Sub


  'A request to delete a file
  Private Sub FileSrv_OnNeedDeleteFile(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedDeleteFileEvent) Handles FileSrv.OnNeedDeleteFile
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": delete file " + PreSlash(e.aPath))
  End Sub


  'A request to download
  Private Sub FileSrv_OnNeedDownload(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedDownloadEvent) Handles FileSrv.OnNeedDownload
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": start downloading " + PreSlash(e.aPath))
  End Sub


  'The download operation is completed
  Private Sub FileSrv_OnDownloadDone(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnDownloadDoneEvent) Handles FileSrv.OnDownloadDone
    LogMsg(GetUsername(e.aHandle) + ": finish downloading ")
  End Sub


  'A request to upload
  Private Sub FileSrv_OnNeedUpload(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnNeedUploadEvent) Handles FileSrv.OnNeedUpload
    e.aOkay = True
    e.aRoot = App_Path()
    LogMsg(GetUsername(e.aHandle) + ": start uploading " + PreSlash(e.aPath))
  End Sub


  'The upload operation is completed
  Private Sub FileSrv_OnUploadDone(ByVal sender As Object, ByVal e As AxBSFileSrvLib.IBSFileSrvXEvents_OnUploadDoneEvent) Handles FileSrv.OnUploadDone
    LogMsg(GetUsername(e.aHandle) + ": finish uploading ")
  End Sub



  Private Sub lvClients_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lvClients.SelectedIndexChanged
    UpdateStatus()
  End Sub

End Class