laatzen/Pruef2000/source/modSIRT.bas
2021-10-01 11:11:04 +02:00

75 lines
2.3 KiB
QBasic
Raw Blame History

Attribute VB_Name = "modSIRT"
Option Explicit
Public Function NumberFromByteArray(mybyteArray, fromNumber As Integer, toNumber As Integer) As Currency
Dim Number As Currency
Dim i As Integer
Number = 0
For i = fromNumber To toNumber
Number = Number * 256
Number = Number + mybyteArray(i)
Next
NumberFromByteArray = Number
End Function
Public Function StringHexDecodedFromByteArray(mybyteArray, fromNumber As Integer, toNumber As Integer) As String
Dim i As Integer
For i = fromNumber To toNumber
If mybyteArray(i) <> 0 Then
StringHexDecodedFromByteArray = StringHexDecodedFromByteArray & Chr(mybyteArray(i))
Else
Exit Function
End If
Next
End Function
Public Function HexStringFromByteArray(mybyteArray, fromNumber As Integer, toNumber As Integer) As String
Dim i As Integer
For i = fromNumber To toNumber
HexStringFromByteArray = HexStringFromByteArray & CStr(mybyteArray(i))
Next
End Function
Public Function Currency2Hex(currencyValue As Currency, Optional FormatStellen As Integer = 8) As String
' 000000 000000 - FFFFFF FFFFFF
Dim Temp1 As Currency
Dim Temp2 As Currency
Temp1 = Fix(currencyValue / 16777216#) ' vordersten Bytes
Temp2 = currencyValue - (Temp1 * 16777216#) ' hintersten 3 Bytes
Currency2Hex = Right("0000000" & Hex(Temp1), 6) & Right("00000" & Hex(Temp2), 6)
Currency2Hex = Right(Currency2Hex, FormatStellen)
End Function
Public Function Var2Hex(varValue As Variant, Optional FormatStellen As Integer = 8) As String
' 000000 000000 - FFFFFF FFFFFF
Dim Temp1 As Currency
Dim Temp2 As Currency
Temp1 = Fix(varValue / 16777216#) ' vordersten Bytes
Temp2 = varValue - (Temp1 * 16777216#) ' hintersten 3 Bytes
Var2Hex = Right("0000000" & Hex(Temp1), 6) & Right("00000" & Hex(Temp2), 6)
Var2Hex = Right(Var2Hex, FormatStellen)
End Function
Public Function Hex2(byteWert As Byte) As String
Hex2 = Right("0" & Hex(byteWert), 2)
End Function
Public Function HexToLong(HexValue As String) As Long
' g<>ltig von 0x00000000 - 0x7FFFFFFF bzw. 0 - 2147483647
' negativ von 0x80000000-0xFFFFFFFF
If UCase$(Left$(HexValue, 2)) = "0X" Then
HexToLong = Val("&H" & Mid$(HexValue, 3))
ElseIf UCase$(Left$(HexValue, 2)) <> "&H" Then
HexToLong = Val("&H" & HexValue)
Else
HexToLong = Val(HexValue)
End If
End Function