Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Потрепаться";
Текущий архив: 2004.06.06;
Скачать: [xml.tar.bz2];

Вниз

Покритикуйте код   Найти похожие ветки 

 
Романов Р.В. ©   (2004-05-19 14:29) [0]

type
 TErrorCategory = (ecCriticalError, ecInformation, ecErrorWithContinue,
   ecErrorWithCancel);
 TErrorCategories = array[TErrorCategory] of string;

const
 ErrCategory: TErrorCategories = ("Критическая ошибка", "Информация",
   "Ошибка с продолжением работы", "Ошибка с отменой операции");

type
 TErrorInfo = record
   Time: TDateTime;
   Place, Text: string;
   Category: TErrorCategory;
 end;

 TErrorsLog = class
 private
   FErrors: array of TErrorInfo;
   FCount: Integer;
   FLastErrorCount: Integer;
   FFileName: string;
   FEnabled: Boolean;
   function GetError(Index: Integer): TErrorInfo;
 public
   constructor Create;
   destructor Destroy; override;
   procedure Add(APlace, AText: string; ACategory: TErrorCategory);
   procedure Clear;
   procedure SaveToFile(FName: string; AClear: Boolean = True);
   property Error[Index: Integer]: TErrorInfo read GetError;
   property FileName: string read FFileName write FFileName;
   property Enabled: Boolean read FEnabled write FEnabled;
   property Count: Integer read FCount;
 end;

{ TErrorsLog }

procedure TErrorsLog.Add(APlace, AText: string; ACategory: TErrorCategory);
var
 i: Integer;
begin
 if not FEnabled then
   Exit;
 i := Length(FErrors);
 if FCount >= i then
   SetLength(FErrors, Max(i + 100, Trunc(i * 1.1)));
 with FErrors[FCount] do
 begin
   Time := Now();
   Place := APlace;
   Text := AText;
   Category := ACategory;
 end;
 Inc(FCount);
 Inc(FLastErrorCount);
end;

procedure TErrorsLog.Clear;
begin
 SetLength(FErrors, 0);
 FCount := 0;
 FLastErrorCount := 0;
end;

constructor TErrorsLog.Create;
begin
 FFileName := "";
 FEnabled := True;
 Clear;
end;

destructor TErrorsLog.Destroy;
begin
 if FFileName <> "" then
   SaveToFile(FFileName, False);
 SetLength(FErrors, 0);
 inherited;
end;

function TErrorsLog.GetError(Index: Integer): TErrorInfo;
begin
 if (0 <= Index) and (Index < FCount) then
   Result := FErrors[Index]
 else
   Result.Time := 0;
end;

procedure TErrorsLog.SaveToFile(FName: string; AClear: Boolean = True);
var
 F: TextFile;
 i: Integer;
begin
 if not FEnabled then
   Exit;
 try
   AssignFile(F, FName);
   try
     Rewrite(F);
     for i := 0 to FCount - 1 do
       Writeln(F, Format("%s; %s; %s; %s", [
         FormatDateTime("dd.mm.yyyy hh:nn:zzz", FErrors[i].Time),
           ErrCategory[FErrors[i].Category],
           FErrors[i].Place, FErrors[i].Text]));
     if AClear then
       Clear;
   finally
     CloseFile(F);
   end;
 except
 end;
end;


 
Igorek ©   (2004-05-19 14:42) [1]


> procedure Add...

Лучше Add(something)


>    constructor Create;
>    destructor Destroy; override;

После конст/дест-рукторов я обычно пустую строку ставлю.


> var
>  i: Integer;

I лучше.

>  if FCount >= i then
>    SetLength(FErrors, Max(i + 100, Trunc(i * 1.1)));

Сложные выражения я предпочитаю писать так:

SetLength(
   FErrors,
   Max(
       i + 100,
       Trunc(i * 1.1)
   )
);


> destructor TErrorsLog.Destroy;
> begin
>  if FFileName <> "" then
>    SaveToFile(FFileName, False);
>  SetLength(FErrors, 0);
>  inherited;
> end;

destructor TErrorsLog.Destroy;
begin
 inherited
 ...
end;


>  try
>    AssignFile(F, FName);
>...
>  except
>  end;

Зачем давить ошибки?


 
Игорь Шевченко ©   (2004-05-19 14:42) [2]

Критикую:

try
......
except
end;

