Simple Process Communication

Post date: May 30, 2010 11:45:03 PM

In computing, Inter-process communication (IPC) is a set of techniques for the exchange of data among multiple threads in one or more processes. Processes may be running on one or more computers connected by a network. IPC techniques are divided into methods for message passing, synchronization, shared memory, and remote procedure calls (RPC). The method of IPC used may vary based on the bandwidth and latency of communication between the threads, and the type of data being communicated.

Read more: http://en.wikipedia.org/wiki/Inter-process_communication

This unit, written by Alice, enables you to perform inter-process communication.

Unit:

unit ipc;
//By Alice
interface
uses
  Windows;
type
  TIpc = record
    Status: Cardinal;
    ReportName: Array [0..255] of Char;
  end;
  PIpc = ^TIpc;
const
  IPC_SCRIPT_WRITTEN = $0001;
  IPC_REPORT_WRITTEN = $0002;
  IPC_SCRIPT_READ = $0004;
  IPC_REPORT_READ = $0008;
function ipcReadScript(Name: String): String;
function ipcWriteScript(Name, Value: String): Boolean;
function ipcReadReportHeader(Name: String): String;
function ipcReadReport(Name: String): String;
function ipcWriteReportHeader(Name, ReportName: String): Boolean;
function ipcWriteReport(Name, Value: String): Boolean;
function ipcSetStatus(Name: String; Status: Cardinal): Boolean;
function ipcGetStatus(Name: String): Cardinal;
implementation
function ipcCreateFileMap(Name: String; MapSize: Cardinal): Cardinal;
begin
  Result := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, MapSize, PChar(Name));
end;
function ipcReadScript(Name: String): String;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := '';
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      if (lpIpc^.Status = IPC_SCRIPT_WRITTEN) then
        Result := PChar(Integer(lpIpc) + SizeOf(TIpc));
    except
    end;
  end;
end;
function ipcWriteScript(Name, Value: String): Boolean;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := False;
  hFileMap := ipcCreateFileMap(Name, SizeOf(TIpc) + Length(Value) + 1);
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      lpIpc^.Status := IPC_SCRIPT_WRITTEN;
      lpIpc^.ReportName := '';
      CopyMemory(Ptr(Integer(lpIpc) + SizeOf(TIpc)), PChar(Value), Length(Value) + 1);
      Result := True;
    except
    end;
  end;
end;
function ipcReadReportHeader(Name: String): String;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := '';
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      if (lpIpc^.Status = IPC_REPORT_WRITTEN) then
        Result := lpIpc^.ReportName;
    except
    end;
  end;
end;
function ipcReadReport(Name: String): String;
var
  lpReport: PChar;
  hFileMap: Cardinal;
begin
  Result := '';
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpReport := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpReport <> nil) then
  begin
    try
      Result := String(lpReport);
    except
    end;
  end;
end;
function ipcWriteReportHeader(Name, ReportName: String): Boolean;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := False;
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      CopyMemory(@lpIpc^.ReportName[0], PChar(ReportName), Length(ReportName) + 1);
      Result := True;
    except
    end;
  end;
end;
function ipcWriteReport(Name, Value: String): Boolean;
var
  lpReport: PChar;
  hFileMap: Cardinal;
begin
  Result := False;
  hFileMap := ipcCreateFileMap(Name, Length(Value) + 1);
  if (hFileMap = 0) then Exit;
  lpReport := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpReport <> nil) then
  begin
    try
      CopyMemory(lpReport, PChar(Value), Length(Value) + 1);
      Result := True;
    except
    end;
  end;
end;
function ipcSetStatus(Name: String; Status: Cardinal): Boolean;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := False;
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      lpIpc^.Status := Status;
      Result := True;
    except
    end;
  end;
end;
function ipcGetStatus(Name: String): Cardinal;
var
  lpIpc: PIpc;
  hFileMap: Cardinal;
begin
  Result := 0;
  hFileMap := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(Name));
  if (hFileMap = 0) then Exit;
  lpIpc := MapViewOfFile(hFileMap, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if (lpIpc <> nil) then
  begin
    try
      Result := lpIpc^.Status;
    except
    end;
  end;
end;
end.

Usage:

function TF_WriteScript(P: Pointer): Cardinal; stdcall;
var
  ReportName: String;
begin
  Result := 0;
  ipcWriteScript('Script1', Form1.Memo1.Lines.Text);
  while (ipcGetStatus('Script1') <> IPC_REPORT_WRITTEN) do Sleep(1000);
  ReportName := ipcReadReportHeader('Script1');
  if (ReportName = '') then Exit;
  Form1.Memo1.Lines.Text := ipcReadReport(ReportName);
  ipcSetStatus('Script1', IPC_REPORT_READ);
  MessageBox(0, 'WriteScript', '', MB_OK);
end;
function TF_ReadScript(P: Pointer): Cardinal; stdcall;
begin
  Result := 0;
  Form1.Memo1.Lines.Text := ipcReadScript('Script1');
  ipcSetStatus('Script1', IPC_SCRIPT_READ);
  if not (ipcWriteReportHeader('Script1', 'Report1')) then
    Exit;
  ipcWriteReport('Report1', 'String copied to Form successfully!!');
  ipcSetStatus('Script1', IPC_REPORT_WRITTEN);
  while (ipcGetStatus('Script1') <> IPC_REPORT_READ) do Sleep(1000);
  MessageBox(0, 'ReadScript', '', MB_OK);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
  lpThreadId: Cardinal;
begin
  CreateThread(nil, 0, @TF_WriteScript, nil, 0, lpThreadId);
end;
procedure TForm1.Button2Click(Sender: TObject);
var
  lpThreadId: Cardinal;
begin
  CreateThread(nil, 0, @TF_ReadScript, nil, 0, lpThreadId);
end;