![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как объявить процедуру, универсальную для разных объектов?
Aleksandr © (2002-06-28 13:50:00)Например, несколько потоков по ходу работы пишут в лог и на странички PageControl. В принципе, у них отличаются только имена файлов лога и номера страничек. Как объявить процедуру, которая бы вызывалась внутри каждого без утомительных упоминаний имен файлов каждый раз и выполняла общие для всех действия?
Aleksandr (2002-06-28 16:00:00) [1]Мда... нет, я не тормоз, я другой... Спасибо.
panov (2002-06-28 14:25:00) [2]в коде CS - это глобальная TCriticalSection.
panov (2002-06-28 14:24:00) [3]Я пользуюсь вот таким способом.
Создаю поток (а их можно создать склоько угодно для разных журналов) и в любом месте программы вызываю метод Write:
unit utLog;
interface
uses
classes,Sysutils, windows,FileCtrl;
type
TLog = class(TThread)
private
FName: String;
FHandle: Integer;
FMaxSize: Integer;
procedure Open;
procedure Arhive;
public
constructor Create(aMaxSize:Integer);
destructor Destroy; override;
procedure Execute; override;
procedure Write(s: String);
end;
implementation
uses
ufMain;
constructor TLog.Create(aMaxSize:Integer);
begin
inherited Create(True);
FName := AnsiUpperCase(ParamStr(0));
FName := StringReplace(FName,".EXE",".LOG",[]);
FMaxSize := aMaxSize;
Open;
FreeOnTerminate := True;
Resume;
end;
procedure TLog.Open;
begin
if not FileExists(FName) then
begin
try
FHandle := FileCreate(FName);
finally
FileClose(FHandle);
end;
end;
FHandle := FileOpen(FName,fmOpenReadWrite+fmShareDenyNone);
if FileSeek(FHandle,0,2)>1024*FMaxSize then
begin
FileClose(FHandle);
Arhive;
Open;
end;
end;
procedure TLog.Arhive;
var
fNameAr: String;
begin
try
if not DirectoryExists(ExtractFilePath(ParamStr(0))+"ArchLog") then
begin
ForceDirectories(ExtractFilePath(ParamStr(0))+"ArchLog");
end;
fNameAr := FormatDateTime("ddmm_hhnnss.ar",now);
CopyFile(PChar(FName),PChar(ExtractFilePath(ParamStr(0))+"ArchLog\"+FNameAr),False);
DeleteFile(PChar(FName));
except
end;
end;
procedure TLog.Write(s: String);
var
ps: String;
begin
cs.Enter;
ps := FormatDateTime("dd.mm.yyyy hh:nn:ss ",now) + s+Chr(13)+Chr(10);
FileWrite(FHandle,ps[1],Length(ps));
if FileSeek(FHandle,0,2)>1024*1024 then
begin
FileClose(FHandle);
Arhive;
Open;
end;
cs.Leave;
end;
procedure TLog.Execute;
begin
while not Terminated do
begin
Sleep(1);
end;
end;
destructor TLog.Destroy;
begin
FileClose(FHandle);
inherited;
end;
end.
Skier (2002-06-28 13:53:00) [4]> Aleksandr
Общий класс-предок ?