Давить в корне.


>  if FCount >= i then
>    SetLength(FErrors, Max(i + 100, Trunc(i * 1.1)));


Смысл такой непонятной конструкции в чем ?


> destructor TErrorsLog.Destroy;
> begin
>  if FFileName <> "" then
>    SaveToFile(FFileName, False);
>  SetLength(FErrors, 0);
>  inherited;
> end;


Может, вместо SetLength(FErrors, 0); вызывать метод Clear ?


 
vuk ©   (2004-05-19 14:53) [3]

Я бы вообще сразу в файл писал...


 
Романов Р.В. ©   (2004-05-19 14:54) [4]


> > procedure Add...
>
> Лучше Add(something)

Не понял... Вместо нескольких параметров использовать рекорд?
> destructor TErrorsLog.Destroy;
> begin
>  inherited
>  ...
> end;

 Как раз наоборот.

Зачем давить ошибки?
Ну это как бы компонент для обработки ошибок и сам он по идее не должен выдавать ошибки. А то может быть зацикливание если работать с ним в Application.OnException.

>  if FCount >= i then
>    SetLength(FErrors, Max(i + 100, Trunc(i * 1.1)));

Смысл такой непонятной конструкции в чем ?

Не увеличивать каждый раз массив на 1, а на 100 элементов или на 10%.


> Может, вместо SetLength(FErrors, 0); вызывать метод Clear
> ?

Помоему тут можно вообще ничего не вызывать


 
Романов Р.В. ©   (2004-05-19 14:58) [5]


> Я бы вообще сразу в файл писал


Я тоже писал. Но решил перейти на более высокий уровень организации логов


 
Игорь Шевченко ©   (2004-05-19 15:04) [6]


> Не увеличивать каждый раз массив на 1, а на 100 элементов
> или на 10%.


RTFS: TList.SetCapacity


> Помоему тут можно вообще ничего не вызывать


Спорный вопрос. Если метод .Clear сделать виртуальным, то следует вызывать, для того, чтобы наследники смогли сделать свою специфическую ошибку. RTFS: TList.Destroy


> Зачем давить ошибки?
> Ну это как бы компонент для обработки ошибок и сам он по
> идее не должен выдавать ошибки. А то может быть зацикливание
> если работать с ним в Application.OnException


Ну вот и надо добиваться, чтобы он не выдавал ошибок. А то ерунда получается - файл не смог создать (места на диске нету), а для пользователя получается, что все хорошо отработало.


 
Goida   (2004-05-19 15:16) [7]

Код плохой, а может и хороший... Если по другому посмотреть...


 
vuk ©   (2004-05-19 15:29) [8]

to оманов Р.В. ©   (19.05.04 14:58) [5]:
>Но решил перейти на более высокий уровень организации логов
Чем же он более высокий? Возможностью потери данных? :o)


 
Mystic ©   (2004-05-19 15:38) [9]

FErrors: array of TErrorInfo;
Напрашивается TList

Trunc(i * 1.1)
Лучше использовать целочисленную арифметику: (i div 10) * 11. А еще лучше просто умножить на 2.

destructor TErrorsLog.Destroy;
begin
if FFileName <> "" then
  SaveToFile(FFileName, False);
SetLength(FErrors, 0);
inherited;
end;

До этого можно не дожить.

try ... except end
Использовать нежелательно.

Пожелания:
1) Держать буфер ошибок и по мере его заполнения скидывать в файл. Предусмотреть Flush
2) Многопоточность
3) Формировать log-файл по имени EXE-файла по умолчанию
4) Создать один экземпляр ErrorLog по умолчанию.


 
вася   (2004-05-19 15:57) [10]

а чем плох try/except ?


 
Mystic ©   (2004-05-19 16:14) [11]

Что не прийдется голову ломать над тем, почему программа не пишет в log-файл. Особенно это приятно в чужом коде, когда программа не выдает ошибки, но и что задумано не делает. Желательно хотя бы

try
except
 ShowMessage(SErrorMsg);
end;


 
panov ©   (2004-05-19 21:52) [12]

Тоже выложит код для ведения журнала, что-ли... Может тоже покритикуют...


 
Игорь Шевченко ©   (2004-05-19 22:05) [13]

panov ©   (19.05.04 21:52)


> Может тоже покритикуют...


Эт завсегда... :)


 
panov ©   (2004-05-19 22:21) [14]

