Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Работа с потоком как организовать? [D7, XP]


Страницы:   1 2

Xmen ©   (2012-11-21 15:15:00) 

Привет мастерам.
Есть форма в котором подготавливается файл для отправки в филиал (типа почтовый клиент). Выбирается файл или несколько файлы для отправки. после нажатия кнопки отправки файл архивируется и пери именуется по шаблону и помешается в папку для отправки. Каждый 5 минут проверяется папка приёма файлов если там есть файл то он перемешается в нужную папку. Теперь вопрос как можно сделать так чтобы приём файла была в отдельном потоке и пака принимается файл не зависала программа.


Xmen   (2012-11-30 16:54:00) [1]

почитаю еще раз, я же написал что то не получается с первого раза но я постараюсь это исправить.


sniknik   (2012-11-30 15:35:00) [2]

> кусочек
и? тут как раз все правильно, "работа" в потоке, обновление формы в синхронизации. а не как у тебя.
ты объяснения к этому "кусочку" читал?


Xmen   (2012-11-30 15:31:00) [3]


> Тебе уже ее дали, например читай, что сказали про Synchronize
> и где это испоьзовать. В конце концов с Дельфи идет хороший
> пример работы с потоками.

Ну тогда заново начну с начала


Xmen   (2012-11-30 15:30:00) [4]


> врешь ты все. была дана ссылка на нормальное описание, и
> что это дало?
> вот покажи место в каком нибудь примере из ссылки, и чтобы
> было написано сделать как у тебя...
> а если не читаешь, что есть, то какой еще помощи хочешь?
>  чтобы тебе вырезали пример из ссылки, скрестили с твоим
> кодом, до рабочей программы и дали тебе???
ну это слишком я читаю пример но не получается правильно внедрить в мой проект


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;
кусочек


anatoly podgoretsky   (2012-11-30 15:22:00) [5]


> Ваша помощь пригодился бы

Тебе уже ее дали, например читай, что сказали про Synchronize и где это испоьзовать. В конце концов с Дельфи идет хороший пример работы с потоками.


sniknik   (2012-11-30 14:31:00) [6]

> Ваша помощь пригодился бы
врешь ты все. была дана ссылка на нормальное описание, и что это дало?
вот покажи место в каком нибудь примере из ссылки, и чтобы было написано сделать как у тебя...
а если не читаешь, что есть, то какой еще помощи хочешь? чтобы тебе вырезали пример из ссылки, скрестили с твоим кодом, до рабочей программы и дали тебе???


Xmen   (2012-11-30 14:13:00) [7]


>  anatoly podgoretsky ©   (30.11.12 13:07) [19]
>
>
> > все равно что то пропускаю
>
> Ты постоянно пишешь Архангельский код.

Да гуру вы правы По нему когда то учился :)
Ваша помощь пригодился бы


anatoly podgoretsky   (2012-11-30 13:07:00) [8]


> все равно что то пропускаю

Ты постоянно пишешь Архангельский код.


Сергей М.   (2012-11-30 11:16:00) [9]

К TProgressBar допустимо обращаться без синхронизации


brother   (2012-11-30 11:04:00) [10]

> Synchronize

в Execute Для обращения к VCL (визуальным компонентам) все остальные действия потока выполняются в Execute


Xmen   (2012-11-30 10:48:00) [11]

все равно что то пропускаю


brother   (2012-11-30 10:44:00) [12]

прочитай еще раз основы работы с потоками...


Xmen   (2012-11-30 10:42:00) [13]


> sniknik ©   (30.11.12 10:40) [13]
>
> > Synchronize(Refresh);
> это у тебя не поток, это просто код в классе потока вызывающийся
> в основном. с тем же успехом мог просто процедуру вызвать.
>

... изза этого подвисает форма?!!!
а я думал раз в Synchronize то должно получится. А как нужно сделать?


sniknik   (2012-11-30 10:40:00) [14]

> Synchronize(Refresh);
это у тебя не поток, это просто код в классе потока вызывающийся в основном. с тем же успехом мог просто процедуру вызвать.


Xmen   (2012-11-30 10:25:00) [15]

Обновления папок и передача имен файлов в 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.


при работе программы форма повисает но прога работает. Не получился с потоком :(


Xmen   (2012-11-30 10:23:00) [16]

не пинайте сильно вот код рабочий но поток не правильно получился :(
отправка и скачка из 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.


Медвежонок Пятачок   (2012-11-27 16:43:00) [17]

классный класс myTr

обязательно должен быть жив экземпляр класса TForm1
Обязательно ссылка на него должна лежать в переменной Form1
Обязательно на форме должен быть label2
Обязательно в лейбле должна быть строка с валидным целым.

по моему, даже индусы так не умеют.


Xmen   (2012-11-27 16:16:00) [18]

код изменил вроде меняется лейбел но кое что не хватает. Наверно прогрессбар. его тоже так можно управлять?
капшн лайбла сделал 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);


Amoeba_   (2012-11-27 15:51:00) [19]


> Как можно обращаться?

Это ты хоть прочел?
http://forum.vingrad.ru/topic-60076.html
См. главу 3.


Amoeba_   (2012-11-27 15:47:00) [20]


> Как можно обращаться?

Посылкой сообщения или через Synchronize.
Читай букварь.


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо