Attribute VB_Name = "modWarden"
'Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
'Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
'Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'Private Declare Function uncompress Lib "zlib" (ByRef dest As Any, ByRef destLen As Long, ByRef src As Any, ByRef srcLen As Long) As Long
'Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal numbytes As Long)
'Private Declare Function LoadLibraryA Lib "kernel32" (ByVal strFilePath As String) As Long
'Private Declare Function htonl Lib "ws2_32" (ByVal hostlong As Long) As Long
'Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
'
'Private Const PXOR_ENC = "arclion"
'
'Private Hash                As BnetHash
'
'Private Type RANDOMDATA
'    POS                     As Long
'    Data                    As String * 20
'    Sorc1                   As String * 20
'    Sorc2                   As String * 20
'End Type
'Private m_Parse(5)          As Long
'Private m_CallBack(7)       As Long 'callback function list, for warden
'Private m_Func(2)           As Long 'wardens exports
'Private m_KeyOut(257)       As Byte
'Private m_KeyIn(257)        As Byte
'Private m_Seed              As Long
'Private m_Mod               As Long 'pointer to the module
'Private m_ModMem            As Long 'pointer to wardens memory block
'Private m_ModState          As Byte '0=idle,1=downloading,2=hackyhacky
'Private m_RC4               As Long
'Private m_PKT               As String
''//Warden download stuff
'Private m_ModName           As String * 16 'the modules name
'Private m_ModFolder         As String 'the warden folder
'Private m_ModKey(15)        As Byte 'key to crypt module with
'Private m_ModLen            As Long 'lengh of downloading module
'Private m_ModPos            As Long 'position in write data for downloading
'Private m_ModData()         As Byte 'module download buffer
'
'Dim Offset()                As Long
'Dim Length()                As Integer
'Dim Memblob()               As String
'    If (lngID < 6) Then
'        Call CopyMemory(ByVal lngData, ByVal Mid$(s, 5, lngLengh), lngLengh)
'        Call CallWindowProcA(m_Parse(lngID), lngData, lngID, lngLengh, 0)
'    End If
'Public Function WardenInit(CDKeyHash As String, HashPtr As BnetHash) As Byte
''If HashPtr.Product = "RATS" Or HashPtr.Product = "PXES" Then
'
'If Not (Hash Is Nothing) Then
'    WardenInit = 0
'    Exit Function
'End If
'
'    WardenInit = 1
'
'
'    Dim bOut(15)        As Byte
'    Dim bIn(15)         As Byte
'    Dim uRan            As RANDOMDATA
'    Dim lngSeed         As Long
'
'        Call Get_MemBlobs
'        Set Hash = HashPtr
'
'        Call CopyMemory(lngSeed, ByVal CDKeyHash, 4)
'        Call WardenCleanUp
'
'        m_Seed = lngSeed
'        Call Data_Init(uRan, lngSeed)
'        Call Data_Get_Bytes(uRan, bOut(), 16)
'        Call Data_Get_Bytes(uRan, bIn(), 16)
'        Call RC4Key(bOut(), m_KeyOut(), 16)
'        Call RC4Key(bIn(), m_KeyIn(), 16)
'        m_Parse(0) = Addr2Ptr(AddressOf HW0x00)
'        m_Parse(1) = Addr2Ptr(AddressOf HW0x01)
'        m_Parse(2) = Addr2Ptr(AddressOf HW0x02)
'        m_Parse(3) = Addr2Ptr(AddressOf HW0x03)
'        m_Parse(4) = Addr2Ptr(AddressOf HW0x04)
'        m_Parse(5) = Addr2Ptr(AddressOf HW0x05)
'
'        m_ModFolder = App.Path & "\Warden\"
''End If
'
''WardenInit = 2
'End Function
'
'Public Function IsWarden(HashPtr As BnetHash) As Boolean
'If ObjPtr(HashPtr) = ObjPtr(Hash) Then IsWarden = True
'End Function
'
'Public Sub WardenUnload(HashPtr As BnetHash)
'If IsWarden(HashPtr) Then
'    Call Hash.WardenEvents(&H4, "")
'    WardenCleanUp
'    Set Hash = Nothing
'End If
'End Sub
'
'Private Sub WardenCleanUp()
'    If m_Mod Then
'        Call UnloadModule
'        Call free(m_Mod)
'        Call ZeroMemory(m_Func(0), 12)
'        m_Mod = 0
'        m_ModMem = 0
'    End If
'    m_ModState = 0
'    '//Clear download variables
'    Call ZeroMemory(ByVal m_ModName, 16)
'    Call ZeroMemory(m_ModKey(0), 16)
'    m_ModLen = 0
'    m_ModPos = 0
'    Erase m_ModData()
'End Sub
'Private Function LoadModule(ByVal lngMod As Long, ByRef strPath As String) As Long
'    Dim bData()         As Byte
'    Dim i               As Long
'
'    'debug.print "LoadModule()"
'
'    If (lngMod = 0) Then
'        i = FreeFile
'        Open strPath For Binary Lock Read As #i
'            If (LOF(i) < 1) Then
'                Close #i
'                Exit Function
'            End If
'            ReDim bData(LOF(i))
'            Get #i, 1, bData()
'        Close #i
'        lngMod = VarPtr(bData(0))
'    End If
'    If m_Mod Then
'        Call UnloadModule
'        Call free(m_Mod)
'        Call ZeroMemory(m_Func(0), 12)
'    End If
'    m_ModMem = 0
'    m_Mod = PrepareModule(lngMod)
'    If (m_Mod = 0) Then Exit Function
'    Call InitModule
'    If (m_ModMem = 0) Then
'        Call free(m_Mod)
'        Exit Function
'    End If
'    Call CopyMemory(i, ByVal m_ModMem, 4)
'    Call CopyMemory(m_Func(0), ByVal i, 12)
'
'    Hash.WardenEvents &H2, StrToHex(m_ModName, vbNullString) & ".bin"
'
'    'AddChat 0, vbGreen, "Loaded Warden Module: "
'    'AddChat 0, vbWhite, StrToHex(m_ModName, vbNullString) & ".bin"
'    LoadModule = 1
'
'    Hash_Func.FreeMemory
'End Function
'Public Sub WardenOnData(ByRef s As String)
'    Dim lngData         As Long
'    Dim lngLengh        As Long
'    Dim lngID           As Long
'
'    lngLengh = (Len(s) - 4)
'    If (lngLengh < 1) Then Exit Sub
'    lngData = malloc(lngLengh)
'    Call RC4CryptStr(s, m_KeyIn(), 5)
'
'
'    lngID = Asc(Mid$(s, 5, 1))
'
'
'    If (lngID < 6) Then
'        Call CopyMemory(ByVal lngData, ByVal Mid$(s, 5, lngLengh), lngLengh)
'        Call CallWindowProcA(m_Parse(lngID), lngData, lngID, lngLengh, 0)
'    End If
'    Call free(lngData)
'End Sub
'Private Function HW0x00(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'    Dim s           As String
'
'    Call WardenCleanUp
'    If (wLen < 37) Then Exit Function
'    Call CopyMemory(ByVal m_ModName, ByVal hData + 1, 16)
'    Call CopyMemory(m_ModKey(0), ByVal hData + 17, 16)
'    Call CopyMemory(m_ModLen, ByVal hData + 33, 4)
'    s = m_ModFolder & StrToHex(m_ModName, vbNullString) & ".bin"
'    If (Len(Dir$(s)) = 0) Then
'        If (m_ModLen < 50) Or (m_ModLen > 5000000) Then
'            m_ModLen = 0
'            Exit Function
'        End If
'        s = vbNullChar
'        ReDim m_ModData(m_ModLen - 1)
'        m_ModState = 1
'
'        Hash.WardenEvents &H1, StrToHex(m_ModName, vbNullString) & ".bin"
'        'AddChat 0, cYellow, "Downloading Warden Module: "
'        'AddChat 0, vbRed, StrToHex(m_ModName, vbNullString) & ".bin"
'    Else
'        If (LoadModule(0, s) = 0) Then Exit Function
'        s = Chr$(&H1)
'        m_ModLen = 0
'        m_ModState = 2
'    End If
'    m_ModPos = 0
'    Call RC4CryptStr(s, m_KeyOut(), 1)
'
'    Hash.Send_5E s
'
'    HW0x00 = 1
'End Function
'Private Function HW0x01(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'
'    If (Not m_ModState = 1) Then Exit Function
'    If (m_ModLen = 0) Then Exit Function
'    If (wLen < 4) Then Exit Function
'    Call CopyMemory(m_ModData(m_ModPos), ByVal hData + 3, wLen - 3)
'    m_ModPos = m_ModPos + (wLen - 3)
'    'Debug.Print m_ModPos & " Of " & m_ModLen
'    If (m_ModPos >= m_ModLen) Then
'        m_ModState = 2
'        HW0x01 = HW0x01Ex()
'    Else
'        HW0x01 = 1
'    End If
'End Function
'Private Function HW0x01Ex() As Long
'
'    On Error GoTo HW0x01ExErr
'    Dim bData()         As Byte
'    Dim i               As Long
'    Dim s               As String
'    ReDim bData(257)
'    Call RC4Key(m_ModKey(), bData(), 16)
'    Call RC4Crypt(m_ModData(), bData(), m_ModLen)
'    Call CopyMemory(i, m_ModData(0), 4)
'    If (i < &H120) Or (i > 5000000) Then GoTo HW0x01ExErr
'    ReDim bData(i - 1)
'    If (Not uncompress(bData(0), i, m_ModData(4), CLng(m_ModLen - &H108)) = 0) Then GoTo HW0x01ExErr
'    m_ModLen = 0
'    m_ModPos = 0
'    Erase m_ModData()
'    s = m_ModFolder & StrToHex(m_ModName, vbNullString) & ".bin"
'    i = FreeFile
'    Open s For Binary Lock Write As #i
'        Put #i, 1, bData()
'    Close #i
'    If (LoadModule(VarPtr(bData(0)), s) = 0) Then GoTo HW0x01ExErr
'    m_ModState = 2
'    bData(0) = 1
'    Call RC4Crypt(bData(), m_KeyOut(), 1)
'
'    Hash.Send_5E (Chr$(bData(0)))
'
'    Erase bData()
'    HW0x01Ex = 1
'    Exit Function
'HW0x01ExErr:
'    Erase m_ModData()
'    m_ModLen = 0
'    m_ModPos = 0
'    m_ModState = 0
'    Debug.Print "HW0x01Ex() Error: " & Err.Description
'End Function
'Private Function HW0x02(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'
'    'On Error GoTo HW0x02Err
'    'eww, yep
'    Dim s               As String
'    Dim strData         As String
'    Dim P               As Long
'    Dim strOut          As String
'    Dim PosOut          As Long
'    Dim bHeader(6)      As Byte
'    If (Not m_ModState = 2) Then GoTo HW0x02Err
'    If (wLen < 2) Then GoTo HW0x02Err
'    s = Space(wLen)
'    Call CopyMemory(ByVal s, ByVal hData, wLen)
'    If (Not Asc(Mid$(s, 2, 1)) = 0) Then GoTo HW0x02Err
'    P = 3
'    PosOut = 8
'    strOut = Space(255) 'max size are are send buffer
'    Do Until (P >= wLen)
'        strData = Get0x02Data(s, P)
'
'        If (Len(strData) = 0) Then GoTo HW0x02Err
'        Mid$(strOut, PosOut, Len(strData)) = strData
'        PosOut = PosOut + Len(strData)
'    Loop
'    strOut = Left$(strOut, (PosOut - 1))
'    bHeader(0) = &H2
'    Call CopyMemory(bHeader(1), CInt(PosOut - 8), 2)
'    Call CopyMemory(bHeader(3), WardenChecksum(Mid$(strOut, 8)), 4)
'    Call CopyMemory(ByVal strOut, bHeader(0), 7)
'    Call RC4CryptStr(strOut, m_KeyOut(), 1)
'
'    Hash.Send_5E strOut
'
'    HW0x02 = 1
'    Exit Function
'HW0x02Err:
'    Debug.Print "HW0x02() Error: " & Err.Description
'End Function
'Private Function HW0x03(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'    '//Ignore this
'End Function
'Private Function HW0x04(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'    '//Ignore this
'End Function
'Private Function HW0x05(ByVal hData As Long, ByVal uMsg As Long, ByVal wLen As Long, ByVal lParam As Long) As Long
'    Dim ASM             As Assembly
'    Dim bKey(257)       As Byte
'    Dim bData()         As Byte
'    Dim lngRecv         As Long
'    If (Not m_ModState = 2) Then Exit Function
'    Set ASM = New Assembly
'    m_RC4 = 0
'    m_ModState = 0
'    With ASM
'        .push_v32 (4)
'        .push_v32 (VarPtr(m_Seed))
'        .mov__ecx_v32 (m_ModMem)
'        .xor__edx_edx
'        .mov__eax_v32 (m_Func(0))
'        .call_eax
'        .retn 8
'        .Execute
'    End With
'    Set ASM = Nothing
'    If (m_RC4 = 0) Then Exit Function
'    ReDim bData(wLen - 1)
'    Call CopyMemory(bData(0), ByVal hData, wLen)
'    Call CopyMemory(bKey(0), ByVal m_RC4 + 258, 258)
'    Call RC4Crypt(bData(), bKey(), wLen)
'    Call CopyMemory(bKey(0), ByVal m_RC4, 258)
'    m_PKT = vbNullString
'    Set ASM = New Assembly
'    With ASM
'        .push_v32 (VarPtr(lngRecv))
'        .push_v32 (wLen)
'        .push_v32 (VarPtr(bData(0)))
'        .mov__ecx_v32 (m_ModMem)
'        .xor__edx_edx
'        .mov__eax_v32 (m_Func(2))
'        .call_eax
'        .retn 8
'        .Execute
'    End With
'    Set ASM = Nothing
'    If (Len(m_PKT) = 0) Then Exit Function
'    Call RC4CryptStr(m_PKT, bKey(), 1)
'    Call RC4CryptStr(m_PKT, m_KeyOut(), 1)
'    Call CopyMemory(m_KeyOut(0), ByVal m_RC4, 258)
'    Call CopyMemory(m_KeyIn(0), ByVal m_RC4 + 258, 258)
'    m_ModState = 2
'
'    Hash.Send_5E m_PKT
'
'    m_RC4 = 0
'    m_PKT = vbNullString
'End Function
'
'
'Private Function PrepareModule(ByRef pModule As Long) As Long
'    '//carbon copy port from iagos code
'    'Debug.Print "PrepareModule()"
'    Dim dwModuleSize        As Long
'    Dim pNewModule          As Long
'    dwModuleSize = getInteger(pModule, &H0)
'    pNewModule = malloc(dwModuleSize)
'    Call ZeroMemory(ByVal pNewModule, dwModuleSize)
'    'debug.print "   Allocated " & dwModuleSize & " (0x" & Hex(dwModuleSize) & ") bytes for new module"
'    Call CopyMemory(ByVal pNewModule, ByVal pModule, 40)
'    Dim dwSrcLocation       As Long
'    Dim dwDestLocation      As Long
'    Dim dwLimit             As Long
'    dwSrcLocation = &H28 + (getInteger(pNewModule, &H24) * 12)
'    dwDestLocation = getInteger(pModule, &H28)
'    dwLimit = getInteger(pModule, &H0)
'    Dim bSkip               As Boolean
'    'debug.print "   Copying code sections to module."
'    While (dwDestLocation < dwLimit)
'        Dim dwCount         As Long
'        Call CopyMemory(ByVal VarPtr(dwCount), ByVal pModule + dwSrcLocation, 1)
'        Call CopyMemory(ByVal VarPtr(dwCount) + 1, ByVal pModule + dwSrcLocation + 1, 1)
'        dwSrcLocation = dwSrcLocation + 2
'        If (bSkip = False) Then
'            Call CopyMemory(ByVal pNewModule + dwDestLocation, ByVal pModule + dwSrcLocation, dwCount)
'            dwSrcLocation = dwSrcLocation + dwCount
'        End If
'        bSkip = Not bSkip
'        dwDestLocation = dwDestLocation + dwCount
'    Wend
'    'debug.print "   Adjusting references to global variables..."
'    dwSrcLocation = getInteger(pModule, 8)
'    dwDestLocation = 0
'    Dim i                       As Long
'    Dim lng0x0C                 As Long
'    Dim lngTest                 As Long
'    Call CopyMemory(lng0x0C, ByVal pNewModule + &HC, 4)
'    While (i < lng0x0C)
'        Call CopyMemory(lngTest, ByVal pNewModule + dwSrcLocation, 1)
'        lngTest = lngTest And &HFF&
'        Call CopyMemory(ByVal VarPtr(lngTest) + 0, ByVal pNewModule + dwSrcLocation + 1, 1)
'        Call CopyMemory(ByVal VarPtr(lngTest) + 1, ByVal pNewModule + dwSrcLocation, 1)
'        dwDestLocation = dwDestLocation + lngTest
'        dwSrcLocation = dwSrcLocation + 2
'        Call insertInteger(pNewModule, dwDestLocation, getInteger(pNewModule, dwDestLocation) + pNewModule)
'        i = i + 1
'    Wend
'    'debug.print "   Updating API library references.."
'    dwLimit = getInteger(pNewModule, &H20)
'    Dim dwProcStart             As Long
'    Dim szLib                   As String
'    Dim dwProcOffset            As Long
'    Dim hModule                 As Long
'    Dim dwProc                  As Long
'    Dim szFunc                  As String
'    For i = 0 To dwLimit - 1
'        dwProcStart = getInteger(pNewModule, &H1C) + (i * 8)
'        szLib = GetSTR(pNewModule + getInteger(pNewModule, dwProcStart))
'        dwProcOffset = getInteger(pNewModule, dwProcStart + 4)
'        'debug.print "   Lib: " & szLib
'        hModule = LoadLibraryA(szLib)
'        dwProc = getInteger(pNewModule, dwProcOffset)
'        While dwProc
'            If (dwProc > 0) Then
'                szFunc = GetSTR(pNewModule + dwProc)
'                'debug.print "       Function: " & szFunc
'                Call insertInteger(pNewModule, dwProcOffset, GetProcAddress(hModule, szFunc))
'            Else
'                dwProc = dwProc And &H7FFFFFFF
'                'debug.print "       Ordinary: 0x" & Hex(dwProc)
'            End If
'            dwProcOffset = dwProcOffset + 4
'            dwProc = getInteger(pNewModule, dwProcOffset)
'        Wend
'    Next i
'
'
'    Hash.WardenEvents &H0, Hex(pNewModule)
'
'    PrepareModule = pNewModule
'End Function
'Private Sub InitModule()
'    'debug.print "InitModule()"
'    Dim A               As Long
'    Dim B               As Long
'    Dim C               As Long
'    C = getInteger(m_Mod, &H18)
'    B = 1 - C
'    If (B > getInteger(m_Mod, &H14)) Then Exit Sub
'    A = getInteger(m_Mod, &H10)
'    A = getInteger(m_Mod, A + (B * 4)) + m_Mod
'    'debug.print "   Initialize Function is mapped at 0x" & Hex(A)
'    m_CallBack(0) = Addr2Ptr(AddressOf SendPacket)
'    m_CallBack(1) = Addr2Ptr(AddressOf CheckModule)
'    m_CallBack(2) = Addr2Ptr(AddressOf ModuleLoad)
'    m_CallBack(3) = Addr2Ptr(AddressOf AllocateMem)
'    m_CallBack(4) = Addr2Ptr(AddressOf FreeMemory)
'    m_CallBack(5) = Addr2Ptr(AddressOf SetRC4Data)
'    m_CallBack(6) = Addr2Ptr(AddressOf GetRC4Data)
'    m_CallBack(7) = VarPtr(m_CallBack(0))
'    Dim ASM         As New Assembly
'    With ASM
'        .mov__ecx_v32 (VarPtr(m_CallBack(7)))
'        .call_ptr (VarPtr(A))
'        .mov__ptr_eax (VarPtr(m_ModMem))
'        .retn 8
'        .Execute
'    End With
'    Set ASM = Nothing
'End Sub
'Private Sub UnloadModule()
'If (Hash Is Nothing) Then Exit Sub
'Dim ASM         As New Assembly
'
'With ASM
'    .mov__ecx_v32 (m_ModMem)
'    .call_ptr (VarPtr(m_Func(1)))
'    .retn 8
'    .Execute
'End With
'
'    Set Hash = Nothing
'    Set ASM = Nothing
'End Sub
'
'Private Sub SendPacket(ByVal ptrPacket As Long, ByVal dwSize As Long)
'    If (dwSize < 1) Then Exit Sub
'    If (dwSize > 5000) Then Exit Sub
'    m_PKT = Space(dwSize)
'    Call CopyMemory(ByVal m_PKT, ByVal ptrPacket, dwSize)
'    'Debug.Print "Warden.SendPacket() pkt=0x" & Hex(ptrPacket) & ", size=" & dwSize & vbCrLf & GetLog(m_PKT)
'End Sub
'Private Function CheckModule(ByVal ptrMod As Long, ByVal ptrKey As Long) As Long
'    'Debug.Print "Warden.CheckModule() " & ptrMod & "/" & ptrKey
'    'CheckModule = 0 '//Need to download
'    'CheckModule = 1 '//Don't need to download
'    CheckModule = 1
'End Function
'Private Function ModuleLoad(ByVal ptrRC4Key As Long, ByVal pModule As Long, ByVal dwModSize As Long) As Long
'    'Debug.Print "Warden.ModuleLoad() " & ptrMod & "/" & ptrKey
'    'ModuleLoad = 0 '//Need to download
'    'ModuleLoad = 1 '//Don't need to download
'    ModuleLoad = 1
'End Function
'Private Function AllocateMem(ByVal dwSize As Long) As Long
'    AllocateMem = malloc(dwSize)
'End Function
'Private Sub FreeMemory(ByVal dwMemory As Long)
'    Call free(dwMemory)
'    'Debug.Print "Warden.FreeMemory() 0x" & Hex(dwMemory)
'End Sub
'Private Function SetRC4Data(ByVal lpKeys As Long, ByVal dwSize As Long) As Long
'    'Debug.Print "Warden.SetRC4Data() 0x" & Hex(lpKeys) & "/0x" & Hex(dwSize)
'End Function
'Private Function GetRC4Data(ByVal lpBuffer As Long, ByRef dwSize As Long) As Long
'    GetRC4Data = m_RC4
'    m_RC4 = lpBuffer
'End Function
'
'Private Function getInteger(ByRef bArray As Long, ByVal dwLocation As Long) As Long
'    Call CopyMemory(getInteger, ByVal bArray + dwLocation, 4)
'End Function
'Private Sub insertInteger(ByRef bArray As Long, ByVal dwLocation As Long, ByVal dwValue As Long)
'    Call CopyMemory(ByVal bArray + dwLocation, dwValue, 4)
'End Sub
'Private Function GetSTR(ByRef bArray As Long) As String
'    Dim bTest           As Byte
'    Dim i               As Long
'    Do
'        Call CopyMemory(bTest, ByVal bArray + i, 1)
'        If (bTest = 0) Then
'            If (i = 0) Then Exit Function
'            GetSTR = String(i, 0)
'            Call CopyMemory(ByVal GetSTR, ByVal bArray, i)
'            Exit Function
'        End If
'        i = i + 1
'    Loop
'End Function
'Private Function Addr2Ptr(ByVal lngAddr As Long) As Long
'    Addr2Ptr = lngAddr
'End Function
'
'Private Sub Data_Init(ByRef R As RANDOMDATA, ByVal lngSeed As Long)
''debug.print "Data_init()"
'    Dim s           As String * 4
'    Call CopyMemory(ByVal s, lngSeed, 4)
'    R.Sorc1 = BSHA1(Left$(s, 2), True, True)
'    R.Sorc2 = BSHA1(Right$(s, 2), True, True)
'    R.Data = String$(20, 0)
'    R.Data = BSHA1(R.Sorc1 & R.Data & R.Sorc2, True, True)
'    R.POS = 1
'End Sub
'Private Sub Data_Get_Bytes(ByRef R As RANDOMDATA, ByRef bData() As Byte, ByVal lngBytes As Long)
'    Dim i           As Long
'    For i = 0 To (lngBytes - 1)
'        bData(i) = Asc(Mid$(R.Data, R.POS, 1))
'        R.POS = R.POS + 1
'        If (R.POS > 20) Then
'            R.POS = 1
'            R.Data = BSHA1(R.Sorc1 & R.Data & R.Sorc2, True, True)
'        End If
'    Next i
'End Sub
'Private Sub RC4Key(ByRef bData() As Byte, ByRef B() As Byte, ByVal lngLengh As Long)
'    Dim i           As Long
'    Dim A           As Long
'    Dim C           As Byte
'    Dim bR(255)     As Byte
'    B(256) = 0
'    B(257) = 0
'    For i = 0 To 255
'        bR(i) = bData(i Mod lngLengh)
'        B(i) = i
'    Next i
'    A = 0
'    For i = 0 To 255
'        A = (A + B(i) + bR(i)) Mod 256
'        C = B(i)
'        B(i) = B(A)
'        B(A) = C
'    Next i
'End Sub
'Private Sub RC4CryptStr(ByRef s As String, ByRef bK() As Byte, ByVal POS As Long)
'    Dim A           As Long
'    Dim B           As Long
'    Dim C           As Byte
'    Dim i           As Long
'    A = bK(256)
'    B = bK(257)
'    For i = POS To Len(s)
'        A = (A + 1) Mod 256
'        B = (B + bK(A)) Mod 256
'        C = bK(A)
'        bK(A) = bK(B)
'        bK(B) = C
'        Mid(s, i, 1) = Chr$(Asc(Mid$(s, i, 1)) Xor bK((CInt(bK(A)) + bK(B)) Mod 256))
'    Next i
'    bK(256) = A
'    bK(257) = B
'End Sub
'Private Sub RC4Crypt(ByRef bData() As Byte, ByRef bK() As Byte, ByVal lngLengh As Long)
'    Dim A           As Long
'    Dim B           As Long
'    Dim C           As Byte
'    Dim i           As Long
'    A = bK(256)
'    B = bK(257)
'    For i = 0 To (lngLengh - 1)
'        A = (A + 1) Mod 256
'        B = (B + bK(A)) Mod 256
'        C = bK(A)
'        bK(A) = bK(B)
'        bK(B) = C
'        bData(i) = bData(i) Xor bK((CInt(bK(A)) + bK(B)) Mod 256)
'    Next i
'    bK(256) = A
'    bK(257) = B
'End Sub
'Private Function WardenChecksum(ByRef s As String) As Long
'    Dim lngData(4)  As Long
'    Call CopyMemory(lngData(0), ByVal BSHA1(s, True, True), 20)
'    WardenChecksum = lngData(0) Xor lngData(1) Xor lngData(2) Xor lngData(3) Xor lngData(4)
'End Function
'Private Function Get0x02Data(ByRef s As String, ByRef P As Long) As String
'    Dim R           As String
'    Dim bTest       As Boolean
'    Dim A           As Long
'    Dim L           As Byte
'    If ((P + 6) >= Len(s)) Then Exit Function
'    bTest = (Asc(Mid(s, P + 1, 1)) = 0)
'    bTest = bTest And (Asc(Mid(s, P + 6, 1)) < &H40)
'    If bTest Then
'        Call CopyMemory(A, ByVal Mid$(s, P + 2, 4), 4)
'        L = Asc(Mid$(s, P + 6, 1))
'
'        Debug.Print Hex(A)
'
'        For X = 0 To UBound(Offset)
'            If (A = Offset(X)) And (L = Length(X)) Then
'                R = HexToStr(Memblob(X))
'                GoTo Finish
'            End If
'        Next X
'Finish:
'        If Len(R) Then
'            P = P + 7
'            Get0x02Data = vbNullChar & R
'            Exit Function
'        End If
'    End If
'
'    If ((P + 29) >= Len(s)) Then Exit Function
'    bTest = (Asc(Mid$(s, P + 29, 1)) < &H80)
'    bTest = bTest And (Asc(Mid$(s, P + 28, 1)) = 0)
'    bTest = bTest And (Asc(Mid$(s, P + 27, 1)) < &H40)
'    If (bTest = False) Then Exit Function
'    Call CopyMemory(A, ByVal Mid$(s, P + 26, 4), 4)
'    Select Case A
'        Case &H10000050
'        Case &H10000070
'        Case &H100000A1
'        Case &H1700007C
'        Case &H170001E9
'        Case &H19000059
'        Case &H1A0000C3
'        Case &H1F000219
'        Case &H1F000234
'        Case &H20000022
'        Case &H20000049
'        Case &H23000048
'        Case &H24000032
'        Case &H250001EE
'        Case &H250001FE
'        Case &H28000091
'        Case &H2A0000E1
'        Case &H2A0000F1
'        Case &H3000069C
'        Case &H300006D4
'        Case &H300006D7
'        Case &H300007A8
'        Case &H32000121
'        Case &H33000030
'        Case &H3700008E
'        Case &H40000081
'        Case &HD0000E8
'        Case &HD000160
'        Case &HE0001FD
'        Case &HE000622
'        Case Else: Exit Function
'    End Select
'    P = P + 30
'    Get0x02Data = vbNullChar
'End Function
'
'Public Function malloc(ByVal dwSize As Long) As Long
'    Dim lngHandle   As Long
'    lngHandle = GlobalAlloc(0, dwSize + 4)
'    malloc = GlobalLock(lngHandle) + 4
'    Call CopyMemory(ByVal malloc - 4, lngHandle, 4)
'End Function
'
'Public Sub free(ByVal dwPtr As Long)
'    Dim lngHandle   As Long
'    Call CopyMemory(lngHandle, ByVal dwPtr - 4, 4)
'    Call GlobalUnlock(lngHandle)
'    Call GlobalFree(lngHandle)
'End Sub
'
'Private Function StrToHex(ByVal strData As String, Optional Splitter As String = " ") As String
'    Dim aLen As Long: aLen = Len(strData)
'    Dim eLen As Long: eLen = 2 + Len(Splitter)
'    Dim iPos As Long
'    StrToHex = Space((aLen * eLen))
'    For i = 1 To (aLen * eLen) Step eLen
'        iPos = iPos + 1
'        Mid(StrToHex, i, eLen) = Right("0" & Hex(Asc(Mid(strData, iPos, 1))), 2) & Splitter
'    Next i
'    StrToHex = Trim(StrToHex)
'End Function
'
'Private Function HexToStr(ByVal strData As String) As String
'    HexToStr = String(Len(strData) / 3, 0)
'    Dim iPos As Long
'    For i = 1 To Len(strData) Step 3
'        iPos = iPos + 1
'        Mid$(HexToStr, iPos, 1) = Chr("&H" & Mid$(strData, i, 2))
'    Next i
'End Function
'
'
'
'Private Function BSHA1(ByVal s As String, _
'                      Optional ByVal bRE As Boolean = False, _
'                      Optional ByVal bStandard As Boolean = False) As String
'
'    Dim B(21)       As Long 'hash buffer
'    Dim i           As Long
'
'    '//Init the seeds
'    B(0) = &H67452301
'    B(1) = &HEFCDAB89
'    B(2) = &H98BADCFE
'    B(3) = &H10325476
'    B(4) = &HC3D2E1F0
'
'    '//Update the string buffer (to be hashed)
'    Call SHA1Update(bRE, bStandard, B(), s)
'
'    '//Reverse endian if needed
'    If bRE Then
'        For i = 0 To 4
'            B(i) = htonl(B(i))
'        Next i
'    End If
'
'    '//Return the broken SHA1 hash
'    BSHA1 = String(20, 0)
'    Call CopyMemory(ByVal BSHA1, B(0), 20)
'End Function
'Private Sub SHA1Update(ByVal bRE As Boolean, _
'                       ByVal bS As Boolean, _
'                       ByRef B() As Long, _
'                       ByVal s As String)
'    Dim i       As Long
'    Dim A       As String
'    If bS Then
'        '//Standard SHA1 padding
'        A = Chr$(128) & String$((128 - (Len(s) Mod 64) - 9) Mod 64, 0)
'        If bRE Then
'            s = s & A & String$(4, 0) & StrReverse(MakeDWORD((Len(s) * 8)))
'        Else
'            s = s & A & MakeDWORD((Len(s) * 8)) & String$(4, 0)
'        End If
'    Else
'        If ((Len(s) Mod 64) <> 0) Then
'            '//buffer the string so its divisible by 64 (0x40)
'            s = s & String(64 - (Len(s) Mod 64), 0)
'        End If
'    End If
'    For i = 1 To Len(s) Step 64
'        '//copy chunk of the string into the long array to be hashed
'        Call CopyMemory(B(5), ByVal Mid$(s, i, 64), 64)
'        '//transform
'        Call SHA1Transform(bRE, bS, B)
'    Next i
'End Sub
'Private Sub SHA1Transform(ByVal bRE As Boolean, ByVal bS As Boolean, ByRef P() As Long)
'    Dim hB(80) As Long
'    Dim A      As Long
'    Dim B      As Long
'    Dim C      As Long
'    Dim D      As Long
'    Dim E      As Long
'    Dim G      As Long
'    Dim i      As Long
'    If bRE Then 'reverse endian
'        For i = 0 To 15: hB(i) = htonl(P(i + 5)): Next i
'    Else
'        For i = 0 To 15: hB(i) = P(i + 5): Next i
'    End If
'    If bS Then 'standard SHA1
'        For i = 16 To 79
'            hB(i) = LSC((hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)), 1)
'        Next i
'    Else
'        For i = 16 To 79
'            hB(i) = LSC(1, (hB(i - 16) Xor hB(i - 8) Xor hB(i - 14) Xor hB(i - 3)) And 31)
'        Next i
'    End If
'    A = P(0)
'    B = P(1)
'    C = P(2)
'    D = P(3)
'    E = P(4)
'    For i = 0 To 19
'        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), ((B And C) Or ((Not B) And D))), &H5A827999)
'        E = D: D = C: C = LSC(B, 30): B = A: A = G
'    Next i
'    For i = 20 To 39
'        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &H6ED9EBA1)
'        E = D: D = C: C = LSC(B, 30): B = A: A = G
'    Next i
'    For i = 40 To 59
'        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (C And B) Or (D And C) Or (D And B)), &H8F1BBCDC)
'        E = D: D = C: C = LSC(B, 30): B = A: A = G
'    Next i
'    For i = 60 To 79
'        G = Add(Add(Add(Add(hB(i), E), LSC(A, 5)), (D Xor C Xor B)), &HCA62C1D6)
'        E = D: D = C: C = LSC(B, 30): B = A: A = G
'    Next i
'    P(0) = Add(P(0), A)
'    P(1) = Add(P(1), B)
'    P(2) = Add(P(2), C)
'    P(3) = Add(P(3), D)
'    P(4) = Add(P(4), E)
'End Sub
''~~~~~~ Extra functions ~~~~~~~
'Private Function LSC(ByVal N As Long, ByVal s As Long) As Long
'    'left shift circle
'    LSC = (LS(N, s) Or RS(N, (32 - s)))
'End Function
'Private Function RS(ByVal N As Long, ByVal s As Long) As Long
'    'right shift bits
'    If (s < 0) Or (s > 31) Then
'        RS = 0
'    ElseIf (s = 0) Then
'        RS = N
'    Else
'        If ((N And &H80000000) = &H80000000) Then
'            N = (N And &H7FFFFFFF)
'            If (s = 31) Then 'stop over flow when shifting 31bits
'                N = N / 2147483648#
'            Else
'                N = N \ (2 ^ s)
'            End If
'            RS = N Or (2 ^ (31 - s))
'        Else
'           RS = Int(CDbl(N) / CDbl(2 ^ s))
'        End If
'    End If
'End Function
'Private Function LS(ByVal N As Long, ByVal s As Long) As Long
'    'left shift bits
'    If (s < 0) Or (s > 31) Then
'        LS = 0
'    ElseIf s = 0 Then
'        LS = N
'    Else
'        N = N And (2 ^ (32 - s) - 1)
'        LS = WDbl(CDbl(N) * CDbl(WDbl(2 ^ s)))
'    End If
'End Function
'Private Function WDbl(ByVal N As Double) As Long
'    'wrap a double back to a long
'    If N > &H7FFFFFFF Then
'        N = N - 4294967296#
'    ElseIf N < &H80000000 Then
'        N = N + 4294967296#
'    End If
'    WDbl = N
'End Function
'Private Function Add(ByVal N1 As Long, ByVal N2 As Long, Optional ByVal D As Double) As Long
'    'add 2 longs to a double, then wrap round
'    D = N1
'    D = D + N2
'    Add = WDbl(D)
'End Function
'
'Private Function MakeDWORD(ByVal lngValue As Long) As String
'    MakeDWORD = String(4, vbNullChar)
'    Call CopyMemory(ByVal MakeDWORD, lngValue, 4)
'End Function
'
'Private Function XOREncryption(CodeKey As String, DataIn As String) As String
'Dim lonDataPtr      As Long
'Dim strDataOut      As String
'Dim intXOrValue1    As Integer
'Dim intXOrValue2    As Integer
'
'For lonDataPtr = 1 To Len(DataIn)
'    intXOrValue1 = Asc(Mid$(DataIn, lonDataPtr, 1))
'    intXOrValue2 = Asc(Mid$(CodeKey, ((lonDataPtr Mod Len(CodeKey)) + 1), 1))
'    strDataOut = strDataOut + Chr(intXOrValue1 Xor intXOrValue2)
'Next lonDataPtr
'
'   XOREncryption = strDataOut
'End Function
'
'Private Sub Get_MemBlobs()
'Dim splt() As String, V As String, Data As String, X As Integer
'
'
'Open (App.Path & "\mem_blobs.bin") For Input As #1
'    Do
'        Input #1, V
'        Data = Data & V
'    Loop Until EOF(1)
'Close #1
'
'splt = Split(Data, Chr(8))
'
'For X = 0 To UBound(splt) - 1
'    splt(X) = Replace(splt(X), Chr(2), ",")
'    ReDim Preserve Offset(X)
'    ReDim Preserve Length(X)
'    ReDim Preserve Memblob(X)
'    NewData = XOREncryption(PXOR_ENC, splt(X))
'    Offset(X) = CLng(Left(NewData, 8))
'    Memblob(X) = Right(NewData, Len(NewData) - 9)
'    Length(X) = UBound(Split(Memblob(X), " ")) + 1
'Next X
'
'
'End Sub
'
