-
код модуля потока предназначенного для транспорта пакетов с диска в и-нет(FTP) Еще неизвестно как будет хранится база клиентов и не ведуться логи Просьба посмотреть данный код на корректность, в смысле поведения при нестабильном конекте (ну и вообще :) )
unit u_send;
interface
uses
Classes, Windows, SysUtils, StrUtils, DateUtils,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;
type
TThreadSend = class(TThread)
private
protected
procedure Execute; override;
end;
var
FTP: TIdFTP;
implementation
uses
Main;
procedure TThreadSend.Execute;
var
SearchRec: TSearchRec;
FindResult: Integer;
ClientCode: string;
FTPLogin: string;
HomeDir: string;
begin
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.
-
> ну и вообще
Sleep(15000) - это зачем ?
-
> [1] Сергей М. © (16.10.07 13:59)
Что бы FTP не поплохело :)
-
> Dennis I. Komarov © (16.10.07 15:35) [2]
Каким образом протоколу может "поплохеть" или "похорошеть" от твоего sleep'а или его отсутствия ?
-
Разумеется я про FTP-сервер, хотя если файлов для отправки нет - связываться он не будет. Просто нет необходимости бродить по диску все время. Побродил - на отдых (дай другим поработать), нашел - отправил.
А что, в этом есть что-то критичное?
-
var FTP: TIdFTP; засунь в тело потока
-
> нет необходимости бродить по диску все время. Побродил - > на отдых (дай другим поработать), нашел - отправил
Дык на то есть асинхроннаая ReadDirectoryChangesW) При ее использовании нет необходимости "бродить по диску" вообще - система сама известит тебя о произошедших измениях.
> в этом есть что-то критичное?
В принципе нет, но и резона тоже нет. И уж тем более непонятно, как это сказывается на работе FTP-сервера, так что без этой задержки серверу "заплохеет".
Гораздо более критично [5].
-
> Гораздо более критично [5].
Это да, согласен.
> ReadDirectoryChangesW
Не слышал про такую :) Пойду гляну, что за зверь.
-
> Пойду гляну, что за зверь
Оч даже симпатичный, ласковый и некапризный)
-
> [8] Сергей М. © (17.10.07 10:05)
Я так понял, что если программа не запущена, то все изменения за это время пройдут мимо. Т.е. сперва все равно надо "побродить по диску"?
-
> Dennis I. Komarov © (17.10.07 14:11) [9]
Угу.
-
Вот и вернулся я :) > Сергей М. ©
В результате, наверное должно получиться что-то подобное:
unit u_send;
interface
uses
Classes, Windows, SysUtils, StrUtils, DateUtils,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;
type
TThreadSend = class(TThread)
private
protected
procedure Execute; override;
end;
var
implementation
uses
Main;
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
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 с дискриптором события? Вобщем не совсем понятно, как получить извещение от системы.
-
> событие, которое надо как-то связать с помощью GetOverlappedResult > в сруктуре _Overlapped.hEvent с дискриптором события
Прежде чем обращаться к дескриптору события нужно создать этот объект. А ты его не создал.
-
> Прежде чем обращаться к дескриптору события нужно создать > этот объект
Разумеется, но я к нему еще и не обращался :)
Просто выложил код чтоб проверить, правильно ли я понимаю свои действия
-
> я к нему еще и не обращался
Как это не обращался ?
Ты передал параметром overladded-структуру, в которой поле hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.
Как же система уведомит тебя о наступившем событии, если ты не указал посредством какого объекта тебя уведомлять ?
-
А если передать указатель @AnyProc
procedure AnyProc; begin end;
-
> [15] Dennis I. Komarov © (19.10.07 16:24)
Бредю :) Адрес памяти <> хэндлу системы
-
> если передать указатель @AnyProc
Имеешь ввиду параметр lpCompletionRoutine ?
Да, можно и так. Но прототип этой ф-ции должен соответствовать прототипу FileIOCompletionRoutine (см. справку)
-
> [14] Сергей М. © (19.10.07 15:05)
Предположим создал некую:
type
OnDirectoryChange = procedure(Sender: TObject); ...
procwdure OnDirectoryChange((Sender: TObject);
begin
end;
А как узнать хандл процедуры? Мыслю в верном направлении?
-
> Dennis I. Komarov © (23.10.07 16:00) [18]
> Мыслю в верном направлении?
Нет.
Ты про прототип FileIOCompletionRoutine вник ?
-
> Dennis I. Komarov (23.10.2007 16:00:18) [18]
Какой еще хендл у процедуры?
-
> [19] Сергей М. © (23.10.07 16:16)
Нет, я отвернулся в сторону GetOverLappedResult.
> Ты передал параметром overladded-структуру, в которой поле > hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.
или в данном случае это будет @OnDirectoryChange? Или ивент-объект не есть процедура?
-
> ивент-объект не есть процедура? >
Конечно не процедура.
ивент-объект создается вызовом CreateEvent()
-
uses
Main;
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
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.
Похоже? И как отлавливать теперь это событие?
-
> GetMem(lpOverlapped, SizeOf(lpOverlapped));
SizeOf(lpOverlapped) всегда равен 4, потому что это указатель. Либо разыменовывай его для взятия размера либо объяви переменную TOverlapped, тогда и GetMem не потребуется.
> ZeroMemory(lpBuf, SizeOf(lpBuf));
Здесь та же самая грубая ошибка.
> как отлавливать теперь это событие?
Любой удобной функцией ожидания - WaitForSingleObject, MsgWaitForMultipleObjects и иже с ними.
-
> > GetMem(lpOverlapped, SizeOf(lpOverlapped)); > > ZeroMemory(lpBuf, SizeOf(lpBuf));
Ой мама, это как это я??? Это я не специально :)
-
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
protected
procedure Execute; override;
end;
var
TCP: TIdTCPClient;
implementation
uses
Main;
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
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
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.
??? :)
-
> //Сюда должны попасть если в директории есть изменения
Да.
> //С помощью GetOverLappedResult > //Если при чтении из lpBuf узнаем, что появился > новый файл, тогда отправляем его споследствиями
Да, но при условии что ф-ция вернула True
> // Тут наверное надо обнулить lpBuf
Нафига ?
И вообще заведи себе привычку вызывать WinAPI-функции как функции - возвращаемые ими результаты следует анализировать, ибо от них напрямую зависит дальнейшее правильное ветвление алгоритма.
> WaitForSingleObject(hDirChangeEvent, 5000)
Тебя не смущает, что в течение этих 5 сек. таймаута ожидания сигнала ивента твой поток не будет реагировать на флаг Terminated ?
-
> FreeOnTerminate:=false;
Это лишнее.
> GetMem(lpOverlapped, SizeOf(lpOverlapped^));
Почему бы не сделать переменную Overlapped: TOverlapped локальной или полем класса ? Она ж крохотная, есть ли резон динамически распределять под нее память ?
> CreateEvent(nil, false, true, PChar('OnChangeDirecory'));
Почему true ? Он же у тебя сразу и просигналит, в то время как никаких изменений еще и в помине не было ...
Да и имя ивента не обязательно.
-
> И вообще заведи себе привычку вызывать WinAPI-функции как > функции - возвращаемые ими результаты следует анализировать, > ибо от них напрямую зависит дальнейшее правильное ветвление > алгоритма.
Угу. Это же пока черновик :) Ну мне сейчас хочется разобраться в логике ассинхронного вызова.
> > //Сюда должны попасть если в директории есть изменения > > > Да.
Логично предположить, что при этом запрос в очереди уже отсутствует!?
> > WaitForSingleObject(hDirChangeEvent, 5000) > > > Тебя не смущает, что в течение этих 5 сек. таймаута ожидания > сигнала ивента твой поток не будет реагировать на флаг Terminated > ?
Ну вообще не смущает. Если при остановки вся это бодяга остановится через пять сек. меня это не очень расстроит, хотя сделую 1000 :) Уговорил.
> > GetMem(lpOverlapped, SizeOf(lpOverlapped^)); > > > Почему бы не сделать переменную Overlapped: TOverlapped > локальной или полем класса ? Она ж крохотная, есть ли резон > динамически распределять под нее память ?
А разница?
> > CreateEvent(nil, false, true, PChar('OnChangeDirecory') > ); > > > Почему true ? Он же у тебя сразу и просигналит, в то время > как никаких изменений еще и в помине не было ...
Да, тут не правильно перевел "F1" :)
> Да и имя ивента не обязательно.
Ну пускай будет :)
-
> Логично предположить, что при этом запрос в очереди уже > отсутствует!?
Конечно. Его результаты выбраны из очереди в указанный тобой буфер.
> сделую 1000 :) Уговорил
Да я тебя не уговаривал) Просто есть гораздо более изящные решения для преодоления этой "проблемы")
-
> есть гораздо более изящные решения
Пример? :)
-
WaitFoeMultipleObjects, MsgWaitFoeMultipleObjects
-
> [32] Сергей М. © (25.10.07 12:55)
А в чем принципиальная разница? Чем оно "изящней"?
-
Тем что поток приобретает способность немедленно реагировать не только на твой overlapped-ивент, но и на другие ивенты и/или сообщения.
-
Я думал изящность имено в решении, а не в возможностях
Есть приложение (возможно служба) задача которой транспортировка файлов с диска (не факт что локального) в сеть (FTP-сервер), и аналогично обратное. За каждое из действий отвечает свой поток. Ранее он (который отправлял) просто сканил папки на отправку (FindFirst/Next, ну сам видел). Более на него никаких функций не накладывается (разве что лог ). Другую смысловую нагрузку он не несет. Реакция на Terminated в течении секунды - это даже более чем :) .
Непонятна такая вешь: Мы посавили запрос в очередь. По некоему событию, мы получаем факт, что этот запрос обработался и в указанном месте появились изменения. Данные об изменениях храняться по адресу lpBuf. Далее мы отправляем аналогичный запрос в очередь. 1. На черта нам тогда функция GetOverlappedResult и 2. В то время, пока мы обрабатываем ин-цию об изменениех, происходящие изменения не фиксируются?
-
> 1. На черта нам тогда функция GetOverlappedResult
Мало ли что могло произойти во время исполнения запроса ! Ф-ция как раз и покажет, успешно ли выполнен запрос. А сигнал ивента лишь фиксирует факт завершения (успешного или неуспешного) асинхронной операции.
> пока мы обрабатываем ин-цию об изменениех, происходящие > изменения не фиксируются?
Нет. Поэтому следует как можно быстрей после сигнала ивента принять решение о постановке очередного запроса и лишь потом разбирать результаты текущего выполненного.
-
> Нет. Поэтому следует как можно быстрей после сигнала ивента > принять решение о постановке очередного запроса и лишь потом > разбирать результаты текущего выполненного.
Гм... Но для этого все равно понадобится какое то время, т.е. Получили сигнал события, далее по идее запроса в очереди нет, следует отправить его еще раз, отправлять с тем же указателем на буфер низя - можем потерять его, следовательно, предварительно надо сохранить данные, это потребует некоторого времени, за которое могут произойти изменения, начинаю подумывать о том, что "сканить" диск всетаки надежнее
> Мало ли что могло произойти во время исполнения запроса > ! > Ф-ция как раз и покажет, успешно ли выполнен запрос. > А сигнал ивента лишь фиксирует факт завершения (успешного > или неуспешного) асинхронной операции.
hFile - чего она сюда хочет?
-
> чего она сюда хочет?
hDir твой она хочет.
-
> "сканить" диск всетаки надежнее
С чего бы ?
Explorer, заметь, использует именно ReadDirectoryChangesW
-
> [39] Сергей М. © (26.10.07 11:44)
Но ведь не асинхронный.
-
> Dennis I. Komarov © (26.10.07 12:26) [40]
> Но ведь не асинхронный.
С чего ты так уверен ? Да и какая разница, синхронный или асинхронный ? Режим не имеет значения с т.з. твоих волнений насчет "потерь" .
-
> С чего ты так уверен ?
Ибо обновление по F5 получаем. Я сомниваюсь, что все это время Explorer хранит эти изменения, и отображает их по команде.
А первоначальную информацию он как читает?
----------
lpNumberOfBytesTranferred - это VAR ? Он вообще имеет значение, ведь читаль lpBuf будем.
-
> Ибо обновление по 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
> Он вообще имеет значение
А нафига он тогда фигурирует в структуре, если он якобы не нужен ?
-
> Это 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. (разумеется не переменная)
-
> Dennis I. Komarov © (26.10.07 15:47) [44]
А, ты вон про что ..
Ну да, в дельфийской декларации этот параметр объявлен для передачи по ссылке, т.е. как var-параметр.
> Мой скромный перевод - это скока надо читать ин-фы из lpBuf. > (разумеется не переменная)
Правильно перевел.
-
Как понимаю, lpBuff заполняется пакетамя типа TFileNotifyInformation, в котором NextEntryOffset отвечает за существование следующего пакета. Отсюда и возник вопрос, нужен ли pNumberOfBytesTranferred вообще.
И как лучше сделать: 1.
... if WaitFor...... do begin if ReadDir... //далее разбираем lpBuf end;
2. if WaitFor...... do begin //тут разбираем lpBuf if ReadDir... end;
-
if WaitFor...... and GetOverlappedResult(..) then begin if ReadDir... //далее разбираем lpBuf end;
-
А как положено разбирать lpBuf? Ведь там может храниться несколько записей типа TFileNotifyInformation.
-
> как положено разбирать lpBuf?
В точном соответствии с офиц.описанием структуры FILE_NOTIFY_INFORMATION.
> Ведь там может храниться несколько записей типа
И что ?
-
> [47] Сергей М. © (26.10.07 16:51)
> if WaitFor...... and GetOverlappedResult(..) then > begin > if ReadDir... > //далее разбираем lpBuf Если получаем информацию, о появлении нового файла, то отправляем на FTP, исли он отправился успешно, то удаляем его => получаем очередное изменение, а значит lpBuf изменен, т.е. все остальные информацонные записи - утеряны :( Как быть? > end;
-
> Как быть?
Ну как ?... Конечно же скопировать содержимое lpBuf^ во временный буфер и разбирать уже этот временнный буфер, а не lpBuf^. Неужели это не очевидно ?
-
unit u_send;
interface
uses
Classes, Windows, SysUtils, StrUtils, DateUtils,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;
type
TThreadSend = class(TThread)
private
protected
procedure Execute; override;
end;
implementation
uses
Main;
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
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
Inc(i);
until tBuf[i].NextEntryOffset > 0
end;
end;
finally
FreeMem(lpBuf);
FreeMem(lpOverlapped);
CloseHandle(hDirChangeEvent);
CloseHandle(hDir);
end;
end;
end;
end.
Вот такой "безобразие". Как оно?
-
Действительно безобразие)
> 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^ ?
-
> Накой ляд тут этот цикл ?
Дабы если false, то пытался поставить запрос заново :)
> Как кореллирует sizeof(TTFileNotifyInformationArray) c 64*1024 > и lpNumberOfBytesTansferred^ ?
Откровенно говоря никак, но он веди не меньше получится. Я так понимаю, что остальные элементы массива просто пустыми остануться. А 1000 поставил из-за щедрости :)
Ок, понял. Меняем packed record на просто record
array [0..4095] of ....
-
> Дабы если false, то пытался поставить запрос заново
Малацца, что тут сказать)
А почему false - тебе по барабану.
Жди бесконечного цикла)
> А 1000 поставил из-за щедрости
От балды ты поставил, а не "из-за щедрости")
Программа, реализованная от балды, работать как положено никогда не будет.
У тебя есть lpNumberOfBytesTansferred^, у тебя есть связный список в lpBuf^, вот пробегись по этому списку и выдели памяти под врем.буфер ровно столько, сколько нужно, но не более lpNumberOfBytesTansferred^
-
Почему > lpNumberOfBytesTansferred^
?
GetOverLappedResult(hDir, lpOverlapped^, lpNumberOfBytesTansferred, true) третьим параметром указатель кушать не хочет, хотя в справке LPDWORD
В функции хочет Cardinal а на Pointer ругается.
> От балды ты поставил, а не "из-за щедрости")
Неее, балда подумала, что этого более чем хватит!
A array [0..4095] of ... почему низя сделать? Получим такойже объем (64*1024 = SizeOf(TFileNotifyInformation)*4096). По идее все должно оказаться в массиве. С ним же удобнее работать. Ну и пусть памяти быдет выделено немного больше (65Kb Не так страшно)
-
BytesTansferred: Cardinal;
..
GetOverLappedResult(... BytesTansferred ...)
> A array [0..4095] of ... почему низя сделать?
А почему не 100000 ? Почему не миллион ?
От балды оно и есть от балды, типа авось хватит)
А надо не "авось", а ровно столько, сколько возвращено операцией чтения.
-
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;
-
CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)
-
А если к примеру в этом месте происходит событие (Появился/удалился новый файл), то вернувшись в начало цикла WaitFor... получит эту информацию?
-
> получит эту информацию?
ПРобуй и поймешь)
-
> [61] Сергей М. © (31.10.07 08:22)
Тогда уже поздно будет :(
-
А как попрыгать по 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
-
> Dennis I. Komarov © (31.10.07 12:57) [63]
> CopyMemory(x, TempBuf, SizeOf(x^);
Сравни с:
CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)
Найди семь отличий
-
> [64] Сергей М. © (31.10.07 13:40)
Copy Memory(Адрес получателся, адрес источника, Количество байт)
Что не так?
x: PFileNotifyInformation; - адрес куда скопирукм одну запись tempBuf - временный буфер содержащий все записи SizeOf(x^) - Розмер записи содержащейся по адресу x
-
> адрес куда скопирукм одну запись
Почему одну-то ? Все записи разом нужно копировать, если тебя волнует максимально быстрая обработка события !
-
Неее
CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)
Мы сделали временный буфер в tempBuf. Далее мы с чистой совестью можем запустить ReadDir... Теперь нам надо пробежаться по tempBuf и считать всю инфу. в x хочу считать первую запись, затем смещать позицию на x^.NextEntryOffset. Как - не знаю :(
-
pInfo: PFileNotifyInformation; ..
pInfo := tempBuf; repeat .. pInfo указывает на очередную запись .. Inc(Cardinal(pInfo), NextEntryOffset); until NextEntryOffset = 0;
-
> [68] Сергей М. © (31.10.07 16:15) > Inc(Cardinal(pInfo), NextEntryOffset);
Вот его-то мне и не хватало :) И так я его и эдак. Мерси!
-
> И так я его и эдак
Мартышка и очки ?)
Паскаль-то учить надо)
-
В указателях пробел :(
-
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 я пологаю перестарался.
-
> SizeOf(lpBuf)
У попа была собака...
см. [24]
-
Да, бывает :( Paste блин.
А с сетевами (причем не win-выми) дисками она работать должна?
-
Ух ты, старый ник просочился :)
-
> А с сетевами (причем не win-выми) дисками она работать должна?
НЕ БУДЕТ :(
|