Bad Code.. Someone help me?

**Evan** · Aug 28th, 2000, 05:07 PM

This code is suppose to put
a directory together and then
take it apart.

Could someone fix it.. It
wont work.

----------------------------
Instructions:

1. Make a directory called "win"
in C:\ and put 4 files in it.
(Any files .. Doesnt Matter)

Project List:

Add form1
On form1 place 2 command buttons.
Add Module1

' In Form1

Private Sub Command1_Click()
SplitPictures Dir_Files, "C:\win\dir.enc"
MsgBox "Directory Extracted!"
End Sub

Private Sub Command2_Click()
Dim Dir_Files As Variant
Static UboundB As Integer
Dir_Files = FastFindFiles("c:\win")
UboundB = UBound(Dir_Files)
JoinDirectory Dir_Files, "C:\win\dir.enc"
MakeDirFileNames Dir_Files, "C:\win\names"
MsgBox "Directory Encrypted!"
End Sub

Private Sub form_load ()
command2.caption = "Encrypt"
command1.caption = "Unencrypt"
End Sub

'In Module

Option Explicit

Public Names(5) As String

'API Consts, Types and Functions
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Global YourDir As String
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private aFileList As Variant
Private nFileCount As Long

Function FastFindFiles(ByVal sFolder As String, Optional ByVal sPattern As String = "*") As Variant
'Initialize the Private File Array and Count, then call the Fast
'File Recursive Function to populate the Array, then return it.
nFileCount = 0
aFileList = Array()
Screen.MousePointer = vbArrowHourglass
Call RecurseFindFiles(sFolder, sPattern)
Screen.MousePointer = vbDefault
FastFindFiles = aFileList
End Function

Private Sub RecurseFindFiles(ByVal sFolder As String, ByVal sPattern As String)
Dim tFD As WIN32_FIND_DATA, lFile As Long, bFound As Long, aSubs() As String, nSubs As Long, sFilename As String

'Make sure the passed folder includes an ending "\"
If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

'Find the First File in the Specified Location
lFile = FindFirstFile(sFolder & "*", tFD)
bFound = lFile

'Loop while a File is found
While bFound
'Get the Filename
sFilename = UCase(Left(tFD.cFileName, InStr(tFD.cFileName, Chr(0)) - 1))
If (tFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
'If it's a Folder, add it to the Sub Folders Array
If Left(sFilename, 1) <> "." Then
ReDim Preserve aSubs(nSubs)
aSubs(nSubs) = sFilename
nSubs = nSubs + 1
End If
Else
'If it's a File, compare it to the Pattern for a Match
If sFilename Like UCase(sPattern) Then
'If it matches, add it to the File Array
ReDim Preserve aFileList(nFileCount)
aFileList(nFileCount) = sFolder & sFilename
nFileCount = nFileCount + 1
End If
End If
'Find the Next File, (if there is one).
bFound = FindNextFile(lFile, tFD)
Wend
'Close the API Find Handle
Call FindClose(lFile)

'If there were Sub Folders found, Recurse them too..
If nSubs Then
For nSubs = 0 To UBound(aSubs)
Call RecurseFindFiles(sFolder & aSubs(nSubs), sPattern)
Next
End If
End Sub

Function SaveYourDir()
Dim a As String
a = InputBox("What is your directory?", "NewDirectory", "C:\YourDirName")
SaveSetting App.Title, "Saved", "UserDirectory", a
GetYourDir
End Function

Function GetYourDir()
Dim a As String
a = GetSetting(App.Title, "Saved", "UserDirectory", "")
If a = "" Then
SaveYourDir
Else
YourDir = a
End If
End Function

Public Sub JoinDirectory(VarDir As Variant, strNewFile As String)
Dim btemp() As Byte
Dim EndArr As Integer
Dim currentnum As Integer

EndArr = UBound(VarDir)
Open strNewFile For Binary As #1
Do While currentnum <= EndArr
Put #1, , FileLen(VarDir(currentnum)) & " "
currentnum = currentnum + 1
Loop

currentnum = 0
Do While currentnum <= EndArr
Open VarDir(currentnum) For Binary As #2
ReDim btemp(LOF(2) - 1) As Byte
Get #2, , btemp
Put #1, , btemp
Close #2
currentnum = currentnum + 1
Loop

Close #1

End Sub

Function MakeDirFileNames(VarDir As Variant, strNewFile As String)
Dim btemp() As Byte
Dim EndArr As Integer
Dim currentnum As Integer

EndArr = UBound(VarDir)

Open strNewFile For Binary As #1

Do While currentnum <= EndArr
Put #1, , CStr(VarDir(currentnum)) & " "
currentnum = currentnum + 1
Loop

Close #1
End Function
Public Sub SplitPictures(VarDir As Variant, strJoinedFile As String)
Dim Lengths(5) As Single
Dim Looper As Boolean
Dim strSize(5) As String
Dim strTemp As String
Dim ip As Long
Dim btemp() As Byte
Dim TempFile() As Byte

GetNames

Open strJoinedFile For Input As #1
Line Input #1, strTemp
Close #1
ip = InStr(1, strTemp, " ")
Lengths(0) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Lengths(1) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Lengths(2) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Lengths(3) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)

'redim the array to teh size of the first picture
TempFile = Left$(strTemp, Lengths(0) - 1)
Open Names(0) For Binary As #2
'get the data starting from after the length data
Get #1, , TempFile
'put the data
Put #2, , TempFile
Close #2

Close #1

End Sub

Function GetNames()
Dim Lengths(5) As Single
Dim Looper As Boolean
Dim strSize(5) As String
Dim strTemp As String
Dim ip As Long
Dim btemp() As Byte
Open "C:\win\names" For Input As #1
Line Input #1, strTemp
Close #1
'get teh sizes from the temp string
ip = InStr(1, strTemp, " ")
Names(0) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Names(1) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Names(2) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
ip = InStr(1, strTemp, " ")
Names(3) = Left$(strTemp, ip)
strTemp = Right$(strTemp, Len(strTemp) - ip)
End Function

'The Program Places all the files in the
'directory, in a file named dir.enc and the
'names of the file in names

[Edited by Evan on 08-28-2000 at 06:10 PM]

**dimava** · Aug 28th, 2000, 06:56 PM

this is much easier to read, although I dont have the answer:

form1:

Code:

Private Sub Command1_Click()
    SplitPictures Dir_Files, "C:\win\dir.enc"
    MsgBox "Directory Extracted!"
End Sub

Private Sub Command2_Click()
    Dim Dir_Files As Variant
    Static UboundB As Integer
    Dir_Files = FastFindFiles("c:\win")
    UboundB = UBound(Dir_Files)
    JoinDirectory Dir_Files, "C:\win\dir.enc"
    MakeDirFileNames Dir_Files, "C:\win\names"
    MsgBox "Directory Encrypted!"
End Sub

Private Sub form_load()
    command2.Caption = "Encrypt"
    command1.Caption = "Unencrypt"
End Sub

module:

Code:

Option Explicit

Public Names(5) As String

'API Consts, Types and Functions
Private Const MAX_PATH = 260
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
Global YourDir As String
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long

Private aFileList As Variant
Private nFileCount As Long

Function FastFindFiles(ByVal sFolder As String, Optional ByVal sPattern As String = "*") As Variant
'Initialize the Private File Array and Count, then call the Fast
'File Recursive Function to populate the Array, then return it.
    nFileCount = 0
    aFileList = Array()
    Screen.MousePointer = vbArrowHourglass
    Call RecurseFindFiles(sFolder, sPattern)
    Screen.MousePointer = vbDefault
    FastFindFiles = aFileList
End Function