>Романов Р.В. ©   (19.05.04 14:29)
Можно здесь код привести тоже?
Там решены некоторые пожелания от Mystic ©   (19.05.04 15:38) [9]

1) Держать буфер ошибок и по мере его заполнения скидывать в файл. Предусмотреть Flush
2) Многопоточность
3) Формировать log-файл по имени EXE-файла по умолчанию


 
vuk ©   (2004-05-19 22:28) [15]

Без особых претензий на что-то.


unit SimpleLogger;

interface
uses
   SysUtils;

function WriteLog( const FileName, Message : string ) : boolean; overload;
function WriteLog( Message : string ) : boolean; overload;
function WriteLog( const FileName : string; const Fmt : string;
 const Args: array of const ) : boolean; overload;
function WriteLog( const Fmt : string;
 const Args : array of const ) : boolean; overload;
procedure SetDefaultLogFileName( const FileName: string );
procedure LockLogging;
procedure UnlockLogging;

var
 WriteLogTime: boolean = false;
 LogTimeFormat: string = "dd.mm.yyyy hh:nn:ss";

implementation
uses
   SyncObjs;

var
  LoggerSync : TCriticalSection;
  DefaultLog : string;

procedure LockLogging;
begin
 LoggerSync.Acquire;
end;

procedure UnlockLogging;
begin
 LoggerSync.Release;
end;

procedure SetDefaultLogFileName( const FileName: string );
begin
 LoggerSync.Acquire;
 try
   DefaultLog := FileName;
 finally
   LoggerSync.Release;
 end;
end;

function WriteLog( const FileName, Message : string ) : boolean;
var
 F : Text;
 s: string;
begin
 Result := true;

 LoggerSync.Acquire;
 try
   Assign( F, FileName );
   if FileExists( FileName ) then Append( F )
     else Rewrite( F );
   try
     if WriteLogTime then
     begin
       try
         s := FormatDateTime(LogTimeFormat, Now);

       except
         s := "";
       end;
       s := Format("%s %s", [s, Message]);
     end else
       s := Message;
     writeln( F, s );
   finally
     CloseFile( F );
   end;
 finally
   LoggerSync.Release;
 end;
end;

function WriteLog( Message : string ) : boolean;
begin
 Result := WriteLog( DefaultLog, Message );
end;

function WriteLog( const FileName : string; const Fmt : string;
 const Args: array of const ) : boolean;
begin
 Result := WriteLog( FileName, Format( Fmt, Args ));
end;

function WriteLog( const Fmt : string; const Args : array of const ) : boolean;
begin
 Result := WriteLog( DefaultLog, Fmt, Args );
end;

initialization
 LoggerSync := TCriticalSection.Create;
 DefaultLog := ChangeFileExt( ParamStr(0), ".log" );

finalization
 LoggerSync.Free;
end.



 
Игорь Шевченко ©   (2004-05-19 22:36) [16]

vuk ©   (19.05.04 22:28)

Я бы в класс свел :)


 
panov ©   (2004-05-19 22:37) [17]


 TLog = class(TThread)
 private
   fHandleList: THandle;     //Ссылка на корневой элемент списка сообщений
   fBuf: PChar;              //Ссылка на буфер для записи журнала
   cs: RTL_CRITICAL_SECTION; //критическая секция для защиты от одновременной
                             //записи из нескольких потоков(TLog.Write)
   fSemaphore: THandle;      //Семафор для ожидания в TLog.Execute
   fName: String;            //Файл журнала
   fHandle: Integer;         //Дескриптор файла
   fMaxSize: Integer;        //Максимальный размер журнала(Кб)
   fMaxQueue: Integer;       //Максимальный размер очереди незаписанных
                             //на диск сообщений(шт.) (РЕЗЕРВ)
   fArchDir: String;         //Каталог для архивных журналов
                             //Каталог запуска программы+"ArchLog\"
   fNumArch: Integer;
   procedure NewMsg(const aMsg: String); //Постановка в очередь нового сообщения
   procedure DeleteMsg(const p:Pointer); //Удаление из очереди сообщения
   procedure SaveLog;        //Запись строки в журнал
   function Open: Boolean;   //Создание и открытие файла журнала
   procedure Archive;         //Перенос активного журнала в архив
   procedure Close;          //Закрытие файла журнала
 public
   constructor Create(const aPathArchive: String;const aMaxSize:Integer);
   destructor Destroy; override;
   procedure Execute; override;
   procedure Write(s: String); //Процедура для записи в журнал
                               //Доступ из других потоков
   property Semaphore: THandle read fSemaphore; //(РЕЗЕРВ)
 end;

