Форум: "Сети";
Текущий архив: 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