![]() |
| ||
|
|
Новости |
Поиск |
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.
Dennis I. Komarov (2007-10-19 16:28:00) [61]> [15] Dennis I. Komarov © (19.10.07 16:24)
Бредю :) Адрес памяти <> хэндлу системы
Dennis I. Komarov (2007-10-19 16:24:00) [62]А если передать указатель @AnyProc
procedure AnyProc;
begin
end;
Сергей М. (2007-10-19 15:05:00) [63]
> я к нему еще и не обращался
Как это не обращался ?
Ты передал параметром overladded-структуру, в которой поле hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.
Как же система уведомит тебя о наступившем событии, если ты не указал посредством какого объекта тебя уведомлять ?
Dennis I. Komarov (2007-10-19 14:56:00) [64]> Прежде чем обращаться к дескриптору события нужно создать
> этот объект
Разумеется, но я к нему еще и не обращался :)
Просто выложил код чтоб проверить, правильно ли я понимаю свои действия
Сергей М. (2007-10-19 13:50:00) [65]
> событие, которое надо как-то связать с помощью GetOverlappedResult
> в сруктуре _Overlapped.hEvent с дискриптором события
Прежде чем обращаться к дескриптору события нужно создать этот объект. А ты его не создал.
Dennis I. Komarov (2007-10-19 13:40:00) [66]Вот и вернулся я :)
> Сергей М. ©
В результате, наверное должно получиться что-то подобное:
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-17 15:04:00) [67]
> Dennis I. Komarov © (17.10.07 14:11) [9]
Угу.
Dennis I. Komarov (2007-10-17 14:11:00) [68]> [8] Сергей М. © (17.10.07 10:05)
Я так понял, что если программа не запущена, то все изменения за это время пройдут мимо. Т.е. сперва все равно надо "побродить по диску"?
Сергей М. (2007-10-17 10:05:00) [69]
> Пойду гляну, что за зверь
Оч даже симпатичный, ласковый и некапризный)
Dennis I. Komarov (2007-10-17 10:02:00) [70]> Гораздо более критично [5].
Это да, согласен.
> ReadDirectoryChangesW
Не слышал про такую :) Пойду гляну, что за зверь.
Сергей М. (2007-10-17 09:26:00) [71]
> нет необходимости бродить по диску все время. Побродил -
> на отдых (дай другим поработать), нашел - отправил
Дык на то есть асинхроннаая ReadDirectoryChangesW)
При ее использовании нет необходимости "бродить по диску" вообще- система сама известит тебя о произошедших измениях.
> в этом есть что-то критичное?
В принципе нет, но и резона тоже нет. И уж тем более непонятно, как это сказывается на работе FTP-сервера, так что без этой задержки серверу "заплохеет".
Гораздо более критично [5].
Slym (2007-10-17 09:16:00) [72]var FTP: TIdFTP;
засунь в тело потока
Dennis I. Komarov (2007-10-16 18:00:00) [73]Разумеется я про FTP-сервер, хотя если файлов для отправки нет - связываться он не будет. Просто нет необходимости бродить по диску все время. Побродил - на отдых (дай другим поработать), нашел - отправил.
А что, в этом есть что-то критичное?
Сергей М. (2007-10-16 15:44:00) [74]
> Dennis I. Komarov © (16.10.07 15:35) [2]
Каким образом протоколуможет "поплохеть" или "похорошеть" от твоего sleep'а или его отсутствия ?
Dennis I. Komarov (2007-10-16 15:35:00) [75]> [1] Сергей М. © (16.10.07 13:59)
Что бы FTP не поплохело :)
Сергей М. (2007-10-16 13:59:00) [76]
> ну и вообще
Sleep(15000) - это зачем ?