implementation

function pInc(const p:Pointer;const incr: Integer):Pointer;
begin
 Result := Pointer(Integer(p)+incr);
end;

function pDec(const p:Pointer;const decr: Integer):Pointer;
begin
 Result := Pointer(Integer(p)-decr);
end;

function GetValue(const p: Pointer):Pointer;
begin
 Result := Pointer(Integer(p^));
end;

function GetLenMsg(const p: Pointer):Integer;
begin
 Result := Integer(GetValue(pInc(p,8)));
end;

function GetNextAddrMsg(const p: Pointer):Pointer;
begin
 Result := GetValue(pInc(p,4));
end;

function GetPrevAddrMsg(const p: Pointer):Pointer;
begin
 Result := GetValue(p);
end;

function GetRootMsg(const p: Pointer): Pointer;
begin
 Result := p;
 while GetValue(Result)<>nil do Result := GetPrevAddrMsg(Result);
end;

function GetCountMsg(const aHandle: THandle): Integer;
var
 p: Pointer;
begin
 p := Pointer(aHandle);
 Result := Integer(GetValue(pInc(p,8)));
 Exit;
 while p<>nil do
 begin
   Inc(Result);
   p := GetValue(pInc(p,4));
 end;
end;

procedure SetValue(const pAddr,pDest: Pointer);
begin
 Integer(pDest^) := Integer(pAddr);
end;

procedure mv(const aSrc,aDest: Pointer;const Len: Integer);
begin
 Move(aSrc^,aDest^,Len);
end;

function MemComp(const p1,p2:Pointer;const aLen: Integer): Boolean;
var
 i: Integer;
 tp1,tp2: PChar;
begin
 Result := False;
 tp1 := p1;
 tp2 := p2;
 for i := 0 to aLen-1 do
 begin
   if tp1[i]<>tp2[i] then Exit;
 end;
 Result := True;
end;

function GetMsg(const aSrc: Pointer): String;
var
 p: Pointer;
begin
 p := pInc(aSrc,8);
 SetLength(Result,Integer(GetValue(p)));
 p := pInc(p,4);
 Move(p^,Result[1],Length(Result));
end;

function AddMsg(const aHandle: THandle;const aStr: String):Pointer;
var
 p,pn: Pointer;
 Len: Integer;
begin
 p := Pointer(aHandle);
 SetValue( pInc(GetValue(pInc(p,8)),1),pInc(p,8));
 while GetValue(pInc(p,4))<>nil do p := GetValue(pInc(p,4));
 Len := Integer(GetValue(pDec(Pointer(aStr),4)));

 GetMem(pn,Len+12);

 SetValue(pn,pInc(p,4));
 SetValue(p,pn);
 SetValue(nil,pInc(pn,4));
 SetValue(Pointer(Len),pInc(pn,8));

 mv(@aStr[1],pInc(pn,12),Len);
 Result := pn;
end;

function DelMsg(const aSrc: Pointer): Boolean;
var
 pPrev,pNext: Pointer;
begin
 Result := False;
 if GetPrevAddrMsg(aSrc)=nil then Exit;
 if aSrc=nil then Exit;
 pPrev := GetValue(aSrc);
 pNext := GetValue(pInc(aSrc,4));
 if pNext<>nil then
 begin
   SetValue(pPrev,pNext);
 end;
 SetValue(pNext,pInc(pPrev,4));
 FreeMem(aSrc);
 pPrev := GetRootMsg(pPrev);
 SetValue(pInc(GetValue(pDec(pPrev,8)),1),pInc(pPrev,8));
 Result := True;
end;

procedure DelAllMsg(aHandle: THandle);
var
 p: Pointer;
begin
 p := pInc(Pointer(aHandle),4);
 while DelMsg(GetValue(p)) do ;
end;

function CreateList: THandle;
var
 p: Pointer;
begin
 GetMem(p,12);
 SetValue(nil,p);
 SetValue(nil,pInc(p,4));
 SetValue(nil,pInc(p,8));
 Result := Integer(p);
end;

procedure DeleteList(const aHandle: THandle);
begin
 DelAllMsg(aHandle);
 FreeMem(Pointer(aHandle));
end;

function DelBackSlash(const aDirName: String): String;
begin
 Result := aDirName;
 if aDirName="" then Exit;
 if aDirName[Length(aDirName)]="\"
   then Delete(Result,Length(aDirName),1)
   else Exit;
end;



 
panov ©   (2004-05-19 22:37) [18]


constructor TLog.Create(const aPathArchive: String;const aMaxSize:Integer);
var
 i: Integer;
 Len: Integer;
 tS: String;
begin

 inherited Create(True);

 FreeOnTerminate := True;
 InitializeCriticalSection(cs);

 fMaxQueue := 1000;

 fHandleList := CreateList;
 fName := ParamStr(0);
 Len := Length(fName);

 fName[Len] := "g";
 fName[Len-1] := "o";
 fName[Len-2] := "l";

 tS := fName;

 for i := 1 to Len do
 begin
   if tS[i]="\" then tS[i] := "_";
 end;

 fArchDir := DelBackSlash(aPathArchive);
 FMaxSize := aMaxSize;
 fHandle := 0;
 fNumArch := 0;

 fSemaphore := CreateSemaphore(nil,0,High(Integer),PChar("LogThread_"+tS));

 if fSemaphore=0 then Terminate;

 Resume;
end;

procedure TLog.Execute;
var
 Ret: Cardinal;
begin
//  Write("Start Logging");
 while not Terminated do
 begin
   Ret := WaitForSingleObject(fSemaphore,1);
   if Ret = WAIT_OBJECT_0 then
   begin
     SaveLog;
   end;
   if Ret = WAIT_FAILED then break;
 end;
 if Terminated then
 begin
   repeat
     Ret := WaitForSingleObject(fSemaphore,1);
     if Ret = WAIT_OBJECT_0 then
     begin
       SaveLog;
     end;
   until Ret<>WAIT_OBJECT_0;
 end;
end;

procedure TLog.SaveLog;
var
 ResultCount:Cardinal;
 Len:Integer;
 p: Pointer;
 SizeHigh: Int64;
 Size: Integer;
begin
 if fHandle=0 then Open;
 if fHandle=0 then Exit;
 p := GetNextAddrMsg(Pointer(fHandleList));
 if p=nil then Exit;
 Len := GetLenMsg(p);
 fBuf := pInc(p,12);
 if WriteFile(fHandle,fBuf^,Len,ResultCount,nil) then
 begin
   DeleteMsg(p);
 end;
 Size := GetFileSize(fHandle,@SizeHigh);
 if Size>fMaxSize*1024 then
 begin
   Close;
   Archive;
   Open;
 end;
end;

procedure TLog.NewMsg(const aMsg: String);
var
 cnt: Cardinal;
