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

Вниз

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

← →
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;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.46 MB
Время: 0.011 c