{$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!';
REASON_CAMP = 'Camping is not allowed!';
var
BadWords: TStringArray;
EvulPlayers: Array of TEvulPlayer;
Players: Array[1..32] of TPlayer;
const
//Teams
ALPHA = 1;
BRAVO = 2;
CHARLIE = 3;
DELTA = 4;
SPECTATOR = 5;
//Game Modes
DEATHMATCH = 0;
POINTMATCH = 1;
TEAMMATCH = 2;
CTF = 3;
RAMBO = 4;
INF = 5;
HTF = 6;
//Weapons
DEAGLES = 1;
HKMP5 = 2;
AK74 = 3;
STEYR = 4;
SPAS = 5;
RUGER = 6;
M79 = 7;
BARRET = 8;
MINIMI = 9;
MINIGUN = 10;
FLAMER = 11;
BOW = 12;
FLAMEBOW = 13;
SOCOM = 0;
KNIFE = 14;
CHAINSAW = 15;
LAW = 16;
//Mine
UNP_CNTDOWNLENGTH = 5; //-- /unpause: countdown length in seconds
AUTOADMIN_UPDATE = 20; //-- AUTOADMIN update frequency minutes
PLAYER_STATS_ON = 1;
//PlAYER_STATS_URL='http://127.0.0.1/zitrostats/PlayerStats.php';
PlAYER_STATS_URL='http://server.the-black-army.de/zitrostats/PlayerStats.php';
var
iUnpauseTarget: integer; //-- /unpause
inpause,startunpause: boolean;
IPList,bnames: TStringArray;
FirstBlood: boolean;
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;
procedure Gamemode(const gm:String);
begin
if ((gm = 'dm') and (GameStyle <> 0)) then
command('/gamemode 0')
else if ((gm = 'pm') and (GameStyle <> 1)) then
command('/gamemode 1')
else if (((gm = 'tm') or (gm ='td'))and(GameStyle <> 2)) then
command('/gamemode 2')
else if ((gm = 'ct') and (GameStyle <> 3)) then
command('/gamemode 3')
else if ((gm = 'rm') and (GameStyle <> 4)) then
command('/gamemode 4')
else if ((gm = 'in') and (GameStyle <> 5)) then
command('/gamemode 5')
else if ((gm = 'ht') and (GameStyle <> 6)) then
command('/gamemode 6');
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 ForgiveEvuls;
var
i,z:Integer;
begin
for i:=0 to GetArrayLength(EvulPlayers)-1 do begin
if EvulPlayers[i].Level = 1 then begin
for z:=i to GetArrayLength(EvulPlayers)-2 do begin
EvulPlayers[z]:= EvulPlayers[z+1];
end;
SetArrayLength(EvulPlayers,GetArrayLength(EvulPlayers)-1);
end else
EvulPlayers[i].Level := EvulPlayers[i].Level -1;
end;
end;
procedure PunishEvulPlayer(const ID: Byte; const Reason:String);
var
i,z:integer;
sIP,sNick:String;
Found: Boolean;
begin
sIP:= IDToIP(ID);
sNick:= IDtoName(ID);
for i:=0 to GetArrayLength(EvulPlayers)-1 do begin
if ((sIP = EvulPlayers[i].IP) or (sNick = EvulPlayers[i].Nick)) then begin
EvulPlayers[i].Level := EvulPlayers[i].Level + 1;
if (PUNISH_BAN <= EvulPlayers[i].Level) then begin
SayToID(ID,Reason);
SayToID(ID,PUNISH_BAN_MSG);
BanPlayerReason(ID,PUNISH_BAN_TIME,Reason)
end else if (PUNISH_KICK <= EvulPlayers[i].Level) then begin
SayToID(ID,Reason);
SayToID(ID,PUNISH_KICK_MSG);
KickPlayer(ID);
end else begin
Command('/kill '+IntToStr(ID));
SayToID(ID,PUNISH_WARN_MSG);
SayToID(ID,Reason);
SetScore(ID,0);
end;
Found:= True;
break;
end;
end;
if not found then begin
if ServerPort<>23073 then begin
SetArrayLength(EvulPlayers,GetArrayLength(EvulPlayers)+1);
z:= GetArrayLength(EvulPlayers)-1;
EvulPLayers[z].Nick:= sNick;
EvulPLayers[z].IP:= sIP;
EvulPLayers[z].Level:= 1;
Command('/kill '+IntToStr(ID));
end;
SayToID(ID,PUNISH_WARN_MSG);
SayToID(ID,Reason);
end;
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,);
PunishEvulPlayer(ID,REASON_SWEAR);
break;
end;
end;
end;
end;
procedure DoUnpause;
begin
//Command('/pause');
if (inpause AND NOT startunpause) then
begin
command('/say unpausing server in '+IntToStr(UNP_CNTDOWNLENGTH)+' seconds');
startunpause := true;
iUnpauseTarget := StrToInt(FormatDate('ss'))+ UNP_CNTDOWNLENGTH;
if (iUnpauseTarget > 59) then iUnpauseTarget := iUnpauseTarget-60;
end;
//Command('/pause');
ThreadFunc([],'PauseBack')
end;
procedure PauseBack;
var
i: Integer;
begin
Command('/pause');
for i:=0 to 25 do begin
Sleep(1);
Command('/pause');
end;
end;
procedure DoPause(const ID:integer);
begin
if (NOT inpause) then
begin
command('/say PAUSED ');
SayToID(ID,'Use /unp to unpause');
inpause := true;
end
else
begin
SayToID(ID,'Its already paused. Use /unp to unpause');
//command('/pause');
end;
end;
procedure DoUnpauseCountdown;
var
secleft,secnow:integer;
begin
Command('/pause');
SayToID(1,':O');
secnow :=StrToInt(FormatDate('ss'));
if (secnow <> iUnpauseTarget) then
begin
// countdown output
secleft := iUnpauseTarget - secnow;
if (secleft<0) then secleft := iUnpauseTarget - secnow + 60;
command('/say '+IntToStr(secleft));
end
else
begin
// unpausing
command('/say Go!');
command('/unpause');
inpause := false;
startunpause := false;
end;
end;
procedure DNSUpdate;
var
i: Integer;
begin
//Sleep(20000);
SetArrayLength(IPList,0);
IPList := xsplit(ReadFile('autoadmin_dns.txt'),chr(10));
for i := 0 to ArrayHigh(IPList) do begin
//writeln(IPList[i]);
//IPList[i]:= GetURL('http://127.0.0.1/resolve.php?ip='+IPList[i]);
IPList[i]:= Mytrim(GetURL('http://127.0.0.1/resolve.php?ip='+IPList[i]));
//Writeln('=> '+IPList[i]);
end;
WriteLn('AutoAdmin-DNS-Updated');
end;
procedure ActivateServer();
begin
bNames:= xsplit(ReadFile('bnames.txt'),#13#10);
if ServerPort<> 23073 then Firstblood := true else Firstblood := false;
if(bNames[ArrayHigh(bNames)]='') then SetArrayLength(bNames,ArrayHigh(bNames));
if LoadBadWords then DNSUpdate;
//ThreadFunc([],'LoadBadWords');
//sleep(500);
//ThreadFunc([],'DNSUpdate');
end;
procedure AppOnIdle(Ticks: integer);
begin
if Ticks mod (3600 * AUTOADMIN_UPDATE) = 0 then ThreadFunc([],'DNSUpdate'); //DNSUpdate;
if (startunpause) then DoUnpauseCountdown;
end;
procedure AddBadName(const ID: Byte;const Pattern: String; const Ban: Boolean);
var
Parts: TStringArray;
m,i: integer;
S:String;
begin
if Ban then begin
Parts:= xsplit(Pattern,':');
try
m:= StrToInt(Parts[ArrayHigh(Parts)]);
except
m:=0;
end;
s:= Parts[0];
for i:=1 to ArrayHigh(Parts)-1 do Begin
s:= s +':'+ Parts[i];
end;
s:= s + ':ban:' + IntToStr(m)+ ';';
end else begin
s:= Pattern+':kick;';
end;
WriteLnFile('bnames.txt',s);
SetArrayLength(bNames,ArrayHigh(bNames)+2);
bNames[ArrayHigh(bNames)]:= s;
SayToID(ID,'Line: >'+s+ '< added');
end;
procedure DelBadName(const ID: Byte;const Pattern: String);
var
i,z:integer;
s:string;
found: Boolean;
begin
z:= Length(Pattern)+1;
for i:=0 to ArrayHigh(bNames) do begin
if (LowerCase(Copy(bNames[i],1,z))=LowerCase(Pattern)+':') then begin
for z:=i to ArrayHigh(bNames)-1 do begin
bnames[z]:= bnames[z+1];
end;
SetArrayLength(bNames,ArrayHigh(bNames));
Found:= true;
end;
end
if Found then begin
for i:=0 to ArrayHigh(bnames) do begin
s:=s+bnames[i]+chr(13)+chr(10);
end;
WriteFile('bnames.txt',s);
SayToID(ID,Pattern+' deleted');
end else SayToID(ID,Pattern+ ' not found');
end;
procedure OnCamp(const ID: Byte);
begin
//SayToID(ID,);
PunishEvulPlayer(ID,REASON_CAMP);
end;
procedure PutMap(const ID:Byte; const Map:String);
begin
SayToID(ID,'I guess you meant '''+Map+'''');
Command('/map '+Map);
end;
Procedure HelpToChangeMap(const ID:Byte; Map: String);
begin
Map:= Trim(Map);
SayToID(ID,'Searchin for '+map);
if not FileExists('maps/'+Map+'.PMS') then begin
Case lowercase(Map) of
'nub','nubia','nuubia','ctf_nubia','ctf_nuubia','ctf_nub': PutMap(ID,'ctf_Nuubia');
'laos','loas','ctf_laos','ctf_loas': PutMap(ID,'ctf_Laos');
'ash','ahs','ctf_ash','ctf_ahs': PutMap(ID,'ctf_Ash');
'b2b','ctf_b2b': PutMap(ID,'ctf_B2b');
'cobra','ctf_cobra': PutMap(ID,'ctf_Cobra');
'conquest','ctf_conquest': PutMap(ID,'ctf_Conquest');
'd2','death2','daeth2','ctf_d2','ctf_daeth2','ctf_death2': PutMap(ID,'ctf_Death2');
'div','division','ctf_div','ctf_division': PutMap(ID,'ctf_Division');
'dd2','dropdown2','ctf_dropdown2': PutMap(ID,'ctf_Dropdown2');
'equi','equinox','ctf_equi','ctf_equinox': PutMap(ID,'ctf_Equinox');
'kampf','ctf_kampf': PutMap(ID,'ctf_Kampf');
'lanu','lanub','lanubya','lanubia','ctf_lanub','ctf_lanubia','ctf_lanubya': PutMap(ID,'ctf_Lanubya');
'm2','maya2','ctf_maya2': PutMap(ID,'ctf_Maya2');
'maya','ctf_maya': PutMap(ID,'ctf_Maya');
'ruin','ruins','ctf_ruins': PutMap(ID,'ctf_Ruins');
'run','ctf_run': PutMap(ID,'ctf_Run');
'snake','snakebyte','snakebite','ctf_snakebyte','ctf_snakebite': PutMap(ID,'ctf_Snakebite');
'steel','ctf_steel': PutMap(ID,'ctf_Steel');
'viet','ctf_viet': PutMap(ID,'ctf_Viet');
'vol','voland','ctf_vol','ctf_voland': PutMap(ID,'ctf_Voland');
end;
end;
end;
function OnCommand(ID: Byte; Text: string): boolean;
begin
if(text='/test') then begin
if FileExists('test') then SayToID(ID,'test works')
else SayToID(ID,'test failed');
end;
//NOTE: This function will be called when an admin types a / command.
//Writeln('cmd "'+text+'" "'+Copy(Text,1,4)+'"');
Result := false; // Return true if you want to ignore the command typed.
//if (Copy(Text,1,5)= '/say ') then WriteLn('/say '+Copy(Text,6,Length(Text)-5)+' ('+IDToName(ID)+')');
if (Copy(Text,1,4) = '/map') then ThreadFunc([ID,Copy(Text,5,30)],'HelpToChangeMap');
Text := lowercase(Text);
if (Copy(Text,1,9) = '/gamemode') then Gamemode(Copy(Text,11,2))
else if (Copy(Text,1,6) = '/pause') then DoPause(ID)
else if (Copy(Text,1,4) = '/unp') then DoUnpause
else if ((Copy(Text,1,8) = '/restart') or (Copy(Text,1,8) = '/nextmap') or (Copy(Text,1,5) = '/map ')) then
begin
inpause:= false;
startunpause:=false;
end
else if (Copy(Text,1,11) = '/addbadname') then begin
if (Copy(Text,12,1)= 'b') then AddBadName(ID,Copy(Text,14,21),True)
else AddBadName(ID,Copy(Text,13,16),False);
end
else if (Copy(Text,1,11) = '/delbadname') then DelBadName(ID,Copy(Text,13,16))
else 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)
else if (Copy(Text,1,5) = '/camp') then OnCamp(StrToInt(Trim(Copy(Text,7,2))));
end;
procedure DoGetRanking(const ID:Byte);
var
Response: String;
ResponseLines: TStringArray;
i: integer;
begin
try
Response:= GetURL(PLAYER_STATS_URL+'?name='+HTTPEncode(IDtoName(ID)));
ResponseLines:= xsplit(Response,chr(13));
for i:=0 to ArrayHigh(ResponseLines) do begin
Response:= MyTrim(ResponseLines[i]);
If Players[ID].Ranked then SaytoID(ID,Response)
else SaytoID(0,Response);
end;
Players[ID].Ranked:= True;
except
WriteLn('bug!');
end;
end;
procedure DoGetPrivRanking(const ID:Byte);
var
oldstate : Boolean;
begin
oldstate := Players[ID].Ranked;
Players[ID].Ranked := true;
DoGetRanking(ID);
Players[ID].Ranked := oldstate;
end;
function OnPlayerCommand(ID: Byte; Text: string): boolean;
begin
//NOTE: This function will be called when [_ANY_] player types a / command.
if (text = '/rank') then DoGetPrivRanking(ID);
Result := false; //Return true if you want disable the command typed.
end;
procedure OnException(ErrorMessage: string);
begin
WriteLn(ErrorMessage);
//WriteFile('ErrorLog.txt', ErrorMessage);
end;
//NETWORKCORE.PAS
function HTTPEncode_(Str: String):String;
var
i: integer;
s: string;
begin
for i:=1 to length(Str) do begin
s:= Copy(Str,i,1);
if s=' ' then result:=result+'%20'
else if s='!' then result:=result+'%21'
else if s='"' then result:=result+'%22'
else if s='#' then result:=result+'%23'
else if s='$' then result:=result+'%24'
else if s='%' then result:=result+'%25'
else if s='&' then result:=result+'%26'
else if s='''' then result:=result+'%27'
else if s='(' then result:=result+'%28'
else if s=')' then result:=result+'%29'
else if s='*' then result:=result+'%2A'
else if s='+' then result:=result+'%2B'
else if s=',' then result:=result+'%2C'
else if s='-' then result:=result+'%2D'
else if s='.' then result:=result+'%2E'
else if s='/' then result:=result+'%2F'
else if s=':' then result:=result+'%3A'
else if s=';' then result:=result+'%3B'
else if s='<' then result:=result+'%3C'
else if s='=' then result:=result+'%3D'
else if s='>' then result:=result+'%3E'
else if s='?' then result:=result+'%3F'
else if s='@' then result:=result+'%40'
else if s='[' then result:=result+'%5B'
else if s='\' then result:=result+'%5C'
else if s=']' then result:=result+'%5D'
else if s='^' then result:=result+'%5E'
else if s='_' then result:=result+'%5F'
else if s='`' then result:=result+'%60'
else if s='{' then result:=result+'%7B'
else if s='|' then result:=result+'%7C'
else if s='}' then result:=result+'%7D'
else if s='~' then result:=result+'%7E'
else if s='§' then result:=result+'%A7'
else if s='²' then result:=result+'%B2'
else if s='³' then result:=result+'%B3'
else if s='´' then result:=result+'%B4'
else if s='µ' then result:=result+'%B5'
else result:=result+s;
end;
end;
function OnRequestGame(IP: string; State: integer): integer;
var
i: integer;
begin
//if not NumPlayers=MaxPlayers then
for i:=0 to ArrayHigh(IPList) do begin
if (IP = IPList[i]) then begin
State := 1; // OK
WriteLn('VIP detected...');
command('/unban '+IP);
command('/admip '+IP);
break;
end;
end;
result := State; // Return new state
end;
procedure OnWeaponChange(ID, PrimaryNum, SecondaryNum: byte);
begin
end;
procedure CheckBadName(ID:Byte);
var
bType, wtf: TStringArray;
i:integer;
Nickname: String;
begin
Nickname:= LowerCase(IDtoName(ID));
for i:=0 to ArrayHigh(bNames) do begin
SetArrayLength(bType,0);
bType := xsplit(bNames[i],':');
if MaskCheck(Nickname,bType[0]) then begin
if Copy(bType[1],1,5) = 'kick;' then begin
KickPlayer(ID);
end;
if Copy(bType[1],1,3) = 'ban' then begin
wtf := xsplit(bType[2],';');
if wtf[0] = '' then begin
wtf[0] := '0';
end;
BanPlayer(ID, StrtoInt(wtf[0]));
end;
end;
end;
end;
procedure AddBot(const Team:Byte);
begin
Sleep(500);
if Team=0 then Command('/addbot DoNKeY')
else Command('/addbot'+IntToStr(Team)+' DoNKeY');
Sleep(1500);
BotChat(NameToID('DoNKeY'),'Welcome! Sense there is nobody else here, so I''ll entertain you for a little while.');
end;
procedure OnJoinGame(ID, Team: byte);
begin
ThreadFunc([ID],'CheckBadName');
if ServerPort<>23073 then begin
//WriteLN('oj '+inttostr(numplayers));
Case NumPlayers of
1: if Team=1 then ThreadFunc([2],'AddBot')
else if Team=0 then ThreadFunc([0],'AddBot')
else ThreadFunc([1],'AddBot');
3: if NumBots>0 then ThreadFunc([],'DelBot');
end;
if (Copy(IDToName(ID),1,10)='#tba.') then Players[ID].BigPoint:= True;
end;
end;
procedure OnJoinTeam(ID, Team: byte);
begin
// FairTeams - BEGIN
if ( ServerPort <> 23073) then case Team of
1: if (AlphaPlayers > BravoPlayers +1) then
begin
Command('/say Kinda unfair '+ IDtoName(ID) +'!');
Command('/setteam2 '+ IntToStr(ID));
end;
2: if (BravoPlayers > Alphaplayers +1) then
begin
Command('/say Kinda unfair '+ IDtoName(ID) +'!');
Command('/setteam1 '+ IntToStr(ID));
end;
end;
// FairTeams -END
end;
procedure MoveOneTo(Team: Byte);
var
i: integer;
begin
for i:=MaxPlayers+1 downto 1 do
if (
(GetPlayerStat(i,'team')<> 0)
and (GetPlayerStat(i,'team')<> Team)
and (GetPlayerStat(i,'active')= true)
and (GetPlayerStat(i,'flagger')= false)
) then begin
Command('/setteam'+IntToStr(Team)+' '+IntToStr(i));
WriteConsole(0,'Teams balanced!',$EE81FAA1);
break;
end;
end;
procedure BalanceTeams;
begin
if ServerPort<>23073 then begin
if AlphaPlayers+1 < BravoPlayers then MoveOneTo(1) else
if AlphaPlayers > BravoPlayers+1 then MoveOneTo(2) else
WriteConsole(0,'Teams quite fair!',$EE81FAA1);
end;
end;
procedure DelBot;
begin
sleep(2000);
Command('/kick DoNKeY');
sleep(1000);
BalanceTeams;
end;
procedure OnLeaveGame(ID, Team: byte; Kicked: boolean);
begin
if ServerPort<>23073 then begin
Players[ID].BigPoint:= False;
//Writeln('Np '+IntToStr(NumPlayers)+' NBots '+IntToStr(NumBots));
case NumPlayers of
2: if NumBots>0 then ThreadFunc([],'DelBot')
else ThreadFunc([Team],'AddBot');
end;
end;
//ThreadFunc([ID,Team,Kicked],'MyOnLeaveGame');
end;
procedure OnFlagGrab(ID, TeamFlag: byte; GrabbedInBase: boolean);
begin
end;
procedure OnFlagReturn(ID, TeamFlag: byte);
begin
end;
procedure OnFlagScore(ID, TeamFlag: byte);
begin
end;
procedure OnMapChange(NewMap: string);
var
i:integer;
begin
if ServerPort<> 23073 then begin
Firstblood:=true;
ThreadFunc([],'ForgiveEvuls');
end;
For i:=1 to 32 do begin
Players[i].Ranked:= false;
end;
end;
procedure OnPlayerKill(Killer, Victim: byte; Weapon: string);
begin
if Serverport <> 23073 then begin
//FirstBlood - begin
if (Killer <> Victim) then begin
if FirstBlood then begin
FirstBlood := false;
WriteConsole(0,'FIRSTBLOOD! '+IdToName(Victim)+' killed by '+IdToName(Killer),$0000FFFF);
WriteConsole(0,IdToName(Killer)+' gained +5 extra points !!',$0000FFFF);
SetScore(Killer,GetPlayerStat(Killer,'Kills')+5);
DrawText(0,'FIRST BLOOD !',330,$00FF0000,0.2,100,370);
//DrawText(0,'Hello big world!',6030,RGB(255,255,255),0.20,40,240);
end;
//firstblood - end
if GetPlayerStat(Victim,'flagger') then begin
WriteConsole(Killer,'+5 extra points for killing the Flagger',$0000FFFF);
SetScore(Killer,GetPlayerStat(Killer,'Kills')+5);
end;
if GetPlayerStat(Killer,'flagger') then begin
WriteConsole(Killer,'+1 extra point for killing as Flagger',$0000FFFF);
SetScore(Killer,GetPlayerStat(Killer,'Kills')+1);
if ((GetPlayerStat(Killer,'flagger')) and (GetPlayerStat(Victim,'flagger'))) then begin
WriteConsole(Killer,'+5 ComboBonus',$0000FFFF);
SetScore(Killer,GetPlayerStat(Killer,'Kills')+5);
end;
end;
if Players[Victim].BigPoint then begin
WriteConsole(Killer,'+1 BIGPOINT',$0000FFFF);
SetScore(Killer,GetPlayerStat(Killer,'Kills')+1);
end;
end;
end;
end;
function OnPlayerDamage(Victim, Shooter: byte; Damage: integer): integer;
begin
// Victim = Player Damaged // Shooter = Player doing the damage
result := Damage;
end;
procedure OnPlayerRespawn(ID: byte);
begin
end;
procedure OnPlayerSpeak(ID: byte; Text: string);
begin
Text:= Lowercase(Text);
if (MaskCheck(Text,'rank*') or MaskCheck(Text,'?rank*')) and (PLAYER_STATS_ON=1) then
DoGetRanking(ID)
else if (MaskCheck(Text,'teams*') or MaskCheck(Text,'?teams*')) then BalanceTeams
else if (MaskCheck(Text,'nextmap*') or MaskCheck(Text,'?nextmap*')) then Command('/say Next map: ' + NextMap)
else if (MaskCheck(Text,'*pause*') or MaskCheck(Text,'*stop*')) and (ServerPort = 23073) then begin command('/pause'); DoPause(ID); end
else ThreadFunc([ID,Text],'CheckBadWords');
end;
// ADMINCORE.PAS
procedure OnAdminConnect(IP: string);
begin
end;
procedure OnAdminDisconnect(IP: string);
begin
end;
// Custom-function used in OnAdminMessage
procedure ShowPlayers(IP: String);
var
i: Integer;
s: String;
begin
for i:=0 to 32 do begin
if(IDToName(i)<>'') then begin
s:= s+ IDToName(i)+', ';
end;
end;
s:= 'Players ('+IntToStr(NumPlayers)+') '+ Copy(s,1,Length(s)-2);
TCPAdminPM(IP,s);
end;
procedure OnAdminMessage(IP, Msg: string);
begin
if (Copy(Msg,1,8) = '/players') then Showplayers(IP);
end;