Связь приложения с консольной программой, написанной на SWI Prolog

  type
  TPipeHandles = (IN_WRITE, IN_READ,
    OUT_WRITE, OUT_READ,
    ERR_WRITE, ERR_READ);
 
  TPipeArray = array[TPipeHandles] of THandle;
 
var
  i: LongWord;
  ph: TPipeHandles;
  sa: TSecurityAttributes;
  Pipes: TPipeArray;
  StartInf: TStartupInfo;
  ProcInf: TProcessInformation;
  Buf: array[0..1024] of byte;
  TimeStart: TDateTime;
  Si:TStartupInfo;
  Pi:TProcessInformation;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
 
function ExecuteFile(FileName,StdInput: string; TimeOut: integer; var StdOutput:string) : boolean;
 
label Error;
 
type
  TPipeHandles = (IN_WRITE,  IN_READ,
                  OUT_WRITE, OUT_READ,
                  ERR_WRITE, ERR_READ);
 
type
  TPipeArray = array [TPipeHandles] of THandle;
 
var
  i         : integer;
  ph        : TPipeHandles;
  SA        : TSecurityAttributes;
  Pipes     : TPipeArray;
  StartInf  : TStartupInfo;
  ProcInf   : TProcessInformation;
  Buf       : array[0..1000] of byte;
  Bytes     : DWord;
  TimeStart : TDateTime;
  Rlst: LongBool;
 
begin
  Result := false;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do Pipes[ph] := INVALID_HANDLE_VALUE;
 
  // ñîçäàåì ïàéïû
 
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;
 
  if not CreatePipe(Pipes[IN_READ],Pipes[IN_WRITE], @sa, 0 ) then goto Error;
  if not CreatePipe(Pipes[OUT_READ],Pipes[OUT_WRITE], @sa, 0 ) then  goto Error;
  if not CreatePipe(Pipes[ERR_READ],Pipes[ERR_WRITE], @sa, 0 ) then  goto Error;
 
  // ïèøåì â STDIN
 
  WriteFile(Pipes[IN_WRITE],PChar(StdInput+^Z)^,Length(stdInput)+1,Bytes,nil);
 
  // õåíäë çàïèñè â StdIn íàäî çàêðûòü - èíà÷å âûïîëíÿåìàÿ
  // ïðîãðàììà ìîæåò íå ïðî÷èòàòü èëè ïðî÷èòàòü íå âåñü StdIn.
 
  CloseHandle(Pipes[IN_WRITE]);
  Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;
 
  FillChar(StartInf,sizeof(TStartupInfo),0);
  StartInf.cb := sizeof(TStartupInfo);
  StartInf.dwFlags :=STARTF_USESHOWWINDOW;
 
  StartInf.wShowWindow := SW_SHOW; // ??? SW_HIDE ???? ???? ????????? ????????
 
  StartInf.hStdInput := Pipes[IN_READ];
  StartInf.hStdOutput := Pipes[OUT_WRITE];
  StartInf.hStdError := Pipes[ERR_WRITE];
 
 
  CreateProcess(Nil,'program.exe', nil,
                       nil, true, NORMAL_PRIORITY_CLASS,
                       nil, nil, StartInf, ProcInf);
 
 
 
  TimeStart := Now;
 
  repeat
  Application.ProcessMessages;
   i := WaitForSingleObject(ProcInf.hProcess,100);
    if i = WAIT_OBJECT_0 then break;
   if (Now-TimeStart)*SecsPerDay>TimeOut then break;
  until false;
 
  if i<>WAIT_OBJECT_0 then goto Error;
 
  // ????????? ????? ?????? ? STDOUT ????? ????????? ?????????? ?????
 
  CloseHandle(Pipes[OUT_WRITE]);
  Pipes[OUT_WRITE] := INVALID_HANDLE_VALUE;
 
  // ?????? STDOUT
   
  StdOutput := '1';
  repeat
    Bytes:= 0;
    ReadFile(Pipes[OUT_READ],Buf,SizeOf(Buf),Bytes,nil);
    if Bytes=0 then break;
    i := Length(StdOutput);
    SetLength(StdOutput,i+Bytes);
    Move(Buf[0],StdOutput[i+1],Bytes);
  until false;
 
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
  if Pipes[ph]<>INVALID_HANDLE_VALUE then CloseHandle(Pipes[ph]);
 
  CloseHandle(ProcInf.hProcess);
  CloseHandle(ProcInf.hThread);
  Result := true;
  Exit;
 
Error:
  if ProcInf.hProcess<>INVALID_HANDLE_VALUE then
  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if i<>WAIT_OBJECT_0 then
    begin
      ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE, FALSE, ProcInf.dwProcessId);
      if ProcInf.hProcess <> 0 then
      begin
        TerminateProcess(ProcInf.hProcess, 0);
        CloseHandle(ProcInf.hProcess);
      end;
    end;
  end;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
  if Pipes[ph]<>INVALID_HANDLE_VALUE then CloseHandle(Pipes[ph]);
end;
 
 
procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
ExecuteFile('program.exe','translate(p->q).',9000000,s);
Memo2.Lines.Add(s);
end;
 
end.