потоки и компонент

← →
alex134 (2003-10-27 23:56) [0]

Разрабатывая свой компонент решил вынести длительное по времени действие по работе с файлами в отдельный поток - TMyThread.
Несмотря на это, при выполнении этого действия программа временно "подвисает" - ее окно не перерисовывается. Почему, ведь за отрисовку окна отвечает гланый поток, а тормоз-действия в другом потоке?
Привожу код потока и компонента.
Поток:

TMyThread = class(TThread) protected procedure Execute; override; public ThrdKey, ThrdMask, ThrdFileName, ThrdDirectory:string; ThrdKeyDelta:longint; ThrdRename:boolean; end;

Компонент:

TMyCoder = class(TComponent) private FKey, FMask, FFileName, FDirectory:string; FRename:boolean; procedure SetFileName(Name:string); procedure SetDirectory(Name:string); protected ThreadObj:TMyThread; public published property Key:string write FKey; property Mask:string read FMask write FMask; property FileName:string read FFilename write SetFilename; property Directory:string read FDirectory write SetDirectory; property RenameFile:boolean read FRename write FRename default true; function Decode(Decode:boolean):integer; end;

Функция выполнения потока:

procedure TMyThread.Execute; var SearchRec: TSearchRec; VFile: file of byte; List1: TStringList; Min, i: smallint; NewName: string; Digit: byte; j: longint; c:char; begin if ThrdDirectory="" then //encoding one file: begin AssignFile(VFile, ThrdFileName); Reset(VFile); if FileSize(VFile)<100 then Min:=FileSize(VFile)-1 else Min:=100; for i:=1 to Min do begin Seek(VFile, i); Read(VFile, Digit); Inc(Digit, ThrdKeyDelta); Seek(VFile, i); Write(VFile, Digit); end; CloseFile(VFile); if ThrdRename then begin NewName:=ExtractFileName(ThrdFileName); for i:=1 to Length(NewName) div 2 do begin if i mod 2 = 0 then begin c:=NewName[i]; NewName[i]:=NewName[Length(NewName)+1-i]; NewName[Length(NewName)+1-i]:=c; end; end; CopyFile(PAnsiChar(ThrdFileName),PAnsiChar(NewName),false); DeleteFile(PAnsiChar(ThrdFileName)); end; end else //encoding directory: begin List1:=TSTringList.Create; if FindFirst(ThrdMask, faAnyFile, SearchRec)=0 then repeat if FileExists(SearchRec.Name) then List1.Add(SearchRec.Name); until FindNext(SearchRec)<>0; for j:=0 to List1.Count-1 do begin ThrdFileName:=List1.Strings[j]; AssignFile(VFile, ThrdFileName); Reset(VFile); if FileSize(VFile)<100 then Min:=FileSize(VFile)-1 else Min:=100; for i:=1 to Min do begin Seek(VFile, i); Read(VFile, Digit); Inc(Digit, ThrdKeyDelta); Seek(VFile, i); Write(VFile, Digit); end; CloseFile(VFile); if ThrdRename then begin NewName:=ExtractFileName(ThrdFileName); for i:=1 to Length(NewName) div 2 do begin if i mod 2 = 0 then begin c:=NewName[i]; NewName[i]:=NewName[Length(NewName)+1-i]; NewName[Length(NewName)+1-i]:=c; end; end; CopyFile(PAnsiChar(ThrdFileName),PAnsiChar(NewName),false); DeleteFile(PAnsiChar(ThrdFileName)); end; end; end; end; {procedure TMyThread.Execute}

← →
Zergling (2003-10-28 07:28) [1]

Показывай уж всю реализацию класса. Где методы Create и Destroy класса TMyCoder. Как класс TMyCoder определяет определят о зовершении потока TMyThread (может он утебя раз 20 запускается :))? Незабывай про блок Try Finalli.

try
Reset(VFile);
if FileSize(VFile)<100 then Min:=FileSize(VFile)-1 else Min:=100;
for i:=1 to Min do
begin
Seek(VFile, i);
Read(VFile, Digit);
Inc(Digit, ThrdKeyDelta);
Seek(VFile, i);
Write(VFile, Digit);
end;
finally
CloseFile(VFile);
end;

← →
alex134 (2003-10-28 10:46) [2]

unit MyCoder;

interface

uses
SysUtils, Classes, Windows;

type

TMyThread = class(TThread)
protected
procedure Execute; override;
public
ThrdKey, ThrdMask, ThrdFileName, ThrdDirectory:string;
ThrdKeyDelta:longint;
ThrdRename:boolean;
end;

TMyCoder = class(TComponent)
private
FKey, FMask, FFileName, FDirectory:string;
FRename:boolean;
procedure SetFileName(Name:string);
procedure SetDirectory(Name:string);
protected
ThreadObj:TMyThread;
public
published
property Key:string write FKey;
property Mask:string read FMask write FMask;
property FileName:string read FFilename write SetFilename;
property Directory:string read FDirectory write SetDirectory;
property RenameFile:boolean read FRename write FRename default true;
function Decode(Decode:boolean):integer;
end;
{результат функции Decode:
0:нет ошибок
1:не задан ключ
2:не задано имя файла или каталога
3:файл не найден
4:каталог не найден}

procedure Register;

implementation

procedure TMyThread.Execute;
var
SearchRec: TSearchRec;
VFile: file of byte;
List1: TStringList;
Min, i: smallint;
NewName: string;
Digit: byte;
j: longint;
c:char;
begin
if ThrdDirectory="" then //encoding one file:
begin
AssignFile(VFile, ThrdFileName);
Reset(VFile);
if FileSize(VFile)<100 then Min:=FileSize(VFile)-1 else Min:=100;
for i:=1 to Min do
begin
Seek(VFile, i);
Read(VFile, Digit);
Inc(Digit, ThrdKeyDelta);
Seek(VFile, i);
Write(VFile, Digit);
end;
CloseFile(VFile);
if ThrdRename then
begin
NewName:=ExtractFileName(ThrdFileName);
for i:=1 to Length(NewName) div 2 do
begin
if i mod 2 = 0 then
begin
c:=NewName[i];
NewName[i]:=NewName[Length(NewName)+1-i];
NewName[Length(NewName)+1-i]:=c;
end;
end;
CopyFile(PAnsiChar(ThrdFileName),PAnsiChar(NewName),false);
DeleteFile(PAnsiChar(ThrdFileName));
end;
end
else //encoding directory:
begin
List1:=TSTringList.Create;
if FindFirst(ThrdMask, faAnyFile, SearchRec)=0 then
repeat
if FileExists(SearchRec.Name) then List1.Add(SearchRec.Name);
until FindNext(SearchRec)<>0;

for j:=0 to List1.Count-1 do
begin
ThrdFileName:=List1.Strings[j];
AssignFile(VFile, ThrdFileName);
Reset(VFile);
if FileSize(VFile)<100 then Min:=FileSize(VFile)-1 else Min:=100;
for i:=1 to Min do
begin
Seek(VFile, i);
Read(VFile, Digit);
Inc(Digit, ThrdKeyDelta);
Seek(VFile, i);
Write(VFile, Digit);
end;
CloseFile(VFile);
if ThrdRename then
begin
NewName:=ExtractFileName(ThrdFileName);
for i:=1 to Length(NewName) div 2 do
begin
if i mod 2 = 0 then
begin
c:=NewName[i];
NewName[i]:=NewName[Length(NewName)+1-i];
NewName[Length(NewName)+1-i]:=c;
end;
end;
CopyFile(PAnsiChar(ThrdFileName),PAnsiChar(NewName),false);
DeleteFile(PAnsiChar(ThrdFileName));
end;
end;
end;
end; {procedure TMyThread.Execute}

procedure TMyCoder.SetFileName(Name: string);
begin
if FileExists(Name) then
FFileName:=Name
else
FFileName:="file not existst!";
end; {procedure TMyCoder.SetFileName(Name: string)}

procedure TMyCoder.SetDirectory(Name: string);
begin
if DirectoryExists(Name) then
FDirectory:=Name
else
FDirectory:="directory not existst!";
end; {procedure TMyCoder.SetDirectory(Name: string)}

function TMyCoder.Decode(Decode:boolean): integer;
var
i:smallint;
KeyDelta:longint;
begin
if Self.FKey="" then
begin
result:=1;
exit;
end;
if (Self.FFileName="") and (Self.FDirectory="") then
begin
result:=2;
exit;
end;

KeyDelta:=0;
for i:=1 to Length(FKey) do inc(KeyDelta, ord(FKey[i]));
if not Decode then KeyDelta:=-KeyDelta;

if FDirectory="" then
begin
if Not FileExists(FFileName) then
begin
result:=3;
exit;
end;
end
else
if Not DirectoryExists(FDirectory) then
begin
result:=4;
exit;
end;

ThreadObj:=TMyThread.Create(true);
ThreadObj.Priority:=tpLowest;
with ThreadObj do
begin
ThrdDirectory:=FDirectory;
ThrdFileName:=FFileName;
ThrdKeyDelta:=KeyDelta;
ThrdRename:=FRename;
ThrdMask:=FMask;
ThrdKey:=FKey;
end;
ThreadObj.Execute;
Result:=0;
end; {function TMyCoder.Decode(Decode:boolean): integer;}

procedure Register;
begin
RegisterComponents("Samples", [TMyCoder]);
end;

end.

← →
Digitman (2003-10-28 11:15) [3]

ThreadObj:=TMyThread.Create(true);
ThreadObj.Priority:=tpLowest;
with ThreadObj do
begin
ThrdDirectory:=FDirectory;
ThrdFileName:=FFileName;
ThrdKeyDelta:=KeyDelta;
ThrdRename:=FRename;
ThrdMask:=FMask;
ThrdKey:=FKey;
Resume; // !!!!
end;
//ThreadObj.Execute; // ???

потоки и компонент Найти похожие ветки