Главная страница
    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.7 MB
Время: 0.008 c
2-1221488145
Totaren
2008-09-15 18:15
2008.10.19
Как убрать полосы прокрутки в родительской форме MDI приложения?


15-1220007907
DiamondShark
2008-08-29 15:05
2008.10.19
С какой учётной записью


15-1219872645
+koha
2008-08-28 01:30
2008.10.19
Кто занимается параллельными машинами подскажите


15-1220028990
DevilDevil
2008-08-29 20:56
2008.10.19
Соотношение сторон монитора. Потестируйте, пожалуйста.


2-1221147485
Weeeetch
2008-09-11 19:38
2008.10.19
Требуется подсказка





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский