Attribute VB_Name = "modHex"
Option Explicit

Function fHexByte(ByVal bytVar As Byte) As String
On Error GoTo Err_

Dim strVar As String

If bytVar > 15 Then
    strVar = Hex(bytVar)
Else
    strVar = "0" & Hex(bytVar)
End If

Exit_:
fHexByte = strVar
Exit Function

Err_:
strVar = ""
Resume Exit_
'Resume Next

End Function

Function fHexBytes(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long) As String
On Error GoTo Err_

Dim strHex As String
Dim lngOffsetStep As Long

strHex = ""

For lngOffsetStep = lngOffset To (lngOffset + lngOffsetPlus) Step 1
    strHex = strHex & fHexByte(bytArray(lngOffsetStep))
Next lngOffsetStep

Exit_:
fHexBytes = strHex
Exit Function

Err_:
strHex = ""
Resume Exit_
'Resume Next

End Function

Sub sHexStringToBytes(ByRef bytArray() As Byte, ByVal strHexBytes As String)
'Used for clipboard routine only!
On Error GoTo Err_

Dim intFor As Integer
Dim intUbound As Integer

intUbound = (Len(strHexBytes) \ 2) - 1
If intUbound < 0 Then 'Get around one character strings used when converting player positions from clipboard
    intUbound = 0
End If

ReDim bytArray(0 To intUbound)

For intFor = 0 To intUbound
    bytArray(intFor) = fHexToDecimal(Mid(strHexBytes, (intFor * 2) + 1, 2))
Next intFor

Exit_:
Exit Sub

Err_:
MsgBox vbNewLine & Err.Description & vbTab, vbCritical, Err.Number
ReDim bytArray(0)
Resume Exit_

End Sub

Sub sHexBytesAdjust(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long, ByVal AdjustValue As Long, Optional ByVal blnAudit As Boolean = False)
On Error GoTo Err_

Dim strHex As String
Dim lngOffsetStep As Long
Dim lngStep As Long

Dim strOriginalHexValue As String
Dim lngOriginalHexValue As Long
Dim lngAdjustedHexValue As Long
Dim strAdjustedHexValue As String
Dim lngMaxValue As Long
Dim lngByteHexLen As Long

strOriginalHexValue = ""

strOriginalHexValue = fHexBytes(bytArray(), lngOffset, lngOffsetPlus)

lngOriginalHexValue = fHexToDecimal(strOriginalHexValue)
lngAdjustedHexValue = lngOriginalHexValue + AdjustValue
strAdjustedHexValue = Hex(lngAdjustedHexValue)
lngByteHexLen = (lngOffsetPlus + 1) * 2
strAdjustedHexValue = String(lngByteHexLen - Len(strAdjustedHexValue), "0") & strAdjustedHexValue

If blnAudit Then
    lngMaxValue = fHexToDecimal(String(lngByteHexLen, "F"))

    If (lngAdjustedHexValue < 0) Or (lngAdjustedHexValue > lngMaxValue) Then  'len check to fix out of bounds issue of lng!
        MsgBox "Error writing byte adjust!... email the dev fucker"
        GoTo Exit_
    End If
End If

For lngStep = 0 To lngOffsetPlus
    bytArray(lngOffset + lngStep) = fHexToDecimal(Mid(strAdjustedHexValue, lngStep * 2 + 1, 2))
Next


Exit_:
Exit Sub

Err_:
'Resume Exit_
Resume Next

End Sub

Sub sHexBytesShift(ByRef bytArray() As Byte, ByVal lngOffsetShiftStart As Long, ByVal lngOffsetShiftEnd As Long, ByVal lngByteShift As Long)
On Error Resume Next

Dim lngFor As Long
Dim intStep As Integer

If lngByteShift < 0 Then
    For lngFor = lngOffsetShiftStart To lngOffsetShiftEnd Step 1
        bytArray(lngFor + lngByteShift) = bytArray(lngFor)
    Next lngFor
ElseIf lngByteShift > 0 Then
    For lngFor = lngOffsetShiftEnd To lngOffsetShiftStart Step -1
        bytArray(lngFor + lngByteShift) = bytArray(lngFor)
    Next lngFor
End If


End Sub

Sub myxtest()

Dim bty() As Byte

ReDim bty(0 To 6)

bty(0) = 0
bty(1) = 1
bty(2) = 2
bty(3) = 3
bty(4) = 4
bty(5) = 5
bty(6) = 6

Call sHexBytesShift(bty(), 5, 6, -2)

MsgBox bty(0)
MsgBox bty(1)
MsgBox bty(2)
MsgBox bty(3)
MsgBox bty(4)
MsgBox bty(5)
MsgBox bty(6)

'MsgBox fHexBytes(bty(), 0, 1)
'Call sHexBytesAdjust(bty(), 0, 1, 2)
'MsgBox fHexBytes(bty(), 0, 1)

