Форум: "Начинающим";
Текущий архив: 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