Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2002.04.25;
Скачать: [xml.tar.bz2];

Вниз

Как работать с TNMStrm на подтверждение чего-либо?   Найти похожие ветки 

 
Aleksandr   (2002-02-13 16:01) [8]

2 Digitman
Ок, даю код:
// модуль с потоком-отсыльщиком данных
type
TDataStatus=(dsIdle,dsCommand);

TWebDataProcessor=class (TThread)
private
...
FNMStream : TNMStrm;
FStatus : TDataStatus;
public
constructor Create(ACreateSuspended : boolean;
ASleepInterval : longint;ADir : string;
AHost : string; APort : word);
procedure Execute; override;
function SendFile(AFileName : string) : boolean;
procedure FNMStreamOnRead(Sender : TObject);
...
end;

var
Section : TRTLCriticalSection;

implementation

...
constructor TWebDataProcessor.Create(ACreateSuspended : boolean;
ASleepInterval : longint;ADir : string;
AHost : string; APort : word);
begin
inherited Create(true);
FreeOnTerminate:=False;
FSleepInterval:=ASleepInterval;
FDir:=ADir;
FNMStream:=TNMStrm.Create(nil);
FNMStream.Host:=AHost;
FNMStream.Port:=APort;
FNMStream.OnRead:=FNMStreamOnRead;
FlogCount:=1000;
FStatus:=dsIdle;
FLogFile:=CorrectPath(LogFilesDir)+"nmstream.log";
InitializeCriticalSection(Section);
if NOT ACreateSuspended then
Resume
end;

procedure TWebDataProcessor.Execute;
var
HeadersList : TList;
FData : PWin32FindData;
i : integer;
s : string;
begin
while NOT Terminated do begin
HeadersList:=TList.Create;
if SearchFiles32(HeadersList,FDir+HeadersMask) then begin
for i:=0 to HeadersList.Count-1 do begin
FData:=HeadersList.Items[i];
EnterCriticalSection(Section);
if FileExists(CorrectPath(FDir)+ExtractFileName(FData.cFileName)) AND SendFile(CorrectPath(FDir)+ExtractFileName(FData.cFileName)) then begin
s:=CorrectPath(FDir)+ExtractFileName(FData.cFileName);
AddLog("header sended: "+s)
end;
LeaveCriticalSection(Section);
Dispose(Fdata)
end
end;
HeadersList.Free;
Sleep(FSleepInterval)
end
end;

function TWebDataProcessor.SendFile(AFileName: string): boolean;
var
R : TRiHeader;
F : TFileStream;
begin
Result:=false;
R:=TRIHeader(GetFromFileStream(AFileName));
try
if FileExists(R.TransName) then begin
F:=TFileStream.Create(R.TransName,fmOpenRead);
try
FNMStream.FromName:=ExtractFileName(R.TransName);
FNMStream.PostIt(F);
FStatus:=dsCommand;
FNMStream.TimeOut:=5000;
FNMStream.Connect;
if FNMStream.Connected then begin
FNMStream.Writeln("OK");
while (FStatus=dsCommand) OR FNMStream.BeenTimedOut do
Application.ProcessMessages;
FNMStream.DisConnect;
end;
FNMStream.TimeOut:=0;
if (NOT FNMStream.BeenTimedOut) AND (FStatus=dsIdle) then
Result:=true;
except
on E:Exception do
AddLog(E.Message)
end
end
finally
if Assigned(F) then
F.Free;
if Result then begin
DeleteFile(AFileName);
DeleteFile(R.TransName)
end;
R.Free
end
end;

procedure TWebDataProcessor.FNMStreamOnRead(Sender: TObject);
begin
if FStatus=dsCommand then
FStatus:=dsIdle
end;

//Код из программы-клиента в создании формы:
FDataProcessor:=TWebDataProcessor.Create(false,500,....,80);
//Код из тестировочной программы-сервера:

type
TForm1 = class(TForm)
lbMessages: TListBox;
NMStrmServ1: TNMStrmServ;
procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;strm: TStream);
procedure FormCreate(Sender: TObject);
...
private
FStatus : TDataStatus;
public
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
F : TMemoryStream;
begin
if FStatus=dsIdle then begin
F:=TMemoryStream.Create;
F.CopyFrom(Strm,NMStrmServ1.BytesTotal);
F.SaveToFile(OutDir+sFrom);
F.Free;
FStatus:=dsCommand;
lbMessages.Items.Add("Received "+sFrom)
end
else begin
NMStrmServ1.Writeln("OK!");
lbMessages.Items.Add("Executing - OK ");
FStatus:=dsIdle
end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Fstatus:=dsIdle;
NMStrmServ1.Connect
end;



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2002.04.25;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.45 MB
Время: 0.006 c
1-80984
Sat7
2002-04-12 11:59
2002.04.25
Есть дерево. Но не бинарное. :)


7-81089
SoftOne
2002-01-30 02:11
2002.04.25
I/O error, 32


1-80867
лут
2002-04-13 15:23
2002.04.25
как сделать анлимитед анду/реду для мемо?


7-81094
Lord BDV
2002-01-28 20:37
2002.04.25
Работа со шрифтами


3-80828
SasaR
2002-04-05 15:24
2002.04.25
Без BDE





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский