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.