Path/Key Handling and Manipulation

Category:

String Manipulation

Type:

Modules

Difficulty:

Beginning

Author:

Roman Bobik

Version Compatibility: Visual Basic 6

More information:

These functions allow you do manipulate Directory/File Paths or Keys (maybe for TreeView) separated by a backslash "\". The functions are optimized for max. performance and are all written in pure VB.

Following functions are included:

getLen: Retrieves the Length (Count of Path-Parts) of the Path
getLeft: Retrieves a given count of Path-Parts from a Path of the left side
getRight: Retrieves a given count of Path-Parts from a Path of the right side
GetParent: Retrieves the Parent-Path of a given Path.
TrimPath: Trimms a path to a given count of characters. Path parts are shortened by replacing them with "...".
StrCount: Used by GetLen to retrieve the count of a given SubString in a string.
GetFileName: Retrieves the filename of a path (with extension or without)
MakeEndBackslash: Ensures that a given Path ends with a Backslash.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

Function getLen(ByVal Key As String) As Long
    Static lastKey As String, lastLen As Long
    If Key = lastKey Then
        getLen = lastLen
    Else
        getLen = StrCount(Key, "\") + 1
        lastLen = getLen
        lastKey = Key
    End If
End Function

Function getLeft(ByVal Key As String, ByVal length As Long) As String
    Dim zahl As Long, i As Long

zahl = 1
    For i = 1 To length
        zahl = InStr(zahl + 1, Key, "\")
        If zahl = 0 Then
            zahl = Len(Key) + 1
            Exit For
        End If
    Next i
    getLeft = Left$(Key, zahl - 1)
End Function

Function getRight(Key As String, length As Long) As String
    Dim zahl As Long, i As Long

zahl = Len(Key)
    For i = 1 To length
        zahl = InStrRev(Key, "\", zahl - 1)
        If zahl = 0 Then Exit For 'Wenn nicht gefunden, dann gleich ganzes nehmen, und damit das passiert muss zahl wieder 0 sein, was ja eh schon der fall ist
    Next i
    getRight = Right$(Key, Len(Key) - zahl)
End Function

Function GetParent(Key As String) As String
    GetParent = Left$(Key, InStrRev(Key, "\") - 1)
End Function

Function TrimPath(ByVal MaxChars As Long, ByVal PathTxt As String) As String
    Dim NewPath As String, Filename As String, NPLen As Long, alreadytrimmed As Boolean
    NewPath = Trim$(PathTxt)
    If Len(NewPath) > MaxChars Then
        Filename = getRight(PathTxt, 1)
        NPLen = getLen(NewPath)
        alreadytrimmed = False
        While Len(NewPath) > MaxChars And (NPLen > 3 Or Not alreadytrimmed) And NPLen > 2
            If Not alreadytrimmed Then
                NewPath = getLeft(NewPath, NPLen - 2) & "\...\" & Filename
                alreadytrimmed = True
            Else
                NewPath = getLeft(NewPath, NPLen - 3) & "\...\" & Filename
            End If
            NPLen = getLen(NewPath)
        Wend
        If Len(NewPath) > MaxChars Then
            If Len("...\" & Filename) > MaxChars Then
                NewPath = Filename
            Else
                NewPath = "...\" & Filename
            End If
        End If
    End If
    TrimPath = NewPath
End Function

Public Function StrCount(stSource As String, ByVal subST1 As String) As Long
    Dim pos As Long
    Dim iCount As Long

pos = 1
    Do
        pos = pos + Len(subST1)
        pos = InStr(pos, stSource, subST1)
        If pos > 0 Then
            iCount = iCount + 1
        End If
    Loop While pos > 0

StrCount = iCount

End Function

Function GetFileName(Path As String, Extension As Boolean) As String
    Dim zahl As Long
    GetFileName = getRight(Path, 1)
    If Not Extension Then
        zahl = InStrRev(GetFileName, ".")
        If zahl <> 0 Then
            GetFileName = Left(GetFileName, zahl - 1)
        End If
    End If
End Function

Function MakeEndBackslash(Path As String) As String
    MakeEndBackslash = Path
    If Right(MakeEndBackslash, 1) <> "\" Then MakeEndBackslash = MakeEndBackslash & "\"
End Function