Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2002.07.15;
Скачать: CL | DM;

Вниз

Как объявить процедуру, универсальную для разных объектов?   Найти похожие ветки 

 
Aleksandr ©   (2002-06-28 13:50) [0]

Например, несколько потоков по ходу работы пишут в лог и на странички PageControl. В принципе, у них отличаются только имена файлов лога и номера страничек. Как объявить процедуру, которая бы вызывалась внутри каждого без утомительных упоминаний имен файлов каждый раз и выполняла общие для всех действия?


 
Skier ©   (2002-06-28 13:53) [1]

> Aleksandr
Общий класс-предок ?


 
panov ©   (2002-06-28 14:24) [2]

Я пользуюсь вот таким способом.
Создаю поток (а их можно создать склоько угодно для разных журналов) и в любом месте программы вызываю метод 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.


 
panov ©   (2002-06-28 14:25) [3]

в коде CS - это глобальная TCriticalSection.


 
Aleksandr ©   (2002-06-28 16:00) [4]

Мда... нет, я не тормоз, я другой... Спасибо.



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

Текущий архив: 2002.07.15;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.025 c
1-47270
qd5
2002-06-28 23:52
2002.07.15
Вызов процедуры


14-47755
Val
2002-06-12 12:39
2002.07.15
Дао Программирования


1-47462
qube
2002-07-03 13:56
2002.07.15
Проблемы с XML Schema


14-47699
mph
2002-06-15 14:08
2002.07.15
многопроцессорные системы


1-47557
alxx
2002-06-27 12:11
2002.07.15
Масштаб метафайла