unit uPipeThread;
interface
uses
Windows,
SysUtils,
Classes,
Dialogs;
const
CONNECTING_STATE = 0;
READING_STATE = 1;
BUFSIZE = 4096;
PipeName = '
\\.\pipe\RegPipe';
type
TDataArray =
array[0..BUFSIZE-1]
of Char;
LPOVERLAPPED = POVERLAPPED;
LPPipeInst = ^PipeInst;
_PipeInst =
record
oOverlap : OVERLAPPED;
hPipeInst : THandle;
chRequest : TDataArray;
cbRead : DWORD;
dwState : DWORD;
fPendingIO : BOOL;
EventArray : TWOHandleArray;
end;
PipeInst = _PipeInst;
TPipeThread =
class(TThread)
private
Pipe : PipeInst;
FAccount :
String;
FDomain :
String;
FOnTerminate: TNotifyEvent;
function ConnectToNewClient (hPipe : THandle; lpo : LPOVERLAPPED) : BOOL;
procedure DisconnectAndReconnect;
procedure log(msg :
string);
procedure SetOnTerminate(
const Value: TNotifyEvent);
property OnTerminate : TNotifyEvent
read FOnTerminate
write SetOnTerminate;
protected
procedure Execute;
override;
public
Constructor Create;
end;
implementation
{ TPipeThread }
function TPipeThread.ConnectToNewClient(hPipe: THandle;
lpo: LPOVERLAPPED): BOOL;
var
fConnected : BOOL;
fPendingIO : BOOL;
begin
log('
connecttonewclient');
fConnected := false;
fPendingIO := true;
fConnected := ConnectNamedPipe (hPipe, lpo);
Pipe.EventArray[1] := lpo^.hEvent;
if fConnected
then
begin
Result := false;
Exit;
end;
case GetLastError
of
ERROR_IO_PENDING : fPendingIO := true;
ERROR_PIPE_CONNECTED : SetEvent(lpo^.hEvent);
else
Result := false;
Exit;
end;
Result := fPendingIO;
end;
constructor TPipeThread.Create;
begin
log('
create');
FreeOnTerminate := false;
try
Pipe.EventArray[0] := CreateEvent(
nil, false, true,
nil);
except
on E:
Exception do log(E.
Message);
end;
log('
create 2');
inherited Create(true);
end;
procedure TPipeThread.DisconnectAndReconnect;
begin
log('
dc and rc');
DisconnectNamedPipe (Pipe.hPipeInst);
Pipe.fPendingIO := ConnectToNewClient (Pipe.hPipeInst, @Pipe.oOverlap);
if Pipe.fPendingIO
then
Pipe.dwState := CONNECTING_STATE
else
Pipe.dwState := READING_STATE;
end;
procedure TPipeThread.Execute;
var
i : DWORD;
dwWait : DWORD;
cbRet : DWORD;
dwError : DWORD;
fSuccess : BOOL;
begin
log('
execute');
Pipe.oOverlap.hEvent := CreateEvent (
nil, false, true,
nil);
Pipe.hPipeInst := CreateNamedPipe (
PipeName,
PIPE_ACCESS_DUPLEX
or FILE_FLAG_OVERLAPPED,
PIPE_TYPE_MESSAGE
or PIPE_NOWAIT,
PIPE_UNLIMITED_INSTANCES,
BUFSIZE,
BUFSIZE,
0,
nil);
Pipe.fPendingIO := ConnectToNewClient (Pipe.hPipeInst, @Pipe.oOverlap);
if Pipe.fPendingIO
then
Pipe.dwState := CONNECTING_STATE
else
Pipe.dwState := READING_STATE;
while (
not Terminated)
do
begin
log('
in loop');
log('
before waitformultipleobjcts');
dwWait := WaitForMultipleObjects(2, @Pipe.EventArray[0], false, INFINITE);
//dwWait := WaitForSingleObject (Pipe.oOverlap.hEvent, 1000);
log('
after waitformultipleobjcts');
i := dwWait - WAIT_OBJECT_0;
if i <> 1
then
begin
if Pipe.fPendingIO
then
begin
fSuccess := GetOverlappedResult (
Pipe.hPipeInst,
Pipe.oOverlap,
cbRet,
false);
case Pipe.dwState
of
CONNECTING_STATE: Pipe.dwState := READING_STATE;
READING_STATE:
begin
if (
not fSuccess)
and (cbRet = 0)
then
DisconnectAndReconnect;
end;
end;
end;
case Pipe.dwState
of
READING_STATE:
begin
fSuccess := ReadFile (
Pipe.hPipeInst,
Pipe.oOverlap,
BUFSIZE,
Pipe.cbRead,
@Pipe.oOverlap);
if fSuccess
and (Pipe.cbRead <> 0)
then
begin
Pipe.fPendingIO := false;
FAccount := Copy(Pipe.chRequest, 0, Pos(#35, Pipe.chRequest)-1);
FDomain := Copy(Pipe.chRequest, Pos(#35, Pipe.chRequest), sizeof(Pipe.chRequest));
log(FAccount + '
// '+ FDomain);
end;
dwError := GetLastError;
if (
not fSuccess)
and (dwError = ERROR_IO_PENDING)
then
Pipe.fPendingIO := true;
DisconnectAndReconnect;
end;
end;
end;
end;
CloseHandle (Pipe.oOverlap.hEvent);
CloseHandle (Pipe.hPipeInst);
end;
procedure TPipeThread.log(msg:
string);
var
s : tstrings;
begin
try
s := TStringList.Create;
try
s.LoadFromFile('
C:\log.txt');
except
s.SaveToFile('
C:\log.txt');
end;
s.Add(Msg);
s.SaveToFile('
C:\log.txt');
finally
s.Free;
end;
end;
procedure TPipeThread.SetOnTerminate(
const Value: TNotifyEvent);
begin
log('
onterminate');
SetEvent(Pipe.EventArray[0]);
FOnTerminate := Value;
end;
end.