Attribute VB_Name = "ModStrFunc"
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

'Append one string to another (concatenation).
'Replacement for: String = String & "something".
'Usage:
'======
'Dim s As String
's = "This is"
'strAppend s, " a test!"
'MsgBox s
Public Sub StrAppend(ByRef Expression As String, ByRef AppendWhat As String)
    Dim bytExp() As Byte, bytAppend() As Byte
    Dim u As Long, lonLen As Long
    
    If Len(AppendWhat) = 0 Then Exit Sub
    
    bytExp = StrConv(Expression, vbFromUnicode)
    bytAppend = StrConv(AppendWhat, vbFromUnicode)
    
    u = UBound(bytExp)
    lonLen = UBound(bytAppend)
    ReDim Preserve bytExp(0 To u + lonLen + 1) As Byte
    CopyMemory bytExp(u + 1), bytAppend(0), lonLen + 1
    Expression = StrConv(bytExp, vbUnicode)
    
    Erase bytExp, bytAppend
End Sub

'Replacement for StrComp() function.
'Returns TRUE if both strings are equal.
'Not sure if there are any speed gains here...
Public Function StrStrComp(ByRef String1 As String, ByRef String2 As String, _
    Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As Boolean
    
    Dim byt1() As Byte, byt2() As Byte
    byt1 = StrConv(String1, vbFromUnicode)
    byt2 = StrConv(String2, vbFromUnicode)
    
    StrStrComp = CompareBytes(byt1, byt2, CompareMethod)
    Erase byt1, byt2
End Function

'Gets the entire contents of a file as a string.
Public Function StrGetEntireFile(ByRef Path As String) As String
    Dim intFF As Integer, bytData() As Byte
    intFF = FreeFile
    
    Open Path For Binary Access Read As #intFF
        ReDim bytData(0 To LOF(intFF) - 1) As Byte
        Get #intFF, , bytData
    Close #intFF
    
    StrGetEntireFile = StrConv(bytData, vbUnicode)
    Erase bytData
End Function

'Gets part of a file.
'Offset - Position in file to start reading from.
'Length - Size of data (in bytes) to read.
Public Function StrGetPartOfFile(ByRef Path As String, ByVal Offset As Long, _
    ByVal Length As Long) As String
    
    If Length < 1 Then Exit Function
    
    Dim intFF As Integer, bytData() As Byte
    Dim lonLen As Long
    intFF = FreeFile
    
    Open Path For Binary Access Read As #intFF
        If Offset <= LOF(intFF) Then
            If LOF(intFF) - Offset >= Length Then
                ReDim bytData(0 To Length) As Byte
                Get #intFF, Offset, bytData
            Else
                lonLen = LOF(intFF) - Offset
                ReDim bytData(0 To lonLen) As Byte
                Get #intFF, Offset, bytData
            End If
        End If
    Close #intFF
    
    StrGetPartOfFile = StrConv(bytData, vbUnicode)
    Erase bytData
End Function

'Replacement for InStr() function.
Public Function StrInStr(ByVal Start As Long, ByRef Expression As String, _
    ByRef Find As String, Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As Long
    
    Dim bytExp() As Byte, bytFind() As Byte
    Dim l As Long, u As Long, lonLenFind As Long
    Dim bytTest() As Byte, lonRet As Long
    
    bytExp = StrConv(Expression, vbFromUnicode)
    bytFind = StrConv(Find, vbFromUnicode)
    lonLenFind = UBound(bytFind) + 1
    
    u = UBound(bytExp)
    
    For l = (Start - 1) To u
        If bytExp(l) = bytFind(0) Then
            ReDim bytTest(0 To lonLenFind - 1) As Byte
            CopyMemory bytTest(0), bytExp(l), lonLenFind
            
            If CompareBytes(bytTest, bytFind, CompareMethod) Then
                lonRet = l
                Exit For
            End If
        End If
    Next l
    
    StrInStr = lonRet
    Erase bytExp, bytFind, bytTest
End Function

'Simply compares 2 bytes and returns TRUE of they are equal.
Private Function CompareBytes(ByRef ByteArray1() As Byte, ByRef ByteArray2() As Byte, _
    Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) As Boolean
    
    Dim l As Long, u As Long
    Dim bolRet As Boolean
    
    bolRet = True
    u = UBound(ByteArray1)
    If UBound(ByteArray2) <> u Then Exit Function
    
    '2 Separate loops instead of checking inside the loop on each iteration.
    If CompareMethod = vbBinaryCompare Then
        For l = 0 To u
            If ByteArray1(l) <> ByteArray2(l) Then
                bolRet = False
                Exit For
            End If
        Next l
    Else
        For l = 0 To u
            If BytLCaseSingle(ByteArray1(l)) <> BytLCaseSingle(ByteArray2(l)) Then
                bolRet = False
                Exit For
            End If
        Next l
    End If
    
    CompareBytes = bolRet
End Function

'Convert a byte value to its lowercase equivalent.
Private Function BytLCaseSingle(ByVal Data As Byte) As Byte
    Select Case Data
        Case 65 To 90 'A-Z
            BytLCaseSingle = Data + 32
        Case Else
            BytLCaseSingle = Data
    End Select
End Function

'Replacement for Mid() function.
Public Function StrMid(ByRef Expression As String, ByVal Start As Long, Optional ByVal Length As Long = 0) As String
    Dim lonLen As Long, bytExp() As Byte
    Dim bytRet() As Byte, lonALen As Long
    
    lonLen = Len(Expression)
    
    If lonLen = 0 Or Start > lonLen Then
        StrMid = vbNullString
    Else
        lonALen = Length
        If lonALen = 0 Then lonALen = (lonLen - Start)
        ReDim bytRet(1 To lonALen) As Byte
        bytExp = StrConv(Expression, vbFromUnicode)
        CopyMemory bytRet(1), bytExp(Start - 1), lonALen
        StrMid = StrConv(bytRet, vbUnicode)
    End If
    
    Erase bytExp, bytRet
End Function

'Replacement for Left() function.
Public Function StrLeft(ByRef Expression As String, ByVal Length As Long) As String
    Dim lonLen As Long, bytExp() As Byte
    Dim bytRet() As Byte
    
    lonLen = Len(Expression)
    
    If Length = 0 Or lonLen = 0 Then
        StrLeft = vbNullString
    Else
        If lonLen <= Length Then
            StrLeft = Expression
        Else
            bytExp = StrConv(Expression, vbFromUnicode)
            ReDim bytRet(1 To Length) As Byte
            CopyMemory bytRet(1), bytExp(0), Length
            StrLeft = StrConv(bytRet, vbUnicode)
        End If
    End If
    
    Erase bytExp, bytRet
End Function

'Replacement for Right() function.
Public Function StrRight(ByRef Expression As String, ByVal Length As Long) As String
    Dim lonLen As Long, bytExp() As Byte
    Dim bytRet() As Byte
    
    lonLen = Len(Expression)
    
    If Length = 0 Or lonLen = 0 Then
        StrRight = vbNullString
    Else
        If Length >= lonLen Then
            StrRight = Expression
        Else
            bytExp = StrConv(Expression, vbFromUnicode)
            ReDim bytRet(1 To Length) As Byte
            CopyMemory bytRet(1), bytExp((UBound(bytExp) - Length) + 1), Length
            StrRight = StrConv(bytRet, vbUnicode)
        End If
    End If
    
    Erase bytExp, bytRet
End Function