Delphi source codes

program PipeServer;

// Server application which creates an inbound pipe and waits for data from client processes.

{$APPTYPE CONSOLE}

uses

  SysUtils,

  Windows;

procedure ReceivePipeData();

var

  pipe: Cardinal;

  RecBuffer: Array[0..999] of Byte;

  numBytesRead: DWORD;

  result: LongBool;

  sReadData: AnsiString;

  sa: SECURITY_ATTRIBUTES;

  sd: SECURITY_DESCRIPTOR;

begin

  // Must grant access rights in case User Account Control is on, on WinVista and above,

  // and communicating processes are under a different user (which can be also SYSTEM).

  // Otherwise, the other side of the pipe will receive ERROR_ACCESS_DENIED upon CreateFile().

  // If UAC is on and we are trying to use pipe between a userlevel and a system process,

  // even if we are inside the same user account, pipe communication will fail.

  // In order to avoid this, we must initialize a security descriptor for the pipe.

  InitializeSecurityDescriptor(@sd, SECURITY_DESCRIPTOR_REVISION);

  // There is an important difference between an empty and a nonexistent DACL.

  // When a DACL is empty, it contains no access control entries (ACEs); therefore, no access 

     rights are explicitly granted.

  // As a result, access to the object is implicitly denied.

  // When an object has no DACL (when the pDacl parameter is NULL),

  // no protection is assigned to the object, and all access requests are granted.

  SetSecurityDescriptorDacl(@sd, True, nil, False);

  sa.bInheritHandle := false;

  sa.lpSecurityDescriptor := @sd;

  sa.nLength := sizeof(sa);

  while true do begin

    repeat

      // Create a new pipe to receive data

      pipe := CreateNamedPipe(

         '\.pipeSamplePipe', // Our pipe name

         PIPE_ACCESS_INBOUND, // Read-only pipe

         PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE, //Using Message mode

         PIPE_UNLIMITED_INSTANCES ,

         0,  // No outbound buffer

         0,  // No inbound buffer

         0,  // Use default wait time

         @sa // Set security attributes to grant access rights

      );

      if (pipe = INVALID_HANDLE_VALUE) then begin

        Write('[ERROR] Failed to create pipe. Error code ' + IntToStr(GetLastError()) + #13#10 + 

              'Press Enter to retry');

        Readln;

      end;

    until pipe <> INVALID_HANDLE_VALUE;

    WriteLn('[INFO] Inbound pipe created! Waiting for a client process to connect...');

    // This call blocks until a client process connects to the pipe

    result := ConnectNamedPipe(pipe, nil);

    if (result = false) then begin

      Writeln('[ERROR] Failed to connect to pipe. Error code ' + IntToStr(GetLastError()));

    end

    else begin

      Writeln('[INFO] Client connected! Waiting for data...');

      numBytesRead := 0;

      // The read operation will block until there is data to read

      result := ReadFile(

          pipe,

          RecBuffer[0], // The data from the pipe will be put here

          sizeof(RecBuffer), // Number of bytes allocated

          numBytesRead, // This will store number of bytes actually read

          nil // Not using overlapped IO

      );

      if (result = false) then begin

          Writeln('[ERROR] Failed to read pipe data! Error code ' + IntToStr(GetLastError()));

      end else begin

          SetString(sReadData,PAnsiChar(@recBuffer[0]), numBytesRead); //Copy byte array to string

          Writeln('[SUCCESS] Data received: ' + sReadData);

      end;

    end;

    //Close our pipe handle

    CloseHandle(pipe);

  end;

end;

//Program start procedure

begin

  Writeln('*** Pipe Server Application ***' + #13#10);

  Write('[INFO] Press Enter to create pipe server and start listening for incoming data');

  ReadLn;

  ReceivePipeData();

end.

program PipeClient;
// Client application which sends data to pipe server.

{$APPTYPE CONSOLE}

uses
SysUtils,
Windows,
Classes;

// Data to send via pipe is read from a file.
function GetDataFromFile(sFileName: AnsiString): AnsiString;
var
DataFile: TFileStream;
ReadBuffer: array of Byte;
sDataToSend: AnsiString;
begin
  try
    DataFile := TFileStream.Create( sFileName , fmOpenRead);
    SetLength(ReadBuffer, DataFile.Size);
    DataFile.Read(ReadBuffer[0], Length(ReadBuffer));
    SetString(sDataToSend,PAnsiChar(@ReadBuffer[0]), DataFile.Size); //Copy byte array to string
    DataFile.Free;
    Result := sDataToSend;
  except
    Result := '';
  end;
end;

procedure SendPipeData();
var
pipe: Cardinal;
numBytesWritten: DWORD;
result: LongBool;
sDataToSend: AnsiString;
begin
  repeat
    // Open the named pipe, previusly created by server application
    pipe := CreateFile(
    '\.pipeSamplePipe', // Our pipe name
    GENERIC_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE,
    nil,
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0
    );
    if (pipe = INVALID_HANDLE_VALUE) then begin
      Write('[ERROR] Failed to open pipe (server must be running first).' + #13#10 + 'Press Enter to 
      retry');
      Readln;
    end;
  until pipe <> INVALID_HANDLE_VALUE;

  repeat
    //Get data to send from file
    sDataToSend := GetDataFromFile(ExtractFilePath(ParamStr(0)) + 'DataToSend.txt');
    if sDataToSend = '' then begin
      Write('[ERROR] Unable to read data from file (may be unexistent or empty).' + #13#10 + 'Press
      Enter to retry');
      Readln;
    end;
  until sDataToSend <> '';

  numBytesWritten := 0;
  result := WriteFile(
  pipe, // Handle to our outbound pipe
  sDataToSend[1], // Pointer to data to send
  Length(sDataToSend), // Length of data to send (bytes)
  numBytesWritten, // Will store actual amount of data sent
  nil // Not using overlapped IO
  );

  if (result = false) then
    Writeln('[ERROR] Failed to send pipe data. Error code ' + IntToStr(GetLastError()))
  else Writeln('[SUCCESS] Pipe data sent: ' + sDataToSend);

  // Close the pipe handle
  CloseHandle(pipe);
end;

//Program start procedure
begin
  Writeln('*** Pipe Client Application ***' + #13#10);
  while true do begin
    Write('[INFO] Press Enter to send pipe data to server');
    Readln;
    SendPipeData();
  end;
end.