directory.cls

这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.

' @return The list of matching file names. If no filenames matched, then an empty,
' zero-length array is returned.
' @remarks The path can be absolute or relative. The path is not included in the
' filename result.
'
Public Function GetFiles(ByVal Path As String, Optional ByVal SearchPattern As String = "*") As String()
    GetFiles = InternalGetFiles(Path, SearchPattern, FileEntry)
End Function

''
' Returns both directories and files that match the specified pattern.
'
' @param Path The directory to search for the files and directories.
' @param SearchPattern The pattern the filenames and directories must match.
' @return The list of files and directories that matched the pattern. If no files or directories
' matched the pattern, then an empty, zero-length array is returned.
' @remarks The path can be absolute or relative.
'
Public Function GetFileSystemEntries(ByVal Path As String, Optional ByVal SearchPattern As String = "*") As String()
    GetFileSystemEntries = InternalGetFiles(Path, SearchPattern, DirectoryEntry Or FileEntry)
End Function

''
' Returns a list of the logical drives installed on this machine.
'
' @return The list of logical drives on this machine.
'
Public Function GetLogicalDrives() As String()
    Dim Ret() As String
    ReDim Ret(25) As String ' just allocate the maximum letters possible.
    
    Dim mask As Long
    mask = VBCorType.GetLogicalDrives
    
    Dim letter As Long
    letter = vbUpperA
    
    Dim i As Long
    Do While mask <> 0
        If mask And 1 Then
            Ret(i) = Chr$(letter) & ":\"
            i = i + 1
        End If
        letter = letter + 1
        mask = mask \ 2
    Loop
    
    ReDim Preserve Ret(0 To i - 1)
    GetLogicalDrives = Ret
End Function

''
' Returns the parent of the specified directory.
'
' @param Path The directory to retrieve the parent of.
' @return A DirectoryInfo object representing the parent directory.
' @remarks The path can be absolute or relative.
'
Public Function GetParent(ByVal Path As String) As DirectoryInfo
    If Len(Path) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "Path")

    Call mPath.VerifyPath(Path)
    Path = mPath.GetFullPath(Path)
    
    Dim DirName As String
    DirName = mPath.GetDirectoryName(Path)
    If cString.IsNull(DirName) Then Exit Function
    Set GetParent = Cor.NewDirectoryInfo(DirName)
End Function

''
' Moves a directory and all of its contents to another location.
'
' @param SourceDirectory The directory to be moved.
' @param DestinationDirectory The directory to be moved to.
' @remarks The destination directory is the source directory renamed
' after the moving of the source directory.
'
Public Sub Move(ByVal SourceDirectory As String, ByVal DestinationDirectory As String)
    If Len(SourceDirectory) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "SourceDirectory")
    If Len(DestinationDirectory) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "DestinationDirectory")
    
    SourceDirectory = LCase$(Path.InternalGetFullRootedPath(SourceDirectory))
    DestinationDirectory = LCase$(Path.InternalGetFullRootedPath(DestinationDirectory))
    
    If SourceDirectory = DestinationDirectory Then _
        Throw Cor.NewIOException("Source and Destination directories must be different.")
    If Path.GetPathRoot(SourceDirectory) <> Path.GetPathRoot(DestinationDirectory) Then _
        Throw Cor.NewIOException("Source and Destination directories must be on the same root drive.")
        
    If API.MoveFile(SourceDirectory, DestinationDirectory) = BOOL_FALSE Then
        Dim Result  As Long
        Result = Err.LastDllError
        If Result = ERROR_FILE_NOT_FOUND Then
            IOError ERROR_PATH_NOT_FOUND, SourceDirectory
        Else
            IOError Result
        End If
    End If
End Sub

''
' Changes the current directory to the specified directory.
'
' @param Path The new directory to set as the current directory.
' @remarks The path can be absolute or relative.
'
Public Sub SetCurrentDirectory(ByVal Path As String)
    If Len(Path) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "Path")
    
    Call mPath.VerifyPath(Path)
    If Not Exists(Path) Then _
        Throw New DirectoryNotFoundException
    
    If API.SetCurrentDirectory(Path) = BOOL_FALSE Then IOError Err.LastDllError, Path
End Sub

''
' Sets the creation time of the specified directory to the local time.
'
' @param Path The directory to set the creation time for.
' @param CreationTime A Date or cDateTime object of the new time.
' @remarks The time will have the UTC offset removed before setting the
' the directory to it. When the time is read, it will be in local time to the timezone.
'
Public Sub SetCreationTime(ByVal Path As String, ByVal CreationTime As Variant)
    Call InternalSetFileTime(Path, cDateTime.GetcDateTime(CreationTime).ToFileTime)
End Sub

''
' Sets the creation time of the specified directory to UTC time.
'
' @param Path The directory to set the creation time for in UTC.
' @param CreationTime A Date or cDateTime object of the new UTC time.
' @remarks The directory is set to the actual time passed in.
'
Public Sub SetCreationTimeUtc(ByVal Path As String, ByVal CreationTime As Variant)
    Call InternalSetFileTime(Path, cDateTime.GetcDateTime(CreationTime).ToFileTimeUtc)
End Sub

''
' Sets the time the directory was last accessed in local time.
'
' @param Path The directory to set the new time for.
' @param LastAccessTime A Date or cDateTime object of the new time.
' @remarks The UTC offset is removed from the time before setting the directory.
'
Public Sub SetLastAccessTime(ByVal Path As String, ByVal LastAccessTime As Variant)
    Call InternalSetFileTime(Path, , cDateTime.GetcDateTime(LastAccessTime).ToFileTime)
