0 Members and 1 Guest are viewing this topic.
{/////////////////////////////////////////////// //// Soldat Server TCP Socket Usage Example //// //// by EnEsCe - http://enesce.com //// //// Please leave this message if you use //// //// any of these functions! <3 <3 //// ///////////////////////////////////////////////}{Usage: (Creates socket in a seperate thread) CreateSocket('127.0.0.1',23073); Use the OnDataReceived event below for any data parsing}var SocketIndex: Integer; SocketConnected: Array of Boolean; cl: longint; status: string; // "connected" "off" "created" connectedto_ip: string; connectedto_port: integer; procedure wc (ID: Byte; Text: string; color: longint);begin WriteConsole (ID, '[SOCKET] ' + Text, color); WriteLn ('[SOCKET] ' + Text); WriteLnFile('\socket-logs\' + FormatDate('dd.mm.yy') + '.txt', FormatDate ('hh:nn:ss:zz') + '>' + Text);end;procedure OnDataReceived(Index: Integer; Buffer: String);begin if (Index = 0) or (SocketConnected[Index] = false) then exit; { Disconnected socket? }end;procedure MainSocketLoop(Index: Integer);var Buff: String;begin while SocketConnected[Index] do begin ReadLnSocket(Index,Buff); if Buff <> '' then OnDataReceived(Index,Buff); sleep(1); end;end;procedure OnConnected(Index: Integer);begin SetArrayLength(SocketConnected,GetArrayLength(SocketConnected)+2); ThreadFunc([Index],'MainSocketLoop'); SocketConnected[GetArrayLength(SocketConnected)-1] := true;end;procedure OnDisconnected(Index: Integer);begin SocketConnected[GetArrayLength(SocketConnected)-1] := false;end;procedure ThreadedCreate(IP: String;Port: Integer;var IndexVar: Integer);begin ConnectSocket(IP,Port,IndexVar); OnConnected(IndexVar);end;procedure CreateSocket(IP: String;Port: Integer);begin ThreadFunc([IP,Port,SocketIndex],'ThreadedCreate');end;procedure Disconnect();begin status := 'off'; OnDisconnected(2);end;procedure ActivateServer ();begin status := 'off'; wc (0, 'Recompiled!', $EEFF00FF);end;function OnPlayerCommand (ID: Byte; Text: string): boolean;begin if GetPiece(Text, ' ', 0) = '/connect' then begin if status = 'off' then begin status := 'connected'; connectedto_ip := GetPiece(Text, ' ', 1); ConnectSocket(connectedto_ip, 23000, socketindex); wc (0, 'Connecting to host: ' + Connectedto_ip + ':23000', $EE00FF00); end else begin wc(id, 'Already connected to host: ' + Connectedto_ip + ':23000' , $EEFF0000); end; end; if GetPiece(Text, ' ', 0) = '/disconnect' then begin if (status = 'connected') or (status = 'created') then begin Disconnect(); wc (0, 'Disconnected!', $EE00FF00); connectedto_ip := ''; end else begin wc(id, 'Not connected' , $EEFF0000); end; end;end;
{/////////////////////////////////////////////// //// Soldat Server TCP Socket Usage Example //// //// by EnEsCe - http://enesce.com ///////////////////////////////////////////////////}var //SocketIndex: Integer; SocketConnected: Array of Boolean; cl: longint; sep: string; // seperate char status: string; // "connected" "off" "created" connectedto_ip: string; connectedto_port: integer; Data, file, filename, fileplace: string; filesize: integer; procedure wc (ID: Byte; Text: string; color: longint);begin WriteConsole (ID, '[SOCKET] ' + Text, color); WriteLn ('[SOCKET] ' + Text); WriteLnFile(sep + 'socket-logs' + sep + FormatDate('dd.mm.yy') + '.txt', FormatDate ('hh:nn:ss:zz') + '>' + Text);end;procedure OnDataReceived(Index: Integer; Buffer: String);begin if (Index <> 2) or (SocketConnected[Index] = false) then exit; { Disconnected socket? } ReciveFile(Buffer); //ReciceMSG(Buffer); //ReciceCMD(buffer);end;procedure MainSocketLoop(Index: Integer);var Buff: String;begin while SocketConnected[Index] do begin ReadLnSocket(Index,Buff); if Buff <> '' then OnDataReceived(Index,Buff); sleep(1); end;end;procedure OnConnected(Index: Integer);begin SetArrayLength(SocketConnected,GetArrayLength(SocketConnected)+2); ThreadFunc([Index],'MainSocketLoop'); SocketConnected[GetArrayLength(SocketConnected)-1] := true;end;procedure ThreadedCreate(IP: String;Port: Integer;var IndexVar: Integer);begin ConnectSocket(IP,Port,IndexVar); OnConnected(IndexVar);end;procedure CreateSocket(IP: String;Port: Integer);begin ThreadFunc([IP,Port,SocketIndex],'ThreadedCreate');end;procedure ReciveFile(data: string);begin if data = '•FILE_BEGIN' then begin // begin of file recording file := ''; end; if GetPiece (data, '•', 0) = 'F_I' then begin // get file information filename := GetPiece (data, '•', 1); fileplace := GetPiece (data, '•', 2); filesize := strtoint(GetPiece (data, '•', 3)); WriteLn ('File transfer begins: ' + filename); WriteLn (' Size: ' + inttostr(filesize)); WriteLn (' Location: ' + fileplace); end; if GetPiece (data, '•', 0) = 'F_T' then begin // collect file pieces file := file + chr(13) + chr(10) + GetPiece (data, '•', 1); end; if data = '•FILE_END' then begin WriteFile (sep + fileplace + sep + filename, file); WriteLn ('File transfer complete: ''' + fileplace + sep + filename + ''''); end; result := 0;end;procedure ActivateServer ();begin status := 'off'; wc (0, 'Recompiled!', $EEFF00FF); CreateSocket ('127.0.0.1', 23000); status := 'created'; wc (0, 'Socket created at port 23000', $EE00FF00); if Getsystem = 'windows' then begin sep = '\'; wc (0, 'Server system: Windows', $EEff00ff); end else if Getsystem = 'linux' then begin sep = '/'; wc (0, 'Server system: Linux', $EEff00ff); end else begin wc(0, 'Could not detect server system [defaulting to windows]', $EEFF0000); sep = '\'; end;end;
wow... does it actually work without any sleep() and threadfunc?
:JFKsoldatserver -safe 0goto JFK
- ConnectSocket Use this function to create the socket and connect it. - CloseSocket Disconnect a socket created with CreateSocket and destroy from memory.- SendData Send a string to a socket.- ReadLnSocket Read a line from a socket to a variable (Line end character is 0A (chr(10))
Compiling Menager -> menager_client.pas... Menager -> [Hint] (82:10): Variable 'Result' never used Menager -> [Error] (136:2): Duplicate identifier 'SocketConnected' Compilation Failed.
Do i need to have forwarded ports to CreateSocket ?
For the second server, you will need to treat your other server as an admin, and parse the messages through OnAdminMessage and other functions. To send data, either WriteLn it, or it'd be better to use TCPAdminPM.
parse the messages through OnAdminMessage and other functions
function OnPlayerCommand (ID: byte; Text: string): boolean;begin if GetPiece(text, ' ', 0) = '/connect' then begin Connect(GetPiece(text, ' ', 1), GetPiece(text, ' ', 2), getpiece(text,' ',3)); end; if GetPiece(Text,' ', 0) = '/data' then begin If IPP <> '' then begin TCPAdminPM(IPP,'test'); WriteConsole(0,'Data sent',co); end else begin WriteConsole(0,'Not connected to server',co); end; end;end;procedure OnAdminMessage(IP, Msg: string);begin //If (IP = IPP) then begin WriteLn('Data recieved'); //end;end;