Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2008.10.19;
Скачать: CL | DM;

Вниз

Для опытного глаза   Найти похожие ветки 

 
Dennis I. Komarov ©   (2007-10-16 10:11) [0]

код модуля потока предназначенного для транспорта пакетов с диска в и-нет(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-16 13:59) [1]


> ну и вообще


Sleep(15000) - это зачем ?


 
Dennis I. Komarov ©   (2007-10-16 15:35) [2]

> [1] Сергей М. ©   (16.10.07 13:59)

Что бы FTP не поплохело :)


 
Сергей М. ©   (2007-10-16 15:44) [3]


> Dennis I. Komarov ©   (16.10.07 15:35) [2]


Каким образом протоколу может "поплохеть" или "похорошеть" от твоего sleep"а или его отсутствия ?


 
Dennis I. Komarov ©   (2007-10-16 18:00) [4]

Разумеется я про FTP-сервер, хотя если файлов для отправки нет - связываться он не будет. Просто нет необходимости бродить по диску все время. Побродил - на отдых (дай другим поработать), нашел - отправил.

А что, в этом есть что-то критичное?


 
Slym ©   (2007-10-17 09:16) [5]

var FTP: TIdFTP;
засунь в тело потока


 
Сергей М. ©   (2007-10-17 09:26) [6]


> нет необходимости бродить по диску все время. Побродил -
>  на отдых (дай другим поработать), нашел - отправил


Дык на то есть асинхроннаая ReadDirectoryChangesW)
При ее использовании нет необходимости "бродить по диску" вообще - система сама известит тебя о произошедших измениях.


> в этом есть что-то критичное?


В принципе нет, но и резона тоже нет. И уж тем более непонятно, как это сказывается на работе FTP-сервера, так что без этой задержки серверу "заплохеет".

Гораздо более критично [5].


 
Dennis I. Komarov ©   (2007-10-17 10:02) [7]

> Гораздо более критично [5].

Это да, согласен.

> ReadDirectoryChangesW

Не слышал про такую :) Пойду гляну, что за зверь.


 
Сергей М. ©   (2007-10-17 10:05) [8]


> Пойду гляну, что за зверь


Оч даже симпатичный, ласковый и некапризный)


 
Dennis I. Komarov ©   (2007-10-17 14:11) [9]

> [8] Сергей М. ©   (17.10.07 10:05)

Я так понял, что если программа не запущена, то все изменения за это время пройдут мимо. Т.е. сперва все равно надо "побродить по диску"?


 
Сергей М. ©   (2007-10-17 15:04) [10]


> Dennis I. Komarov ©   (17.10.07 14:11) [9]


Угу.


 
Dennis I. Komarov ©   (2007-10-19 13:40) [11]

Вот и вернулся я :)


> Сергей М. ©

В результате, наверное должно получиться что-то подобное:


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

implementation

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;

begin
 { Place thread code here }
 FreeOnTerminate:=false;
 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));
     ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
   finally
     FreeMem(lpBuf); FreeMem(lpOverlapped);
   end;

 end;
end;
end.



При выполнении такого кода, я так понимаю будет поспавлен запрос в очередь. Как только что-то в директории(дереве) изменится мы должны "получить" событие, которое надо как-то связать с помощью GetOverlappedResult в сруктуре _Overlapped.hEvent с дискриптором события?
Вобщем не совсем понятно, как получить извещение от системы.


 
Сергей М. ©   (2007-10-19 13:50) [12]


> событие, которое надо как-то связать с помощью GetOverlappedResult
> в сруктуре _Overlapped.hEvent с дискриптором события


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


 
Dennis I. Komarov ©   (2007-10-19 14:56) [13]

> Прежде чем обращаться к дескриптору события нужно создать
> этот объект

Разумеется, но я к нему еще и не обращался :)

Просто выложил код чтоб проверить, правильно ли я понимаю свои действия


 
Сергей М. ©   (2007-10-19 15:05) [14]


> я к нему еще и не обращался


Как это не обращался ?

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

Как же система уведомит тебя о наступившем событии, если ты не указал посредством какого объекта тебя уведомлять ?


 
Dennis I. Komarov ©   (2007-10-19 16:24) [15]

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

procedure AnyProc;
begin
end;


 
Dennis I. Komarov ©   (2007-10-19 16:28) [16]

> [15] Dennis I. Komarov ©   (19.10.07 16:24)

Бредю :) Адрес памяти <> хэндлу системы


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


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


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

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


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

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

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

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

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

end;


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

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


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


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


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


Нет.

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


 
Anatoly Podgoretsky ©   (2007-10-23 16:17) [20]

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

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


 
Dennis I. Komarov ©   (2007-10-23 16:33) [21]

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

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

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

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


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


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


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

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


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


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-24 09:21) [24]


> GetMem(lpOverlapped, SizeOf(lpOverlapped));


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


> ZeroMemory(lpBuf, SizeOf(lpBuf));


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


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


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


 
Dennis I. Komarov ©   (2007-10-24 11:39) [25]


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

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


 
Dennis I. Komarov ©   (2007-10-24 16:57) [26]


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.


??? :)


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


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


Да.


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


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


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


Нафига ?

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


> WaitForSingleObject(hDirChangeEvent, 5000)


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


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


> FreeOnTerminate:=false;


Это лишнее.


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


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


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


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

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


 
Dennis I. Komarov ©   (2007-10-25 10:21) [29]

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

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


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

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


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

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

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

А разница?

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

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

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

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


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


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


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


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


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


 
Dennis I. Komarov ©   (2007-10-25 11:15) [31]

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

Пример? :)


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

WaitFoeMultipleObjects, MsgWaitFoeMultipleObjects


 
Dennis I. Komarov ©   (2007-10-25 13:29) [33]

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

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


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

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


 
Dennis I. Komarov ©   (2007-10-25 16:48) [35]

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

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

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


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


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


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


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


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


 
Dennis I. Komarov ©   (2007-10-26 09:57) [37]

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

Гм... Но для этого все равно понадобится какое то время, т.е.
Получили сигнал события, далее по идее запроса в очереди нет, следует отправить его еще раз, отправлять с тем же указателем на буфер низя - можем потерять его, следовательно, предварительно надо сохранить данные, это потребует некоторого времени, за которое могут произойти изменения, начинаю подумывать о том, что "сканить" диск всетаки надежнее


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


hFile - чего она сюда хочет?


 
Сергей М. ©   (2007-10-26 11:23) [38]


> чего она сюда хочет?


hDir твой она хочет.


 
Сергей М. ©   (2007-10-26 11:44) [39]


> "сканить" диск всетаки надежнее


С чего бы ?

Explorer, заметь, использует именно ReadDirectoryChangesW


 
Dennis I. Komarov ©   (2007-10-26 12:26) [40]

> [39] Сергей М. ©   (26.10.07 11:44)

Но ведь не асинхронный.


 
Сергей М. ©   (2007-10-26 12:32) [41]


> Dennis I. Komarov ©   (26.10.07 12:26) [40]


> Но ведь не асинхронный.


С чего ты так уверен ?
Да и какая разница, синхронный или асинхронный ?
Режим не имеет значения с т.з. твоих волнений насчет "потерь" .


 
Dennis I. Komarov ©   (2007-10-26 13:34) [42]

> С чего ты так уверен ?

Ибо обновление по F5 получаем. Я сомниваюсь, что все это время Explorer хранит эти изменения, и отображает их по команде.

А первоначальную информацию он как читает?

----------

lpNumberOfBytesTranferred - это VAR ? Он вообще имеет значение, ведь читаль lpBuf будем.


 
Сергей М. ©   (2007-10-26 14:40) [43]


> Ибо обновление по F5 получаем


