Mailslots and Terminal Server

NetGeek

I have found mailslots to be a pain. Why not use TCP? There are some great components out there like Indy and errmm the french one :) (cant remember the name off by heart).
You could make a server app that monitors on one port number e.g. 200 for login in then you could keep a string list of who is logged on so when you need to make a broadcast you could just write a loop to go through them. Or if you want to you can send it on ip address 255.255.255.255 which is supposed to be the broadcast ip for TCP but Ive never tried it.

I do have some examples of some client / server apps with TCP if you want them.
just a thought.
regards
Smurff

Use Named Pipes (NT only). Start both client and server from a DOS window.

Modyfied version of: http://www.jgsoftware.com/files/pipes.zip



======= PipeClnt.dpr =========

program PipeClnt;

{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils, PipeObjs;

var
  Pipe: TPipeClient;
  BrokenPipe: Boolean;
  buf: AnsiString;

begin
  Pipe:= TPipeClient.Create('\\.\pipe\TestServer');
  repeat
    Readln(buf);
    if buf <> '' then begin
      Pipe.WriteStr(buf + #13#10);
      Pipe.ReadStr(buf);
      write('From server: ', buf);
    end;
  until buf = '';
  Pipe.Free;
end.



======= PipeSrv.dpr =========

program PipeSrv;

{$APPTYPE CONSOLE}

uses
  Windows, SysUtils, PipeObjs;

const
  CR = #13;
  LF = #10;
  CRLF = CR + LF;

var
  Pipe: TPipeServer;
  BrokenPipe: Boolean;
  buf: AnsiString;
  sa: TSecurityAttributes;

begin
  writeln('Halt with ^C');
  // Set NIL security
  sa.nLength:= sizeOf(sa);
  sa.bInheritHandle:= false;
  sa.lpSecurityDescriptor:= nil;
  while true do begin
    try
      Pipe:= TPipeServer.Create('\\.\pipe\TestServer', sa);
    except
      on E: Exception do begin
        writeln(E.Message);
        halt(1);
      end;
    end;
    { Wait for client to connect }
    if not Pipe.Connect then begin
      Writeln('Connect failed');
      Pipe.Destroy;
      halt(2);
    end;
    { Client is connected, process input }
    writeln('Client has connected!');
    BrokenPipe:= false;
    repeat
      try
        Pipe.ReadStr(buf);
      except
        BrokenPipe:= true;
      end;
      if not BrokenPipe then
        Pipe.WriteStr(UpperCase(buf));
    until BrokenPipe;
    { Clean up }
    Pipe.Free;
  end; // while
end.



======= PipeObjs.pas=========

unit PipeObjs;

interface

uses
  Windows, Classes, SysUtils;

type
  EPipe = class(Exception);

  TPipe = class(TObject)
    pipeHandle: THandle;
    rc        : Boolean;

    destructor  Destroy; override;

    procedure Read(var buf; bufsize: Integer; var BytesRead: Cardinal);
    procedure Write(var buf; bufsize: Integer; var BytesWritten: Cardinal);
    procedure ReadStr(var buf: AnsiString);
    procedure WriteStr(ToSend: AnsiString);
  end;

  TPipeServer = class(TPipe)
    constructor Create(AName: AnsiString; var sa: TSecurityAttributes); virtual;

    function Connect: Boolean;
  end;

  TPipeClient = class(TPipe)
    constructor Create(AName: AnsiString); virtual;
  end;

implementation

procedure TPipe.Read(var buf; bufsize: Integer; var BytesRead: Cardinal);
begin
  rc:= ReadFile(pipeHandle, buf, bufsize, BytesRead, nil);
  if not rc then
    raise EPipe.Create('TPipe.Read : Broken pipe, error = ' + IntToStr(GetLastError));
end;

procedure TPipe.Write(var buf; bufsize: Integer; var BytesWritten: Cardinal);
begin
  rc:= WriteFile(pipeHandle, buf, bufsize, BytesWritten, nil);
  if not rc then
    raise EPipe.Create('TPipe.Write : Broken pipe, error = ' + IntToStr(GetLastError));
end;

procedure TPipe.ReadStr(var buf: AnsiString);
var
  BytesRead: Cardinal;
begin
  SetLength(buf, 255);
  Read(buf[1], length(buf), BytesRead);
  SetLength(buf, BytesRead);
end;

procedure TPipe.WriteStr(ToSend: AnsiString);
var
  buf: AnsiString;
  BytesWritten: Cardinal;
begin
  buf:= ToSend;
  Write(buf[1], length(buf), BytesWritten);
end;


destructor TPipe.Destroy;
begin
  if pipeHandle <> 0 then CloseHandle(pipeHandle);
  Inherited Destroy;
end;

constructor TPipeServer.Create(AName: AnsiString; var sa: TSecurityAttributes);
begin
  Inherited Create;
  pipeHandle:= CreateNamedPipe(PChar(AName), PIPE_ACCESS_DUPLEX, PIPE_TYPE_MESSAGE +
                               PIPE_WAIT, 1, 0, 0, 150, @sa);
  if pipeHandle = INVALID_HANDLE_VALUE then
    raise EPipe.Create('TPipeServer.Create, error = ' + IntToStr(GetLastError));
end;

function TPipeServer.Connect: Boolean;
begin
  Result:= ConnectNamedPipe(pipeHandle, nil);
end;

constructor TPipeClient.Create(AName: AnsiString);
begin
  Inherited Create;
  pipeHandle:= CreateFile(PChar(AName), GENERIC_READ + GENERIC_WRITE,
                          FILE_SHARE_READ, nil, OPEN_EXISTING,
                          FILE_ATTRIBUTE_NORMAL, 0);
  if pipeHandle = INVALID_HANDLE_VALUE then
    raise EPipe.Create('TPipeClient.Create, error = ' + IntToStr(GetLastError));
end;

end.

NetGeek, as quick fix, you could use an identifier unique to the logged on user as Mailslot identifier, so that different users in different sessions on the same server will work correctly.

I found what you need as identifier: when TS is running, a global environment variable SESSIONNAME is set with the session identifier unique to the system. If SESSIONNAME is empty (does not exist), you're app is running on the console.

smurff, I agree completely that mailslots are a real pain, but I have a component that makes it very easy to use them, so.. ;-). I've also thought about using TCP/IP sockets with a service application controlling it all, but I really would prefer the appliocations to control it all themselves. I'm quite familiar with the use of TCP/IP sockets (I've written a nice little thing that allows sharing clipboards on the entire network), but thanks for you offer anyway :-)

epsylon, that looks very interessting at first glance, and I'll look over as soon as I can. I'm somewhat worried about the createfile call, but I hope it will work :-)

AvonWyss, giving the mailslots unique identifiers wont work, because one messages has to get to all other mailslots currently running (created).

I'll be back with more as soon as I have tried out the named pipes solution

Best regards
NetGeek

NetGeek, you'll very probably encounter the very same problem when using named pipes since there also the file will already be open when one app is running. And even if you use sockets, you'll run into basically the same problem: only one socket can listen on a specific port...

A possibility would be to make some sort of proxy per machine (as application, service, COM-object or whatever) which opens the one mailslot instance and allows multiple apps with unique ID's to subscribe to the mailslot data distribution (this can again be using mailslots or any other IPC like memory mapped file, named pipes, sockets etc.). By this, you will have one mailslot per machine and several applications connecting to this single mailslot instance.

Yeah, the Pipes solution has the same problem :-(

So far I've solved the problem by keeping track of what machines are running on the TS and then using those machine names as additional aliases, but that slows it down some.

I'll try the TCP/IP solution tomorrow, cause I dont think I'll have the same problem there, becasuse the service will only run in one instance,and it keeps track of the connected clients with their handles, not their IP numbers (i hope).

Please keep those ideas coming :-)

Best regards
NetGeek

How about impersonating another user before creating pipes or mailslots?

Sorry, Epsylon, but even if I where able to program something like that, I wouldn't feel comfortable using that. I'm installing the system on a clients network, and I have no real control over their network setup.

I've actually started looking into the Terminal Server settings, hoping there's a way to completely separate the individual sessions on the TS.

Best regards
NetGeek

NetGeek, has any solution come up?

Not really AvonWyss, I've installed a system where I keep track of what connections are using the terminal server, then assign them a unique alias. The problem with this of course thatI have to send everything out to all the assigned aliases :-(

No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:

To be PAQ/Refund

Please leave any comments here within the next seven days.
 
PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER!
 
Thank you,
Russell

EE Cleanup Volunteer