jpiserver.bas

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

Attribute VB_Name = "Servermodule"
Global Const VERSION = "V2.0"
Type KillCounts
  BuildingsDestroyed As Integer
  UnitsDestroyed As Integer
  PeopleKilled As Integer
  BuildingsSacrificed As Integer
  UnitsSacrificed As Integer
  PeopleSacrificed As Integer
End Type
Const MAXDATALINES = 30
Type Playrs
  Active As Boolean
  IncomingDataCodes(MAXDATALINES) As Integer
  IncomingData(MAXDATALINES) As String
  DataLines As Integer
  NickName As String
  InGame As Boolean
  KillTally As KillCounts
  
  OutGoingDataCodes(MAXDATALINES) As Integer
  OutGoingData(100) As String
  OutGoingLines As Integer
End Type
Global Const MAXPLAYERS = 10
Global Players(MAXPLAYERS) As Playrs
Global PlayersLoggedOn As Integer
Type TimeObj
  Hour As Integer
  Minute As Integer
  Second As Integer
  Day As Integer
  Month As Integer
  Year As Integer
End Type
Type OldPeople
  EntryActive As Boolean
  NickName As String
  KillTally As KillCounts
End Type
Global Const MAXSCORES = 100
Type ServerDat
  ScoreHistory(MAXSCORES) As OldPeople
  LocalIP As String
  LocalPort As Integer
  Active As Boolean
  ServerStartTime As TimeObj
  MotD As String
  SysopName As String
  LogOns As Integer
End Type
Global ServerData As ServerDat
Type GameNfo
  MapName As String
  UsingPatch As Boolean
  PatchName As String
  GameTimer As Integer
  GameTimeLimit As Boolean
  GameLength As Integer 'For time-limited games
End Type
Global GameInfo As GameNfo
Global Const DefaultPort = 4000
Sub StartServer(PortNum)
'On Error Resume Next
Form1.AnswerSock.LocalPort = PortNum
Form1.AnswerSock.Listen
End Sub
Sub Delay(timedel)
strttime = Timer
Do
  DoEvents
  If Timer > strttime + timedel Then Exit Do
Loop
End Sub
Sub StartupPlayer(Index)
ServerData.MotD = "Welcome to the JPI game     server " & VERSION & ".  if you're a wuss,   get out of here."
Call SendData(Index, CODE_ASSIGNPLAYERINDEX, Index)
Call WaitForIncomingData(Index)
If Players(Index).IncomingDataCodes(1) = CODE_ASSIGNPLAYERNICKNAME Then
  nick = Players(Index).IncomingData(1)
  NotFound = True
  For i = 1 To PlayersLoggedOn
    If PlayerVerify(i) = True Then
      If Players(i).NickName = nick Then
        NotFound = False
      End If
    End If
  Next i
  If NotFound = True Then
    Players(Index).NickName = nick
    Call SendData(Index, CODE_USERACCEPTED, WELCOMEMESSAGE)
    Call GetRidOfDataLine(Index)
  Else
    Call SendData(Index, CODE_USERLOGINFAILED, "Nickname In Use")
    DoEvents
    Call KillUser(Index)
  End If
End If
'give the client the game info HERE
DoEvents
Call SendData(Index, CODE_MESSAGE, "JPI Server V1.0")
DoEvents
Call SendData(Index, CODE_MESSAGE, "SYSOP: " & ServerData.SysopName)
DoEvents
Call SendData(Index, CODE_MESSAGE, "MOTD: " & ServerData.MotD)
DoEvents
Call SendData(Index, CODE_MESSAGE, "PLAYERS LOGGED ON: " & PlayersLoggedOn)
DoEvents
Players(Index).InGame = True
Call BroadcastEvent(CODE_MESSAGE, Players(Index).NickName & " " & "logged on.")
onserv = 0
For i = 1 To PlayersLoggedOn
  If Players(i).Active = True Then
    onserv = onserv + 1
  End If
Next i
Form1.Text2.Text = onserv
End Sub
Sub KillServer()
For i = 1 To PlayersLoggedOn
  If PlayerVerify(i) = True Then
    Call SendData(i, CODE_SERVERSHUTDOWN, "Shutting down...")
    Call KillUser(i)
    DoEvents
  End If
Next i
PlayersLoggedOn = 0
DoEvents
End Sub
Sub SendData(PlayerIndex, DataCode, DataString)
On Error Resume Next
Form1.ServerSock(PlayerIndex).SendData DataCode & DataString & "|"
End Sub
Sub WaitForIncomingData(Index)
Do
  DoEvents
  If Players(Index).DataLines > 0 Then
    Exit Do
  End If
Loop
End Sub
Sub GetRidOfDataLine(Index)
Players(Index).DataLines = Players(Index).DataLines - 1
For i = 1 To Players(Index).DataLines
  Players(Index).IncomingData(i) = Players(Index).IncomingData(i + 1)
  Players(Index).IncomingDataCodes(i) = Players(Index).IncomingDataCodes(i + 1)
Next i
End Sub
Sub KillUser(Index)
On Error Resume Next
Players(Index).Active = False
Players(Index).InGame = False
Players(Index).DataLines = 0
Players(Index).OutGoingLines = 0
Form1.ServerSock(Index).Close
Unload Form1.ServerSock(Index)
Load Form1.ServerSock(Index)
For i = 1 To PlayersLoggedOn
  If Players(i).Active = True Then
    mnum = i
  End If
Next i
PlayersLoggedOn = mnum
'make killall player's objects here

Call BroadcastEvent(CODE_MESSAGE, Players(Index).NickName & " " & "left the game.")

Call BroadcastEvent(CODE_SUICIDE, Index)

Call BroadcastEvent(CODE_PLAYERKILLEDFROMSERVER, Index)
onserv = 0
For i = 1 To PlayersLoggedOn
  If Players(i).Active = True Then
    onserv = onserv + 1
  End If
Next i
Form1.Text2.Text = onserv
End Sub
Sub BroadcastEvent(DataCode, DataString)
For i = 1 To PlayersLoggedOn
  If PlayerVerify(i) = True Then
    Players(i).OutGoingLines = Players(i).OutGoingLines + 1
    Players(i).OutGoingDataCodes(Players(i).OutGoingLines) = DataCode
    Players(i).OutGoingData(Players(i).OutGoingLines) = DataString
  End If
Next i
End Sub
Function PlayerVerify(i)
If Players(i).Active = True Then
  If Players(i).InGame = True Then
    PlayerVerify = True
  End If
End If
End Function
Sub SendDataToPlayer(Index)
For i = 1 To Players(Index).OutGoingLines
  Call SendData(Index, Players(Index).OutGoingDataCodes(i), Players(Index).OutGoingData(i))
  DoEvents
Next i
Players(Index).OutGoingLines = 0
DoEvents
End Sub
Sub HandlePlayerData(Index)
For i = 1 To Players(Index).DataLines
  Select Case Players(Index).IncomingDataCodes(i)
  Case CODE_JOININGGAME
    Call BroadcastEvent(CODE_MESSAGE, Players(Index).NickName & " " & "joined the game.")
  Case CODE_MESSAGE
    Call BroadcastEvent(CODE_MESSAGE, Players(Index).NickName & ": " & Players(Index).IncomingData(i))
  Case CODE_LOGOFF
    Call KillUser(Index)
    Exit Sub
  Case CODE_EVENT
    Call BroadcastEvent(CODE_EVENT, Players(Index).IncomingData(i))
  End Select
Next i
Players(Index).DataLines = 0
End Sub
Sub Rotation()
Do
  DoEvents
  For i = 1 To PlayersLoggedOn
    If PlayerVerify(i) = True Then Call HandlePlayerData(i)
    If PlayerVerify(i) = True Then Call SendDataToPlayer(i)
  Next i
Loop
End Sub
Sub BreakDownMessage(MessageText, Index)
messagetxt = MessageText
Do
  Players(Index).DataLines = Players(Index).DataLines + 1
  Players(Index).IncomingDataCodes(Players(Index).DataLines) = Left$(messagetxt, 4)
  Players(Index).IncomingData(Players(Index).DataLines) = Mid$(messagetxt, 5, InStr(1, messagetxt, "|") - 5)
  messagetxt = Right$(messagetxt, Len(messagetxt) - InStr(1, messagetxt, "|"))
  If messagetxt = "" Then Exit Do
Loop
End Sub