End Sub

Function fHexBytesChr(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long) As String
On Error GoTo Err_

Dim strHexAsc As String
Dim lngOffsetStep As Long

strHexAsc = ""

For lngOffsetStep = lngOffset To (lngOffset + lngOffsetPlus) Step 1
    If bytArray(lngOffsetStep) = 0 Then
        strHexAsc = strHexAsc & " "
    Else
        strHexAsc = strHexAsc & Chr(bytArray(lngOffsetStep))
    End If
Next lngOffsetStep

Exit_:
fHexBytesChr = strHexAsc
Exit Function

Err_:
strHexAsc = ""
Resume Exit_
'Resume Next

End Function

Function fHexBytesAsc(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long) As String
On Error GoTo Err_

Dim strHexAsc As String
Dim lngOffsetStep As Long

strHexAsc = vbNullString

For lngOffsetStep = lngOffset To (lngOffset + lngOffsetPlus) Step 1
'For lngOffsetStep = 1 To Len(myString) Step 1
        strHexAsc = strHexAsc & fHexByte(bytArray(lngOffsetStep))
        'strHexAsc = strHexAsc & fHexByte(Asc(Mid(myString, lngOffsetStep, 1)))
Next lngOffsetStep

Exit_:
fHexBytesAsc = strHexAsc
Exit Function

Err_:
strHexAsc = vbNullString
Resume Exit_
'Resume Next

End Function

Function fHexToDecimal(ByVal strHex As String) As Long
On Error GoTo Err_

fHexToDecimal = CLng("&H" & strHex)
'CDBL for larger range?

Exit_:
Exit Function

Err_:
fHexToDecimal = -1
Resume Exit_

'On Error GoTo Err_

'Dim intStrHexLen As Integer
'Dim lngDecimal As Long
'Dim intFor As Long
'Dim strChar As String * 1

'intStrHexLen = Len(strHex)
'strHex = UCase(strHex)
'lngDecimal = 0

'For intFor = intStrHexLen To 1 Step -1
   
'    strChar = Left(strHex, 1)
'    strHex = Right(strHex, Len(strHex) - 1)

'    If strChar >= "1" And strChar <= "9" Then
'        lngDecimal = (16 ^ (intFor - 1)) * CInt(strChar) + lngDecimal 'or -48 as below for AscNumToDec
'    ElseIf strChar >= "A" And strChar <= "F" Then
'        lngDecimal = (16 ^ (intFor - 1)) * (Asc(strChar) - 55) + lngDecimal '55 for AscHexChrToDec
'    ElseIf Not strChar = "0" Then
'        GoTo Err_
'    End If
    
'Next intFor

'Exit_:
'fHexToDecimal = lngDecimal
'Exit Function

'Err_:
'lngDecimal = -1 'Error!
'Resume Exit_

End Function

Sub sHexBytesWriteByte(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long, Optional ByVal bytValue As Byte = &HFF)
On Error Resume Next

Dim lngFor As Long

For lngFor = lngOffset To (lngOffset + lngOffsetPlus)
    bytArray(lngFor) = bytValue
Next lngFor

End Sub

Sub sHexBytesWriteText(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal strText As String)
On Error Resume Next

Dim lngFor As Long

If Len(strText) > 0 Then
    For lngFor = lngOffset To (lngOffset + Len(strText) - 1)
        bytArray(lngFor) = Asc(Mid(strText, lngFor - lngOffset + 1, 1))
    Next lngFor
End If
End Sub

Sub sHexBytesWriteTextAsc(ByRef bytArray() As Byte, ByVal lngOffset As Long, ByVal lngOffsetPlus As Long, ByVal strText As String, ByVal btyAscChar As Byte)
On Error Resume Next

Dim lngFor As Long
Dim intStrLen As Integer

intStrLen = Len(strText)

If intStrLen > 0 Then
    For lngFor = 0 To lngOffsetPlus
        If lngFor > intStrLen - 1 Then '-1 to account for 0 start!
            bytArray(lngOffset + lngFor) = btyAscChar
        Else
            bytArray(lngOffset + lngFor) = Asc(Mid(strText, lngFor + 1, 1))
        End If
        
    Next lngFor
End If
End Sub

Sub compareteamdata()
    
Dim intFor As Integer
Dim lngTag As Long

    For intFor = 0 To (intTeamCount - 1)
        lngTag = fHexToDecimal(fHexBytes(btyaryOpenFile(), (intFor * 4) + lngTeamsStartOffset, 3))
        lngTag = lngTag + fHexToDecimal(fHexBytes(btyaryOpenFile(), lngTag + 8, 1))
        'Debug.Print fHexBytes(btyaryOpenFile(), lngTag, 3)
    Next intFor
    
End Sub



