I'm trying to get my application to encrypt directories with this code, but for some reason, it doesn't work.
Note: Dir1 is a directory boxCode:Sub Encrypt(Filename, Password) Dim sHead As String Dim NewFile1 Dim sT As String Dim sA As String Dim cphX As New Cipher Dim n As Long Dim LenOfFile As Long Dim TenPercent As Long Dim OverwriteEncryptedFile As Long On Error GoTo EncryptError Open Filename For Binary As #1 'Load entire file into sA sA = Space$(LOF(1)) Get #1, , sA Close #1 'Prepare header string with salt characters sT = Hash(Date & Str(Timer)) sHead = "[Secret]" & sT & Hash(sT & Password) 'Do the encryption cphX.KeyString = sHead cphX.Text = sA cphX.DoXor cphX.Stretch sA = cphX.Text 'Write header ' See if we should overwrite the existing file OverwriteEncryptedFile = GetSetting(App.EXEName, "Options", "Overwrite Existing File When Encrypting") If OverwriteEncryptedFile = 0 Then NewFile1 = Filename + ".enc" FileCopy Filename, NewFile1 Filename = Filename + ".enc" Open NewFile1 For Output As #1 Print #1, sHead 'Write encrypted data n = 1 Do Print #1, Mid(sA, n, 70) n = n + 70 Loop Until n > Len(sA) Close #1 Exit Sub End If OverwriteEncryptedFile = GetSetting(App.EXEName, "Options", "Overwrite Existing File When Encrypting") If OverwriteEncryptedFile = 1 Then Kill Filename Open Filename For Output As #1 Print #1, sHead 'Write encrypted data n = 1 Do Print #1, Mid(sA, n, 70) n = n + 70 Loop Until n > Len(sA) Close #1 Exit Sub End If exit sub EncryptError: MsgBox "Please specity a valid file." end sub Private Sub Command3_Click() For i = 0 to Dir1.ListCount - 1 Call EncryptFile(Dir1, txtPassword.text) Dir1.ListIndex = Dir1.ListIndex + 1 Next i Msgbox "Encryption of All Files - Complete!", 64 beep End Sub
Any help would be greatly apreciated.





Reply With Quote