Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing QuickQuery HL Edition/RCONForm.frm (8.78 KB)
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form RCONForm
Caption = "RCON Console"
ClientHeight = 3795
ClientLeft = 60
ClientTop = 450
ClientWidth = 7815
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "RCONForm.frx":0000
MinButton = 0 'False
ScaleHeight = 3795
ScaleWidth = 7815
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Timer DelayTimer
Enabled = 0 'False
Interval = 1000
Left = 480
Top = 480
End
Begin MSWinsockLib.Winsock WS_GameRules
Left = 480
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.Timer PostLoadTimer
Interval = 1
Left = 0
Top = 480
End
Begin MSWinsockLib.Winsock WS_RCON
Left = 0
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin VB.CommandButton Command1
Caption = "&Send"
Default = -1 'True
Enabled = 0 'False
Height = 315
Left = 6600
TabIndex = 2
Top = 3480
Width = 1215
End
Begin VB.TextBox txtInput
Height = 315
Left = 0
MaxLength = 64000
TabIndex = 1
Top = 3480
Width = 6615
End
Begin VB.TextBox txtBuffer
BackColor = &H8000000C&
BeginProperty Font
Name = "Lucida Console"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3495
Left = 0
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 0
Width = 7815
End
End
Attribute VB_Name = "RCONForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public RCON_Address As String
Public RCON_Port As Long
Public RCON_Password As String
Private RCON_Challenge As String
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Const MF_STRING = &H0&
Private Const MF_SEPARATOR = &H800&
Private Sub AppendLine(strLine As String)
txtBuffer.Text = txtBuffer.Text + strLine + vbCrLf
txtBuffer.SelStart = Len(txtBuffer.Text)
End Sub
Public Sub ClearRCONBuffer()
txtBuffer.Text = ""
End Sub
Public Sub ShowRCONCmds()
AppendLine "---------------------------------------------" + vbCrLf
AppendLine "Basic RCON Commands:" + vbCrLf
AppendLine "banid <minutes> <uniqueid or #userid > : ban a player"
AppendLine "changelevel <levelname> : continue game on a new level"
AppendLine "kick < name > | < # userid >"
AppendLine "maps <* / substring> : shows maps on the server"
AppendLine "say <message> : says a server message"
AppendLine "user <username / userid> : shows info about a specific player"
AppendLine "users : shows all players on the server" + vbCrLf
AppendLine "---------------------------------------------" + vbCrLf
End Sub
Private Sub Command1_Click()
DelayTimer.Enabled = True
Command1.Enabled = False
WS_RCON.Close
WS_RCON.SendData "����rcon " + RCON_Challenge + " """ + RCON_Password + """ " + txtInput.Text
AppendLine "[out]<- " + txtInput.Text
txtInput.SetFocus
txtInput.SelStart = 0
txtInput.SelLength = Len(txtInput.Text)
End Sub
Private Sub DelayTimer_Timer()
DelayTimer.Enabled = False
If txtInput.Text <> "" Then Command1.Enabled = True
End Sub
Private Sub Form_Load()
AppendLine "HL QuickQuery " + Ver + " RCON Console Screen" + vbCrLf
FixSize Me, Width, Height, Screen.Width, Screen.Height
AppendMenu GetSystemMenu(hWnd, False), MF_SEPARATOR, 0&, vbNullString
AppendMenu GetSystemMenu(hWnd, False), MF_STRING, ClearRCONBufMenuID, "C&lear RCON Buffer"
AppendMenu GetSystemMenu(hWnd, False), MF_STRING, ShowRCONCmdsMenuID, "S&how RCON Commands"
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
UnfixSize Me
End Sub
Private Sub Form_Resize()
On Error Resume Next
txtBuffer.Width = ScaleWidth
txtBuffer.Height = ScaleHeight - txtInput.Height
txtInput.Top = txtBuffer.Height
txtInput.Width = ScaleWidth - Command1.Width
Command1.Left = txtInput.Width
Command1.Top = txtInput.Top
End Sub
Private Sub Form_Unload(Cancel As Integer)
MainForm.SetFocus
End Sub
Private Sub PostLoadTimer_Timer()
PostLoadTimer.Enabled = False
Load RCONSetupForm
Set RCONSetupForm.RCONConsoleForm = Me
If RCON_Address <> "" Then
RCONSetupForm.txtAddress.Text = RCON_Address
RCONSetupForm.txtAddress.SelStart = 0
RCONSetupForm.txtAddress.SelLength = Len(RCONSetupForm.txtAddress.Text)
End If
If RCON_Port <> 0 Then RCONSetupForm.txtPort.Text = RCON_Port
RCONSetupForm.Show 1
If RCON_Password = "" Then
Unload Me
Exit Sub
End If
Caption = Caption + " - " + RCON_Address + ":" & RCON_Port
WS_GameRules.Close
WS_GameRules.RemoteHost = RCON_Address
WS_GameRules.RemotePort = RCON_Port
WS_GameRules.SendData "����rules"
DoEvents
WS_RCON.Close
WS_RCON.RemoteHost = RCON_Address
WS_RCON.RemotePort = RCON_Port
WS_RCON.SendData "����challenge rcon"
DoEvents
txtInput.SetFocus
End Sub
Private Sub txtInput_Change()
If RCON_Challenge <> "" Then
If txtInput.Text = "" Then
Command1.Enabled = False
Else
If DelayTimer.Enabled = False Then Command1.Enabled = True
End If
End If
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 strText As String
Dim strSubItem As String
Dim bAdminModInstalled As Boolean
WS_GameRules.GetData RecvData
WS_GameRules.Close
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 = "admin_mod_version" Then
bAdminModInstalled = True
Exit For
End If
Next i
If bAdminModInstalled = True Then
txtBuffer.Text = Left(txtBuffer.Text, Len(txtBuffer.Text) - 2)
AppendLine "Server is using AdminMod " + strSubItem + vbCrLf
End If
ErrHandler:
End Sub
Private Sub WS_RCON_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ErrHandler
Dim RecvData As String
Dim TmpArray() As String
WS_RCON.GetData RecvData
WS_RCON.Close
If RecvData = "" Then Exit Sub
If Left(RecvData, 13) = "����challenge" Then
TmpArray = Split(RecvData, " ")
RCON_Challenge = Left(TmpArray(2), Len(TmpArray(2)) - 2)
AppendLine "Ready." + vbCrLf
Command1.Enabled = True
ElseIf Left(RecvData, 5) = "����l" Then
RecvData = Mid(RecvData, 6)
If Left(RecvData, 1) = "L" Then RecvData = Mid(RecvData, 2)
RecvData = Replace(RecvData, vbLf + "L", vbCrLf + "[in] -> ")
RecvData = Replace(RecvData, vbLf, vbCrLf)
If InStr(RecvData, vbNullChar) Then RecvData = Left(RecvData, InStr(RecvData, vbNullChar) - 1)
If Right(RecvData, 2) = vbCrLf Then RecvData = Left(RecvData, Len(RecvData) - 2)
If RecvData <> "" Then AppendLine "[in] -> " + RecvData
End If
ErrHandler:
End Sub
Download QuickQuery HL Edition/RCONForm.frm