Конференция "Сети" » Для опытного глаза
 
  • Dennis I. Komarov © (16.10.07 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.

  • Сергей М. © (16.10.07 13:59) [1]

    > ну и вообще


    Sleep(15000) - это зачем ?
  • Dennis I. Komarov © (16.10.07 15:35) [2]
    > [1] Сергей М. ©   (16.10.07 13:59)

    Что бы FTP не поплохело :)
  • Сергей М. © (16.10.07 15:44) [3]

    > Dennis I. Komarov ©   (16.10.07 15:35) [2]


    Каким образом протоколу может "поплохеть" или "похорошеть" от твоего sleep'а или его отсутствия ?
  • Dennis I. Komarov © (16.10.07 18:00) [4]
    Разумеется я про FTP-сервер, хотя если файлов для отправки нет - связываться он не будет. Просто нет необходимости бродить по диску все время. Побродил - на отдых (дай другим поработать), нашел - отправил.

    А что, в этом есть что-то критичное?
  • Slym © (17.10.07 09:16) [5]
    var FTP: TIdFTP;
    засунь в тело потока
  • Сергей М. © (17.10.07 09:26) [6]

    > нет необходимости бродить по диску все время. Побродил -
    >  на отдых (дай другим поработать), нашел - отправил


    Дык на то есть асинхроннаая ReadDirectoryChangesW)
    При ее использовании нет необходимости "бродить по диску" вообще - система сама известит тебя о произошедших измениях.


    > в этом есть что-то критичное?


    В принципе нет, но и резона тоже нет. И уж тем более непонятно, как это сказывается на работе FTP-сервера, так что без этой задержки серверу "заплохеет".

    Гораздо более критично [5].
  • Dennis I. Komarov © (17.10.07 10:02) [7]
    > Гораздо более критично [5].

    Это да, согласен.

    > ReadDirectoryChangesW

    Не слышал про такую :) Пойду гляну, что за зверь.
  • Сергей М. © (17.10.07 10:05) [8]

    > Пойду гляну, что за зверь


    Оч даже симпатичный, ласковый и некапризный)
  • Dennis I. Komarov © (17.10.07 14:11) [9]
    > [8] Сергей М. ©   (17.10.07 10:05)

    Я так понял, что если программа не запущена, то все изменения за это время пройдут мимо. Т.е. сперва все равно надо "побродить по диску"?
  • Сергей М. © (17.10.07 15:04) [10]

    > Dennis I. Komarov ©   (17.10.07 14:11) [9]


    Угу.
  • Dennis I. Komarov © (19.10.07 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 с дискриптором события?
    Вобщем не совсем понятно, как получить извещение от системы.
  • Сергей М. © (19.10.07 13:50) [12]

    > событие, которое надо как-то связать с помощью GetOverlappedResult
    > в сруктуре _Overlapped.hEvent с дискриптором события


    Прежде чем обращаться к дескриптору события нужно создать этот объект. А ты его не создал.
  • Dennis I. Komarov © (19.10.07 14:56) [13]
    > Прежде чем обращаться к дескриптору события нужно создать
    > этот объект

    Разумеется, но я к нему еще и не обращался :)

    Просто выложил код чтоб проверить, правильно ли я понимаю свои действия
  • Сергей М. © (19.10.07 15:05) [14]

    > я к нему еще и не обращался


    Как это не обращался ?

    Ты передал параметром overladded-структуру, в которой поле hEvent = 0, вместо того чтобы содержать хэндл ивент-объекта.

    Как же система уведомит тебя о наступившем событии, если ты не указал посредством какого объекта тебя уведомлять ?
  • Dennis I. Komarov © (19.10.07 16:24) [15]
    А если передать указатель @AnyProc

    procedure AnyProc;
    begin
    end;
  • Dennis I. Komarov © (19.10.07 16:28) [16]
    > [15] Dennis I. Komarov ©   (19.10.07 16:24)

    Бредю :) Адрес памяти <> хэндлу системы
  • Сергей М. © (19.10.07 16:33) [17]

    > если передать указатель @AnyProc


    Имеешь ввиду параметр lpCompletionRoutine ?

    Да, можно и так. Но прототип этой ф-ции должен соответствовать прототипу FileIOCompletionRoutine (см. справку)
  • Dennis I. Komarov © (23.10.07 16:00) [18]
    > [14] Сергей М. ©   (19.10.07 15:05)

    Предположим создал некую:

    type
     OnDirectoryChange = procedure(Sender: TObject);  // Зачем нужен sender сам еще не знаю, но пускай бубет :)
    ...

    procwdure OnDirectoryChange((Sender: TObject);
    begin
    // делать что-то при обнаружении нового файла, а точнее шмальнуть его...

    end;



    А как узнать хандл процедуры?

    Мыслю в верном направлении?
  • Сергей М. © (23.10.07 16:16) [19]

    > Dennis I. Komarov ©   (23.10.07 16:00) [18]


    > Мыслю в верном направлении?


    Нет.

    Ты про прототип FileIOCompletionRoutine вник ?
 
Конференция "Сети" » Для опытного глаза
Есть новые Нет новых   [134431   +10][b:0][p:0.004]