Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / 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-11-07 16:36:00) [1]
> А с сетевами (причем не win-выми) дисками она работать должна?

НЕ БУДЕТ :(

Dennis I. Komarov (2007-11-02 14:27:00) [2]
Ух ты, старый ник просочился :)

iXT (2007-11-02 13:25:00) [3]
Да, бывает :(
Paste блин.

А с сетевами (причем не win-выми) дисками она работать должна?

Сергей М. (2007-11-01 08:36:00) [4]

> SizeOf(lpBuf)

У попа была собака...

см. [24]

Dennis I. Komarov (2007-10-31 17:35:00) [5]
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 я пологаю перестарался.

Dennis I. Komarov (2007-10-31 17:19:00) [6]
В указателях пробел :(

Сергей М. (2007-10-31 17:07:00) [7]

> И так я его и эдак

Мартышка и очки ?)

Паскаль-то учить надо)

Dennis I. Komarov (2007-10-31 16:24:00) [8]
> [68] Сергей М. © (31.10.07 16:15)
> Inc( Cardinal(pInfo), NextEntryOffset);

Вот его-то мне и не хватало :) И так я его и эдак. Мерси!

Сергей М. (2007-10-31 16:15:00) [9]
pInfo: PFileNotifyInformation;
..

pInfo := tempBuf;
repeat
.. pInfo указывает на очередную запись ..
Inc(Cardinal(pInfo), NextEntryOffset);
until NextEntryOffset = 0;

Dennis I. Komarov (2007-10-31 15:42:00) [10]
Неее

CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)

Мы сделали временный буфер в tempBuf.
Далее мы с чистой совестью можем запустить ReadDir...
Теперь нам надо пробежаться по tempBuf и считать всю инфу.
в x хочу считать первую запись, затем смещать позицию на x^.NextEntryOffset. Как - не знаю :(

Сергей М. (2007-10-31 15:34:00) [11]

> адрес куда скопирукм одну запись

Почему одну-то ?
Все записи разом нужно копировать, если тебя волнует максимально быстрая обработка события !

Dennis I. Komarov (2007-10-31 14:48:00) [12]
> [64] Сергей М. © (31.10.07 13:40)

Copy Memory(Адрес получателся, адрес источника, Количество байт)

Что не так?

x: PFileNotifyInformation; - адрес куда скопирукм одну запись
tempBuf - временный буфер содержащий все записи
SizeOf(x^) - Розмер записи содержащейся по адресу x

Сергей М. (2007-10-31 13:40:00) [13]

> Dennis I. Komarov © (31.10.07 12:57) [63]

> CopyMemory(x, TempBuf, SizeOf(x^);

Сравни с:

CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)

Найди семь отличий

Dennis I. Komarov (2007-10-31 12:57:00) [14]
А как попрыгать по 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 (2007-10-31 09:06:00) [15]
> [61] Сергей М. © (31.10.07 08:22)

Тогда уже поздно будет :(

Сергей М. (2007-10-31 08:22:00) [16]

> получит эту информацию?

ПРобуй и поймешь)

Dennis I. Komarov (2007-10-30 17:23:00) [17]
А если к примеру в этом месте происходит событие (Появился/удалился новый файл), то вернувшись в начало цикла WaitFor... получит эту информацию?

Сергей М. (2007-10-30 17:12:00) [18]
CopyMemory(tempBuf, lpBuf, NumberOfBytesTansferred)

Dennis I. Komarov (2007-10-30 17:08:00) [19]
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;

Сергей М. (2007-10-30 16:55:00) [20]
BytesTansferred: Cardinal;

..

GetOverLappedResult(... BytesTansferred ...)

> A array [0..4095] of ... почему низя сделать?

А почему не 100000 ? Почему не миллион ?

От балды оно и есть от балды, типа авось хватит)

А надо не "авось", а ровно столько, сколько возвращено операцией чтения.

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

Наверх

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