old/PAS/Kitten mail Log Viewer/kitlog.pas

Uses Objects, App, Drivers, Menus, Views, CTime, FTN, TKitLog, Dialogs, MsgBox;
type
{TLogInterior}
    PLogInterior         = ^TLogInterior;
    TLogInterior         = object (TScroller)
      Lines:PCollection;
      constructor Init(var R: TRect; SX, SY:PScrollBar;
                       aL:PCollection);
      Procedure   Draw;virtual;
      Destructor  Done;virtual;
    end;
{TLogDialog}
    LogDialogParams      = record
      Hour,Min,SB,RB,ST,RT,SF,RF : longint;
      aProt, aSes       : Pointer;
    end;

    PLogDialog           = ^TLogDialog;
    TLogDialog           = object (TDialog)
      TextLogPath            : PString;
      TxtLog                 : PDOSStream;
      DialData               : LogDialogParams;
      Constructor Init(var Bounds: TRect; ATitle: TTitleStr;aTxtLog:String);
      Procedure   NewLogWnd(OB,OE:LongInt);
      Procedure   HandleEvent(var Event:TEvent);virtual;
      Destructor  Done;virtual;
    end;

    PNodesList           = ^TNodesList;
    TNodesList           = object (TListViewer)
      Log        : PLog;
      CurView    : PCollection;
      DayScroller: PSCrollBar;
      Procedure   FocusItem(Item: Integer);                        virtual;
      Procedure   HandleEvent(var Event: TEvent);                  virtual;
      Procedure   ChangeDay(aD:integer);
      Function    GetText(Item: Integer; MaxLen: Integer): String; virtual;
      Destructor  Done;virtual;
      constructor Init(var Bounds: TRect; ANumCols: Integer;
                           aLogName:FNameStr;
                           AHScrollBar, AVScrollBar: PScrollBar);
    end;
{TKLVApp}
    TKLVApp              = object (TApplication)
      BinaryLog : PString;
      TextLog   : PString;
      Config    : PString;
      Procedure OpenLogWindow(BL,TL:PString);
      Procedure ReadConfig;
      Procedure SaveConfig;
      Function	OptDial:boolean;
      Procedure CheckPaths;
      Procedure Run;                       Virtual;
      Procedure InitStatusLine;            Virtual;
      Procedure InitMenuBar;               Virtual;
      Destructor Done;                     Virtual;
    end;
{------------------------------------------------------------------}
{ I M P L E M E N T A T I O N }
{TKLVApp}
{------------}
Procedure TKLVApp.InitStatusLine;
Var
  R:TRect;
Begin
  GetExtent(R);
  R.A.Y:=R.B.Y-1;
  New(StatusLine,Init(R,
    NewStatusDef(0,10,
      NewStatusKey('~F3~ Открыть лог',kbF3,cmOpen,
      NewStatusKey('~Alt-X~ Выход',kbAltX,cmQuit,
      nil)),
    NewStatusDef(11,12,
      NewStatusKey('Меню работы с файлами',kbNoKey,0,
      nil),
    NewStatusDef(13,14,
      NewStatusKey('Помощь по программе',kbNoKey,0,
      nil),
    nil)))
  ));
End;{TKLVApp.InitStatusLine}
{------------}
Procedure TKLVApp.InitMenuBar;
Var
 R: TRect;
Begin
  GetExtent(R);
  R.B.Y:=R.A.Y+1;
  MenuBar:=New(PMenuBar,Init(R,NewMenu(
    NewSubMenu('~F~ Файл',11,
        NewMenu(
        NewItem('~O~ Открыть','F3',kbF3,cmOpen,hcNoContext,
        NewItem('~X~ Выход','AltX',kbAltX,cmQuit,hcNoContext,
        nil))),
    NewSubMenu('~H~ Помощь',13,
        NewMenu(
        NewItem('~I~ Оглавление','CtrlF1',kbCtrlF1,cmHelp,hcNoContext,
        nil)),
    nil))
  )));
End;{TKLVApp.InitMenuBar}
{---------------------------}
Procedure TKLVApp.OpenLogWindow;
var
 R,RR1,RR2:TRect;
 W:PLogDialog;
 B1,B2:PScrollBar;
 P:PNodesList;
