Advertisement
Guest User

ZitroFUN-Lite

a guest
Dec 29th, 2014
269
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 27.47 KB | None | 0 0
  1. const                                                                                           //      ___                       ___           ___           ___           ___           ___           ___
  2.     ZitroVersion = 'v1.0.0 - Lite'; //Code: 421`291 end = 617 Build=1.2.0.26                    //     /\  \          ___        /\  \         /\  \         /\  \         /\  \         /\__\         /\__\
  3.     PointsForStart = '1000';                                                                    //     \:\  \        /\  \       \:\  \       /::\  \       /::\  \       /::\  \       /:/  /        /::|  |
  4.     YouInfo = 'Script Forum: http://polish-oneshoot.esy.es/';                                   //      \:\  \       \:\  \       \:\  \     /:/\:\  \     /:/\:\  \     /:/\:\  \     /:/  /        /:|:|  |
  5.     GOOD = $EE00FF00;                                                                           //       \:\  \      /::\__\      /::\  \   /::\~\:\  \   /:/  \:\  \   /::\~\:\  \   /:/  /  ___   /:/|:|  |__
  6.     BAD = $ff0033;                                                                              // _______\:\__\  __/:/\/__/     /:/\:\__\ /:/\:\ \:\__\ /:/__/ \:\__\ /:/\:\ \:\__\ /:/__/  /\__\ /:/ |:| /\__\
  7.     CRLF = #13#10;                                                                              // \::::::::/__/ /\/:/  /       /:/  \/__/ \/_|::\/:/  / \:\  \ /:/  / \/__\:\ \/__/ \:\  \ /:/  / \/__|:|/:/  /
  8.     rank_store = 10;                                                                            //  \:\~~\~~     \::/__/       /:/  /         |:|::/  /   \:\  /:/  /       \:\__\    \:\  /:/  /      |:/:/  /
  9.     MaxPointGive = 50;                                                                          //   \:\  \       \:\__\       \/__/          |:|\/__/     \:\/:/  /         \/__/     \:\/:/  /       |::/  /
  10.     precision = 6;                  // Precision calculation powers for point ELO-Point system  //    \:\__\       \/__/                      |:|  |        \::/  /                     \::/  /        /:/  /
  11. type                                                                                            //     \/__/                                   \|__|         \/__/                       \/__/         \/__/
  12.     TRank = record
  13.             Points: integer;
  14.             HWID: string;                      
  15. end;                   
  16. type
  17.     TStats = record
  18.             Kills, TeamKills, Deaths, DeathsByTeam, SelfKills, Points: string;
  19. end;
  20. var
  21.     nickStatus: array [1..32] of boolean;
  22.     PlayerStats: array [1..32] of TStats;
  23.     ranks: array of TRank;
  24.     FriendlyFire: boolean; Liczba, Tysieczna: integer;
  25.  
  26. function Explode(Source: string; const Delimiter: string): array of string;
  27. var Position, DelLength, ResLength: integer;
  28. begin
  29.     DelLength := Length(Delimiter);
  30.     Source := Source + Delimiter;
  31.     repeat
  32.         Position := Pos(Delimiter, Source);
  33.         SetArrayLength(Result, ResLength + 1);
  34.         Result[ResLength] := Copy(Source, 1, Position - 1);
  35.         ResLength := (ResLength + 1);
  36.         Delete(Source, 1, Position + DelLength - 1);
  37.     until (Position = 0);
  38.     SetArrayLength(Result, ResLength - 1);
  39. end;
  40.  
  41. procedure LoadNickname(ID: byte);
  42. var temparray: TStringArray;
  43. begin
  44.     if (FileExists('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt') = true) then begin
  45.         temparray := Explode(ReadFile('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt'),CRLF);
  46.         PlayerStats[ID].Kills := temparray[0];      PlayerStats[ID].TeamKills := temparray[1];  PlayerStats[ID].Deaths := temparray[2]; PlayerStats[ID].DeathsByTeam:= temparray[3];    PlayerStats[ID].SelfKills := temparray[4];
  47.         PlayerStats[ID].Points := temparray[5];
  48.     end else
  49.     begin
  50.         NickStatus[ID] := false;        PlayerStats[ID].Points := PointsForStart;
  51.     end;
  52. end;
  53.  
  54. procedure ResetVar(b: byte);
  55. begin
  56.     NickStatus[b]           := false;   PlayerStats[b].Points       := PointsForStart;  PlayerStats[b].DeathsByTeam     := '0';
  57.     PlayerStats[b].Kills    := '0';     PlayerStats[b].TeamKills    := '0';             PlayerStats[b].Deaths           := '0';     PlayerStats[b].SelfKills    := '0';
  58. end;
  59.  
  60. function StrToID(s: string): byte;
  61. var i: byte;
  62. begin
  63.     Result := 254;
  64.     try
  65.         if GetPlayerStat(StrToInt(s), 'active') then Result := StrToInt(s);
  66.     except
  67.         s := LowerCase(s);
  68.         for i := 1 to 32 do if GetPlayerStat(i, 'active') then if ContainsString(LowerCase(IDToName(i)), s) then begin
  69.             Result := i;
  70.             break;
  71.         end;
  72.     end;
  73. end;
  74.  
  75. function WowSuchASpeed(a: double; b: integer): double;
  76. var c: double;
  77. begin
  78.     if (b = 0) then result := 1 else if b mod 2 = 1 then result := (WowSuchASpeed(a, b-1) * a) else begin
  79.         c := WowSuchASpeed(a, b div 2);
  80.         result := (c * c);
  81.     end;
  82. end;
  83.  
  84. function WowItsEvenFaster(a: double; b: longint): double;
  85. var l, r, s, p: int64; AlgorithmsAreSoEZ: double;
  86. begin
  87.     p := round(WowSuchASpeed(10, precision));
  88.     l := 0;
  89.     r := p;
  90.     while(l<r) do begin
  91.         s := (l+r) div 2;
  92.         AlgorithmsAreSoEZ := s;
  93.         if (WowSuchASpeed(AlgorithmsAreSoEZ, b) > a) then r := s else l := (s + 1);
  94.     end;
  95.     result := (l-1);
  96.     l := 0;
  97.     r := (p-1);
  98.     while(l<r) do begin
  99.         s := (l+r) div 2;
  100.         AlgorithmsAreSoEZ := s;
  101.         AlgorithmsAreSoEZ := (AlgorithmsAreSoEZ / p);
  102.         AlgorithmsAreSoEZ := (AlgorithmsAreSoEZ + result);
  103.         if (WowSuchASpeed(AlgorithmsAreSoEZ, b) > a) then r := s else l := (s + 1);
  104.     end;
  105.     AlgorithmsAreSoEZ := (l - 1);
  106.     AlgorithmsAreSoEZ := (AlgorithmsAreSoEZ / p);
  107.     result := (result + AlgorithmsAreSoEZ);
  108. end;
  109.  
  110. procedure ABP(c: double);
  111. var c1, c2: string; i, b: byte;
  112. begin
  113.     if (c<>0) then begin
  114.         c1 := FloatToStr(c);
  115.         c1 := GetPiece(c1, '.', 1);
  116.         for i := 1 to Length(c1) do if (strtoint(c1[i]) <> 0) then begin
  117.             Liczba := strtoint(c1[i]);
  118.             c2 := '1';
  119.             for b := 1 to i do c2 := c2 + '0';
  120.             Tysieczna := strtoint(c2);
  121.             break;
  122.         end;
  123.     end else
  124.     begin
  125.         Liczba := 0;
  126.         Tysieczna := 0;
  127.     end;
  128. end;
  129.  
  130. function Punkty(Killer, Victim: byte): integer;
  131. var c: double; c1: string; c4: integer; x, x2, x3: double;
  132. begin
  133.     c := (single(strtoint(PlayerStats[Killer].Points)-strtoint(PlayerStats[Victim].Points))/1000);
  134.     if (c >= 1) or (c <= -1) then begin
  135.         c1 := FloatToStr(c);
  136.         if (c > 0) then x := WowSuchASpeed(10,strtoint(Copy(c1,1,1))) else x := WowSuchASpeed(10,strtoint(Copy(c1,1,2)));
  137.         ABP(c);
  138.         if (Liczba >= 1) or (Liczba <= -1) then x2 := Round(WowItsEvenFaster(WowSuchASpeed(10, Liczba), Tysieczna)) else x2 := 0;
  139.         x3 := (single(x)*single(x2));
  140.         c4 := Round(MaxPointGive/single(1+x3));
  141.         Result := c4;
  142.     end else
  143.     begin
  144.         ABP(c);
  145.         if (Liczba >= 1) or (Liczba <= -1) then c4 := Round(WowItsEvenFaster(WowSuchASpeed(10, Liczba), Tysieczna)) else c4 := 0;
  146.         c4 := Round(MaxPointGive/single(1+c4));
  147.         Result := c4;
  148.     end;
  149. end;
  150.  
  151. procedure UpdateNickname(ID: byte);
  152. var outdata: string;
  153. begin
  154.     if (NickStatus[ID] = true) then begin
  155.         outdata := PlayerStats[ID].Kills+CRLF+PlayerStats[ID].TeamKills+CRLF+PlayerStats[ID].Deaths+CRLF+PlayerStats[ID].DeathsByTeam+CRLF+PlayerStats[ID].SelfKills+CRLF+PlayerStats[ID].Points;
  156.         WriteFile('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt',outdata);
  157.         LoadNickname(ID);
  158.     end;
  159. end;
  160.  
  161. procedure AutoSaveNickname(ID: byte);
  162. var outdata: string;
  163. begin
  164.     if (FileExists('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt') = false) then begin
  165.         outdata := '0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+PointsForStart;
  166.         WriteFile('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt',outdata);
  167.         WriteLnFile('nickreg/server/players.db',GetPlayerStat(ID,'HWID'));
  168.     end else WriteConsole(ID,'Nickname already exists!',BAD);
  169. end;
  170.  
  171. procedure LoadRanks();
  172. var i: word; data: array of string;
  173. begin
  174.     ranks := [];
  175.     if (FileExists('nickreg/server/rankpoint.db')) then begin
  176.         data := Explode(ReadFile('nickreg/server/rankpoint.db'), CRLF);
  177.         SetArrayLength(ranks, GetArrayLength(data) div 2);
  178.         if (GetArrayLength(ranks) > 0) then for i := 0 to GetArrayLength(ranks) - 1 do begin
  179.             ranks[i].HWID := data[i * 2];
  180.             ranks[i].Points := StrtoInt(data[i * 2 + 1]);
  181.         end;
  182.     end;
  183. end;
  184.  
  185. procedure DeleteInRank(ID:byte);
  186. var i:word; outdata:string;
  187. begin
  188.     outdata := '';
  189.     if (GetArrayLength(ranks) > 0) then begin
  190.         for i := 0 to GetArrayLength(ranks) - 1 do begin
  191.             if (ranks[i].HWID = GetPlayerStat(ID,'HWID')) then if (GetArrayLength(ranks)<=1) then begin
  192.                 outdata := '';
  193.                 break;
  194.             end else i:=i+1;
  195.             outdata := outdata + ranks[i].HWID + CRLF + inttostr(ranks[i].Points) + CRLF;
  196.         end;
  197.         Delete(outdata, Length(outdata) - 1, 2);
  198.     end;
  199.     WriteFile('nickreg/server/rankpoint.db', outdata);
  200.     LoadRanks();
  201. end;
  202.  
  203. procedure RestartRank();
  204. var i: word; outdata: string; gracze, temparray: TStringArray; b: byte; n, n3: integer; n2: double;
  205. begin
  206.     gracze := Explode(ReadFile('nickreg/server/players.db'),CRLF);
  207.     n := 1;
  208.     n3 := ((GetArrayLength(gracze)-1)+(GetArrayLength(ranks)-2));
  209.     for i:= 2 to (GetArrayLength(gracze)-1) do begin
  210.         if (FileExists('nickreg/'+gracze[i-1]+'.txt') = true) then begin
  211.             n := n+1;
  212.             temparray := Explode(ReadFile('nickreg/'+gracze[i-1]+'.txt'),CRLF);
  213.             outdata :=  temparray[0]+CRLF+temparray[1]+CRLF+temparray[2]+CRLF+temparray[3]+CRLF+temparray[4]+CRLF+PointsForStart;
  214.             WriteFile('nickreg/'+gracze[i-1]+'.txt',outdata);
  215.             n2 := ((single(n)/single(n3))*100);
  216.             DrawTextEx(0,73,'Restart Ranks: '+FormatFloat('0.00',n2)+'%',120,$FF0000,0.065,48,400);
  217.         end;
  218.     end;
  219.     for b := 1 to 32 do if (GetPlayerStat(b, 'Active')=true) then LoadNickname(b);
  220.     outdata := '';
  221.     if (GetArrayLength(ranks) > 0) then begin
  222.         for i := 0 to GetArrayLength(ranks) - 1 do begin
  223.             n := n+1;
  224.             outdata := outdata+ranks[i].HWID+CRLF+PointsForStart+CRLF;
  225.             n2 := ((single(n)/single(n3))*100);
  226.             DrawTextEx(0,73,'Restart Ranks: '+FormatFloat('0.00',n2)+'%',120,$FF0000,0.065,48,400);
  227.         end;
  228.         Delete(outdata, Length(outdata) - 1, 2);
  229.     end;
  230.     WriteFile('nickreg/server/rankpoint.db', outdata);
  231.     LoadRanks();
  232.     DrawTextEx(0,73,'Restart Ranks: Completed!',260,$FF0000,0.065,48,400);
  233. end;
  234.  
  235. procedure SaveRanks();
  236. var i: word; buffer: string;
  237. begin
  238.     buffer := '';
  239.     if (GetArrayLength(ranks) > 0) then begin
  240.         for i := 0 to GetArrayLength(ranks) - 1 do buffer := buffer + ranks[i].HWID + CRLF + InttoStr(ranks[i].Points) + CRLF;
  241.         Delete(buffer, Length(buffer) - 1, 2);
  242.     end;
  243.     WriteFile('nickreg/server/rankpoint.db', buffer);
  244. end;
  245.  
  246. procedure UpdateRanks(ID: byte);
  247. var i, j, lowpoints: integer;
  248. begin
  249.     if (GetArrayLength(ranks) = 0) then lowpoints := 0 else lowpoints := ranks[GetArrayLength(ranks) - 1].Points;
  250.     if ((strtoint(PlayerStats[ID].Points) > lowpoints) or (GetArrayLength(ranks) < rank_store)) then begin
  251.         for i := 0 to GetArrayLength(ranks) - 1 do if (ranks[i].HWID = GetPlayerStat(ID, 'HWID')) then begin
  252.             if (GetArrayLength(ranks) >= i + 2) then for j := i + 1 to GetArrayLength(ranks) - 1 do begin
  253.                 ranks[j - 1].HWID := ranks[j].HWID;
  254.                 ranks[j - 1].Points := ranks[j].Points;
  255.             end;
  256.             SetArrayLength(ranks, GetArrayLength(ranks) - 1);
  257.             break;
  258.         end;
  259.         for i := 0 to GetArrayLength(ranks) - 1 do if (strtoint(PlayerStats[ID].Points) > ranks[i].Points) then break;
  260.         SetArrayLength(ranks, GetArrayLength(ranks) + 1);
  261.         if (GetArrayLength(ranks) >= i + 2) then for j := GetArrayLength(ranks) - 1 downto i + 1 do begin
  262.             ranks[j].HWID := ranks[j - 1].HWID;
  263.             ranks[j].Points := ranks[j - 1].Points;
  264.         end;
  265.         ranks[i].HWID := GetPlayerStat(ID, 'HWID');
  266.         ranks[i].Points := strtoint(PlayerStats[ID].Points);
  267.     end;
  268. end;
  269.  
  270. procedure ResetPlayerStats(ID: byte);
  271. var outdata: string;
  272. begin
  273.     outdata := '0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+PointsForStart;
  274.     WriteFile('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt',outdata);
  275.     LoadNickname(ID);
  276.     DeleteInRank(ID);
  277. end;
  278.  
  279. procedure RestartAllPlayerStats();
  280. var gracze, temparray: TStringArray; i, n, n3: word; outdata: string; b: byte; n2: double;
  281. begin
  282.     gracze := Explode(ReadFile('nickreg/server/players.db'),CRLF);
  283.     n := 1;
  284.     n3 := ((GetArrayLength(gracze)-1)+(GetArrayLength(ranks)-2));
  285.     for i:= 1 to (GetArrayLength(gracze)-1) do begin
  286.         if (FileExists('nickreg/'+gracze[i-1]+'.txt') = true) then begin
  287.             n := n+1;
  288.             temparray := Explode(ReadFile('nickreg/'+gracze[i-1]+'.txt'),CRLF);
  289.             outdata := '0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+'0'+CRLF+PointsForStart;
  290.             WriteFile('nickreg/'+gracze[i-1]+'.txt',outdata);
  291.             n2 := ((single(n)/single(n3))*100); //Dominik
  292.             DrawTextEx(0,73,'Restart all players stats: '+FormatFloat('0.00',n2)+'%',120,$FF0000,0.065,48,400);
  293.         end;
  294.     end;
  295.     for b := 1 to 32 do if (GetPlayerStat(b, 'Active')=true) then LoadNickname(b);
  296.     outdata := '';
  297.     if (GetArrayLength(ranks) > 0) then begin
  298.         for i := 0 to GetArrayLength(ranks) - 1 do begin
  299.             n := n+1;
  300.             outdata := outdata + ranks[i].HWID + CRLF + PointsForStart + CRLF;
  301.             n2 := ((single(n)/single(n3))*100);
  302.             DrawTextEx(0,73,'Restart all players stats: '+FormatFloat('0.00',n2)+'%',120,$FF0000,0.065,48,400);
  303.         end;
  304.         Delete(outdata, Length(outdata) - 1, 2);
  305.     end;
  306.     WriteFile('nickreg/server/rankpoint.db', outdata);
  307.     LoadRanks();
  308.     DrawTextEx(0,73,'Restart all players stats: Completed!',260,$FF0000,0.065,48,400);
  309. end;
  310.  
  311. function OnCommand(ID: Byte; Text: string): boolean;
  312. var i: byte;
  313. begin
  314.     if (lowercase(Text) = lowercase('/ResetAllPlayerStats')) then begin
  315.         RestartAllPlayerStats();
  316.         WriteConsole(0,'Restarted statistics of all players.',GOOD);
  317.     end;
  318.     if (lowercase(Text) = lowercase('/UpdateStats')) then begin
  319.         for i := 1 to 32 do if (GetPlayerStat(i, 'Active') = true) then begin
  320.             UpdateNickname(i);
  321.             if (GetPlayerStat(i, 'Human') = true) then UpdateRanks(i);
  322.             SaveRanks();
  323.             WriteConsole(i,'Update Stats!',GOOD);
  324.         end;
  325.     end;
  326.     if MaskCheck(lowercase(Text),'/ResetStatsID *') then begin
  327.         if (GetPiece(Text,' ',1) <> '') then begin
  328.             try
  329.                 if (GetPlayerStat(strtoint(GetPiece(Text,' ',1)),'Active') = true) then begin
  330.                     if (FileExists('nickreg/'+GetPlayerStat(strtoint(GetPiece(Text,' ',1)),'HWID')+'.txt') = true) then begin
  331.                         ResetPlayerStats(strtoint(GetPiece(Text,' ',1)));
  332.                         WriteConsole(ID,'Restarted player statistics '+GetPlayerStat(strtoint(GetPiece(Text,' ',1)),'Name')+'.',GOOD);
  333.                     end else WriteConsole(ID,'The player does not have an account.',BAD);
  334.                  end else WriteConsole(ID,'None such player.',BAD);
  335.             except WriteConsole(ID,'ID an incorrect.',BAD);
  336.             end;
  337.         end else WriteConsole(ID,'Not given ID.',BAD);
  338.     end;
  339.     if (lowercase(Text) = lowercase('/AdminCommands')) then begin
  340.         WriteConsole(ID,'___Admin Commands:______________________________________',GOOD);
  341.         WriteConsole(ID,'/UpdateStats         - Quick update statistics         |',GOOD);
  342.         WriteConsole(ID,'/ResetRanks          - Restarts ranks                  |',GOOD);
  343.         WriteConsole(ID,'/ResetAllPlayerStats - Restarts all players stats      |',GOOD);
  344.         WriteConsole(ID,'/ResetStatsID <ID>   - Reset stats player (ID)         |',GOOD);
  345.         WriteConsole(ID,'_______________________________________________________|',GOOD);
  346.     end;
  347.     if (lowercase(Text) = lowercase('/ResetRanks')) then begin
  348.         RestartRank();
  349.         WriteConsole(0,'Restart ranks!',GOOD);
  350.     end;
  351.     Result := false;
  352. end;
  353.  
  354. function OnPlayerCommand(ID: Byte; Text: string): boolean;
  355. begin
  356.     if regExpMatch('^/(resetstats|restartstats)$',lowercase(Text)) then begin
  357.         if (NickStatus[ID] = true) then begin
  358.             ResetPlayerStats(ID);
  359.             WriteConsole(ID,'Restarted your stats!',GOOD);
  360.         end else WriteConsole(ID,'Login to restart your stats!',GOOD);
  361.     end;
  362.     Result := false;
  363. end;
  364.  
  365. procedure OnPlayerKill(Killer, Victim: byte; Weapon: string);
  366. var x: integer;
  367. begin
  368.     if (Killer = Victim) then PlayerStats[Victim].SelfKills := inttostr(strtoint(PlayerStats[Victim].SelfKills) + 1);
  369.     if (killer <> victim) then begin
  370.         if (GetPlayerStat(Killer, 'Active') = true) then begin
  371.             if (GetPlayerStat(Killer,'team')<>GetPlayerStat(Victim,'team')) then begin
  372.                 PlayerStats[Killer].Kills := inttostr(strtoint(PlayerStats[Killer].Kills) + 1);
  373.                 x := Punkty(Killer, Victim);
  374.                 PlayerStats[Killer].Points := inttostr(strtoint(PlayerStats[Killer].Points) + x);
  375.                 PlayerStats[Victim].Points := inttostr(strtoint(PlayerStats[Victim].Points) - x);
  376.             end;
  377.             if (GetPlayerStat(Killer,'team')=GetPlayerStat(Victim,'team')) then begin
  378.                 if (GameStyle = 1) and (GetPlayerStat(Killer, 'Flagger')) then PlayerStats[Killer].TeamKills := inttostr(strtoint(PlayerStats[Killer].TeamKills) +2) else PlayerStats[Killer].TeamKills := inttostr(strtoint(PlayerStats[Killer].TeamKills) + 1);
  379.                 if (GameStyle = 0) or (GameStyle = 1) or (GameStyle = 4) then begin
  380.                     x := Punkty(Killer, Victim);
  381.                     PlayerStats[Killer].Points := inttostr(strtoint(PlayerStats[Killer].Points) + x);
  382.                     PlayerStats[Victim].Points := inttostr(strtoint(PlayerStats[Victim].Points) - x);
  383.                 end;
  384.             end;
  385.         end;
  386.         if (GetPlayerStat(victim, 'Active') = true) then begin
  387.             PlayerStats[Victim].Deaths := inttostr(strtoint(PlayerStats[Victim].Deaths) + 1);
  388.             if (GameStyle = 2) or (GameStyle = 3) or (GameStyle = 5) or (GameStyle = 6) then if (GetPlayerStat(Victim,'Team') = GetPlayerStat(Killer,'Team')) then PlayerStats[Victim].DeathsByTeam := inttostr(strtoint(PlayerStats[Victim].DeathsByTeam) + 1);
  389.         end;
  390.     end;
  391.     UpdateNickname(Killer);
  392.     UpdateNickname(Victim);
  393.     if (GetPlayerStat(killer, 'Active') = true) then if (NickStatus[Killer]) then begin
  394.         if (GetPlayerStat(killer, 'Human') = true) then UpdateRanks(killer);
  395.         SaveRanks();
  396.     end;
  397.     if (GetPlayerStat(Victim, 'Active') = true) then if (NickStatus[Victim]) then begin
  398.         if (GetPlayerStat(Victim, 'Human') = true) then UpdateRanks(Victim);
  399.         SaveRanks();
  400.     end;
  401. end;
  402.  
  403. procedure OnMapChange(NewMap: String);
  404. var i: byte;
  405. begin
  406.     for i := 1 to 32 do if (GetPlayerStat(i, 'Active') = true) then begin
  407.         if (NickStatus[i]) then begin
  408.             if (GetPlayerStat(i,'Human') = true) then UpdateRanks(i);
  409.             SaveRanks();
  410.             UpdateNickname(i);
  411.         end;
  412.     end;
  413. end;
  414.  
  415. procedure PokazTop(const ID: byte);
  416. var i, High: integer;
  417. begin
  418.     if (GetArrayLength(ranks) > 0) then begin
  419.         if (GetArrayLength(ranks) < 5) then high := GetArrayLength(ranks) - 1 else high := 5 - 1;
  420.         WriteConsole(0, 'Top ' + InttoStr(high + 1) + ' ranked players:', GOOD);
  421.         for i := 0 to high do WriteConsole(0, InttoStr(i + 1) + '. ' + ranks[i].HWID + ' - ' + InttoStr(ranks[i].Points) + ' pts.', GOOD);  //By
  422.     end else WriteConsole(ID, 'No players are ranked yet.', BAD);
  423. end;
  424.  
  425. procedure PokazTopID(ID: byte; csa: integer);
  426. var b, High: integer;
  427. begin
  428.     if (GetArrayLength(ranks) > 0) then begin
  429.         if (csa<=30) and (csa>0) then begin
  430.             if (GetArrayLength(ranks) < csa) then high := GetArrayLength(ranks) - 1 else high := csa - 1;
  431.             WriteConsole(ID, 'Top ' + InttoStr(high + 1) + ' ranked players:', GOOD);
  432.             for b := 0 to high do WriteConsole(ID, InttoStr(b + 1) + '. ' + ranks[b].HWID + ' - ' + InttoStr(ranks[b].Points) + ' pts.', GOOD);
  433.         end else WriteConsole(ID,'The maximum top is 30 players.',BAD);
  434.     end else WriteConsole(ID, 'No players are ranked yet.', BAD);
  435. end;
  436.  
  437. procedure RankTXT(ID: byte; text: string);
  438. var b, op: integer; tr: byte;
  439. begin
  440.     if (text = '') then begin
  441.         if (FileExists('nickreg/'+GetPlayerStat(ID, 'HWID')+'.txt') = true) then begin
  442.             if (NickStatus[ID] = true) then begin
  443.                 if (GetArrayLength(ranks) > 0) then for b := 0 to GetArrayLength(ranks) - 1 do if (ranks[b].HWID = GetPlayerStat(ID, 'HWID')) then begin
  444.                     WriteConsole(0,'Player '+GetPlayerStat(ID,'name')+' is a '+InttoStr(b + 1)+' in the ranking of '+PlayerStats[ID].Points+' pts.', GOOD);
  445.                     exit;
  446.                 end;
  447.             end else WriteConsole(ID,'Login to see the stats!',BAD);
  448.         end else WriteConsole(ID,'Please register! For instructions type: !reginfo',BAD);
  449.     end else
  450.     begin
  451.         op := StrToID(Text);    tr := 0;
  452.         if (FileExists('nickreg/'+Text+'.txt') = true) then tr := 1 else if (op = 254) then WriteConsole(ID,'Player not found ('+Text+')',BAD) else if (FileExists('nickreg/'+getPlayerStat(op,'HWID')+'.txt') = true) then tr := 2;
  453.         if (tr = 1) or (tr = 2) then begin
  454.             if (GetArrayLength(ranks) > 0) then for b := 0 to GetArrayLength(ranks) - 1 do if (ranks[b].HWID = iif(tr=1,text,getPlayerStat(op,'HWID'))) then begin
  455.                 if (GetArrayLength(ranks) > b) and (b >= 0) then WriteConsole(ID,'Player '+ranks[b].HWID+' is a '+inttostr(b+1)+' in the ranking of '+InttoStr(ranks[b].Points)+' pts.', GOOD) else WriteConsole(ID,'There is no player in that position in the ranking.',BAD);
  456.             end;
  457.         end;
  458.     end;
  459. end;
  460.  
  461. Procedure Stats(ID: byte);
  462. var i: integer; KD: double;
  463. begin
  464.     if (GameStyle = 2) or (GameStyle = 3) or (GameStyle = 5) or (GameStyle = 6) then begin
  465.         if (strtoint(PlayerStats[ID].Kills) <> 0) and (strtoint(PlayerStats[ID].Deaths) <> 0) then begin
  466.             if (GetArrayLength(ranks) > 0) then for i := 0 to GetArrayLength(ranks) - 1 do if (ranks[i].HWID = GetPlayerStat(ID, 'HWID')) then begin
  467.                 KD := single(strtoint(PlayerStats[ID].Kills)) / single(strtoint(PlayerStats[ID].Deaths));
  468.                 WriteConsole(0,'Rank: ' + InttoStr(i + 1) + '/' + InttoStr(GetArrayLength(ranks)) + ', Points: '+PlayerStats[ID].Points+', K/D: '+FormatFloat('0.00',KD), GOOD);
  469.                 WriteConsole(0,'Kills: '+PlayerStats[ID].Kills+', Death: '+PlayerStats[ID].Deaths+', Selfkills: '+PlayerStats[ID].SelfKills,GOOD);
  470.                 if (FriendlyFire) then WriteConsole(0,'Teamkills: '+PlayerStats[ID].TeamKills+', Killed By Friend: '+PlayerStats[ID].DeathsByTeam,GOOD);
  471.                 exit;
  472.             end;
  473.         end else WriteConsole(ID,'We are sorry for the moment we have too little information about you.',BAD);
  474.     end;
  475.     if (GameStyle = 0) or (GameStyle = 1) or (GameStyle = 4) then begin
  476.         if (strtoint(PlayerStats[ID].TeamKills) <> 0) and (strtoint(PlayerStats[ID].Deaths) <> 0) then begin
  477.             if (GetArrayLength(ranks) > 0) then for i := 0 to GetArrayLength(ranks) - 1 do if (ranks[i].HWID = GetPlayerStat(ID, 'HWID')) then begin
  478.                 KD := single(strtoint(PlayerStats[ID].TeamKills)) / single(strtoint(PlayerStats[ID].Deaths));
  479.                 WriteConsole(0, 'Rank: ' + InttoStr(i + 1) + '/' + InttoStr(GetArrayLength(ranks)) + ', Points: '+PlayerStats[ID].Points+', K/D: '+FormatFloat('0.00',KD), GOOD);
  480.                 WriteConsole(0,'Kills: '+PlayerStats[ID].TeamKills+', Death: '+PlayerStats[ID].Deaths+', Selfkills: '+PlayerStats[ID].SelfKills,GOOD);
  481.                 exit;
  482.             end;
  483.         end else WriteConsole(ID,'We are sorry for the moment we have too little information about you.',BAD);
  484.     end;
  485. end;
  486.  
  487. Procedure StatsOther(ID:byte; Text:string);
  488. var op: integer; temparray: TStringArray; KD: double; i: word;
  489. begin
  490.     op := StrToID(Text);
  491.     if (op = 254) then WriteConsole(ID,'Player not found ('+Text+')',BAD) else begin
  492.         temparray := Explode(ReadFile('nickreg/'+GetPlayerStat(op,'HWID')+'.txt'),CRLF);
  493.         if (GameStyle = 2) or (GameStyle = 3) or (GameStyle = 5) or (GameStyle = 6) then begin
  494.             if (strtoint(temparray[0]) <> 0) and (strtoint(temparray[2]) <> 0) then begin
  495.                 if (GetArrayLength(ranks) > 0) then for i := 0 to GetArrayLength(ranks) - 1 do if (ranks[i].HWID = GetPlayerStat(op,'HWID')) then begin
  496.                     WriteConsole(ID,'Player statistics '+getPlayerStat(op,'Name')+':',GOOD);
  497.                     KD := single(strtoint(temparray[0])) / single(strtoint(temparray[2]));
  498.                     WriteConsole(ID,'Rank: ' + InttoStr(i + 1) + '/' + InttoStr(GetArrayLength(ranks)) + ', Points: '+temparray[5], GOOD);
  499.                     WriteConsole(ID,'Kills: '+temparray[0]+', Death: '+temparray[2]+', Selfkills: '+temparray[4]+', K/D: '+FormatFloat('0.00',KD),GOOD);
  500.                     if (FriendlyFire) then WriteConsole(ID,'Teamkills: '+temparray[1]+', Killed By Friend: '+temparray[3],GOOD);
  501.                     exit;
  502.                 end;
  503.             end else WriteConsole(ID,'Have too enough information about this player.',BAD);
  504.         end;
  505.         if (GameStyle = 0) or (GameStyle = 1) or (GameStyle = 4) then begin
  506.             if (strtoint(temparray[1]) <> 0) AND (strtoint(temparray[2]) <> 0) then begin
  507.                 if (GetArrayLength(ranks) > 0) then for i := 0 to GetArrayLength(ranks) - 1 do if (ranks[i].HWID = GetPlayerStat(op,'HWID')) then begin
  508.                     WriteConsole(ID,'Player statistics '+getPlayerStat(op,'Name')+':',GOOD);
  509.                     KD := single(strtoint(temparray[1])) / single(strtoint(temparray[2]));
  510.                     WriteConsole(ID,'Rank: ' + InttoStr(i + 1) + '/' + InttoStr(GetArrayLength(ranks)) + ', Points: '+temparray[5],GOOD);
  511.                     WriteConsole(ID,'Kills: '+temparray[1]+', Death: '+temparray[2]+', Selfkills: '+temparray[4]+', K/D: '+FormatFloat('0.00',KD),GOOD);
  512.                     exit;
  513.                 end;
  514.             end else WriteConsole(ID,'Have too enough information about this player.',BAD);
  515.         end;
  516.     end;
  517. end;
  518.  
  519. procedure AppOnIdle(Ticks: integer);
  520. begin
  521.     if Ticks mod (3600 * 6) = 0 then WriteConsole(0, 'Enter !reginfo to see command. Information: !contact', GOOD);
  522. end;
  523.  
  524. procedure OnPlayerSpeak(ID: byte; Text: string);
  525. var gracze: TStringArray;
  526. begin
  527.     if regExpMatch('^!(top)$',lowercase(Text)) then PokazTop(ID) else if MaskCheck(lowercase(Text),'!top *') then PokazTopID(ID,strtoint(Copy(Text,6,Length(Text))));
  528.     if regExpMatch('^!(rank)$',lowercase(Text)) then RankTXT(ID,Copy(Text,7,Length(Text))) else if MaskCheck(lowercase(Text),'!rank *') then RankTXT(ID,Copy(Text,7,Length(Text)));
  529.     if regExpMatch('^!(stats|raning|statystyki)$',lowercase(Text)) then Stats(ID) else if MaskCheck(Text,'!stats *') then StatsOther(ID,Copy(Text,8,Length(Text)));
  530.         if regExpMatch('^!(reginfo)$',lowercase(Text)) then begin
  531.         WriteConsole(ID,'____Stats Commands___________________________________________',GOOD);
  532.         WriteConsole(ID,'!stats | !stats <ID,Name,PartName> | !top   | !top <number> |',GOOD);
  533.         WriteConsole(ID,'!rank  | !rank <ID,Name,PartName   | !zitro | /resetstats   |',GOOD);
  534.         WriteConsole(ID,'_______|___________________________|________|_______________|',GOOD);
  535.     end;
  536.     if regExpMatch('^!(autor|author|credit|credits|contact|tworca|info|help|zitrofun|zitro|fun)$',lowercase(Text)) then begin
  537.         WriteConsole(ID,'Author scripts: dominikk26',GOOD);
  538.         WriteConsole(ID,'E-mail: dominikk262@wp.pl',GOOD);
  539.         WriteConsole(ID,YouInfo,GOOD);
  540.         WriteConsole(ID,'Script Version: '+ZitroVersion,GOOD);
  541.         gracze := Explode(ReadFile('nickreg/server/players.db'),CRLF);
  542.         WriteConsole(ID,'Registered players: '+inttostr(GetArrayLength(gracze)-2),GOOD);
  543.     end;
  544. end;
  545.  
  546. Procedure OnJoinTeam(ID, Team: byte);
  547. var i: byte;
  548. begin
  549.     if (GetPlayerStat(ID,'Human') = true) then begin
  550.         for i := 1 to 32 do if (GetPlayerStat(i,'Active') = true) then if (GetPlayerStat(i,'HWID') = GetPlayerStat(ID,'HWID')) and (i<>ID) then begin
  551.             WriteConsole(ID,'Please stop buggs! You can not, go two accounts per server at a time.',BAD);
  552.             WriteConsole(0,'[ZitroFUN] I detected two players with the same HWID, '+GetPlayerStat(i,'Name')+' and '+GetPlayerStat(ID,'Name'),BAD);
  553.             KickPlayer(ID);
  554.         end;
  555.     end;
  556. end;
  557.  
  558. Procedure AutoRegLog(ID: byte);
  559. begin
  560.     if (FileExists('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt') = false) and (GetPlayerStat(ID,'Human') = true) then begin
  561.         AutoSaveNickname(ID);
  562.         LoadNickname(ID);
  563.         WriteConsole(ID,'HWID: ' + GetPlayerStat(ID,'HWID') + ' successfully registered!',GOOD);
  564.         WriteConsole(ID,'Type !reginfo to see the available commands!',GOOD);
  565.         WriteLn('HWIDReg: ' + GetPlayerStat(ID,'name') + ' registered from ' + GetPlayerStat(ID,'HWID'));
  566.         NickStatus[ID] := true;
  567.     end;
  568. end;
  569.  
  570. procedure AutoLogin(ID: byte);
  571. begin
  572.     if (length(getPlayerStat(ID, 'name' )) > 24) then begin
  573.         WriteConsole(ID,'...your name is over 24 characters, please change it.',BAD);
  574.         KickPlayer(ID);     Exit;
  575.     end;
  576.     if (FileExists('nickreg/'+GetPlayerStat(ID,'HWID')+'.txt')=true) then begin
  577.         LoadNickname(ID);
  578.         NickStatus[ID] := true;
  579.         WriteConsole(ID,'Welcome back '+GetPlayerStat(ID,'name')+' (HWID: '+GetPlayerStat(ID,'HWID')+')',GOOD);
  580.         if (NickStatus[ID]) then begin
  581.             if (GetPlayerStat(ID,'Human') = true) then UpdateRanks(ID);
  582.             SaveRanks();
  583.         end;
  584.     end else AutoRegLog(ID);
  585. end;
  586.  
  587. procedure OnJoinGame(ID, Team: byte);
  588. begin
  589.     LoadNickname(ID);
  590.     if (GetPlayerStat(ID,'Human')=True) then AutoLogin(ID);
  591. end;
  592.  
  593. procedure OnLeaveGame(ID, Team: byte; Kicked: boolean);
  594. begin
  595.     if (NickStatus[ID] = true) then begin
  596.         if (GetPlayerStat(ID, 'Human') = true) then UpdateRanks(ID);
  597.         SaveRanks();
  598.         UpdateNickname(ID);
  599.         ResetVar(ID);
  600.     end;
  601. end;
  602.  
  603. procedure ActivateServer();
  604. var b: byte;
  605. begin
  606.     if (ReadINI('soldat.ini','GAME','Friendly_Fire','0') = '1') then FriendlyFire:=true else FriendlyFire:=false;
  607.     if (FileExists('nickreg/server/players.db') = false) then WriteLnFile('nickreg/server/players.db','[PlayersList]');
  608.     WriteConsole(0, 'ZitroFun '+ZitroVersion+' recompiled - successfully :)', $FFFFAA00);
  609.     LoadRanks();
  610.     for b := 1 to 32 do begin
  611.         ResetVar(b);
  612.         if (GetPlayerStat(b,'Active')=true) then begin
  613.             LoadNickname(b);
  614.             AutoLogin(b);
  615.         end;
  616.     end;
  617. end;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement