📄 path.cls
字号:
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 + -