swearfilter

{$VERSION 2.6.0}
type
	TEvulPlayer = record
	 Nick,IP: String;
	 Level: Byte;
	end;
	
	TPlayer= record
	 Ranked: Boolean;
	 BigPoint: Boolean;
	end;

const
  BADWORD_LIST = 'scripts/badwords.txt';
  PUNISH_KICK = 3;
  PUNISH_BAN = 4;
  PUNISH_BAN_TIME = 180;
  PUNISH_WARN_MSG = 'Stop it!';
  PUNISH_KICK_MSG = 'You have been warned! KICKED!';
  PUNISH_BAN_MSG = 'Enough is enough! BANNED!';
  REASON_SWEAR = 'Swearing is not allowed!';
var
  BadWords: TStringArray;
  EvulPlayers: Array of TEvulPlayer;
  Players: Array[1..32] of TPlayer;
  
function MyTrim(const S:String):String;
var
 i:integer;
begin
 Result:=S;
 for i:=0 to 31 do Result:= strreplace(Result,chr(i),'');
 Result:= trim(Result);
end;

function xsplit(const source: string; const delimiter: string):TStringArray;
var
	i,x,d,l:integer;
	s:string;
begin
	d:=length(delimiter);
	x:=0;
	i:=1;
	l:=length(source)+1;
	Result:= [];
	SetArrayLength(Result,1);
	while(i<l) do begin
		s:=Copy(source,i,d);   	
	    	if(s=delimiter) then begin
	    		i:=i+d;		
	    		inc(x,1);
	    		SetArrayLength(result,x+1);
	    	end else begin  	     
	    		result[x]:= result[x]+copy(s,1,1);
	    		inc(i,1);
	    		
	  	end;
	end;
	if Result[ArrayHigh(Result)]='' then SetArrayLength(result,x);
end;

procedure SayToID(Const ID:integer;const Text:String);
begin
if (ID=255) then WriteLn(Text)
else WriteConsole(ID, Text,$EE81FAA1);
end;

function LoadBadWords:Boolean;
begin
	BadWords:=[];
	BadWords:= xsplit(ReadFile(BADWORD_LIST),#13#10);
	if BadWords[ArrayHigh(BadWords)] = '' then
		SetArrayLength(BadWords,ArrayHigh(BadWords));
	Writeln('BadWords loaded');
	Result:=true;
end;

procedure OverviewBadWords(const ID:byte);
var
	i:integer;
begin
	for i:=0 to ArrayHigh(BadWords) do begin
		SayToID(ID,'"'+BadWords[i]+'"');
	end;	
SayToID(ID,'BadWords Total: '+ INttostr(getArrayLength(BadWords)));
end;

procedure AddBadWord(const ID: Byte; BadWord: String);
begin
	BadWord:=LowerCase(Trim(BadWord));
	WriteLnFile(BADWORD_LIST,BadWord);
	SetArrayLength(BadWords,GetArrayLength(BadWords)+1);
	BadWords[ArrayHigh(BadWords)]:= BadWord;
	SayToID(ID,'Badword "'+BadWord+'" added');
end;

procedure DelBadWord(const ID: Byte; BadWord: String);
var
	i,z:integer;
	s:string;
	found: Boolean;
begin
	BadWord:=LowerCase(Trim(BadWord));
	for i:=0 to ArrayHigh(BadWords) do begin
  		if (BadWord=BadWords[i]) then begin
  			for z:=i to ArrayHigh(BadWords)-1 do begin
  				BadWords[z]:= BadWords[z+1];
  			end;
  			SetArrayLength(BadWords,ArrayHigh(BadWords));
  			Found:= true;
  			break;
  		end;
  	end	
  	if Found then begin
  		for i:=0 to ArrayHigh(BadWords) do begin
			s:=s+BadWords[i]+chr(13)+chr(10);
		end;
		WriteFile(BADWORD_LIST,s);
		SayToID(ID,'BadWord "'+BadWord+'" deleted');
	end else SayToID(ID,'BadWord "'+BadWord+ ' not found');
end;

procedure PunishEvulPlayer(const ID: Byte; const Reason:String);
begin
	Command('/kick '+inttostr(ID));
end;

procedure CheckBadWords(const ID:Byte; var Text:String);
var
	i: integer;
begin
  if not Players[ID].BigPoint then
	for i:=0 to ArrayHigh(BadWords) do begin
		if MaskCheck(Text,BadWords[i]) then begin
			If not MaskCheck(Text,'*nu*bia*') then begin
				//SayToID(ID,':S');
				PunishEvulPlayer(ID,REASON_SWEAR);
				break;
			end;
		end;
	end;
end;

procedure ActivateServer();
begin
	//bNames:= xsplit(ReadFile('bnames.txt'),#13#10);
	//if(bNames[ArrayHigh(bNames)]='') then SetArrayLength(bNames,ArrayHigh(bNames));
	LoadBadWords
end;

function OnCommand(ID: Byte; Text: string): boolean;
begin
  //NOTE: This function will be called when an admin types a / command.
  Result := false; // Return true if you want to ignore the command typed.

  if (Copy(Text,1,11) = '/addbadword') then AddBadWord(ID,Copy(Text,13,200)) 
  else if (Copy(Text,1,11) = '/delbadword') then DelBadWord(ID,Copy(Text,13,200))
  else if (Copy(Text,1,11) = '/ovebadword') then OverviewBadWords(ID);
end;

procedure OnException(ErrorMessage: string);
begin
  WriteLn(ErrorMessage);
  //WriteFile('ErrorLog.txt', ErrorMessage);
end;


//NETWORKCORE.PAS
procedure CheckBadName(ID:Byte);
var	Nickname: String;
begin
	Nickname:= LowerCase(IDtoName(ID));
	CheckBadWords(ID,Nickname);
end;

procedure OnPlayerSpeak(ID: byte; Text: string);
begin
 Text:= Lowercase(Text);
 ThreadFunc([ID,Text],'CheckBadWords');
end;

procedure OnJoinGame(ID, Team: byte);
begin
	ThreadFunc([ID],'CheckBadName');
end;