Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing LaunchForm.frm (9.89 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"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form LaunchForm
BorderStyle = 3 'Fixed Dialog
Caption = "Launch Half-Life & Connect"
ClientHeight = 1455
ClientLeft = 45
ClientTop = 330
ClientWidth = 5055
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "LaunchForm.frx":0000
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1455
ScaleWidth = 5055
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.TextBox txtCopy
Height = 285
Left = 1080
MultiLine = -1 'True
TabIndex = 9
TabStop = 0 'False
Top = 1080
Visible = 0 'False
Width = 495
End
Begin MSWinsockLib.Winsock WS_GameInfo
Left = 120
Top = 0
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
Begin ComctlLib.ListView LVGameInfo
Height = 1455
Left = 120
TabIndex = 3
Top = 1560
Width = 4815
_ExtentX = 8493
_ExtentY = 2566
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 327682
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 2
BeginProperty ColumnHeader(1) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
Text = "Setting"
Object.Width = 2293
EndProperty
BeginProperty ColumnHeader(2) {0713E8C7-850A-101B-AFC0-4210102A8DA7}
SubItemIndex = 1
Key = ""
Object.Tag = ""
Text = "Value"
Object.Width = 4939
EndProperty
End
Begin VB.CommandButton Command4
Caption = "&Info >>"
Height = 375
Left = 3960
TabIndex = 2
ToolTipText = "Show/hide server's game info"
Top = 960
Width = 975
End
Begin MSComDlg.CommonDialog EXEDialog
Left = 600
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
DialogTitle = "Browse for Half-Life Executable"
Filter = "Half-Life Executable (hl.exe)|hl.exe|Program Files (*.exe)|*.exe|All Files (*.*)|*.*"
InitDir = "C:\SIERRA\Half-Life"
End
Begin VB.CommandButton Command3
Caption = "..."
Height = 255
Left = 4640
Style = 1 'Graphical
TabIndex = 8
ToolTipText = "Browse for Half-Life executable"
Top = 510
Width = 300
End
Begin VB.CommandButton Command2
Cancel = -1 'True
Caption = "Close"
Height = 375
Left = 2880
TabIndex = 1
Top = 960
Width = 975
End
Begin VB.CommandButton Command1
Caption = "&Launch"
Default = -1 'True
Height = 375
Left = 1800
TabIndex = 0
Top = 960
Width = 975
End
Begin VB.TextBox txtPath
Height = 315
Left = 1800
TabIndex = 7
Text = "C:\SIERRA\Half-Life\hl.exe"
Top = 480
Width = 2775
End
Begin VB.TextBox txtAddress
BackColor = &H00C0C0C0&
Height = 315
Left = 1800
Locked = -1 'True
TabIndex = 5
Top = 120
Width = 3135
End
Begin VB.Label Label2
Caption = "&Half-Life Executable:"
Height = 255
Left = 120
TabIndex = 6
Top = 540
Width = 1575
End
Begin VB.Label Label1
Caption = "&Server Address:"
Height = 255
Left = 120
TabIndex = 4
Top = 180
Width = 1215
End
Begin VB.Menu LVPopupMenu
Caption = "LVPopupMenu"
Visible = 0 'False
Begin VB.Menu RefreshMenu
Caption = "&Refresh"
End
Begin VB.Menu CopyMenu
Caption = "&Copy"
End
End
End
Attribute VB_Name = "LaunchForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
If LVGameInfo.ListItems(3).SubItems(1) = "n/a" Then
MsgBox "Cannot launch Half-Life without first receiving the server's game info.", vbExclamation
Exit Sub
End If
Shell txtPath.Text & " -console -game " & LVGameInfo.ListItems(3).SubItems(1) & " +connect " & txtAddress.Text, vbNormalFocus
If Err.Number <> 0 Then
MsgBox "Unable to launch Half-Life." & vbCrLf & vbCrLf & "Please verify that the path is correct.", vbCritical
Else
ExecutablePath = txtPath.Text
End If
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
On Error GoTo CancelErr
EXEDialog.FileName = txtPath.Text
EXEDialog.ShowOpen
txtPath.Text = EXEDialog.FileName
txtPath.SetFocus
txtPath.SelStart = 0
txtPath.SelLength = Len(txtPath.Text)
CancelErr:
End Sub
Private Sub Command4_Click()
If Command4.Caption = "&Info >>" Then
Command4.Caption = "&Info <<"
LVGameInfo.TabStop = True
Height = 3510
Else
Command4.Caption = "&Info >>"
LVGameInfo.TabStop = False
Height = 1830
End If
End Sub
Private Sub CopyMenu_Click()
Dim i As Integer
Dim i2 As Integer
For i = 1 To LVGameInfo.ListItems.Count
txtCopy.Text = txtCopy.Text + LVGameInfo.ListItems(i).Text
For i2 = 2 To LVGameInfo.ColumnHeaders.Count
txtCopy.Text = txtCopy.Text + vbTab + LVGameInfo.ListItems(i).SubItems(i2 - 1)
Next i2
txtCopy.Text = txtCopy.Text + vbCrLf
Next i
txtCopy.SelStart = 0
txtCopy.SelLength = Len(txtCopy.Text)
ClipboardCut txtCopy.hWnd
End Sub
Private Sub Form_Load()
EXEDialog.Flags = cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNHideReadOnly
CButton Command3
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"
End With
LV_FlatColumnHeaders LVGameInfo
txtPath.Text = ExecutablePath
End Sub
Public Sub GetInfo(ServerIP As String, ServerPort As Long)
On Error Resume Next
txtAddress.Text = ServerIP & ":" & ServerPort
WS_GameInfo.RemoteHost = ServerIP
WS_GameInfo.RemotePort = ServerPort
WS_GameInfo.SendData "����info"
End Sub
Private Sub LVGameInfo_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = KEY_F5 Then RefreshMenu_Click
End Sub
Private Sub LVGameInfo_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
If Not (LVGameInfo.SelectedItem Is Nothing) Then
PopupMenu LVPopupMenu, vbPopupMenuRightButton
End If
End If
End Sub
Private Sub RefreshMenu_Click()
On Error Resume Next
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"
End With
WS_GameInfo.SendData "����info"
End Sub
Private Sub WS_GameInfo_DataArrival(ByVal bytesTotal As Long)
On Error GoTo ErrHandler
Dim RecvData As String
Dim i As Integer
WS_GameInfo.GetData RecvData
WS_GameInfo.Close
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))
ErrHandler:
Command1.Enabled = True
End Sub