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

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

Для опытного глаза


Страницы:   1 2 3 4

Dennis I. Komarov ©   (2007-10-16 10:11:00) 

код модуля потока предназначенного для транспорта пакетов с диска в и-нет(FTP)
Еще неизвестно как будет хранится база клиентов и не ведуться логи

Просьба посмотреть данный код на корректность, в смысле поведения при нестабильном конекте (ну и вообще :) )


unit u_send;

interface

uses
 Classes, Windows, SysUtils, StrUtils, DateUtils,
 IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;

type
 TThreadSend = class(TThread)
 private
   { Private declarations }
 protected
   procedure Execute; override;
 end;

var
 FTP: TIdFTP;

implementation

uses
 Main;

{ Important: Methods and properties of objects in visual components can only be
 used in a method called using Synchronize, for example,

     Synchronize(UpdateCaption);

 and UpdateCaption could look like,

   procedure TThreadSend.UpdateCaption;
   begin
     Form1.Caption := 'Updated in a thread';
   end; }

{ TThreadSend }

procedure TThreadSend.Execute;

var
 SearchRec: TSearchRec;
 FindResult: Integer;

 ClientCode: string;
 FTPLogin: string;

 HomeDir: string;

begin
 { Place thread code here }

 FTP:=TIdFTP.Create(nil);
 try
   FTP.Host:='**.**.**.***';
   FTP.Username:='********';
   FTP.Password:='********';
   FTP.Passive:=true;
   while not Terminated do begin
     {для каждого клиента делать } begin
       FindResult := FindFirst(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\*.*', faAnyFile, SearchRec);
       while FindResult = 0 do  begin
         with SearchRec do
           begin
             if (Name <> '.') and (Name <> '..') then
               if not (Attr and faDirectory <> 0)
                 then begin
                   if not(FTP.Connected) then
                     try
                       FTP.Connect;
                       HomeDir:=FTP.RetrieveCurrentDir;
                     except
                       FTP.Disconnect;
                     end;
                   if FTP.Connected then
                     try
                       FTP.ChangeDir(HomeDir + '/' + FTPLogin + '/MBOX/RT');
                       FTP.Put(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\' + Name, Name);
                       if FTP.Size(Name) = Size then begin
                         FTP.Rename(Name, '../R/' + Name);
                         DeleteFile(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\' + Name);
                       end;
                     except
                       FTP.Disconnect;
                     end;
                 end;
             FindResult:= FindNext(SearchRec);
           end;
       end;
       FindClose(SearchRec);
     end;
     FTP.Disconnect;
     Sleep(15000);
   end;
 finally
   FTP.Disconnect;
   FTP.Free;
 end;
end;
end.


Сергей М.   (2007-10-26 08:08:00) [41]


> 1. На черта нам тогда функция GetOverlappedResult


Мало ли что могло произойти во время исполнения запроса !
Ф-ция как раз и покажет, успешно ли выполнен запрос.
А сигнал ивента лишь фиксирует факт завершения (успешного или неуспешного) асинхронной операции.


> пока мы обрабатываем ин-цию об изменениех, происходящие
> изменения не фиксируются?


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


Dennis I. Komarov   (2007-10-25 16:48:00) [42]

Я думал изящность имено в решении, а не в возможностях

Есть приложение (возможно служба) задача которой транспортировка файлов с диска (не факт что локального) в сеть (FTP-сервер), и аналогично обратное. За каждое из действий отвечает свой поток. Ранее он (который отправлял) просто сканил папки на отправку (FindFirst/Next, ну сам видел). Более на него никаких функций не накладывается (разве что лог ). Другую смысловую нагрузку он не несет. Реакция на Terminated в течении секунды - это даже более чем :) .

Непонятна такая вешь: Мы посавили запрос в очередь. По некоему событию, мы получаем факт, что этот запрос обработался и в указанном месте появились изменения. Данные об изменениях храняться по адресу lpBuf. Далее мы отправляем аналогичный запрос в очередь.
1. На черта нам тогда функция GetOverlappedResult и
2. В то время, пока мы обрабатываем ин-цию об изменениех, происходящие изменения не фиксируются?


Сергей М.   (2007-10-25 15:42:00) [43]

Тем что поток приобретает способность немедленно реагировать не только на твой overlapped-ивент, но и на другие ивенты и/или сообщения.


Dennis I. Komarov   (2007-10-25 13:29:00) [44]

> [32] Сергей М. ©   (25.10.07 12:55)

А в чем принципиальная разница? Чем оно "изящней"?


Сергей М.   (2007-10-25 12:55:00) [45]

WaitFoeMultipleObjects, MsgWaitFoeMultipleObjects


Dennis I. Komarov   (2007-10-25 11:15:00) [46]

> есть гораздо более изящные решения

Пример? :)


Сергей М.   (2007-10-25 10:50:00) [47]


> Логично предположить, что при этом запрос в очереди уже
> отсутствует!?


Конечно.
Его результаты выбраны из очереди в указанный тобой буфер.


> сделую 1000 :) Уговорил


Да я тебя не уговаривал)
Просто есть гораздо более изящные решения для преодоления этой "проблемы")


Dennis I. Komarov   (2007-10-25 10:21:00) [48]

> И вообще заведи себе привычку вызывать WinAPI-функции как
> функции - возвращаемые ими результаты следует анализировать,
> ибо от них напрямую зависит дальнейшее правильное ветвление
> алгоритма.

Угу. Это же пока черновик :) Ну мне сейчас хочется разобраться в логике ассинхронного вызова.


> > //Сюда должны попасть если в директории есть изменения
>
>
> Да.

Логично предположить, что при этом запрос в очереди уже отсутствует!?


> > WaitForSingleObject(hDirChangeEvent, 5000)
>
>
> Тебя не смущает, что в течение этих 5 сек. таймаута ожидания
> сигнала ивента твой поток не будет реагировать на флаг Terminated
> ?

Ну вообще не смущает. Если при остановки вся это бодяга остановится через пять сек. меня это не очень расстроит, хотя сделую 1000 :) Уговорил.

> > GetMem(lpOverlapped, SizeOf(lpOverlapped^));
>
>
> Почему бы не сделать переменную Overlapped: TOverlapped
> локальной или полем класса ? Она ж крохотная, есть ли резон
> динамически распределять под нее память ?

А разница?

> > CreateEvent(nil, false, true, PChar('OnChangeDirecory')
> );
>
>
> Почему true ? Он же у тебя сразу и просигналит, в то время
> как никаких изменений еще и в помине не было ...

Да, тут не правильно перевел "F1" :)

> Да и имя ивента не обязательно.

Ну пускай будет :)


Сергей М.   (2007-10-24 17:18:00) [49]


> FreeOnTerminate:=false;


Это лишнее.


> GetMem(lpOverlapped, SizeOf(lpOverlapped^));


Почему бы не сделать переменную Overlapped: TOverlapped локальной или полем класса ? Она ж крохотная, есть ли резон динамически распределять под нее память ?


> CreateEvent(nil, false, true, PChar('OnChangeDirecory'));


Почему true ? Он же у тебя сразу и просигналит, в то время как никаких изменений еще и в помине не было ...

Да и имя ивента не обязательно.


Сергей М.   (2007-10-24 17:10:00) [50]


> //Сюда должны попасть если в директории есть изменения


Да.


> //С помощью GetOverLappedResult
>          //Если при чтении из lpBuf узнаем, что появился
> новый файл, тогда отправляем его споследствиями


Да, но при условии что ф-ция вернула True


> // Тут наверное надо обнулить lpBuf


Нафига ?

И вообще заведи себе привычку вызывать WinAPI-функции как функции- возвращаемые ими результаты следует анализировать, ибо от них напрямую зависит дальнейшее правильноеветвление алгоритма.


> WaitForSingleObject(hDirChangeEvent, 5000)


Тебя не смущает, что в течение этих 5 сек. таймаута ожидания сигнала ивента твой поток не будет реагировать на флаг Terminated ?


Dennis I. Komarov   (2007-10-24 16:57:00) [51]


unit u_send;

interface

uses
 Classes, Windows, SysUtils, StrUtils, DateUtils,
 IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;

type
 OnDirectoryChange = procedure(Sender: TObject);

 TThreadSend = class(TThread)
 private
   { Private declarations }

 protected
   procedure Execute; override;

 end;

var
 TCP: TIdTCPClient;
implementation

uses
 Main;
{ TThreadSend }
type
 PFileNotifyInformation = ^TFileNotifyInformation;
 TFileNotifyInformation = packed record
   NextEntryOffset: DWORD;
   Action: DWORD;
   FileNameLength:DWORD;
   FileName: WideChar;
 end;

procedure TThreadSend.Execute;

var
 hDir: THandle;
 hDirChangeEvent: THandle;

 lpBuf: Pointer;
 lpOverlapped: POverlapped;
