It appears as though the problem with this is in the tme needed to dial
out and authorize. I cannot get the application to 'wait' for a
response. I have tried looping over an application.processmessages but
that did not work.
I would like to try Named Pipes because the CallNamedPipe function has a
timeout variable, however, I can find little documentation and no
examples on how to make this work with Delphi.
Does anyone have a snippet of code that uses CallNamedPipe? Is
CallNamedPipe the only option to use?
Thanks in advance.
Mike
'Django' is a full implementation of all DDE functions delivered in a
single powerful but easy to deploy component. The product comes with
seven demo projects, a 110 page tutorial/reference doc in WORD format,
and extensive on line help.
You can download an evaluation version from our web site at...
http://dspace.dial.pipex.com/town/estate/ns21/icfmdc.htm
Regards,
.... ICFM Software
Cheers
unit uPipes;
////////////////////////////////////////////////////////////////////////////////
// Pipe Server and Client
//
// This code creates a Base Pipe Server Class.
// Inherit it and override the PipeMsgIn method to react to incoming
messages
//
// Author: David Todd
////////////////////////////////////////////////////////////////////////////////
// Modification log
// ----------------
// 16.06.99 Dave Todd
// . Created the class
////////////////////////////////////////////////////////////////////////////////
interface
uses
Windows, Classes, SysUtils, extctrls;
type
{ ----- TPipeServer ----- }
{ The main Pipe Server Class }
TPipeServer = class(TComponent)
protected
ControlPipe : THandle; { handle to pipe }
Interval : integer; { delay time between checking the pipe }
Terminated : boolean; { flag to stop the server }
procedure CreateControlPipe; { creates a pipe handle }
public
PipeName : string; { name of Pipe - should be read only }
constructor CreateServer(AOwner : TComponent; AMachineName, APipeName :
string; AnInterval : integer);
{ constructor - make AMachineName '.' for local machine }
procedure PipeMsgIn(Msg : Byte); virtual; abstract;
{ method for when Server receives message - override to react to message
}
procedure CheckPipe;
{ this method checks the Pipe for data periodically }
{ it is used internally, but public so that threads can get at it }
{ there is no need for any extrnal code to call it }
procedure StartPipeServer;
{ start the Pipe, and checking for data }
procedure StopPipeServer;
{ stop the Pipe, and checking for data }
end; { class }
procedure SendPipeMessage(AMachineName, APipeName : string; Msg : Byte);
{ Client procedure to send Message to the Server }
{ make AMachineName '.' for local machine }
implementation
type
{ ----- TRecBuf ----- }
{ for internal use only }
TRecBuf = array[1..1] of Byte;
{ ----- TPipeServerThread ----- }
{ a thread that reads the Pipe, and passes the data back to the Server }
TPipeServerThread = class(TThread)
protected
ControlPipe : THandle; { handle to pipe }
Owner : TPipeServer; { Pipe Server to report back to }
Msg : Byte; { message read }
procedure Execute; override;
{ main execute procedure of thread }
procedure PipeMsgIn;
{ run once the data has been read - it returns the message to the Server
}
public
constructor CreateThread(AOwner : TPipeServer; AControlPipe : THandle);
{ constructor }
end; { class }
{ ----- TPipeTimerThread ----- }
{ a thread that acts as a timer to notify the server }
{when to poll the Pipe for data }
TPipeTimerThread = class(TThread)
protected
Owner : TPipeServer; { Pipe Server to report back to }
DelayTime : integer; { Sleep Time }
procedure Execute; override;
{ main execute procedure of thread }
procedure TimeUp;
{ run once the sleep has completed - notifies the Server }
public
constructor CreateThread(AOwner : TPipeServer; ADelayTime : integer);
{ constructor }
end; { class }
{ ----- Create ----- }
{ This is the Pipe Server's constructor. It creates the Pipe Name }
constructor TPipeServer.CreateServer(AOwner : TComponent; AMachineName,
APipeName : string; AnInterval : integer);
begin { constructor }
inherited Create(AOwner);
Self.PipeName := '\\'+AMachineName+'\pipe\'+APipeName;
{ \\.\pipe\PipeName }
Self.Interval := AnInterval;
{ Set Pipe Poll time }
end; { constructor }
{ ----- StartPipeServer ----- }
{ This procedure creates a Pipe, and polls it }
procedure TPipeServer.StartPipeServer;
begin { procedure }
Self.CreateControlPipe;
{ Create a Pipe }
Self.Terminated := false;
TPipeTimerThread.CreateThread(Self,Self.Interval);
{ set timer to notify after a given duration }
end; { procedure }
{ ----- StopPipeServer ----- }
{ This procedure stops polling the Pipe, and destroys it }
procedure TPipeServer.StopPipeServer;
begin { procedure }
Self.Terminated := true;
FlushFileBuffers(Self.ControlPipe);
DisconnectNamedPipe(Self.ControlPipe);
CloseHandle(Self.ControlPipe);
{ clear and close the Pipe }
end; { procedure }
{ ----- CreateControlPipe ----- }
{ This procedure creates a Pipe, with security access for all }
procedure TPipeServer.CreateControlPipe;
var
Sd : TSecurityDescriptor;
Sa : TSecurityAttributes;
begin { procedure }
{ set security objects }
InitializeSecurityDescriptor(@Sd,SECURITY_DESCRIPTOR_REVISION);
SetSecurityDescriptorDacl(@Sd,true,nil,false);
Sa.nLength := SizeOf(Sa);
Sa.lpSecurityDescriptor := @Sd;
Sa.bInheritHandle := true;
{ Create Pipe }
Self.ControlPipe := CreateNamedPipe(PChar(Self.PipeName),
PIPE_ACCESS_INBOUND,
PIPE_TYPE_BYTE+PIPE_READMODE_BYTE+PIPE_WAIT,
PIPE_UNLIMITED_INSTANCES,
1,
1,
Self.Interval*2,
@Sa);
if Self.ControlPipe = INVALID_HANDLE_VALUE then
raise Exception.Create('CreateNamedPipe Failed');
end; { procedure }
{ ----- CheckPipe ----- }
{ This procedure checks the Pipe to see if any data has been sent }
procedure TPipeServer.CheckPipe;
var
BytesAvail : DWORD;
begin { procedure }
if not Self.Terminated then
{ while still running loop }
begin { if }
if PeekNamedPipe(Self.ControlPipe,nil,0,nil,@BytesAvail,nil) then
{ if the Named Pipe is active }
begin { if }
if BytesAvail > 0 then
{ and there is data in the Pipe }
begin { if }
TPipeServerThread.CreateThread(Self,ControlPipe);
{ create thread to read the data and return it }
Self.CreateControlPipe;
{ create new pipe for next message }
end; { if }
end; { if }
TPipeTimerThread.CreateThread(Self,Self.Interval);
{ sleep until next poll }
end; { if }
end; { procedure }
{ ----- Create ----- }
{ create the thread that reads the Pipe }
constructor TPipeServerThread.CreateThread(AOwner : TPipeServer;
AControlPipe : THandle);
begin { constructor }
inherited Create(False);
Self.FreeOnTerminate := True;
Self.ControlPipe := AControlPipe;
Self.Owner := AOwner;
end; { constructor }
{ ----- Execute ----- }
{ main execute procedure of thread }
procedure TPipeServerThread.Execute;
var
RecBuf : TRecBuf; { block of memory read from pipe }
BytesRead : DWORD; { count of bytes read }
begin { procedure }
if ReadFile(Self.ControlPipe,RecBuf,1,BytesRead,nil) then
{ if successfully read from Pipe }
begin { if }
Self.Msg := RecBuf[1];
{ Message is first byte of data }
Self.Synchronize(Self.PipeMsgIn);
{ notify server }
end; { if }
FlushFileBuffers(Self.ControlPipe);
DisconnectNamedPipe(Self.ControlPipe);
CloseHandle(Self.ControlPipe);
{ clear and close the Pipe }
end; { procedure }
{ ----- PipeMsgIn ----- }
{ this procedure returns the message to the Server }
procedure TPipeServerThread.PipeMsgIn;
begin { procedure }
Self.Owner.PipeMsgIn(Self.Msg);
end; { procedure }
{ ----- CreateThread ----- }
{ create the thread that acts as a timer for the Pipe Server }
constructor TPipeTimerThread.CreateThread(AOwner : TPipeServer; ADelayTime
: integer);
begin { constructor }
inherited Create(False);
Self.FreeOnTerminate := True;
Self.Owner := AOwner;
Self.DelayTime := ADelayTime;
end; { constructor }
{ ----- Execute ----- }
{ main execute procedure of thread }
procedure TPipeTimerThread.Execute;
begin { procedure }
Sleep(Self.DelayTime);
Self.Synchronize(Self.TimeUp);
end; { procedure }
{ ----- TimeUp ----- }
{ notify the Pipe Server that time is up }
procedure TPipeTimerThread.TimeUp;
begin { procedure }
Self.Owner.CheckPipe;
end; { procedure }
{ ----- SendPipeMessage ----- }
{ Client procedure to send Message to the Server }
{ make AMachineName '.' for local machine }
procedure SendPipeMessage(AMachineName, APipeName : string; Msg : Byte);
var
ControlPipe : THandle; { handle to Pipe }
BytesWrite : DWORD; { count of bytes written }
PipeName : string; { full pipe name }
begin { procedure }
PipeName := '\\'+AMachineName+'\pipe\'+APipeName;
{ \\.\pipe\PipeName }
{ open Named Pipe }
ControlPipe := CreateFile(PChar(PipeName),
GENERIC_WRITE,
0,
nil,
OPEN_EXISTING,
0,
0);
if ControlPipe = INVALID_HANDLE_VALUE then
{ if Pipe not opened properly }
begin { if }
raise Exception.Create('Named Pipe - CreateFile Failed');
end { if }
else
{ if Pipe open }
begin { else }
WriteFile(ControlPipe,Msg,1,BytesWrite,nil);
{ write the data }
CloseHandle(ControlPipe);
{ close handle after use }
end; { else }
end; { procedure }
end.