Форум: "Основная";
Текущий архив: 2004.10.17;
Скачать: [xml.tar.bz2];
ВнизПомогите с теорией, как организовать работу объекта. Найти похожие ветки
← →
Aleksandr. (2004-10-04 14:33) [0]Сейчас у меня есть объект-потомок TObjectList. Его задача - хранить в себе уникальные имена файлов, сгенерированные за последние 2 минуты.
TATIFileItem = class
FileName : string;
FileTime : TDateTime;
constructor Create(AName : string);
end;
TATIFileItemList = class (TObjectList)
private
function Get(Index: integer): TATIFileItem;
procedure Put(Index: integer; const Value: TATIFileItem);
procedure DoCheckTimes;
public
function Add(Item : TATIFileItem) : integer;
function IndexOf(AName : string) : integer;
property Items[Index : integer] : TATIFileItem read Get write Put;
end;
function TATIFileItemList.Add(Item: TATIFileItem): integer;
begin
EnterCriticalSection(GFCS);
try
DoCheckTimes;
Result:=Inherited Add(Item)
finally
LeaveCriticalSection(GFCS)
end
end;
procedure TATIFileItemList.DoCheckTimes;
var
i : integer;
begin
i:=0;
while i<Count do begin
if IncMinute(Items[i].FileTime,2)<Now then
Delete(i)
else
inc(i)
end
end;
function TATIFileItemList.Get(Index: integer): TATIFileItem;
begin
Result:=TATIFileItem(Inherited GetItem(Index))
end;
function TATIFileItemList.IndexOf(AName: string): integer;
var
i : integer;
begin
EnterCriticalSection(GFCS);
try
Result:=-1;
for i:=0 to Count-1 do begin
if ANSISameText(Items[i].FileName,AName) then begin
Result:=i;
Break
end
end
finally
LeaveCriticalSection(GFCS)
end
end;
procedure TATIFileItemList.Put(Index: integer; const Value: TATIFileItem);
begin
Inherited Put(Index,Value)
end;
{ TATIFileItem }
constructor TATIFileItem.Create(AName: string);
begin
FileName:=AName;
FileTime:=Now
end;
В секции initialization объект создается, в finalization уничтожается. Вся работа с ним происходит только в одной глобальной функции:
function SetUnickNameByExt(var FileName : string) : boolean;
var
Ext : TFileExt;
S : string;
TrC : byte;
const
LetArray : array [1..36] of char=("A","B","C","D","E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S","T",
"U","V","W","X","Y","Z","0","1","2","3","4","5","6","7","8","9");
begin
Result:=true;
if FileName="" then
Exit;
FileName:=ANSIUpperCase(FileName);
Ext:=ExtractFileExt(FileName);
if Byte(Ext[0])=0 then
Ext:=".000"
else while Byte(Ext[0])<4 do
Ext:=Ext+"0";
Ext:=ReplaceChar(Ext," ","0");
trc:=0;
s:=Ext[1]+Ext[2]+LetArray[Random(36)+1]+LetArray[Random(36)+1];
FileName:=ChangeFileExt(FileName,s);
while (ATIFileItemList.IndexOf(FileName)>-1) OR FileExists(FileName) do begin
repeat
inc(Trc);
s:=Ext[1]+Ext[2]+LetArray[Random(36)+1]+LetArray[Random(36)+1];
FileName:=ChangeFileExt(FileName,s);
until (NOT FileExists(FileName)) OR (TrC=FilesTryCount);
if TrC=FilesTryCount then
repeat
case Ext[4] of
#48..#56,
#65..#89,
#192..#222 : Inc(Ext[4]); { "0".."8", "A".."Y" , "À".."ß"}
#57 : Ext[4]:="A"; { "9" }
#90 : Ext[4]:="À"; //Russian A
#223 : begin { "Z" }
Ext[4]:="0";
case Ext[3] of
#48..#56,
#65..#89,
#192..#222 : Inc(Ext[3]); { "0".."8", "A".."Y" , "À".."ß"}
#57 : Ext[3]:="A"; { "9" }
#90 : Ext[3]:="À";
#223 : Result:=false
end
end
end;
FileName:=ChangeFileExt(FileName,Ext);
until not FileExists(FileName) or not Result;
if Not Result then
Break;
end;
if Result then
ATIFileItemList.Add(TATIFileItem.Create(FileName))
end;
Не знаю, насколько механизм красив, но в целом он действует. Есть одна проблема - ночью программа, его использующая, фактически простаивает, а незадолго до простоя она в течение меньше чем за минуту добавляет несколько тысяч значений в этот объект. И, так как обработчик проверяет время своих элементов только при добавлении новых, программа всю ночь эти значения держит при себе. Для их постоянной проверки нужен потомок от TThread. Я попытался сделать просто - включил этот объект в приват потомка от TThread, у которого два метода новых - IndexOf и Add, всего лишь "надстройки" над методами объекта с приватной же критической секцией вместо глобальной (из методов TATIFileItemList убрана), соответственно, в глобальной процедуре обращения к этому потоку, и перекрытый Execute:
function TFileListThread.IndexOf(aName : string) : integer;
begin
EnterCriticalSection(FGFCS);
try
Result:=FFileList.IndexOf(aName)
finally
LeaveCriticalSection(FGFCS)
end
end;
function TFileListThread.Add(aItem : TATIFileItem) : integer;
begin
EnterCriticalSection(FGFCS);
try
Result:=FFileList.Add(TATIFileItem)
finally
LeaveCriticalSection(FGFCS)
end
end;
procedure TFileListThread.Execute;
begin
repeat
FFileList.DocheckTimes;
Sleep(10)
until Terminated
end;
И что-то так фигово это стало работать!.. Все тормозило, память моментально испарялась, Delphi выскакивала в Debug CPU. Что тут неправильно сделано было?
← →
Sandman25 © (2004-10-04 14:38) [1]ИМХО неправильно проверять в цикле, тем более каждые 10мс. Ну и пусть себе висят "вчерашние" данные, кому они мешают?
← →
Aleksandr. (2004-10-04 14:47) [2]Sandman25 © :
Мне. На сервере с программой побывал один из тех бездельников, что именуются бессмысленным словом "сисадмин", и после него с программой начались чудеса - как и прежде, оперативку она освобождает после окончания работы с объектами (данные с Process Explorer - Virtual Size я называю виртуальной памятью, а Working Set - оперативкой), а вот виртуальная память у нее копится, и в районе Virtual Size=240 метров и Working Set=12 метров (второе сколько и при запуске) она со ссылкой на нехватку памяти для запуска новых потоков перестает работать, причем случается это сразу утром.
← →
Erik1 © (2004-10-04 14:49) [3]Я за тебя твой код отлаживать небуду, но коекакие рекомендации дам. Твой класс TATIFileItem излишен замени его на
RATIFileItem = record
FileName : ShortString;
FileTime : TDateTime;
end;
и создовай с помощю New уничтожай Dispose. Тогда можно будет использовать TThreadSafeList
TThreadSafeList = class
private
FLock: TMultiReadExclusiveWriteSynchronizer;
FItems: TList;
function GetCount: Integer;
function GetItem(Index: Integer): Pointer;
public
constructor Create;
destructor Destroy; override;
procedure BeginRead;
procedure EndRead;
procedure BeginWrite;
procedure EndWrite;
function IndexOf(Item: Pointer): Integer;
function Add(Item: Pointer): Integer;
procedure Clear;
property Count: Integer read GetCount;
property Items[Index: Integer]: Pointer read GetItem; default;
end;
...........
function TThreadSafeList.GetCount: Integer;
begin
BeginRead;
try
Result := FItems.Count;
finally
EndRead;
end;
end;
Или чтото вроде этого.
← →
Erik1 © (2004-10-04 14:54) [4]Ну и запускатся стоит с интервалом в 2 минуты = 2*60*1000 mc
Также в execute непрлохо поставить функцию ожидания WaitForMultiObject(...,2*60*1000) и предусмотреть event для выхода из программы. У тебя наверника стек переполняется.
← →
Aleksandr. (2004-10-04 15:13) [5]Erik1 © :
>> У тебя наверника стек переполняется.
Да, разумеется, раз Дебаг ЦПУ вылетает. Только не силен я понять технологию, по которой он переполняется.
← →
Erik1 © (2004-10-04 15:55) [6]А ты перепиши все, да с соблюбением рекомендаций по написанию тредов и использованием TMultiReadExclusiveWriteSynchronizer. Глядиш все и заработает.
← →
Defunct © (2004-10-04 18:03) [7]> И, так как обработчик проверяет время своих элементов только при добавлении новых, программа всю ночь эти значения держит при себе.
Почему нельзя воспользоваться обычным таймером?
Страницы: 1 вся ветка
Форум: "Основная";
Текущий архив: 2004.10.17;
Скачать: [xml.tar.bz2];
Память: 0.49 MB
Время: 0.031 c