' By Chris Lucas, cdl1051@earthlink.net, 20011204
' Thanks to Olaf for the class implementation concept

Option Explicit

Private Declare Function ArrPtr& Lib "msvbvm60.dll" Alias "VarPtr" (ptr() As Any)
Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes&)

Private SafeArrayHeader(5) As Long
Private SafeArray() As Long

Private Sub Class_Initialize()
    SafeArrayHeader(0) = 1                ' Number of dimensions
    SafeArrayHeader(1) = 4                ' Bytes per element (long = 4)
    SafeArrayHeader(4) = &H7FFFFFFF       ' Array size

    ' Force SafeArray to use SafeArrayHeader as its own header
    RtlMoveMemory ByVal ArrPtr(SafeArray), VarPtr(SafeArrayHeader(0)), 4
End Sub

Friend Function GetExtension06(sText As String) As String
    Dim i&, SLen&, tmp1&, tmp2&

    SafeArrayHeader(3) = StrPtr(sText)
    SLen = LenB(sText) \ 2

    If (SLen And 1) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H2E& Then Exit Function
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        tmp2 = (tmp1 And &HFFFF0000)
        If tmp2 = &H2E0000 Then GoTo HiWord
        If tmp2 = &H5C0000 Then Exit Function
        tmp2 = (tmp1 And &HFFFF&)
        If tmp2 = &H2E& Then GoTo LoWord
        If tmp2 = &H5C& Then Exit Function
    Next i

    Exit Function

HiWord:
    GetExtension06 = RightB$(sText, SLen + SLen - i - i - i - i - 4)
    Exit Function
LoWord:
    GetExtension06 = RightB$(sText, SLen + SLen - i - i - i - i - 2)

End Function

Friend Function GetFile05(sText As String) As String
    Dim i&, SLen&, tmp1&

    SafeArrayHeader(3) = StrPtr(sText):
    SLen = LenB(sText) \ 2

    If (SLen And 1&) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H5C& Then Exit Function
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        If (tmp1 And &HFFFF0000) = &H5C0000 Then GoTo HiWord
        If (tmp1 And &HFFFF&) = &H5C& Then GoTo LoWord
    Next i

HiWord:
    GetFile05 = RightB$(sText, SLen + SLen - i - i - i - i - 4)
    Exit Function
LoWord:
    GetFile05 = RightB$(sText, SLen + SLen - i - i - i - i - 2)

End Function

Friend Function GetPath05(sText As String) As String
    Dim i&, SLen&, tmp1&

    SafeArrayHeader(3) = StrPtr(sText):
    SLen = LenB(sText) \ 2

    If (SLen And 1) Then
        If (SafeArray(SLen \ 2) And &HFFFF&) = &H5C& Then
            GetPath05 = sText
            Exit Function
        End If
    End If

    For i = SLen \ 2 - 1 To 0 Step -1
        tmp1 = SafeArray(i)
        If (tmp1 And &HFFFF0000) = &H5C0000 Then GoTo HiWord
        If (tmp1 And &HFFFF&) = &H5C& Then GoTo LoWord
    Next i

    GetPath05 = sText
    Exit Function
HiWord:
    GetPath05 = LeftB$(sText, i + i + i + i + 4)
    Exit Function
LoWord:
    GetPath05 = LeftB$(sText, i + i + i + i + 2)

End Function

Private Sub Class_Terminate()
    ' Make SafeArray once again use its own header
    ' If this code doesn't run the IDE will crash
    RtlMoveMemory ByVal ArrPtr(SafeArray), 0&, 4
End Sub