Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Для опытного глаза


Страницы:   1 2 3 4

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) - это зачем ?


Страницы:   1 2 3 4

Наверх

Титульная страница Поиск, карта сайта Написать письмо