'Visual Basic 6 example of secure file sharing client
'To keep this VB6 example simple, we are going to implement
'only the main file operations


Const FolderImgIdx = 1
Const FileImgIdx = 2


Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type


Dim DnldFile As String             'Name of the downloaded file
Dim UpldFile, UpldFol As String    'Name of the uploaded file and folder

Dim NowList, NowCreate, NowDownload, NowUpload, NowRenameFolder, NowDeleteFolder, NowRenameFile, NowDeleteFile As Boolean



' *** General ***

'Add a trailing slash
Private Function AddSlash(aPath As String) As String
  If Right$(aPath, 1) = "\" Then
    AddSlash = aPath
  Else
    AddSlash = aPath + "\"
  End If
End Function


'Remove the trailing slash
Private Function SlashOff(aPath As String) As String
  If Right$(aPath, 1) = "\" Then
    SlashOff = Left(aPath, Len(aPath) - 1)
  Else
    SlashOff = aPath
  End If
End Function



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



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 Long
    intPos = InStrRev(vStrFullPath, "\")
    ExtractFileName = Mid$(vStrFullPath, intPos + 1)
End Function


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


'Return the name of the signed-in user
Private Function GetUsername() As String
  GetUsername = FileCln.Username
  If GetUsername > "" Then Exit Function
  GetUsername = "Default"
End Function


' Convert the FILETIME structure into a Date.
Private Function FileTimeToDate(ft As FILETIME) As Date
' FILETIME units are 100s of nanoseconds.
Const TICKS_PER_SECOND = 10000000

  Dim lo_time As Double
  Dim hi_time As Double
  Dim seconds As Double
  Dim hours As Double
  Dim the_date As Date

  ' Get the low order data.
  If ft.dwLowDateTime < 0 Then
      lo_time = 2 ^ 31 + (ft.dwLowDateTime And &H7FFFFFFF)
  Else
      lo_time = ft.dwLowDateTime
  End If

  ' Get the high order data.
  If ft.dwHighDateTime < 0 Then
      hi_time = 2 ^ 31 + (ft.dwHighDateTime And _
          &H7FFFFFFF)
  Else
      hi_time = ft.dwHighDateTime
  End If

  ' Combine them and turn the result into hours.
  seconds = (lo_time + 2 ^ 32 * hi_time) / _
      TICKS_PER_SECOND
  hours = CLng(seconds / 3600)
  seconds = seconds - hours * 3600

  ' Make the date.
  the_date = DateAdd("h", hours - 4, "1/1/1601 0:00:00 AM")
  the_date = DateAdd("s", seconds, the_date)
  FileTimeToDate = the_date
End Function





' *** Working ***

'Provide an error desctiption
Private Function ErrorText(ByVal aCode As Long) As String
  ErrorText = ""
  If aCode = 0 Then Exit Function
  Select Case aCode
    Case 100
      ErrorText = "Wrong CRC"
    Case 101
      ErrorText = "Broken connection"
    Case 200
      ErrorText = "User break (client)"
    Case 201
      ErrorText = "Invalid handle (client)"
    Case 202
      ErrorText = "Client is not signed in"
    Case 203
      ErrorText = "There is no assigned event handler (client)"
    Case 204
      ErrorText = "There is an error in the event handler (client)"
    Case 205
      ErrorText = "Operation is already in progress (client)"
    Case 206
      ErrorText = "Cannot get file information (client)"
    Case 207
      ErrorText = "Cannot create folder (client)"
    Case 208
      ErrorText = "Cannot delete folder (client)"
    Case 209
      ErrorText = "Cannot delete file (client)"
    Case 210
      ErrorText = "Cannot rename folder (client)"
    Case 211
      ErrorText = "Cannot rename file (client)"
    Case 212
      ErrorText = "Cannot open file (client)"
    Case 213
      ErrorText = "Cannot create file (client)"
    Case 214
      ErrorText = "Cannot read from file (client)"
    Case 215
      ErrorText = "Cannot write to file (client)"
    Case 216
      ErrorText = "Cannot rename temporary file (client)"
    Case 301
      ErrorText = "Cannot start server"
    Case 302
      ErrorText = "Access denied"
    Case 303
      ErrorText = "User break (server)"
    Case 304
      ErrorText = "Invalid handle (server)"
    Case 305
      ErrorText = "There is no assigned event handler (server)"
    Case 306
      ErrorText = "There is an error in the event handler (server)"
    Case 307
      ErrorText = "Operation is already in progress (server)"
    Case 308
      ErrorText = "Cannot get file information (server)"
    Case 309
      ErrorText = "Cannot create folder (server)"
    Case 310
      ErrorText = "Cannot delete folder (server)"
    Case 311
      ErrorText = "Cannot delete file (server)"
    Case 312
      ErrorText = "Cannot rename folder (server)"
    Case 313
      ErrorText = "Cannot rename file (server)"
    Case 314
      ErrorText = "Cannot open file (server)"
    Case 315
      ErrorText = "Cannot create file (server)"
    Case 316
      ErrorText = "Cannot read from file (server)"
    Case 317
      ErrorText = "Cannot write to file (server)"
    Case 318
      ErrorText = "Cannot rename temporary file (server)"
  Case Else
    ErrorText = "Unknown error"
  End Select
  
End Function




'Display an error message, if there is
Private Sub CheckError(ByVal aCode As Long)
  If aCode = 0 Then Exit Sub
  Call ShowMessage(ErrorText(aCode), "Error")
End Sub







'Update the status text
Private Sub UpdateStatus()
  
  If FileCln.Connected Then
    'already connected
    btnConnect.Enabled = False
    btnCancel.Enabled = False
    btnDisconnect.Enabled = True
    If FileCln.WrongKey Then
      StatusBar.Panels.Item(1).Text = "Wrong key"
    Else
      StatusBar.Panels.Item(1).Text = " Connected"
    End If
    StatusBar.Panels.Item(2).Text = FileCln.ServerAddress + ":" + FileCln.ServerPort
    If FileCln.Signedin Then
      StatusBar.Panels.Item(2).Text = " User: " + GetUsername
    Else
      StatusBar.Panels.Item(2).Text = " User: not signed in"
    End If
  Else
    StatusBar.Panels.Item(2).Text = ""
    StatusBar.Panels.Item(3).Text = ""
    If FileCln.Connecting Then
      'now connecting
      btnConnect.Enabled = False
      btnCancel.Enabled = True
      btnDisconnect.Enabled = False
      StatusBar.Panels.Item(1).Text = "Connecting"
    Else
      'not connected
      btnConnect.Enabled = True
      btnCancel.Enabled = False
      btnDisconnect.Enabled = False
      StatusBar.Panels.Item(1).Text = "Disconnected"
    End If
  End If
  
  Call UpdateButtons
 
End Sub



'Update the buttons state
Private Sub UpdateButtons()
  btnList.Enabled = False
  btnIn.Enabled = False
  btnUp.Enabled = False
  btnNew.Enabled = False
  btnDownload.Enabled = False
  btnUpload.Enabled = False
  btnRename.Enabled = False
  btnDelete.Enabled = False
  btnAbortDnld.Enabled = NowDownload
  btnAbortUpld.Enabled = NowUpload

  If Not lvFiles.Enabled Then Exit Sub
    
  btnUp.Enabled = txtFolder.Text > "\"
  btnNew.Enabled = Not NowCreate
  btnList.Enabled = Not NowList
  btnUpload.Enabled = Not NowUpload

  If Not (lvFiles.SelectedItem Is Nothing) Then
    btnIn.Enabled = (lvFiles.SelectedItem.SmallIcon = FolderImgIdx) And Not NowList
    If lvFiles.SelectedItem.SmallIcon = FolderImgIdx Then
      'folder
      btnRename.Enabled = Not NowRenameFolder
      btnDelete.Enabled = Not NowDeleteFolder
    Else
      'file
      btnDownload.Enabled = Not NowDownload
      btnRename.Enabled = Not NowRenameFile
      btnDelete.Enabled = Not NowDeleteFile
    End If
  End If
End Sub







Private Sub btnIn_Click()
  Call GoInFolder
End Sub



Private Sub btnUp_Click()
  Call GoUpFolder
End Sub



Private Sub GoInFolder()
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  txtFolder.Text = AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text
  Call ListFolder
End Sub




Private Sub GoUpFolder()
  Dim S As String
  Dim p As Long
  
  S = SlashOff(txtFolder.Text)
  If S = "" Then Exit Sub  'nothing to do
  p = Len(S)
  Do While p > 0
    If Mid$(S, p, 1) = "\" Then Exit Do
    p = p - 1
  Loop
  txtFolder.Text = PreSlash(Left$(S, p - 1))
  Call ListFolder
End Sub






' *** User Events



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


'Initiate a connection request
Private Sub btnConnect_Click()
  fConnect.Show 1, Me
  If fConnect.Canceled Then Exit Sub
  FileCln.CryptoKey = fConnect.txtKey.Text
  FileCln.UseCompression = fConnect.cbxCompression.Value
  If Not FileCln.Connect(fConnect.txtHost.Text, fConnect.txtPort.Text) Then
    MsgBox ("Error Code: " + Str(FileCln.LastError))
  End If
  UpdateStatus
End Sub


'Cancel the connection attempt
Private Sub btnCancel_Click()
  If Not FileCln.Connecting Then Exit Sub
  FileCln.Disconnect
End Sub


'Disconnect from the server
Private Sub btnDisconnect_Click()
  If Not FileCln.Connected Then Exit Sub
  FileCln.Disconnect
End Sub


'Initializations
Private Sub Form_Load()
  UpdateStatus
End Sub


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


'The crypto key match is changed
Private Sub SockLib_OnKeyChanged(ByVal aHandle As Long)
  UpdateStatus
End Sub


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



Private Sub lvFiles_DblClick()
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  If lvFiles.SelectedItem.SmallIcon = FolderImgIdx Then
    If lvFiles.SelectedItem.Text = ".." Then
      Call GoUpFolder
    Else
      Call GoInFolder
    End If
  Else
    Call GoDownload
  End If
End Sub


Private Sub lvFiles_ItemClick(ByVal Item As MSComctlLib.ListItem)
  UpdateButtons
End Sub









' *** Control Events




'Connection request is completed
Private Sub FileCln_OnConnected()
  lvFiles.Enabled = True
  txtFolder.Text = "\"
  UpdateStatus
  Call FileCln.SignIn(fConnect.txtUsername.Text, fConnect.txtPassword.Text)
End Sub


'Connection request failed
Private Sub FileCln_OnClosed()
  MsgBox ("Cannot connect to " + fConnect.txtHost.Text + ":" + fConnect.txtPort.Text)
  UpdateStatus
End Sub


'The connection is broken
Private Sub FileCln_OnDisconnected()
  lvFiles.Enabled = False
  txtFolder.Text = ""
  lvFiles.ListItems.Clear
  lvFiles.Enabled = False
  UpdateStatus
End Sub


'The key matching is changed
Private Sub FileCln_OnKeyChanged()
  UpdateStatus
End Sub


'The sign-in request is completed
Private Sub FileCln_OnSigninDone(ByVal aCode As Long)
  If aCode = 0 Then
    ListFolder
  Else
    MsgBox ("Error signing in!")
  End If
  UpdateStatus
End Sub






' *** listing ***


Private Sub btnList_Click()
  ListFolder
End Sub


'Request the folder contents
Private Sub ListFolder()
  If NowList Then Exit Sub
  If FileCln.ListFolder(txtFolder.Text) Then
    NowList = True
    lvFiles.ListItems.Clear
    btnList.Enabled = False
    If txtFolder.Text > "\" Then
      Call FileCln_OnHaveListItem("..", True, 0, 0, 0, 0)
    End If
  Else
    CheckError (FileCln.LastError)
  End If
End Sub



'A list item is available
Private Sub FileCln_OnHaveListItem(ByVal aName As String, ByVal aFolder As Boolean, ByVal aLoSize As Long, ByVal aHiSize As Long, ByVal aLoTime As Long, ByVal aHiTime As Long)
  Dim LI As ListItem
  Dim ft As FILETIME
  Dim Dt As Date
  
  Set LI = lvFiles.ListItems.Add(, , aName)
  
  If aFolder Then
    LI.SmallIcon = FolderImgIdx
    LI.SubItems(1) = " "
  Else
    LI.SmallIcon = FileImgIdx
    LI.SubItems(1) = Str(aLoSize)
  End If
    
  
  ft.dwHighDateTime = aHiTime
  ft.dwLowDateTime = aLoTime

  Dt = FileTimeToDate(ft)

  LI.SubItems(2) = Dt
End Sub



'End of the list
Private Sub FileCln_OnListDone(ByVal aCode As Long)
  NowList = False
  CheckError (aCode)
  UpdateButtons
End Sub









' *** new folder ***


'Request a new folder
Private Sub btnNew_Click()
  Dim Nm As String
  
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  Nm = InputBox("Folder name:", "Create folder")
  If Nm = "" Then Exit Sub
  If FileCln.CreateFolder(AddSlash(txtFolder.Text) + Nm) Then
    NowCreate = True
  Else
    CheckError (FileCln.LastError)
  End If
  UpdateButtons
End Sub


'A new folder is created
Private Sub FileCln_OnCreateFolderDone(ByVal aCode As Long)
  NowCreate = False
  CheckError (aCode)
  UpdateButtons
  If aCode > 0 Then Exit Sub
  Call ListFolder
End Sub




' *** renaming ***


'Send rename request
Private Sub btnRename_Click()
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  If lvFiles.SelectedItem.SmallIcon = FolderImgIdx Then
    'it is a folder
    Nm = InputBox("New name:", "Rename folder")
    If Nm = "" Then Exit Sub
    If FileCln.RenameFolder(AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text, AddSlash(txtFolder.Text) + Nm) Then
      NowRenameFolder = True
    Else
      CheckError (FileCln.LastError)
    End If
  Else
    'it is a file
    Nm = InputBox("New name:", "Rename file")
    If Nm = "" Then Exit Sub
    If FileCln.RenameFile(AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text, AddSlash(txtFolder.Text) + Nm) Then
      NowRenameFile = True
    Else
      CheckError (FileCln.LastError)
    End If
  End If
  Call UpdateButtons
End Sub


'A folder is renamed
Private Sub FileCln_OnRenameFolderDone(ByVal aCode As Long)
  NowRenameFolder = False
  CheckError (aCode)
  Call UpdateButtons
  If aCode > 0 Then Exit Sub
  Call ListFolder
End Sub


'A file is renamed
Private Sub FileCln_OnRenameFileDone(ByVal aCode As Long)
  NowRenameFile = False
  CheckError (aCode)
  Call UpdateButtons
  If aCode > 0 Then Exit Sub
  Call ListFolder
End Sub






' *** deletion ***

'Send delete request
Private Sub btnDelete_Click()
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  If lvFiles.SelectedItem.SmallIcon = FolderImgIdx Then
    'it is a folder
    If FileCln.DeleteFolder(AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text) Then
      NowDeleteFolder = True
    Else
      CheckError (FileCln.LastError)
    End If
  Else
    'it is a file
    If FileCln.DeleteFile(AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text) Then
      NowDeleteFile = True
    Else
      CheckError (FileCln.LastError)
    End If
  End If
  Call UpdateButtons
End Sub



'A folder is deleted
Private Sub FileCln_OnDeleteFolderDone(ByVal aCode As Long)
  NowDeleteFolder = False
  CheckError (aCode)
  Call UpdateButtons
  If aCode > 0 Then Exit Sub
  Call ListFolder
End Sub


'A file is deleted
Private Sub FileCln_OnDeleteFileDone(ByVal aCode As Long)
  NowDeleteFile = False
  CheckError (aCode)
  Call UpdateButtons
  If aCode > 0 Then Exit Sub
  Call ListFolder
End Sub




' *** Uploading ***

'Send an upload request
Private Sub btnUpload_Click()
  On Error GoTo IsCanceled
   
  OpenDlg.FileName = ""
  OpenDlg.ShowOpen
  UpldFile = OpenDlg.FileName
  
  If FileCln.Upload(UpldFile, txtFolder.Text) Then
    NowUpload = True
    UpldFol = txtFolder.Text
    txtUpload.Text = ExtractFileName(UpldFile) + ": handshaking"
  Else
    CheckError (FileCln.LastError)
  End If
  
  UpdateStatus
  
IsCanceled:
End Sub



'Abort the upload operation
Private Sub btnAbortUpld_Click()
  If Not FileCln.CancelUpload Then
    CheckError (FileCln.LastError)
  End If
End Sub



'The upload is completed
Private Sub FileCln_OnUploadDone(ByVal aCode As Long)
  If aCode = 0 Then
    txtUpload.Text = ExtractFileName(UpldFile) + " - Done."
  Else
    txtUpload.Text = ExtractFileName(UpldFile) + " - Aborted: " + ErrorText(aCode)
  End If
  NowUpload = False
  Call UpdateButtons
  If UpldFol = txtFolder.Text Then
    Call ListFolder
  End If
End Sub


'Upload progress info
Private Sub FileCln_OnUploadProgress(ByVal aLoCount As Long, ByVal aHiCount As Long, ByVal aLoSize As Long, ByVal aHiSize As Long)
  txtUpload.Text = ExtractFileName(UpldFile) + " - " + Str(aLoCount) + "/" + Str(aLoSize)
End Sub






' *** downloading ***

'Send a download request
Private Sub GoDownload()
  On Error GoTo IsCanceled
  
  If lvFiles.SelectedItem Is Nothing Then Exit Sub
  If lvFiles.SelectedItem.SmallIcon = FolderImgIdx Then Exit Sub
  
  SaveDlg.FileName = lvFiles.SelectedItem.Text
  SaveDlg.ShowSave
  DnldFile = lvFiles.SelectedItem.Text

  If FileCln.Download(AddSlash(txtFolder.Text) + lvFiles.SelectedItem.Text, ExtractFilePath(SaveDlg.FileName)) Then
    NowDownload = True
    txtDownload.Text = DnldFile + ": handshaking"
  Else
    CheckError (FileCln.LastError)
  End If
  
  UpdateStatus

IsCanceled:
End Sub



Private Sub btnDownload_Click()
  Call GoDownload
End Sub


'Abort the download operation
Private Sub btnAbortDnld_Click()
  If Not FileCln.CancelDownload Then
    CheckError (FileCln.LastError)
  End If
End Sub


'The download operation is completed
Private Sub FileCln_OnDownloadDone(ByVal aCode As Long)
  If aCode = 0 Then
    txtDownload.Text = DnldFile + " - Done."
  Else
    txtDownload.Text = DnldFile + " - Aborted: " + ErrorText(aCode)
  End If
  NowDownload = False
  Call UpdateButtons
End Sub


'Download progress info
Private Sub FileCln_OnDownloadProgress(ByVal aLoCount As Long, ByVal aHiCount As Long, ByVal aLoSize As Long, ByVal aHiSize As Long)
  txtDownload.Text = DnldFile + " - " + Str(aLoCount) + "/" + Str(aLoSize)
End Sub