Private Sub RecurseFindFiles(ByVal sFolder As String, ByVal sPattern As String)
    Dim tFD As WIN32_FIND_DATA, lFile As Long, bFound As Long, aSubs() As String, nSubs As Long, sFilename As String

    'Make sure the passed folder includes an ending "\"
    If Right(sFolder, 1) <> "\" Then sFolder = sFolder & "\"

    'Find the First File in the Specified Location
    lFile = FindFirstFile(sFolder & "*", tFD)
    bFound = lFile

    'Loop while a File is found
    While bFound
        'Get the Filename
        sFilename = UCase(Left(tFD.cFileName, InStr(tFD.cFileName, Chr(0)) - 1))
        If (tFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
            'If it's a Folder, add it to the Sub Folders Array
            If Left(sFilename, 1) <> "." Then
                ReDim Preserve aSubs(nSubs)
                aSubs(nSubs) = sFilename
                nSubs = nSubs + 1
            End If
        Else
            'If it's a File, compare it to the Pattern for a Match
            If sFilename Like UCase(sPattern) Then
                'If it matches, add it to the File Array
                ReDim Preserve aFileList(nFileCount)
                aFileList(nFileCount) = sFolder & sFilename
                nFileCount = nFileCount + 1
            End If
        End If
        'Find the Next File, (if there is one).
        bFound = FindNextFile(lFile, tFD)
    Wend
    'Close the API Find Handle
    Call FindClose(lFile)

    'If there were Sub Folders found, Recurse them too..
    If nSubs Then
        For nSubs = 0 To UBound(aSubs)
            Call RecurseFindFiles(sFolder & aSubs(nSubs), sPattern)
        Next
    End If
End Sub

Function SaveYourDir()
    Dim a As String
    a = InputBox("What is your directory?", "NewDirectory", "C:\YourDirName")
    SaveSetting App.Title, "Saved", "UserDirectory", a
    GetYourDir
End Function

Function GetYourDir()
    Dim a As String
    a = GetSetting(App.Title, "Saved", "UserDirectory", "")
    If a = "" Then
        SaveYourDir
    Else
        YourDir = a
    End If
End Function

Public Sub JoinDirectory(VarDir As Variant, strNewFile As String)
    Dim btemp() As Byte
    Dim EndArr As Integer
    Dim currentnum As Integer

    EndArr = UBound(VarDir)
    Open strNewFile For Binary As #1
    Do While currentnum <= EndArr
        Put #1, , FileLen(VarDir(currentnum)) & " "
        currentnum = currentnum + 1
    Loop

    currentnum = 0
    Do While currentnum <= EndArr
        Open VarDir(currentnum) For Binary As #2
        ReDim btemp(LOF(2) - 1) As Byte
        Get #2, , btemp
        Put #1, , btemp
        Close #2
        currentnum = currentnum + 1
    Loop

    Close #1
End Sub

Function MakeDirFileNames(VarDir As Variant, strNewFile As String)
    Dim btemp() As Byte
    Dim EndArr As Integer
    Dim currentnum As Integer

    EndArr = UBound(VarDir)

    Open strNewFile For Binary As #1

    Do While currentnum <= EndArr
        Put #1, , CStr(VarDir(currentnum)) & " "
        currentnum = currentnum + 1
    Loop

    Close #1
End Function

Public Sub SplitPictures(VarDir As Variant, strJoinedFile As String)
    Dim Lengths(5) As Single
    Dim Looper As Boolean
    Dim strSize(5) As String
    Dim strTemp As String
    Dim ip As Long
    Dim btemp() As Byte
    Dim TempFile() As Byte

    GetNames

    Open strJoinedFile For Input As #1
    Line Input #1, strTemp
    Close #1
    ip = InStr(1, strTemp, " ")
    Lengths(0) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Lengths(1) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Lengths(2) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Lengths(3) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)

    'redim the array to teh size of the first picture
    TempFile = Left$(strTemp, Lengths(0) - 1)
    Open Names(0) For Binary As #2
    'get the data starting from after the length data
    Get #1, , TempFile
    'put the data
    Put #2, , TempFile
    Close #2

    Close #1
End Sub

Function GetNames()
    Dim Lengths(5) As Single
    Dim Looper As Boolean
    Dim strSize(5) As String
    Dim strTemp As String
    Dim ip As Long
    Dim btemp() As Byte
    Open "C:\win\names" For Input As #1
    Line Input #1, strTemp
    Close #1
    'get teh sizes from the temp string
    ip = InStr(1, strTemp, " ")
    Names(0) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Names(1) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Names(2) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
    ip = InStr(1, strTemp, " ")
    Names(3) = Left$(strTemp, ip)
    strTemp = Right$(strTemp, Len(strTemp) - ip)
End Function


'The Program Places all the files in the
'directory, in a file named dir.enc and the
'names of the file in names

Thread: Bad Code.. Someone help me?

Thread Tools

Display

Posting Permissions