Игра по сети |
Игра по сети |
Alien |
Сообщение
#1
|
Новичок Группа: Пользователи Сообщений: 14 Репутация: 0 |
Можно ли в паскале реализовать систему ОНЛАЙН игр???? И еще, как сделать ХОРОШУЮ(хотяб как Циливизации2) графику в Паскале с поддержкой моделек извне???
-------------------- В любом из нас спит гений. И с каждым днем все крепче...
|
GLuk |
Сообщение
#2
|
Профи Группа: Пользователи Сообщений: 775 Пол: Мужской Репутация: 0 |
Пожалуйста, протокол IPX:
Код UNIT IPX; Interface Const MaxUsers = 10; { Maximum players } Type PFullAddress = ^TFullAddress; TFullAddress = Record NetAddress : Array[0..3] of Byte; { LAN address (reversed) } Node : Array[0..5] of Byte; { Node address (reversed), i.e. this computer number } Socket : Word { Socket number (reversed) } End; PIPXHeader = ^TIPXHeader; TIPXHeader = Record Checksum, { ? } Length : Word; { Size of this header + data size } TransportCtrl, { ? } PacketType : Byte; { 4 = IPX } Destination, { Receiver address } Source : TFullAddress { Sender address } End; PECB = ^TECB; TECB = Record LinkAddr, { ? } ESRAddr : Pointer; { ? } InUse, { name says :) } CompletionCode : Byte; { name says :) } Socket : Word; { Socket number (reveersed) } IPXWorkSpace : Array[0..3] of Byte; { ? } DriverWorkSpace : Array[0..11] of Byte; { ? } ImmediateAddr : Array[0..5] of Byte; { Receiver/Sender } FragmentCount : Word; { 2 for our program } Fragment1Addr : Pointer; { IPX header address } Fragment1Size : Word; { IPX header size } Fragment2Addr : Pointer; { Data address } Fragment2Size : Word { Data size } End; PIOBuf =^TIOBuf; TIOBuf = Record IPXHeader : TIPXHeader; ECB : TECB; Data : Array [0..511] of Byte { Fixed size !!! } End; Var _Addr : TFullAddress; { This computer's net addr } Function AllocRMBufs : Boolean; { Called automatically on startup } Function FreeRMBufs : Boolean; { You should it call before "End." } Function Is_IPX_Installed : Boolean; { Guess what it does :) } Procedure IPX_Get_Full_Address (Var Addr : TFullAddress); { Returns your full network address } Function IPX_Open_Socket (CloseByCall : Boolean; Var Socket : Word) : Byte; { Opens the "Socket" socket } Procedure IPX_Close_Socket (Socket : Word); { Closes the "Socket" socket } Procedure IPX_Relinquish_Control; { You have to call it once per each game cycle in order to make } { IPX driver working correctly } Procedure IPX_Send_Data (Var Data; Var ToNode); { Sends 512-bytes data block to the "ToNode" node (6 bytes) } { In order to do a broadcast sending, "ToNode" should be filled } { with $FFFFFFFFFFFF } Procedure IPX_Prepare_For_Receiving (UserFirst, UserLast : Word); { Prepears receiving of (UserLast-UserFirst+1) data blocks } { Note: UserFirst <= UserLast < MaxUsers } Function IPX_Receive_Data (UserNo : Word; Var Data; Var FromNode) : Boolean; { Returns True, if receives a 512-bytes data block } { Note: UserNo should be within UserFirst...UserLast range (see above) } { Sender node is returned in "FromNode" var (6 bytes) } Implementation {$IFDEF DPMI} Uses DOS, WinAPI; Type PRegs = ^TRegs; TRegs = Record EDI, ESI, EBP, Res, EBX, EDX, ECX, EAX : LongInt; Flags, ES, DS, FS, GS, IP, CS, SP, SS : Word; End; Var PRMFullAddress : PFullAddress; PRMECB : PECB; RMFullAddressHandle, RMFullAddressSeg, RMECBHandle, RMECBSeg : LongInt; RMIOBufHandle, RMIOBufSeg : LongInt; {$ELSE} Uses DOS; {$ENDIF} Var PRMIOBuf : PIOBuf; { I/O Buffers } (*************** DPMI Support functions ***************) Function AllocRMBufs : Boolean; Begin {$IFDEF DPMI} RMFullAddressHandle := GlobalDOSAlloc (SizeOf(TFullAddress)); RMFullAddressSeg := RMFullAddressHandle shr 16; PRMFullAddress := Ptr (RMFullAddressHandle and $FFFF, 0); RMECBHandle := GlobalDOSAlloc (SizeOf(TECB)); RMECBSeg := RMECBHandle shr 16; PRMECB := Ptr (RMECBHandle and $FFFF, 0); RMIOBufHandle := GlobalDOSAlloc (SizeOf(TIOBuf)*(MaxUsers+1)); RMIOBufSeg := RMIOBufHandle shr 16; PRMIOBuf := Ptr (RMIOBufHandle and $FFFF, 0); {$ELSE} GetMem (PRMIOBuf, SizeOf(TIOBuf)*(MaxUsers+1)); {$ENDIF} AllocRMBufs := True End; Function FreeRMBufs : Boolean; Begin {$IFDEF DPMI} GlobalDOSFree (RMFullAddressHandle); GlobalDOSFree (RMECBHandle); GlobalDOSFree (RMIOBufHandle); {$ELSE} FreeMem (PRMIOBuf, SizeOf(TIOBuf)*(MaxUsers+1)); {$ENDIF} FreeRMBufs := True End; {$IFDEF DPMI} Function RealIntr (Int : Byte; Var RMR : Registers) : Boolean; Var R : Registers; Regs : TRegs; Begin With RMR, Regs do Begin EAX := AX; EBX := BX; ECX := CX; EDX := DX; EBP := BP; ESI := SI; EDI := DI; Regs.Flags := RMR.Flags; Regs.DS := RMR.DS; Regs.ES := RMR.ES; SP := 0; SS := 0 End; R.AX := $300; R.BL := Int; R.BH := 0; R.CX := 0; R.ES := Seg (Regs); R.DI := Ofs (Regs); Intr ($31, R); If R.Flags and FCarry <> 0 then RealIntr := False; With RMR, Regs do Begin AX := EAX; BX := EBX; CX := ECX; DX := EDX; BP := EBP; SI := ESI; DI := EDI; RMR.Flags := Regs.Flags; RMR.DS := Regs.DS; RMR.ES := Regs.ES End; RealIntr := True End; {$ENDIF} (*************** DPMI Support functions ***************) (* IPX ROUTINES *) Function Is_IPX_Installed : Boolean; Assembler; Asm Mov AX, 7A00h Int 2Fh And AL, 1 End; Function IPX_Max_Packet_Size : Word; Var R : Registers; Begin {$IFDEF DPMI} R.BX := $1A; RealIntr ($7A, R); IPX_Max_Packet_Size := R.AX {$ELSE} R.BX := $1A; Intr ($7A, R); IPX_Max_Packet_Size := R.AX {$ENDIF} End; Procedure IPX_Get_Full_Address (Var Addr : TFullAddress); Var R : Registers; Begin {$IFDEF DPMI} R.BX := 9; R.ES := RMFullAddressSeg; R.SI := 0; RealIntr ($7A, R); Move (PRMFullAddress^, Addr, SizeOf(TFullAddress)); {$ELSE} R.BX := 9; R.ES := Seg(Addr); R.SI := Ofs(Addr); Intr ($7A, R); {$ENDIF} End; Function IPX_Open_Socket (CloseByCall : Boolean; Var Socket : Word) : Byte; Var R : Registers; Begin {$IFDEF DPMI} R.BX := 0; R.AL := Byte (CloseByCall); R.DX := ((Socket and $FF) shl 8) or (Socket shr 8); RealIntr ($7A, R); Socket := ((R.DX and $FF) shl 8) or (R.DX shr 8); IPX_Open_Socket := R.AL {$ELSE} R.BX := 0; R.AL := Byte (CloseByCall); R.DX := ((Socket and $FF) shl 8) or (Socket shr 8); Intr ($7A, R); Socket := ((R.DX and $FF) shl 8) or (R.DX shr 8); IPX_Open_Socket := R.AL {$ENDIF} End; Procedure IPX_Close_Socket (Socket : Word); Var R : Registers; Begin {$IFDEF DPMI} R.BX := 1; R.DX := ((Socket and $FF) shl 8) or (Socket shr 8); RealIntr ($7A, R); {$ELSE} R.BX := 1; R.DX := ((Socket and $FF) shl 8) or (Socket shr 8); Intr ($7A, R); {$ENDIF} End; Procedure IPX_Send_Packet (Var ECBS : TECB); Var R : Registers; Begin {$IFDEF DPMI} Move (ECBS, PRMECB^, SizeOf(TECB)); R.BX := 3; R.ES := RMECBSeg; R.SI := 0; RealIntr ($7A, R); {$ELSE} R.BX := 3; R.ES := Seg(ECBS); R.SI := Ofs(ECBS); Intr ($7A, R); {$ENDIF} End; Function IPX_Listen_For_Packet (Var ECBR : TECB) : Byte; Var R : Registers; Begin {$IFDEF DPMI} R.BX := 4; R.ES := RMIOBufSeg; R.SI := Ofs(ECBR); RealIntr ($7A, R); IPX_Listen_For_Packet := R.AL {$ELSE} R.BX := 4; R.ES := Seg(ECBR); R.SI := Ofs(ECBR); Intr ($7A, R); IPX_Listen_For_Packet := R.AL {$ENDIF} End; Procedure IPX_Relinquish_Control; Var R : Registers; Begin {$IFDEF DPMI} R.BX := $A; RealIntr ($7A, R); {$ELSE} R.BX := $A; Intr ($7A, R); {$ENDIF} End; Procedure IPX_Send_Data (Var Data; Var ToNode); Var P : PIOBuf; Begin P := PRMIOBuf; Inc (Word(P), MaxUsers*SizeOf(TIOBuf)); with P^.IPXHeader do Begin Checksum := 0; { ? } Length := SizeOf(TIPXHeader)+512; { Length of packet } TransportCtrl := 0; { ? } PacketType := 4; { IPX } Destination.NetAddress := _Addr.NetAddress; { Our LAN } Move (ToNode, Destination.Node, SizeOf(_Addr.Node));{ Broadcast/Certain recipient } Destination.Socket := _Addr.Socket; { Current socket } Move (_Addr, Source, SizeOf(TFullAddress)) { Sender - this computer } End; with P^.ECB do Begin LinkAddr := Nil; { ? } ESRAddr := Nil; { ? } Socket := _Addr.Socket; { Current socket } FillChar (IPXWorkSpace, 4, 0); { ? } FillChar (DriverWorkSpace, 12, 0); { ? } Move (ToNode, ImmediateAddr, SizeOf(_Addr.Node)); { Broadcast/Certain recipient } FragmentCount := 2; { 2 information blocks } {$IFDEF DPMI} Fragment1Addr := Ptr (RMIOBufSeg, Word(P)); {$ELSE} Fragment1Addr := @P^.IPXHeader; { 1st block is } {$ENDIF} Fragment1Size := SizeOf(TIPXHeader); { IPX header } {$IFDEF DPMI} Fragment2Addr := Ptr (RMIOBufSeg, Word(P)+SizeOf(TIPXHeader)+SizeOf(TECB)); {$ELSE} Fragment2Addr := @P^.Data; { 2nd block is } {$ENDIF} Fragment2Size := 512; { data block we send } End; Move (Data, P^.Data, 512); IPX_Send_Packet (P^.ECB) { Send packet } End; Procedure IPX_Prepare_For_Receiving (UserFirst, UserLast : Word); Var P : PIOBuf; I : Word; Begin If (UserFirst > UserLast) or (UserLast >= MaxUsers) then Exit; P := PRMIOBuf; Inc (Word(P), UserFirst*SizeOf(TIOBuf)); For I := UserFirst to UserLast do Begin with P^.ECB do Begin LinkAddr := Nil; { ? } ESRAddr := Nil; { ? } Socket := _Addr.Socket; { Current socket } FillChar (IPXWorkSpace, 4, 0); { ? } FillChar (DriverWorkSpace, 12, 0); { ? } FillChar (ImmediateAddr, 6, $FF); { Broadcast } FragmentCount := 2; { 2 information blocks } {$IFDEF DPMI} Fragment1Addr := Ptr (RMIOBufSeg, Word(P)); {$ELSE} Fragment1Addr := @P^.IPXHeader; { 1st block is } {$ENDIF} Fragment1Size := SizeOf(TIPXHeader); { IPX header } {$IFDEF DPMI} Fragment2Addr := Ptr (RMIOBufSeg, Word(P)+SizeOf(TIPXHeader)+SizeOf(TECB)); {$ELSE} Fragment2Addr := @P^.Data; { 2nd block is } {$ENDIF} Fragment2Size := 512; { data block we send } End; IPX_Listen_For_Packet (P^.ECB); { Listen for packet } Inc (Word(P), SizeOf(TIOBuf)) End End; Function IPX_Receive_Data (UserNo : Word; Var Data; Var FromNode) : Boolean; Var P : PIOBuf; I : Word; Begin P := PRMIOBuf; Inc (Word(P), UserNo*SizeOf(TIOBuf)); If P^.ECB.InUse = 0 then Begin Move (P^.Data, Data, 512); Move (P^.ECB.ImmediateAddr, FromNode, SizeOf(_Addr.Node)); IPX_Prepare_For_Receiving (UserNo, UserNo); IPX_Receive_Data := True End Else IPX_Receive_Data := False End; Begin AllocRMBufs; End. А это примерчик использования: Код Uses IPX, CRT; (* GENERAL CONSTANTS *) Const DefaultSocket = $5000; { Default socket for the program } DoomSocket = $869C; { Official Doom socket :) } ChatID = 'IPX_CHAT_MSG'; { Chat message ID } MaxMessages = 20; { Max messages at the screen } (* 512-BYTES DATA BLOCK TYPE DEFINITION *) Type TData = Record Typ : Byte; Msg : String; Res : Array[0..254] of Byte End; (* VARIABLES *) Var { Chat socket number } ChatSocket : Word; { Not reversed!!! } Msgs : Array[0..MaxMessages-1] of String; { Received messages } MsgCnt, { Received messages number } I : Integer; Res : Byte; Key : Char; { Character from keyboard } Msg : String; { Own message } GotMsg : Boolean; { Flag of available msg(s) } DataBlock : Array[0..MaxUsers-1] of TData; { 512-bytes data blocks } FromNode : Array[0..MaxUsers-1] of Array [0..5] of Byte; { Senders that sent mesg(s) } (* STRING HANDLING FUNCTIONS *) Function HexB (B : Byte) : String; Const HC : Array [0..15] of Char = '0123456789ABCDEF'; Begin HexB := HC[B shr 4] + HC[B and 15] End; Function ToHex (Var Buf; Count : Integer) : String; Var X : Array[0..255] of Byte Absolute Buf; I : Byte; S : String; Begin S := ''; For I := 0 to Count-1 do S := S + HexB(X[I]); ToHex := S End; (* SENDING/RECEIVING ROUTINES *) Procedure Send_Message (Message : String); Var Data : TData; ToNode : Array [0..5] of Byte; Begin Data.Typ := 1; Data.Msg := ChatID+Message; FillChar (ToNode, 6, $FF); IPX_Send_Data (Data, ToNode) End; (* MESSAGES/SCREEN HANDLING ROUTINES *) Procedure Clear_Messages; Var I : Integer; Begin For I := 0 to MaxMessages-1 do Msgs[I] := ''; MsgCnt := 0 End; Procedure Add_Message (Msg : String); Var I : Integer; Begin If MsgCnt < MaxMessages then Begin Msgs[MsgCnt] := Msg; Inc (MsgCnt) End Else Begin For I := 0 to MaxMessages-2 do Msgs[I] := Msgs[I+1]; Msgs[MaxMessages-1] := Msg End End; Procedure Display_Messages; Var I : Integer; Begin For I := 0 to MaxMessages-1 do Begin GotoXY (1, 2+I); Write (Msgs[I]); ClrEol End End; Procedure Display_Own_Message; Begin GotoXY (1, MaxMessages+3); ClrEol; Write ('>',Msg) End; (* MAIN PROGRAN *) Label LEnd; Begin WriteLn ('IPX Chat v1.0 by Alexei A. Frounze (c) 1999'); If ParamCount <> 0 then Begin If ParamStr(1) = '/?' then Begin WriteLn ('Usage: IPX_CHAT.EXE [SOCKET_NUMBER] <ДЩ'); WriteLn ('Default socket number is 20480 (5000h).'); WriteLn ('You can also ask IPX-driver for available socket number, '); WriteLn ('sipmly type: IPX_CHAT.EXE 0 <ДЩ'); Goto LEnd End; Val (ParamStr(1), ChatSocket, I); If I <> 0 then Begin WriteLn ('You didn''t enter a number.'); Goto LEnd End End Else ChatSocket := DefaultSocket; If not Is_IPX_Installed then Begin WriteLn ('IPX protocol is not installed.'); Goto LEnd End; WriteLn (#13#10'IPX protocol is installed.'); IPX_Get_Full_Address (_Addr); WriteLn (#13#10'Local area network address is: ', ToHex(_Addr.NetAddress,4)); WriteLn ('Node is: ', ToHex(_Addr.Node,6)); WriteLn (#13#10'Trying to open ', ChatSocket, ' socket...'); { gives free socket ($4000...$4FFF) by socket=0 request } Res := IPX_Open_Socket (False, ChatSocket); { Openning socket } If Res <> 0 then Begin WriteLn ('Couldn''t open desired socket.'); Goto LEnd End; WriteLn ('Successfully. Socket ', ChatSocket, ' is open.'); _Addr.Socket := ((ChatSocket and $FF) shl 8) + (ChatSocket shr 8); { Reversed!!! } WriteLn ('Be sure other users enter the chat using this socket.'); WriteLn (#13#10'You should at least see "',ToHex(_Addr.Node,6), '> On-line" message in the chat window.'); Write (#13#10'Hit any key to enter the chat...'); While not KeyPressed do; While KeyPressed do ReadKey; ClrScr; For I := 1 to 80 do Begin GotoXY (I, 1); Write ('-'); GotoXY (I, MaxMessages+2); Write ('-'); End; Msg := ''; Display_Own_Message; IPX_Prepare_For_Receiving (0, MaxUsers-1); { Listen for IPX packets } Send_Message ('On-line'); { We should recive this msg too! } (* MAIN LOOP *) Repeat IPX_Relinquish_Control; { Let IPX driver do some work } GotMsg := False; For I := 0 to MaxUsers-1 do If IPX_Receive_Data (I, DataBlock[I], FromNode[I]) then Begin If Pos(ChatID,DataBlock[I].Msg)=1 then Begin { Got new msg } Delete (DataBlock[I].Msg, 1, Length(ChatID)); Add_Message (ToHex(FromNode[I],6)+'> '+DataBlock[I].Msg); GotMsg := True End End; If GotMsg then Begin Display_Messages; { Displaying it } Display_Own_Message { Your input string } End; If KeyPressed then Key := ReadKey Else Key := #$FF; Case Key of #0 : Begin ReadKey; Key := #$FF End; #27 : Break; #13 : Begin If Msg <> '' then Send_Message (Msg); Msg := '' End; #8 : If Msg <> '' then Dec(Msg[0]); #32..#254 : If Length(Msg) < 66 then Msg := Msg + Key End; If Key in [#8,#13,#32..#254] then Display_Own_Message Until False; Send_Message ('Off-line'); { Say "goodbye" } IPX_Relinquish_Control; IPX_Close_Socket (ChatSocket); { Closing socket } ClrScr; LEnd: FreeRMBufs; { Freeing buffers } End. |
Текстовая версия | 4.05.2024 17:40 |