VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsFunctions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Const OFFSET_4 = 4294967296#
Private Const MAXINT_4 = 2147483647

Public Function StrToHex(ByVal strData As String) As String
Dim strReturn As String
Dim I As Integer
For I = 1 To Len(strData)
    strReturn = strReturn & Right("00" & Hex(Asc(Mid$(strData, I, 1))), 2)
Next I
StrToHex = strReturn
End Function
Public Function HexToStr(ByVal Hex As String) As String
Dim strReturn As String
Dim I As Integer
If Len(Hex) Mod 2 <> 0 Then Exit Function
For I = 1 To Len(Hex) Step 2
    strReturn = strReturn & Chr(Val("&H" & Mid$(Hex, I, 2)))
Next I
HexToStr = strReturn
End Function
Public Function MakeDWORD(Value As Long) As String
Dim strReturn As String * 4
RtlMoveMemory ByVal strReturn, Value, 4
MakeDWORD = strReturn
End Function
Public Function MakeWORD(Value As Integer) As String
Dim strReturn As String * 2
RtlMoveMemory ByVal strReturn, Value, 2
MakeWORD = strReturn
End Function
Public Function GetDWORD(ByVal Data As String) As Long
Dim tmp As String
tmp = StrToHex(Data)
Dim a As String, b As String, C As String, D As String
a = Mid$(tmp, 1, 2)
b = Mid$(tmp, 3, 2)
C = Mid$(tmp, 5, 2)
D = Mid$(tmp, 7, 2)
tmp = D & C & b & a
GetDWORD = CLng(Val("&H" & tmp))
End Function
Public Function GetWORD(ByVal Data As String) As Long
Dim tmp As String
Dim a As String
Dim b As String
tmp = StrToHex(Data)
a = Mid$(tmp, 1, 2)
b = Mid$(tmp, 3, 2)
tmp = b & a
GetWORD = CLng(Val("&H" & tmp))
End Function
Public Function RoL(ByVal Number As Long, ByVal Shift As Long) As Long
Shift = Shift And &H1F
RoL = LShift(Number, Shift) Or RShift(Number, 32 - Shift)
End Function
Public Function TrimNull(strText As String) As String
Dim I As Long
I = InStr(1, strText, vbNullChar)
If I = 0 Then
    TrimNull = strText
Else
    TrimNull = Left$(strText, I - 1)
End If
End Function
Public Function LShift(ByVal pnValue As Long, ByVal pnShift As Long) As Long
If pnShift > 31 Then
    LShift = 0
ElseIf pnShift < 0 Then
    LShift = 0
ElseIf pnShift = 0 Then
    LShift = pnValue
Else
    pnValue = pnValue And (2 ^ (32 - pnShift) - 1)
    LShift = DToL(CDbl(pnValue) * CDbl(DToL(2 ^ pnShift)))
End If
End Function
Public Function RShift(ByVal pnValue As Long, ByVal pnShift As Long) As Long
If pnShift > 31 Then
    RShift = 0
ElseIf pnShift < 0 Then
    RShift = 0
ElseIf pnShift = 0 Then
    RShift = pnValue
Else
    If (pnValue And &H80000000) = &H80000000 Then
        RShift = (pnValue And &H7FFFFFFF)
        RShift = RShift \ (2 ^ pnShift)
        RShift = RShift Or (2 ^ (31 - pnShift))
    Else
        RShift = Int(CDbl(pnValue) / CDbl(2 ^ pnShift))
    End If
    If RShift = -1 Then Debug.Assert False
End If
End Function
Public Function GetHexValue(ByVal v As Long) As String
v = v And &HF
If v < 10 Then
    GetHexValue = Chr$(v + &H30)
Else
    GetHexValue = Chr$(v + &H37)
End If
End Function
Public Function GetNumValue(ByVal C As String) As Long
C = UCase(C)
If IsNumeric(C) Then
    GetNumValue = Asc(C) - &H30
Else
    GetNumValue = Asc(C) - &H37
End If
End Function
Public Function LongToUnsigned(Value As Long) As Double
If Value < 0 Then
    LongToUnsigned = Value + OFFSET_4
Else
    LongToUnsigned = Value
End If
End Function
Public Function UnsignedToLong(Value As Double) As Long
If Value < 0 Or Value >= OFFSET_4 Then Error 6 ' Overflow
If Value <= MAXINT_4 Then
    UnsignedToLong = Value
Else
    UnsignedToLong = Value - OFFSET_4
End If
End Function
Public Function Add(ByVal number1 As Long, ByVal number2 As Long) As Long
Add = DToL(CDbl(number1) + CDbl(number2))
End Function
Public Function DToL(ByVal num As Double) As Long
While num > &H7FFFFFFF
    num = num - 4294967296#
Wend
While num < &H80000000
    num = num + 4294967296#
Wend
DToL = CLng(num)
End Function
Public Function StringFromPointer(ByVal lPointer As Long) As String
Dim strTemp As String
Dim lRetVal As Long
strTemp = String$(Len(lPointer), 0)
lRetVal = lstrcpyA(ByVal strTemp, ByVal lPointer)
If lRetVal Then StringFromPointer = strTemp
End Function
Public Function HIWORD(dw As Long) As Integer
If dw And &H80000000 Then
    HIWORD = (dw \ 65535) - 1
Else
    HIWORD = dw \ 65535
End If
End Function
Public Function LOWORD(dw As Long) As Integer
If dw And &H8000& Then
    LOWORD = &H8000 Or (dw And &H7FFF&)
Else
    LOWORD = dw And &HFFFF&
End If
End Function