begin
 { Place thread code here }
 FreeOnTerminate:=false;
 hDirChangeEvent:=CreateEvent(nil, false, true, PChar('OnChangeDirecory'));
 hDir := CreateFile ( 'c:\test', GENERIC_READ, FILE_SHARE_READ, nil,
         OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
 if hDir <> INVALID_HANDLE_VALUE then begin
   GetMem(lpBuf, 64*1024);
   GetMem(lpOverlapped, SizeOf(lpOverlapped^));
   try
     ZeroMemory(lpBuf, 64*1024);
     lpOverlapped^.hEvent:=hDirChangeEvent;
     ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
     while not Terminated do begin
       if WaitForSingleObject(hDirChangeEvent, 5000) = WAIT_OBJECT_0 then begin
         //Сюда должны попасть если в директории есть изменения
         //С помощью GetOverLappedResult
         //Если при чтении из lpBuf узнаем, что появился новый файл, тогда отправляем его споследствиями
         // Тут наверное надо обнулить lpBuf
         ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
       end;
     end;
   finally
     FreeMem(lpBuf); FreeMem(lpOverlapped);
   end;
 end;
end;
end.


??? :)


Dennis I. Komarov   (2007-10-24 11:39:00) [52]


> > GetMem(lpOverlapped, SizeOf(lpOverlapped));
> > ZeroMemory(lpBuf, SizeOf(lpBuf));

Ой мама, это как это я??? Это я не специально :)


Сергей М.   (2007-10-24 09:21:00) [53]


> GetMem(lpOverlapped, SizeOf(lpOverlapped));


SizeOf(lpOverlapped) всегда равен 4, потому что это указатель.
Либо разыменовывай его для взятия размера либо объяви переменную TOverlapped, тогда и GetMem не потребуется.


> ZeroMemory(lpBuf, SizeOf(lpBuf));


Здесь та же самая грубая ошибка.


> как отлавливать теперь это событие?


Любой удобной функцией ожидания - WaitForSingleObject, MsgWaitForMultipleObjects и иже с ними.


Dennis I. Komarov   (2007-10-23 17:14:00) [54]


uses
Main;

{ TThreadSend }
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = packed record
  NextEntryOffset: DWORD;
  Action: DWORD;
  FileNameLength:DWORD;
  FileName: WideChar;
end;

procedure TThreadSend.Execute;

var
FTP: TIdFTP;

SearchRec: TSearchRec;
FindResult: Integer;

ClientCode: string;
FTPLogin: string;

HomeDir: string;
hDir: THandle;

lpBuf: Pointer;
lpOverlapped: POverlapped;
hOnDirChange: THandle;

begin
{ Place thread code here }
FreeOnTerminate:=false;
hOnDirChange:=CreateEvent(nil, false, true, PChar('OnChangeDirectory');
hDir := CreateFile ( 'c:\test', GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
if hDir <> INVALID_HANDLE_VALUE then begin
  GetMem(lpBuf, 64*1204);
  GetMem(lpOverlapped, SizeOf(lpOverlapped));
  try
    ZeroMemory(lpBuf, SizeOf(lpBuf));
    lpOverlapped^.hEvent:=hOnDirChange;
    ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
  finally
    FreeMem(lpBuf); FreeMem(lpOverlapped);

  end;

end;
end;
end.


Похоже? И как отлавливать теперь это событие?


Сергей М.   (2007-10-23 16:53:00) [55]


> ивент-объект не есть процедура?
>


Конечно не процедура.

ивент-объект создается вызовом CreateEvent()


Dennis I. Komarov   (2007-10-23 16:33:00) [56]

> [19] Сергей М. ©   (23.10.07 16:16)

Нет, я отвернулся в сторону GetOverLappedResult.

> Ты передал параметром overladded-структуру, в которой поле
> hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.

или в данном случае это будет @OnDirectoryChange?
Или ивент-объект не есть процедура?


Anatoly Podgoretsky   (2007-10-23 16:17:00) [57]

> Dennis I. Komarov  (23.10.2007 16:00:18)  [18]

Какой еще хендл у процедуры?


Сергей М.   (2007-10-23 16:16:00) [58]


> Dennis I. Komarov ©   (23.10.07 16:00) [18]


> Мыслю в верном направлении?


Нет.

Ты про прототип FileIOCompletionRoutine вник ?


Dennis I. Komarov   (2007-10-23 16:00:00) [59]

> [14] Сергей М. ©   (19.10.07 15:05)

Предположим создал некую:

type
 OnDirectoryChange = procedure(Sender: TObject);  // Зачем нужен sender сам еще не знаю, но пускай бубет :)
...

procwdure OnDirectoryChange((Sender: TObject);
begin
// делать что-то при обнаружении нового файла, а точнее шмальнуть его...

end;


А как узнать хандл процедуры?

Мыслю в верном направлении?


Сергей М.   (2007-10-19 16:33:00) [60]


> если передать указатель @AnyProc


Имеешь ввиду параметр lpCompletionRoutine ?

Да, можно и так. Но прототип этой ф-ции должен соответствовать прототипу FileIOCompletionRoutine (см. справку)


Страницы:   1 2 3 4

Наверх

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