А у меня Explorer сам отслеживает изменения в показываемой им в тек.момент директории.

Что я делаю не так ?


> А первоначальную информацию он как читает?


А по барабану как он ее читает. Мы же об отслеживании изменений речь ведем)


> это VAR ?


Это Points to a 32-bit variable that receives the number of bytes that were actually transferred by a read or write operation


> Он вообще имеет значение


А нафига он тогда фигурирует в структуре, если он якобы не нужен ?


 
Dennis I. Komarov ©   (2007-10-26 15:47) [44]

> Это Points to a 32-bit variable that receives the number
> of bytes that were actually transferred by a read or write
> operation

Я F1 умею жать :) только не понял почему Points
Мой скромный перевод - это скока надо читать ин-фы из lpBuf. (разумеется не переменная)


 
Сергей М. ©   (2007-10-26 15:51) [45]


> Dennis I. Komarov ©   (26.10.07 15:47) [44]


А, ты вон про что ..

Ну да, в дельфийской декларации этот параметр объявлен для передачи по ссылке, т.е. как var-параметр.


> Мой скромный перевод - это скока надо читать ин-фы из lpBuf.
>  (разумеется не переменная)


Правильно перевел.


 
Dennis I. Komarov ©   (2007-10-26 16:35) [46]

Как понимаю, lpBuff заполняется пакетамя типа TFileNotifyInformation, в котором NextEntryOffset отвечает за существование следующего пакета. Отсюда и возник вопрос, нужен ли pNumberOfBytesTranferred вообще.

И как лучше сделать:
1.

...
 if WaitFor...... do
   begin
     if ReadDir...
     //далее разбираем lpBuf
   end;

2.
 if WaitFor...... do
   begin
     //тут разбираем lpBuf
     if ReadDir...
   end;


 
Сергей М. ©   (2007-10-26 16:51) [47]

if WaitFor...... and GetOverlappedResult(..) then
  begin
    if ReadDir...
    //далее разбираем lpBuf
  end;


 
Dennis I. Komarov ©   (2007-10-29 13:52) [48]

А как положено разбирать lpBuf? Ведь там может храниться несколько записей типа TFileNotifyInformation.


 
Сергей М. ©   (2007-10-29 13:59) [49]


> как положено разбирать lpBuf?


В точном соответствии с офиц.описанием структуры FILE_NOTIFY_INFORMATION.


> Ведь там может храниться несколько записей типа


И что ?


 
Dennis I. Komarov ©   (2007-10-29 17:10) [50]

> [47] Сергей М. ©   (26.10.07 16:51)

> if WaitFor...... and GetOverlappedResult(..) then
>  begin
>    if ReadDir...
>    //далее разбираем lpBuf
Если получаем информацию, о появлении нового файла, то отправляем на FTP, исли он отправился успешно, то удаляем его => получаем очередное изменение, а значит lpBuf изменен, т.е. все остальные информацонные записи - утеряны :(  
    Как быть?
>  end;


 
Сергей М. ©   (2007-10-30 08:18) [51]


> Как быть?


Ну как ?...
Конечно же скопировать содержимое lpBuf^ во временный буфер и разбирать уже этот временнный буфер, а не lpBuf^. Неужели это не очевидно ?


 
Dennis I. Komarov ©   (2007-10-30 15:23) [52]


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;

implementation

uses
 Main;

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

 TTFileNotifyInformationArray = array[0..1000] of TFileNotifyInformation;

procedure TThreadSend.Execute;

var
 i: Integer;
 tBuf: TTFileNotifyInformationArray;
 hDir, hDirChangeEvent: THandle;

 lpBuf: Pointer;
 lpOverlapped: POverlapped;

 lpNumberOfBytesTansferred: Cardinal;
begin
 { Place thread code here }
 FreeOnTerminate:=false;
 hDirChangeEvent:=CreateEvent(nil, false, false, 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;
     if ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil) then
       while not Terminated do begin
         if (WaitForSingleObject(hDirChangeEvent, 1000) = WAIT_OBJECT_0) and
            (GetOverLappedResult(hDir, lpOverlapped^, lpNumberOfBytesTansferred, true)) then begin
           //Копируем результаты в резервный буфер
           tBuf:=TTFileNotifyInformationArray(lpBuf^);
           while not ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil) do;
           i:=0;
           repeat

