Why won't this work???

I'm trying to get my application to encrypt directories with this code, but for some reason, it doesn't work.

Code:

---

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

---

Note: Dir1 is a directory box
Any help would be greatly apreciated.

Dim cphX As New Cipher
what is your reference for this?

Dim cphX As New Cipher
Cipher is a Class Module that I have. It contains all the algorithms I need to do encryption, etc.

OK...guess I can't test the code without it.

Okay...You asked for it...

Code:

---

'Copy (c) 2000 eiSecure, Inc.
'DO NOT COPY THIS CODE!
'I GRANT YOU NO PERMISSION TO EVEN VIEW THIS CODE! (hehehe)
Option Explicit

Private msKeyString As String
Private msText As String

'~~~.KeyString
Public Property Let KeyString(sKeyString As String)
    msKeyString = sKeyString
    Initialize
End Property

'~~~.Text
Public Property Let Text(sText As String)
    msText = sText
End Property
Public Property Get Text() As String
    Text = msText
End Property

'~~~.DoXor
Public Sub DoXor()
    Dim intC As Integer
    Dim intB As Integer
    Dim lngI As Long
    For lngI = 1 To Len(msText)
        intC = Asc(Mid(msText, lngI, 1))
        intB = Int(Rnd * 256)
        Mid(msText, lngI, 1) = Chr(intC Xor intB)
    Next lngI
End Sub

'~~~.Stretch
Public Sub Stretch()
    Dim intC As Integer
    Dim lngI As Long
    Dim lngJ As Long
    Dim intK As Integer
    Dim lngA As Long
    Dim sB As String
    lngA = Len(msText)
    sB = Space(lngA + (lngA + 2) \ 3)
    For lngI = 1 To lngA
        intC = Asc(Mid(msText, lngI, 1))
        lngJ = lngJ + 1
        Mid(sB, lngJ, 1) = Chr((intC And 63) + 59)
        Select Case lngI Mod 3
        Case 1
            intK = intK Or ((intC \ 64) * 16)
        Case 2
            intK = intK Or ((intC \ 64) * 4)
        Case 0
            intK = intK Or (intC \ 64)
            lngJ = lngJ + 1
            Mid(sB, lngJ, 1) = Chr(intK + 59)
            intK = 0
        End Select
    Next lngI
    If lngA Mod 3 Then
        lngJ = lngJ + 1
        Mid(sB, lngJ, 1) = Chr(intK + 59)
    End If
    msText = sB
End Sub

'~~~.Shrink
Public Sub Shrink()
    Dim intC As Integer
    Dim intD As Integer
    Dim intE As Integer
    Dim lngA As Long
    Dim lngB As Long
    Dim lngI As Long
    Dim lngJ As Long
    Dim lngK As Long
    Dim sB As String
    lngA = Len(msText)
    lngB = lngA - 1 - (lngA - 1) \ 4
    sB = Space(lngB)
    For lngI = 1 To lngB
        lngJ = lngJ + 1
        intC = Asc(Mid(msText, lngJ, 1)) - 59
        Select Case lngI Mod 3
        Case 1
            lngK = lngK + 4
            If lngK > lngA Then lngK = lngA
            intE = Asc(Mid(msText, lngK, 1)) - 59
            intD = ((intE \ 16) And 3) * 64
        Case 2
            intD = ((intE \ 4) And 3) * 64
        Case 0
            intD = (intE And 3) * 64
            lngJ = lngJ + 1
        End Select
        Mid(sB, lngI, 1) = Chr(intC Or intD)
    Next lngI
    msText = sB
End Sub

'Initializes random numbers using the Key string
Private Sub Initialize()
    Dim intI As Integer
    Randomize Rnd(-1)
    For intI = 1 To Len(msKeyString)
        Randomize Rnd(-Rnd * Asc(Mid(msKeyString, intI, 1)))
    Next intI
End Sub

---

Function Hash ????

sT = Hash(Date & Str(Timer))

Quote:

---

Function Hash ????

sT = Hash(Date & Str(Timer))

---

Thats another function that I have. It is basically a secret key (can't tell u what it is...sorry) that is multiplied by the time, added with the "salt characters", etc.
Oh, don't mind that line...I know it is valid.

it's not encrypting...it is trying to encrypt a directroy name and not a file name....
for example:
I set the path for the dir to C:\aaa
In in I had 1 file and 2 sub directories.
It doesn't look at the file in the root
and then list the two subs as C:\aaa
that is obviously wrong....it should be going inside
the directory to the files.

Have to go to work now so I'll see if I can scab a few
moments from work and try to get any encrypt going
through the files inside the folders.