begin
 AddMsg(fHandleList,FormatDateTime("dd.mm.yyyy hh:nn:ss ",now) + aMsg+#13#10);
 ReleaseSemaphore(fSemaphore,1,@cnt);
end;

procedure TLog.DeleteMsg(const p: Pointer);
begin
 DelMsg(p);
end;

procedure TLog.Close;
begin
 CloseHandle(fHandle);
 FHandle := 0;
end;

function TLog.Open: Boolean;
begin
 Result := True;
 fHandle := CreateFile(
            PChar(String(fName)),
            GENERIC_READ+GENERIC_WRITE,
            FILE_SHARE_READ,
            nil,
            OPEN_EXISTING+CREATE_NEW,
            0,
            0);
 if fHandle=0 then
 begin
   Result := False;
   Exit;
 end;
 SetFilePointer(fHandle,0,nil,FILE_END);
end;

procedure TLog.Archive;
var
 fNameAr: String;
 tCount: Integer;
begin
 if not CreateDirPath(fArchDir) then
 begin
   Terminate;
   Exit;
 end;
 fNameAr := FormatDateTime("ddmm_hhmmss.ar",now);

 tCount := 0;
 while tCount<5 do
 begin
   if CopyFile(
        PChar(FName),
        PChar(fArchDir+"\"+FNameAr),
        False) then
   begin
     while not DeleteFile(PChar(FName)) do;
     break;
   end;
   Inc(tCount);
 end;
end;

procedure TLog.Write(s: String);
begin
 EnterCriticalSection(cs);
   NewMsg(s);
 LeaveCriticalSection(cs);
end;

destructor TLog.Destroy;
begin
 DelAllMsg(fHandleList);
 DeleteList(fHandleList);
 CloseHandle(fSemaphore);
 Close;
 DeleteCriticalSection(cs);
 inherited;
end;

function CreateLog(const aPathArchive: String;const aMaxSize:Integer):TLog;
begin
 Result := TLog.Create(aPathArchive,aMaxSize);
end;

procedure CloseLog(const aLog: TLog);
begin
 aLog.Terminate;
end;

procedure WriteLog(const aLog: TLog;const aMsg: String);
begin
 aLog.Write(aMsg);
end;


 
panov ©   (2004-05-19 22:39) [19]

Позволяет писать в журнал из нескольких потоков со скоростью не менее 1000-1500 сообщений в секунду.


 
Vlad ©   (2004-05-19 22:39) [20]


> panov ©   (19.05.04 22:37) [17]

Красиво :-)
Я бы не догадался наследником TThread сделать


 
vuk ©   (2004-05-19 22:40) [21]

Я бы тоже свел. :o) Но на данный момент используется во многих местах, так что пусть пока так. Опять же если в класс сводить, то все функции сделать методами класса. И еще, чтобы вопросов не возникало. Функции возвращают boolean для того, чтобы их можно было с Assert использовать - у меня иногда в отладочной версии бывает написано Assert(WriteLog(...)). Очень удобно все отключать сразу одной галочкой. :o)


 
vuk ©   (2004-05-19 22:42) [22]

Последнее мое собщение - в ответ на

Игорь Шевченко ©   (19.05.04 22:36) [16]
>Я бы в класс свел :)


 
Игорь Шевченко ©   (2004-05-19 22:56) [23]


> Позволяет писать в журнал из нескольких потоков со скоростью
> не менее 1000-1500 сообщений в секунду.


То есть, для каждого потока еще и дополнительный поток для записи в журнал создается ?


 
panov ©   (2004-05-19 22:57) [24]

>Игорь Шевченко ©   (19.05.04 22:56) [23]

Нет, используется один экземпляр класса TLog.


 
panov ©   (2004-05-19 23:05) [25]

Еще одну функцию забыл дописат сюда:

function CreateDirPath(const aDir: String): Boolean;
var
 s: String;
 i: Integer;
begin
 Result := False;
 if aDir="" then Exit;
 i := 0 ;
 while i<Length(aDir) do
 begin
   inc(i);
   if (aDir[i]="\") then
   begin
     if (i>1) then
     begin
       if aDir[i-1]<>":" then
       begin
         if not CreateDirectory(PChar(s),nil) then
         begin
           if GetLastError<>ERROR_ALREADY_EXISTS then Exit;
         end;
       end;
     end;
   end;
   s := s + aDir[i];
 end;
 if not CreateDirectory(PChar(s),nil) then
 begin
   if GetLastError<>ERROR_ALREADY_EXISTS then Exit;
 end;
 Result := True;
end;


 
Игорь Шевченко ©   (2004-05-19 23:07) [26]


> Нет, используется один экземпляр класса TLog.


А какой смысл его от TThread наследовать ?


 
panov ©   (2004-05-19 23:08) [27]

>Игорь Шевченко ©   (19.05.04 23:07) [26]

Смысл в том, что лог ведется в отдельном потоке, не тормозит основной поток.
Выстраивается очередь сообщений для записи на диск.


 
Игорь Шевченко ©   (2004-05-19 23:14) [28]

Я могу сказать, что мне не нравится в коде Романова Р.В. и в коде [18]. Лог вообще-топредусмотрен для фиксации неких событий, поэтому любая буферизация в этом случае чревата, как отметил vuk, потерей данных. Это то место, где скорость не нужна и запись должна быть синхронной с событиями, которые надо фиксировать.


 
panov ©   (2004-05-19 23:20) [29]

>Игорь Шевченко ©   (19.05.04 23:14) [28]

Я писал код дне для протоколирования ошибок(их  - в том числе), но в основном для фиксирования некоторых некритичных событий в программе. -)


 
Aldor ©   (2004-05-20 00:01) [30]

panov © [17], [18]

 Действительно красиво.

 А PChar(String(fName)) <- это зачем?


 