{
             Разбераем tBuf[i]
             Если появился новый => шмаляем, исли гуд то в архив
{}

             Inc(i);
           until tBuf[i].NextEntryOffset > 0
         end;
       end;
   finally
     FreeMem(lpBuf);
     FreeMem(lpOverlapped);
     CloseHandle(hDirChangeEvent);
     CloseHandle(hDir);
   end;
 end;
end;

end.


Вот такой "безобразие". Как оно?


 
Сергей М. ©   (2007-10-30 15:33) [53]

Действительно безобразие)


> while not ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf),
>  true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped,
> nil) do;


Накой ляд тут этот цикл ?


>    tBuf:=TTFileNotifyInformationArray(lpBuf^);


А это что такое ?

Как кореллирует sizeof(TTFileNotifyInformationArray) c 64*1024 и lpNumberOfBytesTansferred^ ?


 
Dennis I. Komarov ©   (2007-10-30 15:50) [54]

> Накой ляд тут этот цикл ?

Дабы если false, то пытался поставить запрос заново :)


> Как кореллирует sizeof(TTFileNotifyInformationArray) c 64*1024
> и lpNumberOfBytesTansferred^ ?

Откровенно говоря никак, но он веди не меньше получится. Я так понимаю, что остальные элементы массива просто пустыми остануться. А 1000 поставил из-за щедрости :)

Ок, понял. Меняем packed record на просто record

array [0..4095] of ....


 
Сергей М. ©   (2007-10-30 16:11) [55]


> Дабы если false, то пытался поставить запрос заново


Малацца, что тут сказать)

А почему false - тебе по барабану.

Жди бесконечного цикла)


> А 1000 поставил из-за щедрости


От балды ты поставил, а не "из-за щедрости")

Программа, реализованная от балды, работать как положено никогда не будет.

У тебя есть lpNumberOfBytesTansferred^, у тебя есть связный список в lpBuf^, вот пробегись по этому списку и выдели памяти под врем.буфер ровно столько, сколько нужно, но не более  lpNumberOfBytesTansferred^


 
Dennis I. Komarov ©   (2007-10-30 16:47) [56]

Почему
> lpNumberOfBytesTansferred^

?

GetOverLappedResult(hDir, lpOverlapped^, lpNumberOfBytesTansferred, true)
третьим параметром указатель кушать не хочет, хотя в справке LPDWORD

В функции хочет Cardinal а на Pointer ругается.


> От балды ты поставил, а не "из-за щедрости")


Неее, балда подумала, что этого более чем хватит!

A array [0..4095] of ... почему низя сделать? Получим такойже объем (64*1024 = SizeOf(TFileNotifyInformation)*4096). По идее все должно оказаться в массиве. С ним же удобнее работать. Ну и пусть памяти быдет выделено немного больше (65Kb Не так страшно)


 
Сергей М. ©   (2007-10-30 16:55) [57]

BytesTansferred: Cardinal;

..

GetOverLappedResult(... BytesTansferred ...)


> A array [0..4095] of ... почему низя сделать?


А почему не 100000 ? Почему не миллион ?

От балды оно и есть от балды, типа авось хватит)

А надо не "авось", а ровно столько, сколько возвращено операцией чтения.


 
Dennis I. Komarov ©   (2007-10-30 17:08) [58]

