Модераторы: Snowy, bartram, MetalFan, bems, Poseidon, Riply
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Создать поток для FTP срочно!!! Помогите вынести в поток процедуру 
:(
    Опции темы
Gorinich
Дата 19.1.2006, 17:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 18
Регистрация: 21.10.2005

Репутация: нет
Всего: нет
Помогите вынести в отдельный поток процедуру, которая закачивает файлы на сервер по FTP. Во время закачки на экран выводится форма с TAnimate, TProgressBar и TLabel, которые наглядно отображают работу.
Но во время работы проседуры прога подвисает.
Сначала форма появлялась с большой задержкой - поставил Application.ProcessMessages - форма появляется, но бумажки в TAnimate не бегают.
С потоками у меня не очень. Помогите!!!
Код

...
procedure TForm1.Upload(Connect:pointer;Dir:string);
begin
...
end;
...
procedure TForm1.Publish;
begin
...
Form2.Show;//форма с TAnimate
Application.ProcessMessages;
  Upload(hConnect,uploadDir);//нужно в отдельный поток
Form2.Close;
...
end;

Пробовал CreateThread(nil,128,@Upload(hConnect,uploadDir),self,0,h); - не получается...
PM MAIL   Вверх
Poseidon
Дата 19.1.2006, 17:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133
Код
...
type
  TUploadThread = class(TThread)
  private
    Connect: pointer;
    Dir: string    
  protected
    procedure Execute; override;
  public 
   constructor Create(CreateSuspennded: Boolean;  const FConnect: pointer; FDir: string); 
  end;

type
  TForm1 = class(TForm)
...
  public
    UploadThread: TUploadThread;
  end;

...
implementation
{$R *.dfm}

constructor TUploadThread.Create(CreateSuspennded: Boolean;  const FConnect: pointer; const FDir: string); 
begin 
 inherited Create(CreateSuspennded); 
 Connect := FConnect;
 Dir:= FDir;
end;

procedure TUploadThread.Execute;
begin
// тут тот код, что у тебя в процедуре TForm1.Upload(Connect:pointer;Dir:string);
//Использовать Connect и Dir можно (нужно) бeз обьявления
end;


procedure TForm1.Publish;
begin
...
Form2.Show;//форма с TAnimate
Application.ProcessMessages; // <-- не нужно
  
UploadThread:= TUploadThread.Create(False, hConnect, uploadDir); // запускаем поток

Form2.Close; // <-- я бы убрал тоже в поток UploadThread т.к. Form2 сразу же закроется, если будет тут.
...
end;


Это сообщение отредактировал(а) Poseidon - 19.1.2006, 18:00


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Gorinich
Дата 21.1.2006, 14:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 18
Регистрация: 21.10.2005

Репутация: нет
Всего: нет
Poseidon, спасибо за пример, но у меня проблемка:
процедура Upload(Connect:pointer, Dir:string) - рекурсивная.
В ней просматривается папка Dir, если находится папка, то опять вызывается Upload c путем к папке в параметре Dir, если файл - то он отправляется по FTP.
Так мне что, ставить UploadThread:= TUploadThread.Create(False, hConnect, uploadDir); внутри. И как потом уничтожить потоки?
Буду думать и пробовать.
Код

procedure TForm.Upload(Connect:pointer; Dir:string);
var
SearchRec:TSearchRec;
res:boolean;
begin
 if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
        repeat
              if (SearchRec.name='.') or (SearchRec.name='..') then continue;
              if (SearchRec.Attr and faDirectory)<>0 then
              begin
                   FtpCreateDirectory(Connect,PAnsiChar(SearchRec.Name));
                   FtpSetCurrentDirectory(Connect,PAnsiChar(SearchRec.Name));
                   Upload(Connect,Dir+SearchRec.name); 
              end
              else
              begin
                FtpPutFile(Connect, PAnsiChar(Dir+SearchRec.Name),PAnsiChar('/'+SearchRec.Name),
                    FTP_TRANSFER_TYPE_BINARY, 255); 
                with Form10.ProgressBar1 do
                  Position:=Position+SearchRec.Size;
                Form10.Label2.Caption:=Dir+SearchRec.Name;
              end;
        until FindNext(SearchRec)<>0;
        FindClose(SearchRec);
end;
PM MAIL   Вверх
Poseidon
Дата 21.1.2006, 15:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133
Цитата(Gorinich @ 21.1.2006, 13:17 Найти цитируемый пост)

Так мне что, ставить UploadThread:= TUploadThread.Create(False, hConnect, uploadDir); внутри.
Нет!

Попробуй так:

Код

procedure WorkWithVCL; //работу с VCL лучше реализовать с помощью Synchronize, что мы и сделаем
begin
with Form10 do
ProgressBar1.Position:=ProgressBar1.Position+Size;
Label2.Caption:=Directory;
end;

procedure TUploadThread.Execute;
  procedure Upload(pConnect:pointer; pDir:string);
  var
  SearchRec:TSearchRec;
  res:boolean;
  begin
   if FindFirst(Dir+'*.*', faAnyFile, SearchRec)=0 then
          repeat
                if (SearchRec.name='.') or (SearchRec.name='..') then continue;
                if (SearchRec.Attr and faDirectory)<>0 then
                begin
                     FtpCreateDirectory(Connect,PAnsiChar(SearchRec.Name));
                     FtpSetCurrentDirectory(Connect,PAnsiChar(SearchRec.Name));
                     Upload(pConnect,pDir+SearchRec.name); 
                end
                else
                begin
                  FtpPutFile(Connect, PAnsiChar(Dir+SearchRec.Name),PAnsiChar('/'+SearchRec.Name),
                      FTP_TRANSFER_TYPE_BINARY, 255); 
                  Form10.Directory:= Dir+SearchRec.Name;
                  Form10.Size:= SearchRec.Size;
                 {Directory: string и Size: integer  обьяви как глобальные переменные
                 для TForm10 (можно в public)}

                  Synchronize(WorkWithVCL); // работу с VCL реализуем с помощью Synchronize
                end;
          until FindNext(SearchRec)<>0;
          FindClose(SearchRec);
  end;

begin
Upload(Connect,Dir); 
end;




Цитата(Gorinich @ 21.1.2006, 13:17 Найти цитируемый пост)

И как потом уничтожить потоки?
Поставь после
Код
UploadThread:= TUploadThread.Create(False, hConnect, uploadDir); 

строку
Код
UploadThread.FreeOnTerminate:= True


поток завершится сам сразу после завершение процесса внутре потока.

Это сообщение отредактировал(а) Poseidon - 21.1.2006, 15:07


--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
Gorinich
Дата 21.1.2006, 21:09 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 18
Регистрация: 21.10.2005

Репутация: нет
Всего: нет
Пока не могу протестировать , сервак не доступен smile.
Попробовал скомпилить: procedure WorkWithVCL; внес в TUploadThread и закрыл end'ом.
Вобщем как только с серваком проблемы закончатся буду тестить.
PM MAIL   Вверх
Poseidon
Дата 21.1.2006, 21:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Delphi developer
****


Профиль
Группа: Комодератор
Сообщений: 5273
Регистрация: 4.2.2005
Где: Гомель, Беларусь

Репутация: 10
Всего: 133
Цитата(Gorinich @ 21.1.2006, 20:09 Найти цитируемый пост)
Попробовал скомпилить: procedure WorkWithVCL; внес в TUploadThread и закрыл end'ом.
Не обязательно



--------------------
Если хочешь, что бы что-то работало - используй написанное, 
если хочешь что-то понять - пиши сам...
PM MAIL ICQ   Вверх
bems
Дата 21.1.2006, 21:58 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 21
Всего: 88
TAnimate и так выполняется в огтдельном потоке, так что даже не знаю поможет ли...


--------------------
Обижено школьников: 8
PM MAIL   Вверх
Gorinich
Дата 23.1.2006, 12:39 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 18
Регистрация: 21.10.2005

Репутация: нет
Всего: нет
Не работает smile
Даже файлы заливать перестала.
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: WinAPI и системное программирование"
Snowybartram
MetalFanbems
PoseidonRrader
Riply

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Delphi обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • 99% ответов по WinAPI можно найти в MSDN Library, оставшиеся 1% здесь

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, bartram, MetalFan, bems, Poseidon, Rrader, Riply.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: WinAPI и системное программирование | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0525 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.