begin

  R.Assign(0,0,30,23);
  W:=New(PLogDialog, Init(R,'Ло',PString(TL)^));
  with W^ do
   begin
     RR1.Assign(28,2,29,15);
     B1:=New(PScrollBar, Init(RR1));
     RR2.Assign(1,14,28,15);
     B2:=New(PScrollBar, Init(RR2));
     Insert(B1);
     Insert(B2);
     R.Assign(1,2,28,14);
     P:=New(PNodesList,Init(R,1,PString(BL)^,B2,B1));
     Insert(P);
     RR1.Assign(1,1,28,2);
     Insert(New(PParamText,Init(RR1,'Session begins: %02d:%02d',2)));

     RR1.Assign(1,15,28,16);
     Insert(New(PParamText,Init(RR1,'Send    bytes: %12d',1)));
     RR1.Assign(1,16,28,17);
     Insert(New(PParamText,Init(RR1,'Recived bytes: %12d',1)));

     RR1.Assign(1,17,28,18);
     Insert(New(PParamText,Init(RR1,'Send    time : %12d',1)));
     RR1.Assign(1,18,28,19);
     Insert(New(PParamText,Init(RR1,'Recive  time : %12d',1)));

     RR1.Assign(1,19,28,20);
     Insert(New(PParamText,Init(RR1,'Send    files: %12d',1)));
     RR1.Assign(1,20,28,21);
     Insert(New(PParamText,Init(RR1,'Recived files: %12d',1)));

     RR1.Assign(1,21,28,22);
     Insert(New(PParamText,Init(RR1,'Flags: %-8s %-8s',2)));
   end;
  W^.SetData(W^.DialData);
  Desktop^.Insert(W);
  P^.ChangeDay(0);
end;{TKLVApp.OpenLogWindow}
{-------------------------------------}
Procedure TKLVApp.CheckPaths;
const
  GG = [cmCancel];
Function Exists:boolean;
var
  fr:boolean;
  tst:TDosStream;
begin
  tst.Init(PString(BinaryLog)^,stOpenRead);
  fr := tst.Status = stOK;
  tst.Done;
  tst.Init(PString(TextLog)^,stOpenRead);
  fr := fr and (tst.Status = stOK);
  tst.Done;
  Exists:=fr;
end;
begin
  if not Exists then
    begin
      repeat
        MessageBox('Пути неверны!',nil,0);
{        DisableCommands(GG);
        EnableCommands(GG);}
         if OptDial then
         begin
           if exists then SaveConfig;
         end
         else
          begin
            Done;
            Halt;
          end;
      until Exists;
    end;
end;{TKLVApp.CheckPaths}
{-------------------------------------}
Procedure TKLVApp.ReadConfig;
const
  GG = [cmCancel];
var
  conf : TDosStream;
  s    : string[128];
begin
  conf.Init('kitlog.dat',stOpenRead);
  if conf.status = stOk then
   begin
     conf.Read(S,128);
     BinaryLog:=NewStr(S);
     conf.Read(S,128);
     TextLog:=NewStr(S);
   end
  else
   begin
{     DisableCommands(GG);
      EnableCommands(GG);}
     if OptDial then
      begin
       CheckPaths;
       SaveConfig;
      end
     else
      begin
        Done;
        Halt;
      end;
   end;
  conf.done;
end;{TKLVApp.ReadConfig}
{-------------------------------------}
Procedure TKLVApp.SaveConfig;
var
  conf:PDOSStream;
begin
  conf:=New(PDosStream,Init('kitlog.dat',stCreate));
  conf^.Write(BinaryLog^,128);
  conf^.Write(TextLog^,128);
  conf^.done;
end;{TKLVApp.ReadConfig}
{-------------------------------------}
Function TKLVApp.OptDial;
var
  R:TRect;
  D:PDialog;
  I:PInputLine;

type
  TOptDialData = record
    binpath : string[128];
    txtpath : string[128];
  end;
const
   Data: TOptDialData = (
     Binpath : 'bhistory.dat';
     TxtPath : 'mailer.log');