Игорь Шевченко ©   (2004-05-20 00:39) [31]


>    OPEN_EXISTING+CREATE_NEW,


OPEN_ALWAYS

RTFS: Windows.pas


 
Романов Р.В. ©   (2004-05-20 06:42) [32]


> panov ©   (19.05.04 22:37) [18]
> fNameAr := FormatDateTime("ddmm_hhmmss.ar",now);


"ddmm_hhnnss.ar"


> Игорь Шевченко ©   (19.05.04 23:14) [28]
> Лог вообще-топредусмотрен для фиксации неких событий, поэтому
> любая буферизация в этом случае чревата, как отметил vuk,
> потерей данных

Я вообще то хотел сделать сброс в TStream а из него можно было бы писать хоть в файл хоть в мемо. Но все же учту это замечание, думаю сделать флажок прямой записи в файл. Но есть один вопрос по поводу try except. Запись в файл очень даже небезопасная операция и в случае возникновения потока ошибок - несколько сотен штук и наложении на это событие ошибки записи в файл пользователю придется долго закрывать окна с сообщениями об ошибке. А если при ошибке записи в файл выдавать сообщение и отключать запись в файл? Как такой вариант оцените?


> Игорь Шевченко ©   (19.05.04 15:04) [6]
> RTFS: TList.SetCapacity

Насчет SetCapacity думаю не будет пользоваться этим свойством в моем компоненте, поэтому такое как у меня выделение памяти считаю очень даже оправданым. Если в программе много ошибок памяти резервируется больше, если мало меньше. Хотя при прямой записи в файл это не нужно.

Есть идея организовывать иерархию из этих компанентов. Добавить свойство Parent и если он определен, то все ошибки пересылаются этому Parent`у а уж он их накапливает или пишет в свой файл.
Думаю такой вариант будет удобен например когда несколько человек разрабатывают свои компоненты со встроенным TErrorsLog и тестируют, а при использовании их в одном приложении для TErrorsLog этих компонентов назначается Parent - TErrorsLog приложения и они автоматически пишут свои ошибки в лог приложения. Это бред?


 
panov ©   (2004-05-20 09:49) [33]

>Романов Р.В. ©   (20.05.04 06:42) [32]

Писать лучше действительно таким образом, чтобы другие приложения могли читать из файла параллельно...


 
panov ©   (2004-05-20 10:02) [34]

>Романов Р.В. ©   (20.05.04 06:42) [32]

Есть идея организовывать иерархию из этих компанентов. Добавить свойство Parent и если он определен, то все ошибки пересылаются этому Parent`у а уж он их накапливает или пишет в свой файл.

Мне кажется, что можно написать com-сервер, реализующий запись в журнал, тогда можно будет писать протокол сразу с нескольких копьютеров в сети одновременно...


 
Igorek ©   (2004-05-20 10:20) [35]


> destructor TErrorsLog.Destroy;
> begin
>  inherited
>  ...
> end;

Да, я ошибся. Сбило с толку то, что Дельфи создает так деструктор по Ctrl+Shift+C

За что Ю.З. отправили в R/O?


 
Романов Р.В. ©   (2004-05-20 10:38) [36]


> panov ©   (20.05.04 10:02) [34]


Под 98 не будет работать.
И мне кажется что реализация с com-сервером громоздкая. Гараздо проще в случае необходимости отправлять локальный отчет по заданному адресу.


 
Игорь Шевченко ©   (2004-05-20 10:42) [37]

Романов Р.В. ©   (20.05.04 06:42)


> Насчет SetCapacity думаю не будет пользоваться этим свойством
> в моем компоненте, поэтому такое как у меня выделение памяти
> считаю очень даже оправданым. Если в программе много ошибок
> памяти резервируется больше, если мало меньше. Хотя при
> прямой записи в файл это не нужно.


Я подсказал, куда надо посмотреть, чтобы использовать похожий алгоритм, более понятный постороннему читателю.


> Запись в файл очень даже небезопасная операция и в случае
> возникновения потока ошибок - несколько сотен штук и наложении
> на это событие ошибки записи в файл пользователю придется
> долго закрывать окна с сообщениями об ошибке. А если при
> ошибке записи в файл выдавать сообщение и отключать запись
> в файл? Как такой вариант оцените?