while not Terminated do begin
         if (WaitForSingleObject(hDirChangeEvent, 1000) = WAIT_OBJECT_0) and
            (GetOverLappedResult(hDir, lpOverlapped^, lpNumberOfBytesTansferred, true)) then begin
           //Копируем результаты в резервный буфер
           GetMem(tempBuf, lpNumberOfBytesTansferred);
           try
             tempBuf^:=???
             if not ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil)
               then ; //Тут все плохо, запрос не посавился смотреть GetLastError
           finally
             FreeMem(tempBuf);
           end;

         end;
       end;


 
Сергей М. ©   (2007-10-30 17:12) [59]

CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)


 
Dennis I. Komarov ©   (2007-10-30 17:23) [60]

А если к примеру в этом месте происходит событие (Появился/удалился новый файл), то вернувшись в начало цикла WaitFor... получит эту информацию?


 
Сергей М. ©   (2007-10-31 08:22) [61]


> получит эту информацию?


ПРобуй и поймешь)


 
Dennis I. Komarov ©   (2007-10-31 09:06) [62]

> [61] Сергей М. ©   (31.10.07 08:22)

Тогда уже поздно будет :(


 
Dennis I. Komarov ©   (2007-10-31 12:57) [63]

А как попрыгать по tempBuf?

делаю так:

var
 x: PFileNotifyInformation;

....
память для x тоже выделили
....

repeat
 CopyMemory(x, TempBuf, SizeOf(x^);
 if x^.Action = FILE_ACTION_ADDED then begin
   ....
 end;
 //Тут надо перенести указатель tempBuf на x^.NextEntryOffset или CopyMemory(x, TempBuf + AnyBytes, SizeOf(x^))
until x^.NextEntryOffset > 0


 
Сергей М. ©   (2007-10-31 13:40) [64]


> Dennis I. Komarov ©   (31.10.07 12:57) [63]


> CopyMemory(x, TempBuf, SizeOf(x^);


Сравни с:

CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)

Найди семь отличий


 
Dennis I. Komarov ©   (2007-10-31 14:48) [65]

> [64] Сергей М. ©   (31.10.07 13:40)

Copy Memory(Адрес получателся, адрес источника, Количество байт)

Что не так?

x: PFileNotifyInformation; - адрес куда скопирукм одну запись
tempBuf - временный буфер содержащий все записи
SizeOf(x^) - Розмер записи содержащейся по адресу x


 
Сергей М. ©   (2007-10-31 15:34) [66]


> адрес куда скопирукм одну запись


Почему одну-то ?
Все записи разом нужно копировать, если тебя волнует максимально быстрая обработка события !


 
Dennis I. Komarov ©   (2007-10-31 15:42) [67]

Неее

CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)

Мы сделали временный буфер в tempBuf.
Далее мы с чистой совестью можем запустить ReadDir...
Теперь нам надо пробежаться по tempBuf и считать всю инфу.
в x хочу считать первую запись, затем смещать позицию на x^.NextEntryOffset. Как - не знаю :(


 
Сергей М. ©   (2007-10-31 16:15) [68]

pInfo: PFileNotifyInformation;
..

pInfo := tempBuf;
repeat
 ..  pInfo указывает на очередную запись ..
 Inc(Cardinal(pInfo),  NextEntryOffset);
until NextEntryOffset = 0;


 
Dennis I. Komarov ©   (2007-10-31 16:24) [69]

> [68] Сергей М. ©   (31.10.07 16:15)
> Inc(Cardinal(pInfo),  NextEntryOffset);

Вот его-то мне и не хватало :) И так я его и эдак. Мерси!


 
Сергей М. ©   (2007-10-31 17:07) [70]


> И так я его и эдак


Мартышка и очки ?)

Паскаль-то учить надо)


 
Dennis I. Komarov ©   (2007-10-31 17:19) [71]