begin
  R.Assign(5,6,75,19);
  D:=New(PDialog, Init(R,'Настройка путей'));
  with D^ do
   begin
     R.Assign(1,1,69,3);
     Insert(New(PSTaticText,Init(R,#3'Для работы программы необходимо ввести пути к логам')));
     R.Assign(30,3,65,4);
     I := New(PInputLine, Init(R, 128));
     Insert(i);
     R.Assign(1,3,25,4);
     Insert(New(PLabel,Init(R,'Путь к BinLog''у',I)));
     R.Assign(30,5,65,6);
     I := New(PInputLine, Init(R, 128));     Insert(i);
     R.Assign(1,5,25,6);
     Insert(New(PLabel,Init(R,'Путь к текст. логу',I)));
     R.Assign(7,8,27,10);
     Insert(New(PButton, Init(R,'O~k~',cmOk,bfNormal)));
     R.Assign(42,8,62,10);
     Insert(New(PButton, Init(R,'~О~тменить',cmCancel,bfNormal)));
     SetData(Data);
   end;
 case Desktop^.ExecView(D) of
   cmCancel : OptDial:=false;
 else
   begin
     D^.GetData(Data);
     if BinaryLog <> nil then DisposeStr(BinaryLog);
     BinaryLog:=NewStr(DAta.binpath);
     if TextLog <> nil then DisposeStr(TextLog);
     TextLog:=NewStr(DAta.txtpath);
     optdial:=true;
   end;
 end;
end;{TKLVApp.ReadConfig}
{-------------------------------------}
Procedure TKLVApp.Run;
begin
  ReadConfig;
  CheckPaths;
  OpenLogWindow(BinaryLog,TextLog);
  Inherited Run;
end;{TKLVApp.Run}
{------------}
Destructor TKLVApp.Done;
begin
  if (Binarylog <> nil ) then DisposeStr(BinaryLog);
  if (Config <> nil ) then DisposeStr(Config);
  if (Textlog <> nil ) then DisposeStr(TextLog);
  Inherited Done;
end;{TKLVApp.Done}
{-------------------------------------}
{/TKLVApp}

{TNodesList}
Constructor TNodesList.Init;
begin
  Inherited Init(Bounds,ANumCols,nil, AVScrollBar);
  Log := New(PLog,Init(aLogName,4));
  Log^.Load;
  Log^.SetCurDay;
  SetRange(Log^.CurDay^.GetSesNum);
  CurView := New(PCollection,Init(20,5));
  ChangeDay(0);
  DayScroller := AHScrollBar;
  if (DayScroller<>nil) then DayScroller^.SetParams(Log^.GetDayNum,1,Log^.DayNum,1,1);
end;{TNodesList.Init}
{-------------------------}
Destructor TNodesList.Done;
begin
  CurView^.DeleteAll;
  Dispose(CurView);
  Dispose(Log,Done);
  Inherited Done;
end;{TNodesList.Done}
{-------------------------}
Procedure TNodesList.ChangeDay;
var g:PLogSes;s1,s2:string;
begin
  if (Log<>nil) then
   begin
    FocusItem(0);
    CurView^.DeleteAll;
    Log^.ChangeCurDay(Ad);
    G:=Log^.CurDay^.LogSes;
    SetRange(Log^.CurDay^.GetSesNum);
    if (DayScroller<>nil) then DayScroller^.SetValue(Log^.CurNum+1);
    if (Self.Owner<>nil) then
     begin
      s1:='Лог на ';
      Str(Log^.CurDaY^.Date.tm_mday,s2);
      s1:=s1+s2;
      Str(Log^.CurDaY^.Date.tm_mon,s2);
      s1:=s1+'/'+s2;
      Str(Log^.CurDaY^.Date.tm_year,s2);
      s1:=s1+'/'+s2;
      DisposeStr(PDialog(Self.Owner)^.Title);
      PDialog(Self.Owner)^.Title:=NewStr(S1);
      PDialog(Self.Owner)^.Frame^.Draw;
     end;
    while G <> Nil do
     begin
       CurView^.Insert(G);
       G:=G^.Next;
     end;
    FocusItem(0);
    DrawView;
   end;
end;{TNodesList.ChangeDay}
{-------------------------}
Procedure TNodesList.HandleEvent;
begin
  if Event.What = evKeyDown then
    case CtrlToArrow(Event.KeyCode) of
      kbLeft  : begin ChangeDay(-1);ClearEvent(Event);end;
      kbRight : begin ChangeDay(1);ClearEvent(Event);end;
    end;
  Inherited HandleEvent(Event);
end;{TNodesList.Done}
{-------------------------}
Function TNodesList.GetText;
begin
  GetText:=Copy(AdrToStr(PLogSes(CurView^.At(Item))^.Who),1,MaxLen);
end;{TNodesList.GetText}
{-------------------------}
Procedure TNodesList.FocusItem;
var
  W:PLogDialog;
  g:PLogSes;
begin
  Inherited FocusItem(Item);
  W:=PLogDialog(Self.Owner);
  if (W<>nil) then with W^.DialData do
   begin
    G:=PLogSes(CurView^.At(Focused));
    Hour:=G^.TS.TM_HOUR;
    Min:=G^.TS.TM_min;
    SB:=G^.SB;
    RB:=G^.RB;
    ST:=G^.ST;
    RT:=G^.RT;
    SF:=G^.SF;
    RF:=G^.RF;
    if (aProt<>nil) then DisposeStr(aProt);
    if (Ases<>nil) then DisposeStr(ases);
    aprot:=NewStr(G^.GetProt);
    ases:=NewStr(G^.GetFlag);
    W^.SEtData(W^.DialData);
   end;
end;{TNodesList.GetText}
{/TNodesList}
{-------------------------}

{TLogDialog}
Constructor TLogDialog.Init;
begin
  Inherited Init(Bounds,ATitle);
  TextLogPath:=NewStr(ATxtLog);
  DialData.aProt:=nil;DialData.aSes:=nil;
  TxtLog:=nil;
end;{TLogDialog.Init}
{-------------------------}
Procedure TLogDialog.HandleEvent;
var
  nl : PNodesList;
begin
  if (Event.What = evBroadCast) and (Event.Command = cmListItemSelected) then
    begin
      nl :=PNodesList(Event.InfoPtr);
      NewLogWnd(PLogSes(nl^.CurView^.At(nl^.Focused))^.OL,
                PLogSes(nl^.CurView^.At(nl^.Focused))^.OE);
      ClearEvent(Event);
    end;
  Inherited HandleEvent(Event);
end;{TLogDialog.HandleEvent}
{-------------------------}
Procedure TLogDialog.NewLogWnd;
var
    Ls : PCollection;
    I:Word;
    st2:string;
    W:PDialog;
    R:TRect;
begin
  Ls:=New(PCollection,Init(10,5));

  if (TxtLog=nil) then
    txtlog:=New(PDOSStream,Init(PString(textlogpath)^,stopenread));
  txtlog^.Seek(OB);
  repeat
    i:=0;
     repeat
       inc(i);
       txtlog^.Read(st2[i],1);
       if (txtlog^.Status <> stOK) then
         begin
           Ls^.Insert(NewStr('Ошибка открытия файла'));
           exit;
         end;
     until (I>254) or (st2[I]=#10);
     st2[0]:=chr(i-2);
    if (st2[0]=#0) then Ls^.Insert(NewStr('  ')) else
    Ls^.Insert(NewStr(st2));
  until txtlog^.GetPos>OE;

  R.Assign(1,1,77,22);
  W:=New(PDialog,Init(R,'Лог на сессию'));
  with W^ do
   begin
     GetClipRect(R);
     R.Grow(-1,-1);
     Insert(New(PLogInterior,Init(R,
       StandardScrollBar(sbHorizontal+sbHandleKeyBoard),
       StandardScrollBar(sbVertical+sbHandleKeyBoard),
       Ls)));
   end;
  DeskTop^.ExecView(W);
  W^.Done;
end;{TLogDialog.NewLogWnd}
{-------------------------}
Destructor TLogDialog.Done;
begin
  DisposeStr(TextLogPath);
  if (TxtLog<>nil) then Dispose(TxtLog,Done);
  Inherited Done;
end;{TLogDialog.Done}
{-------------------------}
{/TLogDialog}
{TLogInterior}
Constructor TLogInterior.Init;
begin
  Inherited Init(R,Sx,SY);
  Lines:=Al;
  if (Lines<>nil) then
   begin
     GrowMode := gfGrowHiX+gfGrowHiY;
     SetLimit(128,Lines^.Count-1);
   end;
end;{TLogInterior.Init}
{-------------------------}
Procedure TLogInterior.Draw;
var
 Y:Integer;
 B:TDrawBuffer;
 S:String;
begin
  for Y:=0 to pred(Size.Y) do
   begin
     MoveChar(B,' ',GetColor(1),Size.X);
     if (Y+Delta.Y < Lines^.Count) and (Lines^.At(y+Delta.y)<>nil) then
       begin
         S:= PString(Lines^.At(Y+Delta.Y))^;
         MoveStr(B,Copy(s,Delta.x+1,Length(s)-Delta.x),GetColor(1))
       end;
     WritelINE(0,y,sIZE.x,1,B);
   end;
end;{TLogInterior.Draw}
{-------------------------}
Destructor TLogInterior.Done;
Procedure DelAll(Item: Pointer); far;
begin
  DisPoseStr(Item);
end;{}

begin
  if Lines<>nil then
   begin
    Lines^.ForEach(@DElAll);
    Lines^.DeleteAll;
   end;
  INherited Done;
end;
{/TLogInterior}
{------------------------------------------------------------------}

var
  KLVApp : TKLVApp;
BEGIN
  KLVApp.Init;
  KLVApp.Run;
  KLVApp.Done;
END.