![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Для опытного глаза
Dennis I. Komarov © (2007-10-16 10:11:00)код модуля потока предназначенного для транспорта пакетов с диска в и-нет(FTP)
Еще неизвестно как будет хранится база клиентов и не ведуться логи
Просьба посмотреть данный код на корректность, в смысле поведения при нестабильном конекте (ну и вообще :) )
unit u_send;
interface
uses
Classes, Windows, SysUtils, StrUtils, DateUtils,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;
type
TThreadSend = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
var
FTP: TIdFTP;
implementation
uses
Main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure TThreadSend.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ TThreadSend }
procedure TThreadSend.Execute;
var
SearchRec: TSearchRec;
FindResult: Integer;
ClientCode: string;
FTPLogin: string;
HomeDir: string;
begin
{ Place thread code here }
FTP:=TIdFTP.Create(nil);
try
FTP.Host:='**.**.**.***';
FTP.Username:='********';
FTP.Password:='********';
FTP.Passive:=true;
while not Terminated do begin
{для каждого клиента делать } begin
FindResult := FindFirst(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\*.*', faAnyFile, SearchRec);
while FindResult = 0 do begin
with SearchRec do
begin
if (Name <> '.') and (Name <> '..') then
if not (Attr and faDirectory <> 0)
then begin
if not(FTP.Connected) then
try
FTP.Connect;
HomeDir:=FTP.RetrieveCurrentDir;
except
FTP.Disconnect;
end;
if FTP.Connected then
try
FTP.ChangeDir(HomeDir + '/' + FTPLogin + '/MBOX/RT');
FTP.Put(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\' + Name, Name);
if FTP.Size(Name) = Size then begin
FTP.Rename(Name, '../R/' + Name);
DeleteFile(BCDir + '\MAILBOX\' + ClientCode + '\POSTIN\' + Name);
end;
except
FTP.Disconnect;
end;
end;
FindResult:= FindNext(SearchRec);
end;
end;
FindClose(SearchRec);
end;
FTP.Disconnect;
Sleep(15000);
end;
finally
FTP.Disconnect;
FTP.Free;
end;
end;
end.
Сергей М. (2007-10-26 08:08:00) [41]
> 1. На черта нам тогда функция GetOverlappedResult
Мало ли что могло произойти во время исполнения запроса !
Ф-ция как раз и покажет, успешно ли выполнен запрос.
А сигнал ивента лишь фиксирует факт завершения (успешного или неуспешного) асинхронной операции.
> пока мы обрабатываем ин-цию об изменениех, происходящие
> изменения не фиксируются?
Нет. Поэтому следует как можно быстрей после сигнала ивента принять решение о постановке очередного запроса и лишь потом разбирать результаты текущего выполненного.
Dennis I. Komarov (2007-10-25 16:48:00) [42]Я думал изящность имено в решении, а не в возможностях
Есть приложение (возможно служба) задача которой транспортировка файлов с диска (не факт что локального) в сеть (FTP-сервер), и аналогично обратное. За каждое из действий отвечает свой поток. Ранее он (который отправлял) просто сканил папки на отправку (FindFirst/Next, ну сам видел). Более на него никаких функций не накладывается (разве что лог ). Другую смысловую нагрузку он не несет. Реакция на Terminated в течении секунды - это даже более чем :) .
Непонятна такая вешь: Мы посавили запрос в очередь. По некоему событию, мы получаем факт, что этот запрос обработался и в указанном месте появились изменения. Данные об изменениях храняться по адресу lpBuf. Далее мы отправляем аналогичный запрос в очередь.
1. На черта нам тогда функция GetOverlappedResult и
2. В то время, пока мы обрабатываем ин-цию об изменениех, происходящие изменения не фиксируются?
Сергей М. (2007-10-25 15:42:00) [43]Тем что поток приобретает способность немедленно реагировать не только на твой overlapped-ивент, но и на другие ивенты и/или сообщения.
Dennis I. Komarov (2007-10-25 13:29:00) [44]> [32] Сергей М. © (25.10.07 12:55)
А в чем принципиальная разница? Чем оно "изящней"?
Сергей М. (2007-10-25 12:55:00) [45]WaitFoeMultipleObjects, MsgWaitFoeMultipleObjects
Dennis I. Komarov (2007-10-25 11:15:00) [46]> есть гораздо более изящные решения
Пример? :)
Сергей М. (2007-10-25 10:50:00) [47]
> Логично предположить, что при этом запрос в очереди уже
> отсутствует!?
Конечно.
Его результаты выбраны из очереди в указанный тобой буфер.
> сделую 1000 :) Уговорил
Да я тебя не уговаривал)
Просто есть гораздо более изящные решения для преодоления этой "проблемы")
Dennis I. Komarov (2007-10-25 10:21:00) [48]> И вообще заведи себе привычку вызывать WinAPI-функции как
> функции - возвращаемые ими результаты следует анализировать,
> ибо от них напрямую зависит дальнейшее правильное ветвление
> алгоритма.
Угу. Это же пока черновик :) Ну мне сейчас хочется разобраться в логике ассинхронного вызова.
> > //Сюда должны попасть если в директории есть изменения
>
>
> Да.
Логично предположить, что при этом запрос в очереди уже отсутствует!?
> > WaitForSingleObject(hDirChangeEvent, 5000)
>
>
> Тебя не смущает, что в течение этих 5 сек. таймаута ожидания
> сигнала ивента твой поток не будет реагировать на флаг Terminated
> ?
Ну вообще не смущает. Если при остановки вся это бодяга остановится через пять сек. меня это не очень расстроит, хотя сделую 1000 :) Уговорил.
> > GetMem(lpOverlapped, SizeOf(lpOverlapped^));
>
>
> Почему бы не сделать переменную Overlapped: TOverlapped
> локальной или полем класса ? Она ж крохотная, есть ли резон
> динамически распределять под нее память ?
А разница?
> > CreateEvent(nil, false, true, PChar('OnChangeDirecory')
> );
>
>
> Почему true ? Он же у тебя сразу и просигналит, в то время
> как никаких изменений еще и в помине не было ...
Да, тут не правильно перевел "F1" :)
> Да и имя ивента не обязательно.
Ну пускай будет :)
Сергей М. (2007-10-24 17:18:00) [49]
> FreeOnTerminate:=false;
Это лишнее.
> GetMem(lpOverlapped, SizeOf(lpOverlapped^));
Почему бы не сделать переменную Overlapped: TOverlapped локальной или полем класса ? Она ж крохотная, есть ли резон динамически распределять под нее память ?
> CreateEvent(nil, false, true, PChar('OnChangeDirecory'));
Почему true ? Он же у тебя сразу и просигналит, в то время как никаких изменений еще и в помине не было ...
Да и имя ивента не обязательно.
Сергей М. (2007-10-24 17:10:00) [50]
> //Сюда должны попасть если в директории есть изменения
Да.
> //С помощью GetOverLappedResult
> //Если при чтении из lpBuf узнаем, что появился
> новый файл, тогда отправляем его споследствиями
Да, но при условии что ф-ция вернула True
> // Тут наверное надо обнулить lpBuf
Нафига ?
И вообще заведи себе привычку вызывать WinAPI-функции как функции- возвращаемые ими результаты следует анализировать, ибо от них напрямую зависит дальнейшее правильноеветвление алгоритма.
> WaitForSingleObject(hDirChangeEvent, 5000)
Тебя не смущает, что в течение этих 5 сек. таймаута ожидания сигнала ивента твой поток не будет реагировать на флаг Terminated ?
Dennis I. Komarov (2007-10-24 16:57:00) [51]
unit u_send;
interface
uses
Classes, Windows, SysUtils, StrUtils, DateUtils,
IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP, IniFiles;
type
OnDirectoryChange = procedure(Sender: TObject);
TThreadSend = class(TThread)
private
{ Private declarations }
protected
procedure Execute; override;
end;
var
TCP: TIdTCPClient;
implementation
uses
Main;
{ TThreadSend }
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = packed record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength:DWORD;
FileName: WideChar;
end;
procedure TThreadSend.Execute;
var
hDir: THandle;
hDirChangeEvent: THandle;
lpBuf: Pointer;
lpOverlapped: POverlapped;
begin
{ Place thread code here }
FreeOnTerminate:=false;
hDirChangeEvent:=CreateEvent(nil, false, true, PChar('OnChangeDirecory'));
hDir := CreateFile ( 'c:\test', GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
if hDir <> INVALID_HANDLE_VALUE then begin
GetMem(lpBuf, 64*1024);
GetMem(lpOverlapped, SizeOf(lpOverlapped^));
try
ZeroMemory(lpBuf, 64*1024);
lpOverlapped^.hEvent:=hDirChangeEvent;
ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
while not Terminated do begin
if WaitForSingleObject(hDirChangeEvent, 5000) = WAIT_OBJECT_0 then begin
//Сюда должны попасть если в директории есть изменения
//С помощью GetOverLappedResult
//Если при чтении из lpBuf узнаем, что появился новый файл, тогда отправляем его споследствиями
// Тут наверное надо обнулить lpBuf
ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
end;
end;
finally
FreeMem(lpBuf); FreeMem(lpOverlapped);
end;
end;
end;
end.
??? :)
Dennis I. Komarov (2007-10-24 11:39:00) [52]
> > GetMem(lpOverlapped, SizeOf(lpOverlapped));
> > ZeroMemory(lpBuf, SizeOf(lpBuf));
Ой мама, это как это я??? Это я не специально :)
Сергей М. (2007-10-24 09:21:00) [53]
> GetMem(lpOverlapped, SizeOf(lpOverlapped));
SizeOf(lpOverlapped) всегда равен 4, потому что это указатель.
Либо разыменовывай его для взятия размера либо объяви переменную TOverlapped, тогда и GetMem не потребуется.
> ZeroMemory(lpBuf, SizeOf(lpBuf));
Здесь та же самая грубая ошибка.
> как отлавливать теперь это событие?
Любой удобной функцией ожидания - WaitForSingleObject, MsgWaitForMultipleObjects и иже с ними.
Dennis I. Komarov (2007-10-23 17:14:00) [54]
uses
Main;
{ TThreadSend }
type
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = packed record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength:DWORD;
FileName: WideChar;
end;
procedure TThreadSend.Execute;
var
FTP: TIdFTP;
SearchRec: TSearchRec;
FindResult: Integer;
ClientCode: string;
FTPLogin: string;
HomeDir: string;
hDir: THandle;
lpBuf: Pointer;
lpOverlapped: POverlapped;
hOnDirChange: THandle;
begin
{ Place thread code here }
FreeOnTerminate:=false;
hOnDirChange:=CreateEvent(nil, false, true, PChar('OnChangeDirectory');
hDir := CreateFile ( 'c:\test', GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS or FILE_FLAG_OVERLAPPED, 0);
if hDir <> INVALID_HANDLE_VALUE then begin
GetMem(lpBuf, 64*1204);
GetMem(lpOverlapped, SizeOf(lpOverlapped));
try
ZeroMemory(lpBuf, SizeOf(lpBuf));
lpOverlapped^.hEvent:=hOnDirChange;
ReadDirectoryChangesW(hDir, lpBuf, SizeOf(lpBuf), true, FILE_NOTIFY_CHANGE_FILE_NAME, nil, lpOverlapped, nil);
finally
FreeMem(lpBuf); FreeMem(lpOverlapped);
end;
end;
end;
end.
Похоже? И как отлавливать теперь это событие?
Сергей М. (2007-10-23 16:53:00) [55]
> ивент-объект не есть процедура?
>
Конечно не процедура.
ивент-объект создается вызовом CreateEvent()
Dennis I. Komarov (2007-10-23 16:33:00) [56]> [19] Сергей М. © (23.10.07 16:16)
Нет, я отвернулся в сторону GetOverLappedResult.
> Ты передал параметром overladded-структуру, в которой поле
> hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.
или в данном случае это будет @OnDirectoryChange?
Или ивент-объект не есть процедура?
Anatoly Podgoretsky (2007-10-23 16:17:00) [57]> Dennis I. Komarov (23.10.2007 16:00:18) [18]
Какой еще хендл у процедуры?
Сергей М. (2007-10-23 16:16:00) [58]
> Dennis I. Komarov © (23.10.07 16:00) [18]
> Мыслю в верном направлении?
Нет.
Ты про прототип FileIOCompletionRoutine вник ?
Dennis I. Komarov (2007-10-23 16:00:00) [59]> [14] Сергей М. © (19.10.07 15:05)
Предположим создал некую:
type
OnDirectoryChange = procedure(Sender: TObject); // Зачем нужен sender сам еще не знаю, но пускай бубет :)
...
procwdure OnDirectoryChange((Sender: TObject);
begin
// делать что-то при обнаружении нового файла, а точнее шмальнуть его...
end;
А как узнать хандл процедуры?
Мыслю в верном направлении?
Сергей М. (2007-10-19 16:33:00) [60]
> если передать указатель @AnyProc
Имеешь ввиду параметр lpCompletionRoutine ?
Да, можно и так. Но прототип этой ф-ции должен соответствовать прототипу FileIOCompletionRoutine (см. справку)