Форум: "Основная";
Текущий архив: 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" , "&#192;".."&#223;"}
          #57         : Ext[4]:="A";          { "9" }
          #90         : Ext[4]:="&#192;"; //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" , "&#192;".."&#223;"}
                            #57         : Ext[3]:="A";          { "9" }
                            #90         : Ext[3]:="&#192;";
                            #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.046 c