Projects

QuickQuery Half-Life Edition

April 11, 2007 by Java

Browsing QuickQuery HL Edition/MainMod.bas (10.99 KB)

Attribute VB_Name = "MainMod"

Private Const WM_CUT = &H300
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const SW_NORMAL = 1
Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Long, ByVal dwFlags As Long) As Long
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000

Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long

Public Ver As String
Public bIsLaunched As Boolean

Public sReg_Name As String
Public sReg_Code As String
Public bReg_Valid As Boolean

Public sFileCRC As String
Public sCRC32 As String

Public Const KEY_F5 = 116
Public Const RegAppRoot = "Software\QuickQuery\Half-Life\2.x\"
Public Const SettingsReg = RegAppRoot + "Settings\"
Public Const FiltersReg = RegAppRoot + "Filters\"
Public Const MessagesReg = RegAppRoot + "Messages\"
Public Const ServersReg = RegAppRoot + "Queryied Servers\"
Public Const FavoritesReg = RegAppRoot + "Favorites\"
Public Const ProgramsReg = RegAppRoot + "Programs\"
Public Const PlayerSearchReg = SettingsReg + "Player Search\"

Public ExecutablePath As String
Public CmdLineArguments As String

Public Optn_LVHotTrack As Integer
Public Optn_SaveServers As Integer
Public Optn_ServerFile As String
Public Optn_AutoPB As Integer
Public Optn_AutoPaladin As Integer
Public Optn_AutoCD As Integer
Public Optn_MasterServer As String
Public Optn_LimitServers As Integer
Public Optn_MaxServers As Long
Public Optn_MaxConnections As Integer
Public Optn_RequestTimeout As Long
Public Optn_AutoRefreshRate As Long
Public Optn_UnloadWSControls As Integer
Public Optn_ProcessPriority As Integer
Public Optn_WaitForReturn As Integer
Public Optn_ResetMSNStatus As Integer
Public Optn_ClosePB As Integer
Public Optn_CloseCD As Integer
Public Optn_FilterFavorites As Integer
Public Optn_bSort As Integer
Public Optn_iSort As Integer

Public Msg_Filter As Integer
Public Msg_PBError As Integer
Public Msg_PBPaladinError As Integer
Public Msg_CDError As Integer
Public Msg_MSNError As Integer

Public Filter_AreResponding As Integer
Public Filter_Linux As Integer
Public Filter_Dedicated As Integer
Public Filter_NotEmpty As Integer
Public Filter_RunningMap As Integer
Public Filter_MapName As String
Public Filter_RunningGame As Integer
Public Filter_GameName As String
Public Filter_NotFull As Integer
Public Filter_Proxy As Integer

Public LaunchOptn_RunPB As Integer
Public LaunchOptn_PBLocation As String
Public LaunchOptn_RunPaladin As Integer
Public LaunchOptn_PaladinLocation As String
Public LaunchOptn_RunCD As Integer
Public LaunchOptn_CDLocation As String
Public LaunchOptn_ChangeMSNStatus As Integer
Public LaunchOptn_MSNStatus As Integer

Public FavoritesList() As String

Private Type RCONPasswordArray
    Address As String
    Password As String
End Type

Public RCONPasswordsList() As RCONPasswordArray

Private Type ProgramArray
    Enabled As Boolean
    Target As String
    Path As String
    CmdLine As String
    RunMode As Integer
    ProcessPriority As Integer
    iClose As Integer
    PID As Long
End Type

Public ProgramsList() As ProgramArray

Public Function CheckRegistration(ByVal sRegName As String, ByVal sRegCode As String) As Boolean
On Error GoTo ErrHandler
Dim aessystem As New clsAES
Dim tmpkey As String
Dim TmpArray() As String
Dim i As Long
    sRegName = Left(sRegName, 100)
    sRegName = Mid(sRegName, 2) + CStr(Asc(Left(sRegName, 1)))
    sRegName = aessystem.EncryptString(sRegName, _
    Replace(Mid(sRegName, 1, 1) & "0xEgZ*01-11" & Mid(sRegName, _
    Len(sRegName), 1), "*", Hex(Asc(Mid(sRegName, 4, 1)))), True)
    sRegName = SecureHash(StrReverse(sRegName))
    Set aessystem = Nothing
    tmpkey = ""
    For i = 1 To Len(sRegName) Step 4
        tmpkey = tmpkey + IIf(i = 1, "", "-") + Mid(sRegName, i, 4)
    Next i
    TmpArray = Split(tmpkey, "-")
    SwapString TmpArray(3), TmpArray(9)
    SwapString TmpArray(0), TmpArray(6)
    SwapString TmpArray(7), TmpArray(2)
    SwapString TmpArray(8), TmpArray(4)
    tmpkey = ""
    For i = 0 To 9
        tmpkey = tmpkey + IIf(i = 0, "", "-") + TmpArray(i)
    Next i
    If tmpkey = sRegCode Then
        CheckRegistration = True
        Exit Function
    End If
ErrHandler:
    CheckRegistration = False
End Function


Private Function GetSelfBytes(ByteArray() As Byte) As Boolean
On Error GoTo ErrHandler
Dim FNum As Integer
    FNum = FreeFile
    Open App.Path + IIf(Right(App.Path, 1) = "\", "", "\") + App.EXEName + ".exe" For Binary Access Read As #FNum
        ReDim ByteArray(0 To LOF(FNum) - 1)
        Get #FNum, , ByteArray()
    Close #FNum
    GetSelfBytes = True
    Exit Function
ErrHandler:
    GetSelfBytes = False
End Function

Public Sub LaunchURL(ByVal URL As String)
    ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, SW_NORMAL
End Sub

Public Function ClearWindowTranslucency(ByVal hWnd As Long) As Boolean
Dim nStyle As Long
    hWnd = GetTopLevel(hWnd)
    Call SetLayeredWindowAttributes(hWnd, 0, 255&, LWA_ALPHA)
    nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) And Not WS_EX_LAYERED
    ClearWindowTranslucency = CBool(SetWindowLong(hWnd, GWL_EXSTYLE, nStyle))
End Function

Sub Main()
On Error GoTo ErrHandler
Const lMemBase As Long = &H7638
Dim cCRC32 As New clsCRC
Dim lFileCRC As String
Dim n As Integer
Dim A As String
Dim x As Integer
Dim ByteArray() As Byte
    If IsCompatible() = False Then
        MsgBox "QuickQuery Half-Life Edition will only run on Windows 2000 or later computers.", vbCritical
        Exit Sub
    End If
    If GetSelfBytes(ByteArray) = False Then Exit Sub
    sCRC32 = StrReverse(Chr(ByteArray(lMemBase)) + Chr(ByteArray(lMemBase + 2)) + Chr(ByteArray(lMemBase + 4)) + Chr(ByteArray(lMemBase + 6)))
    ByteArray(lMemBase) = &H2E
    ByteArray(lMemBase + 2) = &H76
    ByteArray(lMemBase + 4) = &H62
    ByteArray(lMemBase + 6) = &H70
    cCRC32.Algorithm = CRC32
    cCRC32.Clear
    lFileCRC = CStr(cCRC32.CalculateBytes(ByteArray))
    Set cCRC32 = Nothing
    Erase ByteArray
    If Len(lFileCRC) < 8 Then lFileCRC = String(8 - Len(lFileCRC), "0") & Hex(lFileCRC)
    sFileCRC = ""
    For n = 1 To 4
        A = "&H" & Mid(lFileCRC, ((n - 1) * 2) + 1, 1)
        x = Val(A) * 16
        A = "&H" & Mid(lFileCRC, ((n - 1) * 2) + 2, 1)
        x = x + Val(A)
        sFileCRC = sFileCRC & Chr(x)
    Next n
    If sFileCRC <> sCRC32 Then Exit Sub
    MainForm.Show
ErrHandler:
End Sub

Public Function RegistryRegCode(ByVal sCode As String, bReverse As Boolean) As String
On Error Resume Next
Dim aessystem As New clsAES
    If bReverse = False Then
        sCode = aessystem.EncryptString(sCode, "g0dZd?~e*", False)
    Else
        sCode = aessystem.DecryptString(sCode, "g0dZd?~e*", False)
    End If
    Set aessystem = Nothing
    RegistryRegCode = sCode
End Function

Public Function SetWindowTranslucency(ByVal hWnd As Long, ByVal Alpha As Byte) As Boolean
Dim nStyle As Long
    hWnd = GetTopLevel(hWnd)
    nStyle = GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    If SetWindowLong(hWnd, GWL_EXSTYLE, nStyle) Then
        SetWindowTranslucency = CBool(SetLayeredWindowAttributes(hWnd, 0, CLng(Alpha), LWA_ALPHA))
    End If
End Function

Private Function GetTopLevel(ByVal hChild As Long) As Long
Dim hWnd As Long
   hWnd = hChild
   Do While IsWindowVisible(GetParent(hWnd))
      hWnd = GetParent(hChild)
      hChild = hWnd
   Loop
   GetTopLevel = hWnd
End Function
Public Function IsCompatible() As Boolean
Dim verinfo As OSVERSIONINFO
    verinfo.dwOSVersionInfoSize = Len(verinfo)
    GetVersionEx verinfo
    If verinfo.dwMajorVersion >= 5 Then
        IsCompatible = True
    Else
        IsCompatible = False
    End If
End Function

Public Function IsWindowsXP() As Boolean
Dim verinfo As OSVERSIONINFO
    verinfo.dwOSVersionInfoSize = Len(verinfo)
    GetVersionEx verinfo
    If verinfo.dwMajorVersion >= 5 And verinfo.dwMinorVersion >= 1 Then
        IsWindowsXP = True
    Else
        IsWindowsXP = False
    End If
End Function

Public Function Float2Int(BinaryStr As String) As Long
Dim i As Integer
Dim ep As Long
Dim dp As Long
Dim ival As Double
Dim power As Double
Dim decval As Double
    ep = 0
    For i = 1 To 8
        ep = ep + Val(Mid(BinaryStr, i + 1, 1)) * (2 ^ (9 - i - 1))
    Next i
    ep = ep - 127
    If ep < -126 Or ep > 127 Then
        dp = 0
        ival = 0
    Else
        dp = -1
        ival = 1
    End If
    For i = 9 To 31
        ival = ival + Val(Mid(BinaryStr, i + 1, 1)) * (2 ^ (dp + 9 - i))
    Next i
    decval = ival * (2 ^ ep)
    If ival > 0 Then
        power = Int(Log(decval) / 2.302)
        decval = decval + (0.5 * (10 ^ (power - 8 + 1)))
    End If
    Float2Int = Int(decval)
End Function

Public Function Hex2Dec(ByVal sHex As String) As Long
Dim i As Integer
Dim nDec As Long
Const HexChar As String = "0123456789ABCDEF"
    For i = Len(sHex) To 1 Step -1
        nDec = nDec + (InStr(1, HexChar, Mid(sHex, i, 1)) - 1) * 16 ^ (Len(sHex) - i)
    Next i
    Hex2Dec = CStr(nDec)
End Function

Public Function Dec2Bin(ByVal nDec As Integer) As String
Dim i As Integer
Dim j As Integer
Dim sHex As String
Const HexChar As String = "0123456789ABCDEF"
    sHex = Hex(nDec)
    For i = 1 To Len(sHex)
        nDec = InStr(1, HexChar, Mid(sHex, i, 1)) - 1
        For j = 3 To 0 Step -1
            Dec2Bin = Dec2Bin & nDec \ 2 ^ j
            nDec = nDec Mod 2 ^ j
        Next j
    Next i
    i = InStr(1, Dec2Bin, "1")
    If i <> 0 Then Dec2Bin = Mid(Dec2Bin, i)
End Function

Public Function Bin2Dec(ByVal sBin As String) As Double
Dim i As Integer
    For i = 1 To Len(sBin)
        Bin2Dec = Bin2Dec + CDbl(CInt(Mid(sBin, Len(sBin) - i + 1, 1)) * 2 ^ (i - 1))
    Next i
End Function
Public Sub ClipboardCut(hWnd As Long)
    SendMessage hWnd, WM_CUT, 0&, 0&
End Sub

Download QuickQuery HL Edition/MainMod.bas

Back to file list

---

Back to project page