End Sub

''
' Sets the time the directory was last accessed in UTC time.
'
' @param Path The directory to set the new time for.
' @param LastAccessTime A Date or cDateTime object of the new time.
' @remarks The directory is set to the actual time passed in.
'
Public Sub SetLastAccessTimeUtc(ByVal Path As String, ByVal LastAccessTime As Variant)
    Call InternalSetFileTime(Path, , cDateTime.GetcDateTime(LastAccessTime).ToFileTimeUtc)
End Sub

''
' Sets the time the directory was last written to in local time.
'
' @param Path The directory to set the new time for.
' @param LastWriteTime A Date or cDateTime object of the new time.
'
Public Sub SetLastWriteTime(ByVal Path As String, ByVal LastWriteTime As Variant)
    Call InternalSetFileTime(Path, , , cDateTime.GetcDateTime(LastWriteTime).ToFileTime)
End Sub

''
' Sets the time the directory was last written to in UTC time.
'
' @param Path The directory to set the new time for.
' @param LastWriteTime A Date or cDateTime object of the new time.
'
Public Sub SetLastWriteTimeUtc(ByVal Path As String, ByVal LastWriteTime As Variant)
    Call InternalSetFileTime(Path, , , cDateTime.GetcDateTime(LastWriteTime).ToFileTimeUtc)
End Sub


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub VerifySearchPattern(ByRef s As String)
    Dim i As Long
    i = InStr(s, "..")
    If i > 0 Then
        If i = Len(s) - 1 Then Throw Cor.NewArgumentException("Cannot end search pattern with '..'")
        Select Case Asc(Mid$(s, i + 2, 1))
            Case DIRECTORY_SEPARATOR_CHAR, ALT_DIRECTORY_SEPARATOR_CHAR
                Throw Cor.NewArgumentException("'..' cannot be followed immediately by a directory separator.")
        End Select
    End If
End Sub

Private Function InternalGetFiles(ByRef sPath As String, ByRef SearchPattern As String, ByVal EntryTypes As SystemEntryTypes) As String()
    Dim FullPath As String
    FullPath = Path.InternalGetFullPath(sPath)
    
    Call VerifySearchPattern(SearchPattern)
    
    Dim Data        As WIN32_FIND_DATA
    Dim FileHandle  As Long
    FileHandle = API.FindFirstFile(Path.Combine(sPath, SearchPattern), Data)
    
    Dim List As New ArrayList
    
    Dim include As Boolean
    If FileHandle <> INVALID_HANDLE Then
        Do
            If Data.dwFileAttributes And FileAttributes.DirectoryAttr Then
                include = (EntryTypes And SystemEntryTypes.DirectoryEntry)
            Else
                include = (EntryTypes And SystemEntryTypes.FileEntry)
            End If
            
            If include Then
                Dim s As String
                s = GetFileNameFromFindData(Data)
                If Len(s) > 0 Then Call List.Add(Path.Combine(sPath, s))
            End If
        Loop While API.FindNextFile(FileHandle, Data) <> BOOL_FALSE
    End If
    
    Dim e As Long
    e = Err.LastDllError    ' cache the error before FindClose changes it.
    
    Call FindClose(FileHandle)
    
    Select Case e
        Case 0, ERROR_NO_MORE_FILES, ERROR_FILE_NOT_FOUND   ' ignore these errors.
        Case Else: IOError e, sPath
    End Select

    InternalGetFiles = List.ToArray(ciString)
End Function

Private Sub InternalSetFileTime(ByRef sPath As String, Optional ByVal CreationTime As Variant, Optional ByVal LastAccessTime As Variant, Optional ByVal LastWriteTime As Variant)
    Dim cnt As Long
    Dim lat As Long
    Dim lwt As Long
    
    If Not IsMissing(CreationTime) Then cnt = VarPtr(CreationTime) + VARIANTDATA_OFFSET
    If Not IsMissing(LastAccessTime) Then lat = VarPtr(LastAccessTime) + VARIANTDATA_OFFSET
    If Not IsMissing(LastWriteTime) Then lwt = VarPtr(LastWriteTime) + VARIANTDATA_OFFSET
    
    If Len(sPath) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_EmptyPath), "sPath")
    
    Call Path.VerifyPath(sPath)
    
    Dim DirHandle As Long
    DirHandle = API.CreateFile(sPath, FileAccess.WriteAccess, FileShare.None, 0, FileMode.OpenExisting, FILE_FLAG_BACKUP_SEMANTICS, 0)
    If DirHandle = INVALID_HANDLE Then IOError Err.LastDllError, sPath
    If SetFileTime(DirHandle, ByVal cnt, ByVal lat, ByVal lwt) = BOOL_FALSE Then
        Close CloseHandle(DirHandle)
        IOError Err.LastDllError, sPath
    End If
    Call CloseHandle(DirHandle)
End Sub

Private Function GetFileNameFromFindData(ByRef Data As WIN32_FIND_DATA) As String
    Dim Ret As String
    Ret = Data.cFileName
    If Len(Ret) = 0 Then Ret = Data.cAlternateFileName
    If Asc(Ret) = vbPeriod Then Exit Function
    GetFileNameFromFindData = Ret
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    Set mPath = modStaticClasses.Path
End Sub