Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/AutoRefreshForm.frm (13.46 KB)
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form AutoRefreshForm
BorderStyle = 3 'Fixed Dialog
Caption = "AutoRefreshing 127.0.0.1"
ClientHeight = 2565
ClientLeft = 45
ClientTop = 330
ClientWidth = 5355
ClipControls = 0 'False
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "AutoRefreshForm.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2565
ScaleWidth = 5355
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin ComctlLib.StatusBar SBar
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 4
Top = 2310
Width = 5355
_ExtentX = 9446
_ExtentY = 450
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 3
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
Text = "Reserve Slots:"
TextSave = "Reserve Slots:"
Object.Tag = ""
EndProperty
BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 1
Object.Width = 4260
Text = "Req Apps:"
TextSave = "Req Apps:"
Object.Tag = ""
EndProperty
BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
AutoSize = 2
Text = "Pass Req:"
TextSave = "Pass Req:"
Object.Tag = ""
EndProperty
EndProperty
End
Begin MSWinsockLib.Winsock WS_GameRules
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.CheckBox chkLaunch
Caption = "&Show launch dialog when server is not full"
Height = 280
Index = 0
Left = 60
TabIndex = 0
Top = 1700
Width = 3675
End
Begin VB.CheckBox chkLaunch
Caption = "&Launch game when server is not full"
Height = 315
Index = 1
Left = 60
TabIndex = 1
Top = 1950
Width = 3675
End
Begin MSWinsockLib.Winsock WS_GameInfo
Left = 960
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.Timer RefreshTimer
Interval = 2000
Left = 480
Top = 0
End
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "Cancel"
Default = -1 'True
Height = 375
Left = 3960
TabIndex = 2
Top = 1800
Width = 1335
End
Begin ComctlLib.ListView LVGameInfo
Height = 1635
Left = 60
TabIndex = 3
Top = 60
Width = 5235
_ExtentX = 9234
_ExtentY = 2884
View = 3
LabelEdit = 1
SortOrder = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 2
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Text = "Setting"
Object.Width = 2822
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 1
Key = ""
Object.Tag = ""
Text = "Value"
Object.Width = 4762
EndProperty
End
End
Attribute VB_Name = "AutoRefreshForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim PingTimer As Single
Dim AvgPing As Long
Dim iReserveSlots As Integer
Dim bPunkBuster As Boolean
Dim bPaladin As Boolean
Dim bCD As Boolean
Dim bPassword As Boolean
Public Sub ServerRulesRecvd(bState As Boolean)
If bState = True Then
SBar.Panels(1).AutoSize = sbrContents
SBar.Panels(2).Visible = True
SBar.Panels(3).Visible = True
Else
SBar.Panels(1).Text = "Receiving game rules..."
SBar.Panels(2).Visible = False
SBar.Panels(3).Visible = False
SBar.Panels(1).AutoSize = sbrSpring
End If
End Sub
Private Sub chkLaunch_Click(Index As Integer)
If chkLaunch(Index).Value = 1 Then
chkLaunch(Abs(Index - 1)).Value = 0
End If
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
LV_FlatColumnHeaders LVGameInfo
RefreshTimer.Interval = Optn_AutoRefreshRate
AvgPing = -1
StartSBarParentSubClass hWnd
End Sub
Private Sub Form_Unload(Cancel As Integer)
EndSBarParentSubClass
End Sub
Private Sub RefreshTimer_Timer()
WS_GameInfo.Close
WS_GameInfo.SendData "����info"
PingTimer = Timer
End Sub
Private Sub WS_GameInfo_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ErrHandler
Dim RecvData As String
Dim ServerPing As Long
Dim i As Integer
WS_GameInfo.GetData RecvData
WS_GameInfo.Close
ServerPing = Abs(Round(Timer - PingTimer, 3) * 1000) + 10
If AvgPing = -1 Then
AvgPing = ServerPing
Else
AvgPing = Round((AvgPing + ServerPing) / 2, 0)
End If
i = 6
i = InStr(i, RecvData, vbNullChar) + 1
LVGameInfo.ListItems(1).SubItems(1) = Mid(RecvData, i, InStr(i + 1, RecvData, vbNullChar) - i)
i = InStr(i, RecvData, vbNullChar) + 1
LVGameInfo.ListItems(2).SubItems(1) = Mid(RecvData, i, InStr(i + 1, RecvData, vbNullChar) - i)
i = InStr(i, RecvData, vbNullChar) + 1
LVGameInfo.ListItems(3).SubItems(1) = Mid(RecvData, i, InStr(i + 1, RecvData, vbNullChar) - i)
i = InStr(i, RecvData, vbNullChar) + 1
LVGameInfo.ListItems(4).SubItems(1) = Mid(RecvData, i, InStr(i + 1, RecvData, vbNullChar) - i)
i = InStr(i, RecvData, vbNullChar) + 1
LVGameInfo.ListItems(5).SubItems(1) = Asc(Mid(RecvData, i, 1)) & "/" & Asc(Mid(RecvData, i + 1, 1))
LVGameInfo.ListItems(6).SubItems(1) = ServerPing & " ms (average: " & AvgPing & " ms)"
If chkLaunch(0).Value = 1 Or chkLaunch(1).Value = 1 Then
If (Asc(Mid(RecvData, i, 1)) + iReserveSlots) < Asc(Mid(RecvData, i + 1, 1)) Then
LaunchForm.txtAddress.Text = WS_GameInfo.RemoteHostIP & ":" & WS_GameInfo.RemotePort
Select Case LVGameInfo.ListItems(3).SubItems(1)
Case "action"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(13, 1)
Case "cstrike"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(5, 1)
Case "dmc"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(7, 1)
Case "dod"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(9, 1)
Case "firearms"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(11, 1)
Case "frontline"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(15, 1)
Case "tfc"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(3, 1)
Case "valve"
LaunchForm.IconImage.Visible = True
LaunchForm.IconImage.Picture = LoadResPicture(2, 1)
Case Else
LaunchForm.IconImage.Visible = False
End Select
LaunchForm.IconImage.ToolTipText = LVGameInfo.ListItems(4).SubItems(1)
LaunchForm.Tag = LVGameInfo.ListItems(3).SubItems(1)
LaunchForm.bHasPassword = False
If Optn_AutoPB = 1 Then
If bPunkBuster = True Then
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(0) = True
LaunchForm.bNoSet = False
Else
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(0) = False
LaunchForm.bNoSet = False
End If
End If
If Optn_AutoPaladin = 1 Then
If bPaladin = True Then
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(1) = True
LaunchForm.bNoSet = False
Else
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(1) = False
LaunchForm.bNoSet = False
End If
End If
If Optn_AutoCD = 1 Then
If bCD = True Then
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(2) = True
LaunchForm.bNoSet = False
Else
LaunchForm.bNoSet = True
LaunchForm.lstOptions.Selected(2) = False
LaunchForm.bNoSet = False
End If
End If
If bPassword = True Then LaunchForm.bHasPassword = True
If chkLaunch(1).Value = 1 Then LaunchForm.PostLoadTimer.Enabled = True
Unload Me
LaunchForm.Show 0, MainForm
End If
End If
ErrHandler:
End Sub
Private Sub WS_GameRules_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ErrHandler
Dim RecvData As String
Dim TotalRules As Long
Dim i As Integer
Dim i2 As Long
Dim LIndex As Long
Dim strText As String
Dim strSubItem As String
WS_GameRules.GetData RecvData
WS_GameRules.Close
iReserveSlots = 0
bPunkBuster = False
bPaladin = False
bCD = False
bPassword = False
i2 = InStr(7, RecvData, vbNullChar) + 1
TotalRules = Asc(Mid(RecvData, 6, 1))
For i = 1 To TotalRules
strText = Mid(RecvData, i2, InStr(i2 + 1, RecvData, vbNullChar) - i2)
i2 = InStr(i2, RecvData, vbNullChar) + 1
strSubItem = Mid(RecvData, i2, InStr(i2 + 1, RecvData, vbNullChar) - i2)
i2 = InStr(i2, RecvData, vbNullChar) + 1
If strText = "reserve_slots" Then iReserveSlots = CInt(Val(strSubItem))
If strText = "sv_contact" And InStr(strSubItem, "{PB REQ}") Then bPunkBuster = True
If strText = "sv_contact" And InStr(strSubItem, "{PALADIN REQ}") Then bPaladin = True
If strText = "cdrequired" Then bCD = CBool(Val(strSubItem))
If strText = "sv_password" Then bPassword = CBool(Val(strSubItem))
Next i
Dim strReqApps As String
If bPunkBuster = True Then strReqApps = "Punkbuster"
If bPaladin = True Then strReqApps = strReqApps + IIf(strReqApps = "", "", "/") + "Paladin"
If bCD = True Then strReqApps = strReqApps + IIf(strReqApps = "", "", "/") + "Cheating-Death"
SBar.Panels(1).Text = "Reserve Slots: " & iReserveSlots
SBar.Panels(2).Text = "Req Apps: " + IIf(strReqApps = "", "None", strReqApps)
SBar.Panels(3).Text = "Pass Req: " + IIf(bPassword, "Yes", "No")
ServerRulesRecvd True
LVGameInfo.ListItems.Clear
With LVGameInfo.ListItems
.Add(, , "Host Name").SubItems(1) = "n/a"
.Add(, , "Map Name").SubItems(1) = "n/a"
.Add(, , "Game Directory").SubItems(1) = "n/a"
.Add(, , "Game Description").SubItems(1) = "n/a"
.Add(, , "Players").SubItems(1) = "n/a"
.Add(, , "Ping").SubItems(1) = "n/a"
End With
WS_GameInfo.RemoteHost = WS_GameRules.RemoteHostIP
WS_GameInfo.RemotePort = WS_GameRules.RemotePort
RefreshTimer.Enabled = True
RefreshTimer_Timer
ErrHandler:
End Sub
Download QuickQuery HL Edition/AutoRefreshForm.frm