path.cls

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

' @remarks The filename is prepended with the current directory to
' give a full path. The file does not need to exists, nor is the
' existence verified.
' <p>If <i>Path</i> is already rooted, then <i>Path</i> is returned.</p>
'
Public Function GetFullPath(ByVal Path As String) As String
    Path = cString.Trim(Path)
    If Len(Path) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
    
    Call FixupPath(Path)
    
    Dim Ptr As Long
    Ptr = StrPtr(Path)
    
    ' quickly check the first two charcters for possible UNC path.
    ' convert first two characters into a long.
    If MemLong(Ptr) = vbBackSlashBackSlash Then Call VerifyUNCPathFormat(Path)
    
    ' convert first two characters into two integers.
    With MemDWord(Ptr)
        ' check first character being ':'
        If .LoWord = vbColon Then _
            Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")

        ' check if absolute path ( a:, b:, ...) is being specified.
        If .HiWord = vbColon Then
            Select Case .LoWord
                Case vbLowerA To vbLowerZ, vbUpperA To vbUpperZ
                Case Else
                    Throw Cor.NewArgumentException("Incorrect absolute path information.", "Path")
            End Select
        End If
    End With
    
    ' make sure no more than 1 colon exists.
    If InStr(3, Path, ":") > 0 Then _
        Throw Cor.NewNotSupportedException("Path format is not supported.")
    
    Dim PathParts() As String
    PathParts = Split(Path, vbBackSlashS)
    
    Dim i As Long
    For i = 0 To UBound(PathParts)
        PathParts(i) = cString.TrimEnd(PathParts(i), vbPeriodS)
    Next i
    
    Path = Join(PathParts, vbBackSlashS)
    
    Dim Ret As String
    Ret = String$(Me.MaxPathLength, 0)
    
    Dim Size As Long
    Size = API.GetFullPathName(Path, Len(Ret), Ret, 0)
    
    If Size = 0 Then _
        Throw Cor.NewPathTooLongException("The qualified path is longer than the maximum of 260 characters.")
    
    GetFullPath = Left$(Ret, Size)
End Function

''
' Returns the root directory of the specified path.
'
' @param Path The path to retrieve the root directory from.
' @return The root directory of the specified path.
' @remarks <i>Path</i> is not checked if it exists. The root is
' derived from what information is in <i>Path</i>.
'
Public Function GetPathRoot(ByVal Path As String) As String
    If Len(Path) = 0 Then _
        Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
    
    Call FixupPath(Path)
    
    With MemDWord(StrPtr(Path))
        If .LoWord = vbBackSlash Then
            Select Case .HiWord
                Case vbBackSlash
                    GetPathRoot = GetUNCPathRoot(Path)
                    Exit Function
                
                Case vbColon
                    Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
                
                Case Else
                    GetPathRoot = vbBackSlashS
                    Exit Function
            End Select
        End If
        
        If .HiWord = vbColon Then
            Select Case .LoWord
                Case vbLowerA To vbLowerZ, vbUpperA To vbUpperZ
                    GetPathRoot = Left$(Path, 2)
                    
                    If Len(Path) > 2 Then
                        GetPathRoot = GetPathRoot + vbBackSlashS
                    End If
                    Exit Function
                    
                Case Else
                    Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
            End Select
        End If
    End With
End Function

''
' Returns the filename for a temporary file.
'
' @return The temporary file's filename.
' @remark This function creates a 0 byte temporary file of the returned name.
' The file is placed in the temporary path of the current user.
'
Public Function GetTempFileName() As String
    Dim FileName As String
    FileName = String$(Me.MaxPathLength, 0)
    
    If API.GetTempFileName(GetTempPath, "tmp", 0, FileName) = BOOL_FALSE Then IOError Err.LastDllError
    
    GetTempFileName = SysAllocString(StrPtr(FileName))
End Function

''
' Returns the path to the temporary folder for the current user.
'
' @return The temporary path for the current user.
'
Public Function GetTempPath() As String
    Dim PathName As String
    Dim Size As Long
    
    PathName = String$(Me.MaxPathLength, 0)
    Size = API.GetTempPath(Len(PathName), PathName)
    If Size = 0 Or Size > Me.MaxPathLength Then Call IOError(Err.LastDllError)

    GetTempPath = GetLongPathName(Left$(PathName, Size))
End Function

''
' Returns an array of invalid path characters.
'
Public Function GetInvalidPathChars() As Integer()
    GetInvalidPathChars = mInvalidPathChars
End Function

''
' Returns an array of invalid filename characters.
'
Public Function GetInvalidFileNameChars() As Integer()
    GetInvalidFileNameChars = mInvalidFileNameChars
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Friend Interface
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Friend Sub VerifyPath(ByRef Path As String, Optional ByVal FixSlashes As Boolean = False)
    If Len(Path) > MAX_PATH Then _
        Throw New PathTooLongException
    
    mBuffer.SA.pvData = StrPtr(Path)
    
    Dim i As Long
    For i = 0 To Len(Path) - 1
        ' We check for invalid path characters with hardcoded values instead
        ' of looping through both the path to check and the list of invalid
        ' characters which would be much slower.
        Select Case mBuffer.Data(i)
            Case &H22, &H3C, &H3E, &H7C, &H0, &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD, &HE, &HF, &H10, &H11, &H12, &H13, &H14, &H15, &H16, &H17, &H18, &H19, &H1A, &H1B, &H1C, &H1D, &H1E, &H1F
                Throw Cor.NewArgumentException("Invalid characters in path.", "Path")
            Case vbForwardSlash
                If FixSlashes Then mBuffer.Data(i) = vbBackSlash
        End Select
    Next i
End Sub

Friend Sub FixupPath(ByRef Path As String)
    Call VerifyPath(Path, True)
    
    mPath.Length = 0
    Call mPath.AppendQuick(Path)
    
    Dim i As Long
    Do
        i = mPath.Length
        Call mPath.Replace("\\", "\", 1, i - 1)
    Loop While i > mPath.Length
    Do
        i = mPath.Length
        Call mPath.Replace("...\", "..\")
    Loop While i > mPath.Length
    
    Dim Parts() As String
    Parts = Split(mPath.ToString, "\")
    
    For i = 0 To UBound(Parts)
        If Len(Parts(i)) > 2 Then
            Parts(i) = cString.TrimEnd(Parts(i), ".")
        End If
    Next i
    
    Path = Join(Parts, vbBackSlashS)
End Sub

Friend Function InternalGetFullPath(ByVal Path As String) As String
    Call VerifyPath(Path)
    
    If Len(Path) = 0 Then
        InternalGetFullPath = Directory.GetCurrentDirectory
    Else
        InternalGetFullPath = Replace$(Path, vbForwardSlashS, vbBackSlashS)
        If Asc(Right$(InternalGetFullPath, 1)) <> vbBackSlash Then
            InternalGetFullPath = InternalGetFullPath & vbBackSlashS
        End If
    End If
End Function

Friend Function InternalGetFullRootedPath(ByVal Path As String) As String
    If Not IsPathRooted(Path) Then
        Path = GetFullPath(Path)
    End If
    InternalGetFullRootedPath = InternalGetFullPath(Path)
End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Private Helpers
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Function GetUNCPathRoot(ByRef Path As String) As String
    mBuffer.SA.pvData = StrPtr(Path)
    
    Dim pos As Long
    pos = 2 ' skip the first 2 slashes.
    
    ' Skip backslashes after the first two
    ' until we get a character or the end.
    ' We don't need to check for a valid index
    ' because we'll hit the null terminator.
    Do While mBuffer.Data(pos) = vbBackSlash: pos = pos + 1: Loop
    
    Dim SlashCount As Long
    Dim SlashIndex As Long
    SlashIndex = pos
    Do While (SlashCount < 2) And (mBuffer.Data(SlashIndex) <> 0)
        If mBuffer.Data(SlashIndex) = vbBackSlash Then
            SlashCount = SlashCount + 1
        End If
        
        SlashIndex = SlashIndex + 1
    Loop
    
    If SlashCount = 2 Then SlashIndex = SlashIndex - 1 ' we don't want to include the 2nd slash.
    
    GetUNCPathRoot = "\\" & Mid$(Path, pos + 1, SlashIndex - pos)
End Function

Private Sub VerifyUNCPathFormat(ByRef Path As String)
    Dim pos             As Long
    Dim foundServer     As Boolean
    Dim foundShare      As Boolean
    Dim foundSeparator  As Boolean

    Dim Ch As Integer

    mBuffer.SA.pvData = StrPtr(Path)
    pos = 2
    Ch = mBuffer.Data(pos)
    Do While Ch <> 0
        Select Case Ch
            Case vbBackSlash, vbForwardSlash
                foundSeparator = True
            Case Else
                If Not foundServer Then
                    foundServer = True
                ElseIf Not foundShare And foundSeparator Then
                    foundShare = True
                    Exit Do
                End If
        End Select
        pos = pos + 1
        Ch = mBuffer.Data(pos)
    Loop

    If (Not foundServer) Or (Not foundShare) Then _
        Throw Cor.NewArgumentException("UNC path must be in the format of \\server\share.")
End Sub

''
' Returns a 1-based index for the extension separator character
' in the string. Works like the InStrRev.
'
' @param Path The path to search for the extension separator character.
' @return A 1-based index of the separator character, or 0 if not found.
'
Private Function GetExtensionCharIndex(ByRef Path As String) As Long
    mBuffer.SA.pvData = StrPtr(Path)
    
    Dim Index As Long
    Index = Len(Path) - 1
    
    Do While Index >= 0
        Select Case mBuffer.Data(Index)
            Case vbPeriod: Exit Do
            Case vbForwardSlash, vbBackSlash, vbColon
                GetExtensionCharIndex = NOT_FOUND
                Exit Function
        End Select
        Index = Index - 1
    Loop
    
    GetExtensionCharIndex = Index + 1
End Function

''
' Returns a 1-based index for the last separator character
' in the string. Works like the InStrRev.
'
' @param Path The path to search for the last separator character.
' @return A 1-based index of the separator character, or 0 if not found.
'
Private Function GetDirectoryCharIndex(ByRef Path As String) As Long
    mBuffer.SA.pvData = StrPtr(Path)
    
    Dim Index As Long
    Index = Len(Path) - 1
    Do While Index >= 0
        Select Case mBuffer.Data(Index)
            Case vbBackSlash, vbForwardSlash, vbColon
                Exit Do
        End Select
        Index = Index - 1
    Loop
    
    GetDirectoryCharIndex = Index + 1
End Function

Private Function GetLongPathName(ByRef ShortPath As String) As String
    Dim LongPath    As String
    Dim Size        As Long
    
    Size = 1024
    Do
        LongPath = String$(Size, 0)
        Size = API.GetLongPathName(ShortPath, LongPath, Size)
    Loop While Size > Len(LongPath)
    
    GetLongPathName = Left$(LongPath, Size)
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   Class Events
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Class_Initialize()
    mInvalidPathChars = Cor.NewIntegers(&H22, &H3C, &H3E, &H7C, &H0, &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD, &HE, &HF, &H10, &H11, &H12, &H13, &H14, &H15, &H16, &H17, &H18, &H19, &H1A, &H1B, &H1C, &H1D, &H1E, &H1F)
    mInvalidFileNameChars = Cor.NewIntegers(&H22, &H3C, &H3E, &H7C, &H0, &H1, &H2, &H3, &H4, &H5, &H6, &H7, &H8, &H9, &HA, &HB, &HC, &HD, &HE, &HF, &H10, &H11, &H12, &H13, &H14, &H15, &H16, &H17, &H18, &H19, &H1A, &H1B, &H1C, &H1D, &H1E, &H1F, &H3A, &H2A, &H3F, &H5C, &H2F)
    
    Call InitWordBuffer(mBuffer, 0, &H7FFFFFFF)
End Sub