В указателях пробел :(


 
Dennis I. Komarov ©   (2007-10-31 17:35) [72]

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;

implementation

uses
 Main;

{ TThreadSend }
type
 PFileNotifyInformation = ^TFileNotifyInformation;
 TFileNotifyInformation = 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;

 f: TextFile;
 FileName: TFileName;
 hDir, hDirChangeEvent: THandle;

 tempBuf: Pointer;
 lpBuf: Pointer;
 lpOverlapped: POverlapped;
 pInfo: PFileNotifyInformation;

 lpNumberOfBytesTansferred: Cardinal;
begin
 { Place thread code here }
 fileName:= "c:\new.log";
 AssignFile(f, FileName);

 FreeOnTerminate:=true;
 hDirChangeEvent:=CreateEvent(nil, false, false, PChar("OnChangeDirecory"));
 hDir := CreateFile (BCDir, 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^));
//    GetMem(pInfo, SizeOf(pInfo^));
   try
     ZeroMemory(lpBuf, 64*1024);
     lpOverlapped^.hEvent:=hDirChangeEvent;
     if ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil) then
       while not Terminated do begin
         if (WaitForSingleObject(hDirChangeEvent, 1000) = WAIT_OBJECT_0) and
            (GetOverLappedResult(hDir, lpOverlapped^, lpNumberOfBytesTansferred, true)) then begin
           GetMem(tempBuf, lpNumberOfBytesTansferred);
           try
             //Копируем результаты в резервный буфер
             CopyMemory(tempBuf, lpBuf, lpNumberOfBytesTansferred);
             if not ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil)
               then ; //Тут все плохо, запрос не посавился смотреть GetLastError
             //А тут теперь пытаемся разобрать tempBuf
             pInfo:=tempBuf;
             repeat
               if pInfo^.Action = FILE_ACTION_ADDED then begin
                 //Надо отправить файлик :)
                 //Пока, что, для проверки заведем файлик типа LOG
                 if FileExists(FileName) then Append(f) else rewrite(f);
                 WriteLn(f, DateTimeToStr(Now) + " - появился новый файл: " + pInfo^.FileName);
                 CloseFile(f);
               end;
               Inc(Cardinal(pInfo), pInfo^.NextEntryOffset);
             until pInfo^.NextEntryOffset = 0
           finally
             FreeMem(tempBuf);
           end;
         end;
       end;
   finally
     FreeMem(lpBuf);
     FreeMem(lpOverlapped);
//      FreeMem(pInfo);
     CloseHandle(hDirChangeEvent);
     CloseHandle(hDir);
   end;
 end;
end;

end.

Начались опыта на кошках. AV на выделенной строке ??? Ну ес-но при новом файле :) Почему нету pInfo?
ЗЫ с GetMem для pInfo я пологаю перестарался.


 
Сергей М. ©   (2007-11-01 08:36) [73]


> SizeOf(lpBuf)


У попа была собака...

см. [24]


 
iXT   (2007-11-02 13:25) [74]

Да, бывает :(
Paste блин.

А с сетевами (причем не win-выми) дисками она работать должна?


 
Dennis I. Komarov ©   (2007-11-02 14:27) [75]

Ух ты, старый ник просочился :)


 
Dennis I. Komarov ©   (2007-11-07 16:36) [76]

> А с сетевами (причем не win-выми) дисками она работать должна?

НЕ БУДЕТ :(



Страницы: 1 2 вся ветка

Текущий архив: 2008.10.19;
Скачать: CL | DM;

Наверх




Память: 0.72 MB
Время: 0.019 c
15-1219989599
oldman
2008-08-29 09:59
2008.10.19
Доступ к старым данным


2-1220850278
FIL-23
2008-09-08 09:04
2008.10.19
Отправка смс


2-1221136125
DJones
2008-09-11 16:28
2008.10.19
Использование многострочных hint в Дельфи


2-1221127435
mefodiy
2008-09-11 14:03
2008.10.19
Черно-белая печать на цветном принтере


15-1219939924
Terasbetoni
2008-08-28 20:12
2008.10.19
Установил компонент, а в закладках с компонентами он не появился