old/PAS/QWLOG.PAS

USES DOS;
Type TRec = record
  Name    : string[20];
  Frag    : integer;
  Suicide : Word;
  Deaths  : word;
  Other   : array [1..20] of Word;
End;

Type TFile = array [1..20] of TRec;

Var
  inp     : file of TFile;
  cur     : TFile;
  find    : SearchRec;
  logfile : text;
  str     : string;
Function ScanName(Name : string) : boolean;
Var i : byte;
Begin
  ScanName := false;
  for i := 1 to 20 do if cur[i].Name = Name then ScanName := true;
End;
{-----------------------------------------}
Procedure AddName(Name : string);
Var i : byte;
Begin
  i := 1;
  while cur[i].Name <> '' do inc(i);
  if i<>20 then cur[i].Name := Name;
End;
{-----------------------------------------}

Procedure AddFrag(Name : string;Num : ShortInt);
Var i : byte;
Begin
  for i := 1 to 20 do if cur[i].Name = Name then inc(cur[i].Frag,Num);
End;

Procedure AddSuicide(Name:string);
Var i :byte;
Begin
  for i := 1 to 20 do if cur[i].Name = Name then inc(cur[i].Suicide);
End;

Procedure AddDeath(Name:string);
Var i :byte;
Begin
  for i := 1 to 20 do if cur[i].Name = Name then inc(cur[i].Deaths);
End;

Function GetNum(Name:string):integer;
Var i : byte;
Begin
  GetNum := -1;
  for i := 1 to 20 do if cur[i].Name = Name then GetNum := i;
End;

Procedure ReadCurData;
Var i : byte;
Begin
  assign(inp,'qwfrag.dat');
  {$I-}
  Reset(inp);
  if IOResult <> 0 then
    begin
      Rewrite(inp);
      for i := 1 to 20 do with cur[i] do begin
        Name := '';
        Frag := 0;
        Suicide := 0;
        Deaths := 0;
        fillChar(other,sizeof(other),0);
        end;
      end
    else Read(inp,cur);
  {$I+}
End;
{----------------------------------}
Procedure AddOther(Name1,Name2:string);
Var i : integer;
Begin
  i := 1;
  while cur[i].Name <> Name1 do inc(i);
  if i <> 20 then inc(cur[i].Other[GetNum(Name2)]);
End;
{------------------------------------}
Procedure Analyze(str : string);
Var Name1,Name2:string[20];i:integer;
Begin
  name1 := '';
  name2 := '';
  i := 2;
  if (pos('\',str) <> 0) and (length(str) > 3) then
  begin
  while str[i] <> '\' do begin Name1 := Name1 + str[i]; inc(i); end;
  inc(i);
  while str[i] <> '\' do begin Name2 := Name2 + str[i]; inc(i); end;
  if Name1 = Name2 then
   begin
    If not ScanName(Name1) then AddName(Name1);
    AddSuicide(Name1);
    AddFrag(Name1,-1);
    AddOther(Name1,Name2);
   end
  else
   begin
     If not ScanName(Name1) then AddName(Name1);
     If not ScanName(Name2) then AddName(Name2);
     AddFrag(Name1,1);
     AddDeath(Name2);
     AddOther(Name1,Name2);
   end;
   end;
End;
{------------------------------------}
Procedure WriteInfo(Name:string;var fout:text);
Var g,h: integer;spaces:string;
Begin
  g := GetNum(Name);
  WriteLn(fout,'        --- ',cur[g].Name,' ---        ');
  WriteLN(fout);
  WriteLn(fout,'Фрагов:      ',cur[g].Frag);
  WriteLn(fout,'Самоубийств: ',cur[g].Suicide);
  WriteLn(fout,'Смертей:     ',cur[g].Deaths);
  WriteLn(fout,'Убийства : ');
  h := 1;
  while cur[h].Name <> '' do
    begin
      FillChar(Spaces, SizeOf(Spaces), ' ');
      Spaces[0] := Chr(15-length(cur[h].Name));
      WriteLn(fout,'  ',cur[h].Name,spaces,' : ',cur[g].Other[h]);
      inc(h);
    end;
  WriteLn(fout);
End;
{------------------------------------}
Procedure SaveRes;
Var
  o : text;
  l : integer;
  max : integer;
Begin
  Assign(o,'qw.scr');
  Rewrite(o);
  l := 1;
  while cur[l].Name <> '' do begin
    WriteInfo(cur[l].Name,o);
    inc(l);
  end;
  WriteLn(o,'------------==================-------------');
  max := 0;
  l := 1;
  While cur[l].Name <> '' do
    begin
      inc(max,cur[l].Frag);
      inc(l);
    end;
  WriteLn(o,'Всего фрагов: ',Max);
  l := 1;
  max := 0;
  While cur[l].Name <> '' do
    begin
      inc(max,cur[l].Suicide);
      inc(l);
    end;
  WriteLn(o,'Всего самоубийств: ',max);
  l := 1;
  max := 0;
  While cur[l].Name <> '' do
    begin
      inc(max,cur[l].Deaths);
      inc(l);
    end;
  WriteLn(o,'Всего смертей: ',max);
  Close(o);
End;
{SaveRes}
{MainPart}
Begin
  if ParamCount = 0 then begin
  ReadCurData;
  FindFirst('*.log',AnyFile,find);
  While DOSError = 0 do
    begin
      WriteLn('Анализирую файл ',find.name,' ...');
      Assign(LogFile,find.name);
      Reset(LOgFile);
      While not EOF(LogFile) do
        begin
          ReadLn(LogFile,str);
          Analyze(str);
        end;
      Close(LogFile);
      Erase(LogFile);
      FindNext(find);
    end;
  SaveRes;
  Close(inp);
  Rewrite(inp);
  Write(inp,cur);
  Close(inp);
  End
  else if ParamStr(1) <> '/?' then WriteLn('Запустите с параметром /? для помощи')
    else
      begin
        WriteLn('О чем : ');
        WriteLn('  Данная программа поможет пользователям системы Quake World');
        WriteLn('  обобщить и наглядно просмотреть результаты баталий.');
        WriteLn('Использование : ');
        WriteLn('  Запустите программу в каталоге с логами, сделанными при');
        WriteLn('  помощи команды "fraglogfile" на сервере. Программа сгенерирует');
        WriteLn('  файл "qwfrag.dat" в котором содержится вся информация.');
        WriteLn('  После работы программы логи будут удалены в целях предотвращения');
        WriteLn('  дупов, и сгенерирован файл "qw.scr" в который в текстовом виде');
        WriteLn('  будет продемонстрирован результат.');
        WriteLn('Ограничения : ');
        WriteLn('  К сожалению на текущий момент количество игороков лимитировано');
        WriteLn('  20-ю вхождениями.');
      end;
  WriteLn;
  WriteLn('Quake World Frag Log Analyzer ver 1.0');
  WriteLn('           Copyright 1999, Rod Inc. 2:5030/538.33');
End.