⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 path.cls

📁 这是一个在vb下实现的各种加密程序,可以实现一般的文本加密和文件加密,但是很多算法都是已经被人破解过的.
💻 CLS
📖 第 1 页 / 共 2 页
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Path"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'    CopyRight (c) 2004 Kelly Ethridge
'
'    This file is part of VBCorLib.
'
'    VBCorLib is free software; you can redistribute it and/or modify
'    it under the terms of the GNU Library General Public License as published by
'    the Free Software Foundation; either version 2.1 of the License, or
'    (at your option) any later version.
'
'    VBCorLib is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU Library General Public License for more details.
'
'    You should have received a copy of the GNU Library General Public License
'    along with Foobar; if not, write to the Free Software
'    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'
'    Module: Path
'

''
' Provides functions to locate and format path information.
'
' @remarks All members of Path are static. To access them, use the
' Path.* convention.
' <pre>
' Dim p As String
' p = Path.Combine(App.Path, "file.txt")
' </pre>
'
Option Explicit

Private Const NOT_FOUND             As Long = &H0
Private Const vbBackSlashBackSlash  As Long = &H5C005C



Private mInvalidPathChars()     As Integer
Private mInvalidFileNameChars() As Integer
Private mBuffer                 As WordBuffer
Private mPath                   As New StringBuilder


''
' Returns the maximum length for a path.
'
' @return Tha maximum length allowed for a path.
' @remarks Returns 32767 on Windows NT machines, 260 for Win9x machines.
'
Public Property Get MaxPathLength() As Long
    MaxPathLength = IIf(Environment.IsNT, MAX_PATH_W, MAX_PATH_A)
End Property

''
' Returns the character code for the alternative directory separator character.
'
' @return The character code of the alternative directory separator (47).
' @remarks The alternate character is usually found on systems such as Unix.
'
Public Property Get AltDirectorySeparatorChar() As Integer
    AltDirectorySeparatorChar = vbForwardSlash
End Property

''
' Returns the string for the alternative directory separator character.
'
' @return The string of the alternative directory separator "/".
' @remarks The alternate string is usually found on systems such as Unix.
'
Public Property Get AltDirectorySeparatorString() As String
    AltDirectorySeparatorString = vbForwardSlashS
End Property

''
' Returns the directory separator character for Windows.
'
' @return The directory separator character for Windows (92).
'
Public Property Get DirectorySeparatorChar() As Integer
    DirectorySeparatorChar = vbBackSlash
End Property

''
' Returns the directory separator string for Windows.
'
' @return The directory separator string for windows "\".
'
Public Property Get DirectorySeparatorString() As String
    DirectorySeparatorString = vbBackSlashS
End Property

''
' Returns an array of characters that are invalid in a Windows path string.
'
' @return An Integer array representing the character code of the the invalid characters.
'
Public Property Get InvalidPathChars() As Integer()
    InvalidPathChars = mInvalidPathChars
End Property

''
' The character code used to separate strings in an environment variable.
'
' @return The environment variable string separator character code (59).
'
Public Property Get PathSeparator() As Integer
    PathSeparator = vbSemiColon
End Property

''
' The string used to seperate strings in an environment variable.
'
' @return The environment variable string separator ";".
'
Public Property Get PathSeparatorString() As String
    PathSeparatorString = vbSemiColonS
End Property

''
' The character code used to separate volume labels from path information.
'
' @return The character code for the volume separator (58).
'
Public Property Get VolumeSeparatorChar() As Integer
    VolumeSeparatorChar = vbColon
End Property

''
' Returns the string version of the volume separator.
'
' @return The string version of the volume separator ":".
'
Public Property Get VolumeSeparatorString() As String
    VolumeSeparatorString = vbColonS
End Property

''
' Replaces the extension of a filename with a new extension.
'
' @param Path The filename with an optional path.
' @param Extension The new extension to change the filename's to.
' @return The filename with the new extension, including a path if supplied.
' @remarks Passing in an <i>Extension</i> of <i>vbNullString</i> will remove
' any extension and period from the path.
'
Public Function ChangeExtension(ByVal Path As String, ByVal Extension As String) As String
    If Len(Path) = 0 Then Exit Function
    
    Call VerifyPath(Path)
    
    If Not cString.IsNull(Extension) Then
        ' replace or append extension.
        If Len(Extension) = 0 Then
            Extension = vbPeriodS
        ElseIf Asc(Extension) <> vbPeriod Then
            Extension = vbPeriodS & Extension
        End If
    End If
    
    Dim PeriodIndex As Long
    PeriodIndex = GetExtensionCharIndex(Path)
    If PeriodIndex = NOT_FOUND Then
        ChangeExtension = Path & Extension
    Else
        ChangeExtension = Left$(Path, PeriodIndex - 1) & Extension
    End If
End Function

''
' Returns an indication if the path is rooted or not.
'
' @param Path The path to check if is rooted.
' @return The indication of the path being rooted.
' @remarks <p>A rooted path is one that starts with a volume name,
' UNC server name, or directory separator. Such paths as C:\MyDir\File,
' \\Server\Share\File, and \MyFile are rooted.</p>
' <p>This function does not verify that the path actually exists.</p>
'
Public Function IsPathRooted(ByVal Path As String) As Boolean
    If Len(Path) = 0 Then Exit Function
    
    Call FixupPath(Path)
    
    With MemDWord(StrPtr(Path))
        If .LoWord = vbBackSlash Then
            IsPathRooted = True
        ElseIf .HiWord = vbColon Then
            IsPathRooted = True
        End If
    End With
End Function

''
' Returns if a filename has an extension.
'
' @param Path A filename and optional path to check for an extension.
' @return An indication of the filename having an extension.
' @remarks <p>The path string is search for a '.' that separates the
' the extension from the filename itself. If any of the directory separator
' characters or volume separator is encountered before a '.', then the
' filename is considered not to have an extension.
'
Public Function HasExtension(ByVal Path As String) As Boolean
    Call VerifyPath(Path)
    
    Select Case GetExtensionCharIndex(Path)
        Case Len(Path): Exit Function
        Case Is > 0: HasExtension = True
    End Select
End Function

''
' Combintes two paths into a single path.
'
' @param Path1 The left-hand side of the two paths to be joined.
' @param Path2 The right-hand side of the two paths to be joined.
' @return The joined paths.
' @remarks <p>If Path1 is an empty string, then Path2 is returned as is. If Path2
' is empty, but not Path1, then Path1 is returned as is.</p>
' <p>If Path2 is rooted (starts with a volume, UNC identifier or directory
' separator), then Path2 is returned, regardless of Path1.</p>
' <p>If Path1 does not end with a directory separator, one will be inserted.</p>
' <p>This function does not verify that the paths exist.</p>
'
Public Function Combine(ByVal Path1 As String, ByVal Path2 As String) As String
    Call VerifyPath(Path1)
    
    ' This will verify Path2 as well.
    If IsPathRooted(Path2) Then
        Combine = Path2
        Exit Function
    End If
    
    If Len(Path1) = 0 Then
        Combine = Path2
        Exit Function
    ElseIf Len(Path2) = 0 Then
        Combine = Path1
        Exit Function
    End If
    
    mBuffer.SA.pvData = StrPtr(Path1)
    Select Case mBuffer.Data(Len(Path1) - 1)
        Case vbBackSlash, vbForwardSlash, vbColon
            Combine = Path1 & Path2
        Case Else
            Combine = Path1 & vbBackSlashS & Path2
    End Select
End Function

''
' Returns the directory portion of a file path.
'
' @param Path The path to parse the directory from.
' @return The directory parsed from the path.
' @remarks The function does not verify that the directory exists.
'
Public Function GetDirectoryName(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 MinSlashes As Long
    With MemDWord(StrPtr(Path))
        If (.LoWord = vbBackSlash) And (.HiWord = vbBackSlash) Then
            MinSlashes = 4
            
        ElseIf .HiWord = vbColon Then
            If (.LoWord = vbColon) Or (InStr(3, Path, ":") > 0) Then _
                Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
            
            Select Case Asc(Path)
                Case vbLowerA To vbLowerZ, vbUpperA To vbUpperZ
                    If Len(Path) > 3 Then MinSlashes = 1
                
                Case Else: Throw Cor.NewArgumentException(Environment.GetResourceString(Argument_InvalidPathFormat), "Path")
            End Select
            
        Else
            MinSlashes = 1
        End If
    End With
    
    Dim PathLength As Long
    If (MinSlashes > 0) And (cString.CharCount(Path, vbBackSlash) >= MinSlashes) Then
        PathLength = InStrRev(Path, vbBackSlashS)
        If PathLength = 3 Then
            If Mid$(Path, 2, 1) <> ":" Then
                PathLength = PathLength - 1
            End If
        Else
            PathLength = PathLength - 1
        End If
    End If
    
    GetDirectoryName = Left$(Path, PathLength)
End Function

''
' Returns the extension of a filename.
'
' @param Path The filename to retrieve the extension of.
' @return The extension of the filename
'
Public Function GetExtension(ByVal Path As String) As String
    Path = GetFileName(Path)
    
    Dim Index As Long
    Index = InStrRev(Path, vbPeriodS)
    If (Index > 0) And (Index < Len(Path)) Then GetExtension = Mid$(Path, Index)
End Function

''
' Returns the filename portion of the specified path.
'
' @param Path The path to retrieve the filename from.
' @return The filetime portion of the specified path.
' @remarks This function does not verify that the file exists.
'
Public Function GetFileName(ByVal Path As String) As String
    Call VerifyPath(Path)
    
    GetFileName = Mid$(Path, GetDirectoryCharIndex(Path) + 1)
End Function

''
' Returns the filename portion of a path without the filename extension.
'
' @param Path The path to parse the filename from.
' @return A filename without the extension present.
' @remarks This function does not verify the file exists.
'
Public Function GetFileNameWithoutExtension(ByVal Path As String) As String
    Path = GetFileName(Path)
    
    Dim Index As Long
    Index = InStrRev(Path, vbPeriodS)
    If Index > 0 Then Path = Left$(Path, Index - 1)
    
    GetFileNameWithoutExtension = Path
End Function

''
' Creates a full path to the specified filename.
'
' @param Path The filename to prepend any path to.
' @return A fully qualified path to a filename.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -