internet.bas

超级C&C有没有搞错,VB还能编出这种即时策略游戏来!没错,这就是我们的超级C&C!虽然游戏经常无故退出,但是原码仍有很多可圈可点的地方.祝你早日编出中国的超级RA,超级KKND,超级星际,超级家园

Attribute VB_Name = "Internet"
Global Const SERVERINDEX = 1

Public Const DefaultPort = 4000
Public Const MAXDATALINES = 50

Public ReceivedDataCodes(MAXDATALINES) As Integer
Public ReceivedData(MAXDATALINES) As String
Public DataLines As Integer

Private Type ServDat
  ConnectedToServer As Boolean
  ServerIP As String
  ServerPort As Integer
End Type
Public ServerData As ServDat

Global Const CODE_ASSIGNPLAYERINDEX = 1000
Global Const CODE_ASSIGNPLAYERNICKNAME = 1001
'For the user being killed,
'preceeds a kill message
Global Const CODE_USERLOGINFAILED = 1003
'an acceptance flag
Global Const CODE_USERACCEPTED = 1004
'For everyone else
Global Const CODE_PLAYERKILLEDFROMSERVER = 1002
'LeavingServer
Global Const CODE_LOGOFF = 1005
Global Const CODE_MESSAGE = 1006

Global Const CODE_SUICIDE = 1007

Global Const CODE_SERVERSHUTDOWN = 1008

Global Const CODE_JOININGGAME = 1010

'Game codes
Global Const CODE_EVENT = 1009


Public MaxMessages As Integer
Type IncomingMessages
  TextLines(10) As String
  LinesActive(10) As Boolean
End Type
Public InternetMessageBox As IncomingMessages
Public Sub LaunchInternetGameConsole()
Const NoBox = 0
Const Messagebox = 1
Const PortBox = 2
Const NickBox = 3
Const BTN_Disconnect = 1
Const BTN_Join = 2
MaxMessages = 7
nicktext = LocalPlayer.NickName
porttext = Internet.ServerData.ServerPort
TextX = 23
ViewForm.KeyboardInputBox.Text = ""
Do
  Call GraphicsEngine.TilePic(InGameConstants(InGameConstant_PICINDEX_ProgramBackground))
  DoEvents
  If KeyStates(KEY_UP) = True Then
    focus = focus - 1
    KeyStates(KEY_UP) = False
    If focus < 1 Then focus = 1
    If focus = Messagebox Then
      ViewForm.KeyboardInputBox.Text = Messageboxtext
      ViewForm.KeyboardInputBox.SelStart = Len(ViewForm.KeyboardInputBox.Text)
    End If
  End If
  If KeyStates(KEY_DOWN) = True Then
    focus = focus + 1
    KeyStates(KEY_DOWN) = False
    If focus = Messagebox Then
      ViewForm.KeyboardInputBox.Text = Messageboxtext
      ViewForm.KeyboardInputBox.SelStart = Len(ViewForm.KeyboardInputBox.Text)
    End If
    If focus > 1 Then focus = 1 'maximum focus index
  End If
  
  If KeyStates(KEY_ESCAPE) = True Then
    KeyStates(KEY_ESCAPE) = True
    Button = BTN_CANCEL
    Exit Do
  End If
  
  If KeyStates(KEY_ENTER) = True Then
    KeyStates(KEY_ENTER) = False
    If focus = Messagebox Then
      Call Internet.TransmitMessage(Messageboxtext)
      ViewForm.KeyboardInputBox.Text = ""
    Else
      focus = NoBox
    End If
  End If
  
  If Mouse.ButtonStates(1) = True Then
    If Mouse.Position.Y > 123 Then
      If Mouse.Position.Y < 123 + FONT_SPACINGY Then
        focus = Messagebox
        ViewForm.KeyboardInputBox.Text = Messageboxtext
        ViewForm.KeyboardInputBox.SelStart = Len(ViewForm.KeyboardInputBox.Text)
      End If
    End If
    If Mouse.Position.Y > 123 + (FONT_SPACINGY * 4) Then
      If Mouse.Position.Y < 123 + (FONT_SPACINGY * 5) Then
        If Mouse.Position.X > TextX Then
          If Mouse.Position.X < TextX + (FONT_SPACINGX * 12) Then
            Button = BTN_Disconnect
            Exit Do
          End If
        End If
        If Mouse.Position.X > TextX + (FONT_SPACINGX * 29) Then
          If Mouse.Position.X < TextX + (FONT_SPACINGX * 34) Then
            Button = BTN_Join
            Exit Do
          End If
        End If
      End If
    End If
  End If
  
  If focus = Messagebox Then Messageboxtext = ViewForm.KeyboardInputBox.Text
  
  If GameInterface.KeyStates(KEY_ESCAPE) = True Then Exit Do
  
  
  Call GraphicsEngine.DisplayText("IP: " & ServerData.ServerIP & ", PORT: " & ServerData.ServerPort, 0, 0, 0)
  texty = 123
  
  Pcol = 0
  Offst = "( ) "
  If focus = Messagebox Then Offst = "(X) ": Pcol = PALLETE_WHITE
  Call GraphicsEngine.DisplayText(Offst & "Send Message: " & Messageboxtext, TextX, texty, Pcol)
  
  Pcol = 0
  texty = texty + FONT_SPACINGY
  texty = texty + FONT_SPACINGY

  texty = texty + FONT_SPACINGY
  Call GraphicsEngine.DisplayText("----------------------------------", TextX, texty, 0)
  texty = texty + FONT_SPACINGY
  Call GraphicsEngine.DisplayText("(DISCONNECT)                (JOIN)", TextX, texty, 0)
  
  
  TextX2 = 27
  texty = 26
  For I = 1 To MaxMessages
    If InternetMessageBox.LinesActive(I) = True Then
      Call GraphicsEngine.DisplayText(InternetMessageBox.TextLines(I), TextX2, texty, PALLETE_WHITE)
      texty = texty + FONT_SPACINGY
    End If
  Next I
  Call GraphicsEngine.GethDC
  Call GraphicsEngine.DrawBox(20, 23, 300, 113, 255, 255, 255, 0, 0, 0, LINEMODE_NORMAL)
  Call GraphicsEngine.ReleasehDC
  
  Call DrawCursor
  Call GraphicsEngine.SwapScreen
Loop
Mouse.ButtonStates(1) = False
Select Case Button
Case BTN_Join
  Internet.SendData CODE_JOININGGAME, "woohoo"
  MessageWindow.Caption = "JPI"
  MessageWindow.Text = "Loading..."
  Call GraphicsEngine.DisplayMessageWindow
  Call GraphicsEngine.SwapScreen
  Call GameEngine.StartNewInternetGame(1)
  Exit Sub
Case BTN_Disconnect
  Call Internet.Disconnect
  Exit Sub
End Select
End Sub
Public Sub NewInternetGameConsole()
If LaunchInternetConnectConsole = True Then
  Call LaunchInternetGameConsole
Else
  Exit Sub
End If
End Sub
Public Function LaunchInternetConnectConsole() As Boolean
Dim MenuInterface As GameInterface.InterfaceObj, ReturnedInterface As GameInterface.InterfaceReturnObj
texty = (GameInterface.HALFINTERFACEHEIGHT - 95) + 1
PicY = texty + (1 * FONT_SPACINGY) + (FONT_SPACINGY / 2)
FontX = GameInterface.HALFINTERFACEWIDTH - 58
FontY = (texty) + Pics(InGameConstants(InGameConstant_PICINDEX_JPILogoRed)).Height + 4
BTNSIZE = FONT_SPACINGY - 1
TEXTSPACING = FONT_SPACINGY + 3
MenuInterface.BackgroundPic = InGameConstants(InGameConstant_PICINDEX_ProgramBackground)
MenuInterface.Controls.ControlAmount = 13

ControlNumber = ControlNumber + 1
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(GameInterface.CONTROLTYPE_PICTUREBOX, GameInterface.HALFINTERFACEWIDTH, PicY, Pics(InGameConstants(InGameConstant_PICINDEX_JPILogoRed)).Width, Pics(InGameConstants(InGameConstant_PICINDEX_JPILogoRed)).Height, InGameConstants(InGameConstant_PICINDEX_JPILogoRed))

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = "IP"
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_LABEL, HALFINTERFACEWIDTH - 70, texty, 140, BTNSIZE, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = ServerData.ServerIP
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_TEXTBOX, HALFINTERFACEWIDTH, texty, 15, 1, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = "PORT"
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_LABEL, HALFINTERFACEWIDTH - 70, texty, 140, BTNSIZE, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = ServerData.ServerPort
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_TEXTBOX, HALFINTERFACEWIDTH, texty, 15, 1, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = "NICKNAME"
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_LABEL, HALFINTERFACEWIDTH - 70, texty, 140, BTNSIZE, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = LocalPlayer.NickName
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_TEXTBOX, HALFINTERFACEWIDTH, texty, 15, 1, Text)

linenumber = linenumber + 1
linenumber = linenumber + 1
ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = "OK"
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_BUTTONLARGE, HALFINTERFACEWIDTH - 70, texty, 140, BTNSIZE, Text)

ControlNumber = ControlNumber + 1: texty = FontY + (linenumber * TEXTSPACING): linenumber = linenumber + 1
Text = "CANCEL"
MenuInterface.Controls.ControlObjects(ControlNumber) = GameInterface.CreateControl(CONTROLTYPE_BUTTONLARGE, HALFINTERFACEWIDTH - 70, texty, 140, BTNSIZE, Text)

Do
    ReturnedInterface = GameInterface.RunStaticInterface(MenuInterface)
    For I = 1 To ReturnedInterface.Controls.ControlAmount
      If ReturnedInterface.Controls.ControlObjects(I).ControlProperties.Properties(CONTROLPROPERTY_STATE) = True Then
        If ReturnedInterface.Controls.ControlObjects(I).ControlType = CONTROLTYPE_BUTTONLARGE Then
          ButtonPressed = I
          Exit Do
        End If
      End If
      If ReturnedInterface.Canceled = True Then
        ButtonPressed = 9
        Exit Do
      End If
    Next I
Loop
Select Case ButtonPressed
Case 9
  LaunchInternetConnectConsole = False
  Exit Function
Case 8
  LocalPlayer.NickName = MenuInterface.Controls.ControlObjects(7).ControlProperties.Properties(CONTROLPROPERTY_TEXT)
  Call Internet.ConnectToServer(MenuInterface.Controls.ControlObjects(3).ControlProperties.Properties(CONTROLPROPERTY_TEXT), Val(MenuInterface.Controls.ControlObjects(5).ControlProperties.Properties(CONTROLPROPERTY_TEXT)))
  LaunchInternetConnectConsole = True
End Select
End Function
Sub ConnectToServer(IPAddy, PortNum)
On Error GoTo Err77
Call Internet.AddToInternetMessageBox("Connecting to " & IPAddy & "...")

ViewForm.ClientSock.RemotePort = PortNum
ViewForm.ClientSock.RemoteHost = IPAddy
ViewForm.ClientSock.Connect
DataLines = 0
StartTime = Timer
Do
  DoEvents
  If Timer > StartTime + 5 Then GoTo Err77
  If ServerData.ConnectedToServer = True Then Exit Do
Loop
ServerData.ServerIP = IPAddy
ServerData.ServerPort = PortNum
Call WaitForIncomingData
LocalPlayer.PlayerIndex = Val(ReceivedData(1))
Call GetRidOfDataLine
Call SendData(CODE_ASSIGNPLAYERNICKNAME, LocalPlayer.NickName)
Call WaitForIncomingData
If ReceivedDataCodes(1) = CODE_USERLOGINFAILED Then
  Call Internet.Disconnect
  Call Internet.AddToInternetMessageBox("Nickname already in use.")
  Call GetRidOfDataLine
  Exit Sub
ElseIf ReceivedDataCodes(1) = CODE_USERACCEPTED Then
  Call Internet.AddToInternetMessageBox("Connection Accepted.")
  Call GetRidOfDataLine
  Players.Player(LocalPlayer.PlayerIndex).NickName = NickName
End If
Exit Sub
Err77:
Call Internet.Disconnect
Exit Sub
End Sub
Sub Disconnect()
On Error Resume Next
Call SendData(CODE_LOGOFF, "Cya")
DoEvents
DoEvents
DoEvents
ViewForm.ClientSock.Close
ServerData.ConnectedToServer = False
Internet.DataLines = 0
End Sub
Sub SendData(DataCode, DataString)
If Internet.ServerData.ConnectedToServer = True Then
  ViewForm.ClientSock.SendData DataCode & DataString & "|"
  DoEvents
End If
End Sub
Sub WaitForIncomingData()
Do
  DoEvents
  If Internet.DataLines > 0 Then
    Exit Do
  End If
Loop
End Sub
Sub GetRidOfDataLine()
Internet.DataLines = Internet.DataLines - 1
For I = 1 To Internet.DataLines
  ReceivedData(I) = ReceivedData(I + 1)
  ReceivedDataCodes(I) = ReceivedDataCodes(I + 1)
Next I
End Sub
Sub TransmitMessage(MessageText)

Call Internet.SendData(CODE_MESSAGE, MessageText)
End Sub
Sub AddToInternetMessageBox(DatTxt)
LineSize = 33
startposition = 1
length = LineSize
Do
  If length + startposition > Len(DatTxt) Then length = Len(DatTxt) - startposition
  Text = Mid$(DatTxt, startposition, length + 1)
  Call AddMessage(Text)
  If length + startposition = Len(DatTxt) Then Exit Do
  startposition = startposition + LineSize + 1
Loop
End Sub
Sub AddMessage(Text)
Const NOLINESLEFT = -1
DatTxt = MiscFunctions.RemoveSpaces(Text)
CurrentLine = NOLINESLEFT
For I = 1 To MaxMessages
  If InternetMessageBox.LinesActive(I) = False Then
    CurrentLine = I
    Exit For
  End If
Next I
If CurrentLine = NOLINESLEFT Then
  For I = 1 To MaxMessages - 1
    InternetMessageBox.LinesActive(I) = InternetMessageBox.LinesActive(I + 1)
    InternetMessageBox.TextLines(I) = InternetMessageBox.TextLines(I + 1)
  Next I
  CurrentLine = MaxMessages
End If
InternetMessageBox.LinesActive(CurrentLine) = True
InternetMessageBox.TextLines(CurrentLine) = DatTxt
End Sub
Sub MiscInternetDataHandler()
Select Case Internet.ReceivedDataCodes(Internet.DataLines)
Case CODE_MESSAGE
  Call Internet.AddToInternetMessageBox(Internet.ReceivedData(Internet.DataLines))
  Internet.DataLines = Internet.DataLines - 1
Case CODE_SERVERSHUTDOWN
  Call Internet.Disconnect
  Call Internet.AddToInternetMessageBox(Internet.ReceivedData(Internet.DataLines))
End Select
End Sub
Sub BreakDownMessage(MessageText)
messagetxt = MessageText
Do
  'currtext = Left$(messagetxt, InStr(1, messagetxt, "|"))
  Internet.DataLines = Internet.DataLines + 1
  ReceivedDataCodes(Internet.DataLines) = Left$(messagetxt, 4)
  ReceivedData(Internet.DataLines) = Mid$(messagetxt, 5, InStr(1, messagetxt, "|") - 5)
  messagetxt = Right$(messagetxt, Len(messagetxt) - InStr(1, messagetxt, "|"))
  Call Internet.MiscInternetDataHandler
  If messagetxt = "" Then Exit Do
Loop
Internet.DataLines = Internet.DataLines + 1
ReceivedDataCodes(Internet.DataLines) = Left$(SData, 4)
ReceivedData(Internet.DataLines) = Right$(SData, Len(SData) - 4)
Call Internet.MiscInternetDataHandler
End Sub
Sub IncomingDataHandler()
Dim EventObject As Events.EventObj
For I = 1 To Internet.DataLines
  Select Case Internet.ReceivedDataCodes(I)
  Case CODE_EVENT
    EventObject.EventType = Left$(Internet.ReceivedData(I), Events.EventDataLength)
    For I2 = 1 To Events.MaxEventParamaters
      EventObject.Paramaters(I2) = Mid$(Internet.ReceivedData(I), (I2 * Events.EventDataLength) + 1, Events.EventDataLength)
    Next I2
    Call Events.RunEvent(EventObject)
  End Select
Next I
Internet.DataLines = 0
End Sub

Sub GetCurrentGameFromServer()

End Sub