Да нет, ошибка при записи в файл обычно одна возникает. Насчет выдачи сообщения и отключении записи в файл, мне идея не нравится тем, что она в принципе сводит на нет весь принцип лога. Можно попробовать автоматически переключить файл (на другой диск, например) и выдать предупреждение о том, что файл протокола был перенаправлен. Если же и эта попытка не увенчается успехом, тогда отключать возможность протоколирования вообще.
Кстати, могу предложить такую идею (успешно внедрена): в случае потока однотипных или одинаковых сообщений, выводить в лог только первое из серии однотипных, а после нее писать фразу вроде "to next line same as above" до первого сообщения, не совпадающего с последним записанным.

> Есть идея организовывать иерархию из этих компанентов. Добавить
> свойство Parent и если он определен, то все ошибки пересылаются
> этому Parent`у а уж он их накапливает или пишет в свой файл.
> Думаю такой вариант будет удобен например когда несколько
> человек разрабатывают свои компоненты со встроенным TErrorsLog
> и тестируют, а при использовании их в одном приложении для
> TErrorsLog этих компонентов назначается Parent - TErrorsLog
> приложения и они автоматически пишут свои ошибки в лог приложения.
> Это бред?


Да нет, не бред, вполне, на первый взгляд, нормальная идея.


 
Романов Р.В. ©   (2004-05-20 11:18) [38]


> Игорь Шевченко ©   (20.05.04 10:42) [37]
> Я подсказал, куда надо посмотреть, чтобы использовать похожий
> алгоритм, более понятный постороннему читателю.


Посмотрел я туда. У меня более простой алгоритм. На что обратить внимание? На то что память резервируется блоками кратными 4? Или то что код увеличения размера вынесен в отдельную процедуру?


> Насчет выдачи сообщения и отключении записи в файл, мне
> идея не нравится тем, что она в принципе сводит на нет весь
> принцип лога. Можно попробовать автоматически переключить
> файл (на другой диск, например) и выдать предупреждение
> о том, что файл протокола был перенаправлен.

Тогда такой вариант. Создаем виртуальный метод обработки этой ошибки. По умолчанию в нем реализован диалог выбора нового файла для лога или его отключение. У программиста существует возможность написать свой обработчик этой ошибки.


> в случае потока однотипных или одинаковых сообщений, выводить
> в лог только первое из серии однотипных, а после нее писать
> фразу вроде "to next line same as above" до первого сообщения,
> не совпадающего с последним записанным.

Хорошая идея. Спасибо.


 
Игорь Шевченко ©   (2004-05-20 11:28) [39]


> Тогда такой вариант. Создаем виртуальный метод обработки
> этой ошибки. По умолчанию в нем реализован диалог выбора
> нового файла для лога или его отключение. У программиста
> существует возможность написать свой обработчик этой ошибки.


Совсем хорошая идея.

Могу поделиться, как сделано в одной из задач у нас.
У нас логгер - это отдельный процесс (сервис), обмен данными с ним происходит через Memory Mapped File или через mailslot, запись в файл, разумеется, прямая, переключение файлов (сложный механизм, каждая подсистема в свой файл может лог писать) и их архивирование происходит автоматически, либо по таймеру, либо по размеру файла лога (задается опцией).
Чем привлекателен такой способ: Если процесс логгера по какой-либо причине умер, то при следующем его запуске сообщения в его буфере сохраняются, и он может записать их без потерь.


 
Романов Р.В. ©   (2004-05-20 12:17) [40]


> Игорь Шевченко ©

Про SetCapacity поясните.


> У нас логгер - это отдельный процесс (сервис),

Это хорошая идея. Если для него разработать компонент для связи с сервесом то один логер можно применять при отадке многих процессов. Гуд.. гуд... есть над чем подумать...



Страницы: 1 2 вся ветка

Форум: "Потрепаться";
Текущий архив: 2004.06.06;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.62 MB
Время: 0.04 c
1-1085514574
CoderX
2004-05-25 23:49
2004.06.06
Имя RichEdit


6-1081625721
Shutov
2004-04-10 23:35
2004.06.06
Компоненты для работы с Bluetooth


14-1084545685
solo
2004-05-14 18:41
2004.06.06
Не читаемый хелп


14-1084859063
WondeRu
2004-05-18 09:44
2004.06.06
Мисс Америка 2004


1-1085486770
Delphin
2004-05-25 16:06
2004.06.06
Как вызвать процедуру





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский