Simple Process Communication

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.

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;