Author Topic: Server Visit  (Read 520 times)

0 Members and 1 Guest are viewing this topic.

Offline soldat-game

  • Camper
  • ***
  • Posts: 360
  • GG: 10210041
Server Visit
« on: June 25, 2017, 05:09:07 am »
Script Name: Server Visit
Script Creator: dominikk26
Script Core: III
Version: 1.0.0
Download: Click Me!
Description:
In contrast to this version https://forums.soldat.pl/index.php?topic=35003
Me version server visits using script core 3 and:
FIX BUG: Cannot Import VARTYPE
FIX BUG: This Week Display, which counted a week since the server started. Now correctly shows from the whole week.
Code:
Code: [Select]
unit ServerVisit;

interface

implementation
const
Patch = 'database.db';
DisplayTime = 1; //Valute in miniutes
var
Today, Week: string;
database: TStringList;

procedure LoadDatabase();
begin
if (File.Exists(Patch)) then database := File.CreateStringListFromFile(Patch) else begin
database := File.CreateStringList();
database.Append('Today 0');
database.Append('Week '+Week+' 0');
database.Append('Total 0');
database.SaveToFile(Patch);
end;
end;

procedure OnDateCheck();
var CurrTim: TDateTime;
begin
CurrTim := date();
if (Today <> FormatDateTime('dddd',CurrTim)) then begin
database[0] := 'Today 0';
Today := FormatDateTime('dddd',CurrTim);
if (Today = GetPiece(GetPiece(database[1],' ', 1),' ', 0)) then database[1] := 'Week '+Week+' 0';
database.SaveToFile(Patch);
end;
end;

function FillWith(const Filler: char; Amount: integer): string;
var i: integer;
begin
for i:= 1 to Amount do Result:= Result + Filler;
end;

procedure CreateBox(const Headline: string; const BorderStyleX, BorderStyleY, CornerStyle: char; const Content: array of string; BorderColor: longint); //By Dominik
var i, MaxSize, len_Headline: integer;
begin
len_Headline:= length(Headline);
MaxSize := len_HeadLine;
for i:= 0 to ArrayHigh(Content) do if (length(Content[i]) > MaxSize) then MaxSize:= length(Content[i]);
if ((MaxSize - len_Headline) mod 2 = 1) then MaxSize := MaxSize+1;
Players.WriteConsole(CornerStyle + FillWith(BorderStyleX, (MaxSize - len_Headline) div 2) + Headline + FillWith(BorderStyleX, (MaxSize - len_Headline) div 2) + CornerStyle, BorderColor);
for i:= 0 to GetArrayLength(Content) - 1 do Players.WriteConsole(BorderStyleY + Content[i] + FillWith(' ', MaxSize - length(Content[i])) + BorderStyleY, BorderColor - ((i + 1) * 25));
Players.WriteConsole(CornerStyle + FillWith(BorderStyleX, MaxSize) + CornerStyle, BorderColor - ((i + 1) * 25));
end;

procedure Timers(Ticks: integer);
var Visits: array [0..2] of string;
begin
if (Ticks mod (3600 * DisplayTime) = 0) then begin
OnDateCheck();
Visits[0]:= 'Today    : '+GetPiece(database[0],' ', 1);
Visits[1]:= 'This week: '+GetPiece(database[1],' ', 2);
Visits[2]:= 'Over-all : '+GetPiece(database[2],' ', 1);
CreateBox('_ Server Visits _', '_', '|', '.', Visits, $23DBDB)
end;
end;

procedure JoinGame(Player: TActivePlayer; Team: TTeam);
begin
database[0] := 'Today '+inttostr(strtoint(GetPiece(database[0],' ',1))+1);
database[1] := 'Week '+Week+' '+inttostr(strtoint(GetPiece(database[1],' ',2))+1);
database[2] := 'Total '+inttostr(strtoint(GetPiece(database[2],' ',1))+1);
database.SaveToFile(Patch);
end;

procedure ScriptDecl();
begin
Game.OnJoin := @JoinGame;
Game.OnClockTick := @Timers;
end;

procedure ScriptRecompile();
var CurrTim: TDateTime;
begin
Week := FormatDateTime('dddd',42911);
LoadDatabase();
CurrTim:=date();
Today := FormatDateTime('dddd',CurrTim);
end;

initialization
begin
ScriptDecl();
ScriptRecompile();
end;

finalization;
end.
Hey, I wrote messages on these topics (https://forums.soldat.pl/index.php?topic=45088.0
https://forums.soldat.pl/index.php?topic=45068.0), about deleting this message in this topic.
https://forums.soldat.pl/index.php?topic=45088.0

"So nothing was done hahahahahaha" Rekt admins remove this all time why? It does not break the rules.