Форум: "Начинающим";
Текущий архив: 2013.07.28;
Скачать: [xml.tar.bz2];
ВнизРабота с потоком как организовать? Найти похожие ветки
← →
Xmen (2012-11-21 15:15) [0]Привет мастерам.
Есть форма в котором подготавливается файл для отправки в филиал (типа почтовый клиент). Выбирается файл или несколько файлы для отправки. после нажатия кнопки отправки файл архивируется и пери именуется по шаблону и помешается в папку для отправки. Каждый 5 минут проверяется папка приёма файлов если там есть файл то он перемешается в нужную папку. Теперь вопрос как можно сделать так чтобы приём файла была в отдельном потоке и пака принимается файл не зависала программа.
← →
DVM © (2012-11-21 15:27) [1]
> Теперь вопрос как можно сделать так чтобы приём файла была
> в отдельном потоке и пака принимается файл не зависала программа.
>
Создать поток и перенести код приема туда? В чем вопрос непонятно.
← →
Xmen (2012-11-21 15:38) [2]Пару раз из примеров взял код выполнил не получился. Потоки для меня все еще не понятен.
← →
DVM © (2012-11-21 15:56) [3]
> Xmen (21.11.12 15:38) [2]
"Multithreading - The Delphi Way"
"Многопоточность - как это делается в Дельфи"
Martin Harvey.
Version 1.1a
http://forum.vingrad.ru/topic-60076.html
Подробнее уж некуда. Там и с примерами и т.д.
← →
Xmen (2012-11-27 15:18) [4]по примерам из статьи сделал простую прогу. 3 кнопки 1 и 2 для проверки формы а 3 для копирования в потоке. Файлы по 4 гига после каждого копирования должно менятся капшен в 2 лейбеле.
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Label2: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses myTread;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
label1.Caption:="Button 1";
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
label1.Caption:="Button 2";
end;
procedure TForm1.Button3Click(Sender: TObject);
var myThd: myTr;
begin
myThd := myTr.Create(True);
myThd.FreeOnTerminate := True;
try
myThd.Resume;
except on EConvertError do
begin
myThd.Free;
ShowMessage("Ne poluchaetsya skachat!");
end;
end;
end;
end.
unit myTread;
interface
uses
Forms, SysUtils, Windows, Classes;
type
myTr = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
implementation
uses main;
procedure myTr.Execute;
var path:string;
begin
path:= ExtractFilePath(Application.ExeName);
Form1.label2.Caption:="start";
copyfile(PChar(path+"1\1.avi"),PChar(path+"2\1.avi"),false);
Form1.label2.Caption:="2";
copyfile(PChar(path+"1\2.avi"),PChar(path+"2\2.avi"),false);
Form1.label2.Caption:="3";
copyfile(PChar(path+"1\3.avi"),PChar(path+"2\3.avi"),false);
Form1.label2.Caption:="end";
end;
end.
← →
Amoeba_ (2012-11-27 15:42) [5]
> procedure myTr.Execute;
> var path:string;
> begin
> path:= ExtractFilePath(Application.ExeName);
> Form1.label2.Caption:="start";
> copyfile(PChar(path+"1\1.avi"),PChar(path+"2\1.avi"),false);
>
> Form1.label2.Caption:="2";
> copyfile(PChar(path+"1\2.avi"),PChar(path+"2\2.avi"),false);
>
> Form1.label2.Caption:="3";
> copyfile(PChar(path+"1\3.avi"),PChar(path+"2\3.avi"),false);
>
> Form1.label2.Caption:="end";
> end;
RTFM! То, что подчеркнуто есть обращение к VCL, а к ней обращаться напрямую из Execute потока нельзя!
← →
Xmen (2012-11-27 15:45) [6]Спасибо.
Как можно обращаться?
← →
Amoeba_ (2012-11-27 15:47) [7]
> Как можно обращаться?
Посылкой сообщения или через Synchronize.
Читай букварь.
← →
Amoeba_ (2012-11-27 15:51) [8]
> Как можно обращаться?
Это ты хоть прочел?
http://forum.vingrad.ru/topic-60076.html
См. главу 3.
← →
Xmen (2012-11-27 16:16) [9]код изменил вроде меняется лейбел но кое что не хватает. Наверно прогрессбар. его тоже так можно управлять?
капшн лайбла сделал 0
procedure myTr.UpdateCaption;
begin
Form1.Label2.Caption := IntToStr(strtoint(Form1.Label2.Caption)+1);
end;
procedure myTr.Execute;
var path:string;
begin
path:= ExtractFilePath(Application.ExeName);
copyfile(PChar(path+"1\1.avi"),PChar(path+"2\1.avi"),false);
Synchronize(UpdateCaption);
copyfile(PChar(path+"1\2.avi"),PChar(path+"2\2.avi"),false);
Synchronize(UpdateCaption);
copyfile(PChar(path+"1\3.avi"),PChar(path+"2\3.avi"),false);
Synchronize(UpdateCaption);
← →
Медвежонок Пятачок © (2012-11-27 16:43) [10]классный класс myTr
обязательно должен быть жив экземпляр класса TForm1
Обязательно ссылка на него должна лежать в переменной Form1
Обязательно на форме должен быть label2
Обязательно в лейбле должна быть строка с валидным целым.
по моему, даже индусы так не умеют.
← →
Xmen (2012-11-30 10:23) [11]не пинайте сильно вот код рабочий но поток не правильно получился :(
отправка и скачка из FTP в потоке
unit FTPThread;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs, shellapi, variants, ftpsend, blcksock, Main;
type
MyThread = class(TThread)
private
{ Private declarations }
TotalBytes, CurrentBytes: integer;
FTPClient: TFTPSend;
FTPStatus:integer;
protected
procedure Execute; override;
procedure Refresh;
procedure SendFTP;
procedure RecvFTP;
procedure LogFTP;
procedure LogoutFTP;
end;
implementation
procedure MyThread.LogFTP;
begin
FTPClient:=TFTPSend.Create;
FTPClient.TargetHost:="xx.xx.xx.xx";
FTPClient.TargetPort:="21";
FTPClient.UserName:="xxxxx";
FTPClient.Password:="xxxxx";
FTPClient.PassiveMode:=True;
if FTPClient.Login then FTPStatus:=1 else FTPStatus:=0;
end;
procedure MyThread.LogoutFTP;
begin
if FTPStatus=1 then
begin
FTPClient.Logout;
FTPClient.Free;
end;
end;
procedure MyThread.SendFTP;
var dn, i, j:integer;
F: TSearchRec;
MyFile:TextFile;
newFile, ftpFileName:string;
ftpFileSize:Integer;
begin
LogFTP;
if FTPStatus=1 then
if Form1.ListView3.Items.Count>0 then
begin
i:=0;
Form1.Memo1.Lines.Add("Îòêðûò ñîåäèíåíèå ñ ñåðâåðîì");
dn := FindFirst(path+"Send\*.*",faArchive,F);
while dn = 0 do
begin
TotalBytes :=F.Size;
newFile:=copy(f.Name,1,Length(f.Name)-4)+".crc";
if not FileExists(path+"Send\"+newFile) then
begin
AssignFile(MyFile,path+"Send\"+newFile);
try
Rewrite(MyFile);
Write(MyFile,TotalBytes);
finally
CloseFile(MyFile);
FTPClient.DataStream.LoadFromFile(path+"Send\"+newFile);
FTPClient.StoreFile(ExtractFileName(FTPClient.GetCurrentDir+"Send/"+NewFile), false);
end;
end
else
begin
FTPClient.DataStream.LoadFromFile(path+"Send\"+newFile);
FTPClient.StoreFile(ExtractFileName(FTPClient.GetCurrentDir+"Send/"+NewFile), false);
end;
FTPClient.DSock.OnStatus := SockPutCallBack;
FTPClient.DataStream.LoadFromFile(path+"Send\"+f.Name);
Form1.Memo1.Lines.Add("Îòïðàâêà ôàéëà: " + f.Name+" Ðàçìåð: " + IntToStr(TotalBytes));
if FTPClient.StoreFile(ExtractFileName(FTPClient.GetCurrentDir+"Send/"+f.Name), false) = true then
begin
FTPClient.List(FTPClient.GetCurrentDir+"/Send/",false);
for j := 0 to FTPClient.FtpList.Count-1 do
begin
ftpFileName:= FTPClient.FtpList[j].FileName ;
ftpFileSize:= FTPClient.FileSize(FTPClient.GetCurrentDir+"Send/"+FTPClient.FtpList[j].FileName);
if (ftpFileName=f.Name) and (TotalBytes = ftpFileSize) then
begin
Form1.Memo1.Lines.Add("Çàãðóæåí ôàéë: "+F.Name+" âðåìÿ çàêà÷êè: "+datetimetostr(NOW));
inc(i);
DeleteFile(path+"Send\"+f.Name);
DeleteFile(path+"Send\"+NewFile);
Break;
end;
end;
end
else Form1.Memo1.lines.add("Îøèáêà îòïðàâêè");
dn := FindNext(F);
end;
Form1.Memo1.Lines.Add("Óñïåøíî çàêà÷àííûõ ôàéëîâ: "+inttostr(i));
Form1.Memo1.Lines.Add("Çàêðûò ñîåäèíåíèå ñ ñåðâåðîì");
end;
LogoutFTP;
end;
procedure MyThread.RecvFTP;
var i:integer;
begin
LogFTP;
if FTPStatus=1 then
begin
FTPClient.List(FTPClient.GetCurrentDir+"/Recv/",false);
if FTPClient.FtpList.Count>0 then
begin
Form1.Memo1.Lines.Add("Îòêðûò ñîåäèíåíèå ñ ñåðâåðîì");
for i := 0 to FTPClient.FtpList.Count-1 do
begin
try
FTPClient.DSock.OnStatus := SockGetCallBack;
TotalBytes := FTPClient.FileSize(FTPClient.GetCurrentDir+"Recv/"+FTPClient.FtpList[i].FileName);
Form1.Memo1.Lines.Add("Ïðå¸ì ôàéëà: " + FTPClient.FtpList[i].FileName+" Ðàçìåð: " + IntToStr(TotalBytes));
if FTPClient.RetrieveFile(FTPClient.GetCurrentDir+"Recv/"+FTPClient.FtpList[i].FileName,false) = true then
begin
FTPClient.DataStream.SaveToFile(path+"\Recv\"+FTPClient.FtpList[i].FileName);
FTPClient.DeleteFile(FTPClient.GetCurrentDir+"Recv/"+FTPClient.FtpList[i].FileName);
Form1.Memo1.Lines.Add("Ñêà÷àí ôàéë: "+FTPClient.FtpList[i].FileName+" âðåìÿ: "+datetimetostr(NOW));
RecvFile(FTPClient.FtpList[i].FileName);
end
else Form1.Memo1.lines.add("Îøèáêà ñêà÷êè");
Form1.ProgressBar2.Position := Form1.ProgressBar2.Position + 1;
except
on E: Exception do ShowMessage("Îøèáêà ïðè ñêà÷èâàíèè ôàéëà %s"#13#10"class:%s"#13#10"%s"+FTPClient.FtpList[i].FileName);
end;
end;
Form1.Memo1.Lines.Add("Óñïåøíî ñêà÷àííûõ ôàéëîâ: "+inttostr(FTPClient.FtpList.Count));
Form1.Memo1.Lines.Add("Çàêðûò ñîåäèíåíèå ñ ñåðâåðîì");
end;
end;
LogoutFTP;
Form1.RzShellList3.Folder.PathName:=dirinput;
end;
procedure MyThread.Refresh;
begin
if Form1.ListView3.Items.Count>0 then
begin
Form1.Timer1.Enabled:=False;
SendFTP;
Form1.Timer1.Enabled:=True;
end;
if Form1.ListView2.Items.Count>0 then
begin
Form1.Timer1.Enabled:=False;
RecvFTP;
Form1.Timer1.Enabled:=True;
end;
end;
procedure MyThread.Execute;
begin
FreeOnTerminate:=true;
Synchronize(Refresh);
if terminated then exit;
end;
end.
← →
Xmen (2012-11-30 10:25) [12]Обновления папок и передача имен файлов в ListBox
unit FTPRefresh;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs, shellapi, variants, ftpsend, blcksock, Main;
type
MyThread2 = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
procedure Refresh;
procedure refreshDir;
procedure refreshFTPsend;
procedure LogFTP;
procedure LogoutFTP;
end;
implementation
procedure MyThread2.LogFTP;
begin
FTPClient:=TFTPSend.Create;
FTPClient.TargetHost:="xx.xx.xx.xx";
FTPClient.TargetPort:="21";
FTPClient.UserName:="xxxxxx";
FTPClient.Password:="xxxxxxx";
FTPClient.PassiveMode:=True;
if FTPClient.Login then FTPStatus:=1 else FTPStatus:=0;
end;
procedure MyThread2.LogoutFTP;
begin
if FTPStatus=1 then
begin
FTPClient.Logout;
FTPClient.Free;
end;
end;
procedure MyThread2.refreshFTPsend;
var F: TSearchRec;
done: integer;
begin
Form1.ListView3.Clear;
done := FindFirst(path+"Send\*.*",faArchive,F);
while done = 0 do
begin
with Form1.ListView3.Items.Add do
begin
Caption:=F.Name;
SubItems.Add(IntToStr(F.Size));
end;
done := FindNext(F);
end;
Form1.ListView4.Clear;
done := FindFirst(RecvDir+"*.*",faArchive,F);
while done = 0 do
begin
with Form1.ListView4.Items.Add do
begin
Caption:=F.Name;
SubItems.Add(IntToStr(F.Size));
end;
done := FindNext(F);
end;
end;
procedure MyThread2.refreshDir;
var i:Integer;
begin
LogFTP;
if FTPStatus=1 then
begin
Form1.ListView1.Clear;
FTPClient.List(FTPClient.GetCurrentDir+"/Send/",false);
for i := 0 to FTPClient.FtpList.Count-1 do
begin
with Form1.ListView1.Items.Add do
begin
Caption:=FTPClient.FtpList[i].FileName;
SubItems.Add(FloatToStr(FTPClient.FtpList[i].FileSize));
end;
end;
Form1.ListView2.Clear;
FTPClient.List(FTPClient.GetCurrentDir+"/Recv/",false);
for i := 0 to FTPClient.FtpList.Count-1 do
begin
with Form1.ListView2.Items.Add do
begin
Caption:=FTPClient.FtpList[i].FileName;
SubItems.Add(FloatToStr(FTPClient.FtpList[i].FileSize));
end;
end;
end;
LogoutFTP;
end;
procedure MyThread2.Refresh;
begin
if not Form1.lbFile.Items.Count=null then
begin
Form1.RefreshFile;
Form1.RefreshSending;
end;
if Form1.lbFileSend.Items.Count=0 then
begin
Form1.RefreshFile;
Form1.RefreshSending;
end;
refreshFTPsend;
refreshDir;
end;
procedure MyThread2.Execute;
begin
FreeOnTerminate:=true;
Synchronize(Refresh);
if terminated then exit;
end;
end.
при работе программы форма повисает но прога работает. Не получился с потоком :(
← →
sniknik © (2012-11-30 10:40) [13]> Synchronize(Refresh);
это у тебя не поток, это просто код в классе потока вызывающийся в основном. с тем же успехом мог просто процедуру вызвать.
← →
Xmen (2012-11-30 10:42) [14]
> sniknik © (30.11.12 10:40) [13]
>
> > Synchronize(Refresh);
> это у тебя не поток, это просто код в классе потока вызывающийся
> в основном. с тем же успехом мог просто процедуру вызвать.
>
... изза этого подвисает форма?!!!
а я думал раз в Synchronize то должно получится. А как нужно сделать?
← →
brother © (2012-11-30 10:44) [15]прочитай еще раз основы работы с потоками...
← →
Xmen (2012-11-30 10:48) [16]все равно что то пропускаю
← →
brother © (2012-11-30 11:04) [17]> Synchronize
в Execute Для обращения к VCL (визуальным компонентам) все остальные действия потока выполняются в Execute
← →
Сергей М. © (2012-11-30 11:16) [18]К TProgressBar допустимо обращаться без синхронизации
← →
anatoly podgoretsky © (2012-11-30 13:07) [19]
> все равно что то пропускаю
Ты постоянно пишешь Архангельский код.
← →
Xmen (2012-11-30 14:13) [20]
> anatoly podgoretsky © (30.11.12 13:07) [19]
>
>
> > все равно что то пропускаю
>
> Ты постоянно пишешь Архангельский код.
Да гуру вы правы По нему когда то учился :)
Ваша помощь пригодился бы
← →
sniknik © (2012-11-30 14:31) [21]> Ваша помощь пригодился бы
врешь ты все. была дана ссылка на нормальное описание, и что это дало?
вот покажи место в каком нибудь примере из ссылки, и чтобы было написано сделать как у тебя...
а если не читаешь, что есть, то какой еще помощи хочешь? чтобы тебе вырезали пример из ссылки, скрестили с твоим кодом, до рабочей программы и дали тебе???
← →
anatoly podgoretsky © (2012-11-30 15:22) [22]
> Ваша помощь пригодился бы
Тебе уже ее дали, например читай, что сказали про Synchronize и где это испоьзовать. В конце концов с Дельфи идет хороший пример работы с потоками.
← →
Xmen (2012-11-30 15:30) [23]
> врешь ты все. была дана ссылка на нормальное описание, и
> что это дало?
> вот покажи место в каком нибудь примере из ссылки, и чтобы
> было написано сделать как у тебя...
> а если не читаешь, что есть, то какой еще помощи хочешь?
> чтобы тебе вырезали пример из ссылки, скрестили с твоим
> кодом, до рабочей программы и дали тебе???
ну это слишком я читаю пример но не получается правильно внедрить в мой проекткусочек
TPrimeThrd = class(TThread)
private
FTestNumber: integer;
FResultString: string;
protected
function IsPrime: boolean;
procedure UpdateResults;
procedure Execute; override;
public
property TestNumber: integer write FTestNumber;
end;
implementation
uses SysUtils, Dialogs, PrimeForm;
procedure TPrimeThrd.UpdateResults;
begin
PrimeFrm.ResultsMemo.Lines.Add(FResultString);
end;
function TPrimeThrd.IsPrime: boolean; {omitted for brevity}
procedure TPrimeThrd.Execute;
begin
if IsPrime then
FResultString := IntToStr(FTestNumber) + " is prime."
else
FResultString := IntToStr(FTestNumber) + " is not prime.";
Synchronize(UpdateResults);
end;
← →
Xmen (2012-11-30 15:31) [24]
> Тебе уже ее дали, например читай, что сказали про Synchronize
> и где это испоьзовать. В конце концов с Дельфи идет хороший
> пример работы с потоками.
Ну тогда заново начну с начала
← →
sniknik © (2012-11-30 15:35) [25]> кусочек
и? тут как раз все правильно, "работа" в потоке, обновление формы в синхронизации. а не как у тебя.
ты объяснения к этому "кусочку" читал?
← →
Xmen (2012-11-30 16:54) [26]почитаю еще раз, я же написал что то не получается с первого раза но я постараюсь это исправить.
Страницы: 1 вся ветка
Форум: "Начинающим";
Текущий архив: 2013.07.28;
Скачать: [xml.tar.bz2];
Память: 0.56 MB
Время: 0.003 c