eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Old stuff

This commit is contained in:
mysticbbs 2013-03-07 15:00:19 -05:00
parent 14a9b303ec
commit a0824a355c
1 changed files with 61 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

88
mdl/m_socket_server.pas
View File

@ -6,15 +6,21 @@ Interface
Uses Uses
Classes, Classes,
m_Socket_Class; m_IO_Sockets;
Const
MaxStatusText = 20;
Type Type
TServerManager = Class; TServerManager = Class;
TServerClient = Class; TServerClient = Class;
TServerCreateProc = Function (Manager: TServerManager; Client: TSocketClass): TServerClient; TServerCreateProc = Function (Manager: TServerManager; Client: TIOSocket): TServerClient;
TServerManager = Class(TThread) TServerManager = Class(TThread)
Server : TSocketClass; Critical : TRTLCriticalSection;
Server : TIOSocket;
ServerStatus : TStringList;
StatusUpdated : Boolean;
ClientList : TList; ClientList : TList;
NewClientProc : TServerCreateProc; NewClientProc : TServerCreateProc;
ClientMax : LongInt; ClientMax : LongInt;
@ -30,16 +36,16 @@ Type
Destructor Destroy; Override; Destructor Destroy; Override;
Procedure Execute; Override; Procedure Execute; Override;
Function CheckIP (IP, Mask: String) : Boolean; Function CheckIP (IP, Mask: String) : Boolean;
Function IsBlockedIP (Var Client: TSocketClass) : Boolean; Function IsBlockedIP (Var Client: TIOSocket) : Boolean;
Function DuplicateIPs (Var Client: TSocketClass) : Byte; Function DuplicateIPs (Var Client: TIOSocket) : Byte;
// Procedure Status (Str: String); Procedure Status (Str: String);
End; End;
TServerClient = Class(TThread) TServerClient = Class(TThread)
Client : TSocketClass; Client : TIOSocket;
Manager : TServerManager; Manager : TServerManager;
Constructor Create (Owner: TServerManager; CliSock: TSocketClass); Constructor Create (Owner: TServerManager; CliSock: TIOSocket);
Destructor Destroy; Override; Destructor Destroy; Override;
End; End;
@ -58,6 +64,8 @@ Var
Begin Begin
Inherited Create(False); Inherited Create(False);
InitCriticalSection(Critical);
Port := PortNum; Port := PortNum;
ClientMax := Max; ClientMax := Max;
ClientRefused := 0; ClientRefused := 0;
@ -66,9 +74,11 @@ Begin
ClientActive := 0; ClientActive := 0;
ClientMaxIPs := 0; ClientMaxIPs := 0;
NewClientProc := CreateProc; NewClientProc := CreateProc;
Server := TSocketClass.Create; Server := TIOSocket.Create;
ServerStatus := TStringList.Create;
ClientList := TList.Create; ClientList := TList.Create;
TextPath := ''; TextPath := '';
StatusUpdated := False;
For Count := 1 to ClientMax Do For Count := 1 to ClientMax Do
ClientList.Add(NIL); ClientList.Add(NIL);
@ -76,17 +86,38 @@ Begin
FreeOnTerminate := False; FreeOnTerminate := False;
End; End;
(*
Procedure TServerManager.Status (Str: String); Procedure TServerManager.Status (Str: String);
Var
Res : String;
Begin Begin
If Server.SocketStatus = NIL Then If ServerStatus = NIL Then Exit;
While Server.SocketStatus = NIL Do Begin
WriteLn('ITS NIL'); EnterCriticalSection(Critical);
Try
If ServerStatus.Count > MaxStatusText Then
ServerStatus.Delete(0);
Res := '(' + Copy(DateDos2Str(CurDateDos, 1), 1, 5) + ' ' + TimeDos2Str(CurDateDos, False) + ') ' + Str;
If Length(Res) > 74 Then Begin
ServerStatus.Add(Copy(Res, 1, 74));
If ServerStatus.Count > MaxStatusText Then
ServerStatus.Delete(0);
ServerStatus.Add(strRep(' ', 14) + Copy(Res, 75, 255));
End Else
ServerStatus.Add(Res);
Except
{ ignore exceptions here -- happens when socketstatus is NIL}
{ need to review criticals now that they are in FP's RTL}
End; End;
Server.Status(Str); StatusUpdated := True;
LeaveCriticalSection(Critical);
End; End;
*)
Function TServerManager.CheckIP (IP, Mask: String) : Boolean; Function TServerManager.CheckIP (IP, Mask: String) : Boolean;
Var Var
@ -122,7 +153,7 @@ Begin
End; End;
End; End;
Function TServerManager.IsBlockedIP (Var Client: TSocketClass) : Boolean; Function TServerManager.IsBlockedIP (Var Client: TIOSocket) : Boolean;
Var Var
TF : Text; TF : Text;
Str : String; Str : String;
@ -146,7 +177,7 @@ Begin
Close (TF); Close (TF);
End; End;
Function TServerManager.DuplicateIPs (Var Client: TSocketClass) : Byte; Function TServerManager.DuplicateIPs (Var Client: TIOSocket) : Byte;
Var Var
Count : Byte; Count : Byte;
Begin Begin
@ -154,22 +185,22 @@ Begin
For Count := 0 to ClientMax - 1 Do For Count := 0 to ClientMax - 1 Do
If ClientList[Count] <> NIL Then If ClientList[Count] <> NIL Then
If Client.PeerIP = TSocketClass(ClientList[Count]).PeerIP Then If Client.PeerIP = TIOSocket(ClientList[Count]).PeerIP Then
Inc(Result); Inc(Result);
End; End;
Procedure TServerManager.Execute; Procedure TServerManager.Execute;
Var Var
NewClient : TSocketClass; NewClient : TIOSocket;
Begin Begin
Repeat Until Server <> NIL; // Synchronize with server class Repeat Until Server <> NIL; // Synchronize with server class
Repeat Until Server.SocketStatus <> NIL; // Syncronize with status class Repeat Until ServerStatus <> NIL; // Syncronize with status class
Server.WaitInit(Port); Server.WaitInit(Port);
If Terminated Then Exit; If Terminated Then Exit;
Server.Status('Opening server socket on port ' + strI2S(Port)); Status('Opening server socket on port ' + strI2S(Port));
Repeat Repeat
NewClient := Server.WaitConnection; NewClient := Server.WaitConnection;
@ -178,30 +209,30 @@ Begin
If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin If (ClientMax > 0) And (ClientActive >= ClientMax) Then Begin
Inc (ClientRefused); Inc (ClientRefused);
Server.Status ('BUSY: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status ('BUSY: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'busy.txt') Then NewClient.WriteLine('BUSY'); If Not NewClient.WriteFile(TextPath + 'busy.txt') Then NewClient.WriteLine('BUSY');
NewClient.Free; NewClient.Free;
End Else End Else
If IsBlockedIP(NewClient) Then Begin If IsBlockedIP(NewClient) Then Begin
Inc (ClientBlocked); Inc (ClientBlocked);
Server.Status('BLOCK: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status('BLOCK: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED'); If Not NewClient.WriteFile(TextPath + 'blocked.txt') Then NewClient.WriteLine('BLOCKED');
NewClient.Free; NewClient.Free;
End Else End Else
If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin If (ClientMaxIPs > 0) and (DuplicateIPs(NewClient) > ClientMaxIPs) Then Begin
Inc (ClientRefused); Inc (ClientRefused);
Server.Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status('MULTI: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user'); If Not NewClient.WriteFile(TextPath + 'dupeip.txt') Then NewClient.WriteLine('Only ' + strI2S(ClientMaxIPs) + ' connection(s) per user');
NewClient.Free; NewClient.Free;
End Else Begin End Else Begin
Inc (ClientTotal); Inc (ClientTotal);
Inc (ClientActive); Inc (ClientActive);
Server.Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')'); Status ('Connect: ' + NewClient.PeerIP + ' (' + NewClient.PeerName + ')');
NewClientProc(Self, NewClient); NewClientProc(Self, NewClient);
End; End;
Until Terminated; Until Terminated;
Server.Status ('Shutting down server...'); Status ('Shutting down server...');
End; End;
Destructor TServerManager.Destroy; Destructor TServerManager.Destroy;
@ -228,12 +259,13 @@ Begin
End; End;
ClientList.Free; ClientList.Free;
ServerStatus.Free;
Server.Free; Server.Free;
Inherited Destroy; Inherited Destroy;
End; End;
Constructor TServerClient.Create (Owner: TServerManager; CliSock: TSocketClass); Constructor TServerClient.Create (Owner: TServerManager; CliSock: TIOSocket);
Var Var
Count : Byte; Count : Byte;
Begin Begin
@ -258,7 +290,7 @@ Begin
Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL; Manager.ClientList[Manager.ClientList.IndexOf(Self)] := NIL;
If Manager.Server <> NIL Then If Manager.Server <> NIL Then
Manager.Server.StatusUpdated := True; Manager.StatusUpdated := True;
Dec (Manager.ClientActive); Dec (Manager.ClientActive);