MichaSchumann
MichaSchumann

Reputation: 1493

Execute external program from Linux/Delphi 10.2 console application

How can I execute an external program from a Linux console application created in Delphi 10.2 Tokyo?

What I want to do is execute a shell command with parameters like

/home/test/qrencode -o /tmp/abc.png '08154711'

I do not need the output of the program but it should be executed synchronously.

It is easy in Windows environments but as 64 bit Linux support in Delphi (after Kylix) is quite new, I could not find any hints on the Web by now.

Any tip helping me to solve that is very appreciated.

Thanks in advance!

Upvotes: 2

Views: 4104

Answers (2)

I wrote this code to do this task

uses
  System.SysUtils,
  System.Classes,
  Posix.Base,
  Posix.Fcntl;

type
  TStreamHandle = pointer;

  TLinuxUtils = class
  public
    class function RunCommandLine(ACommand : string) : TStringList;overload;
    class function RunCommandLine(Acommand : string; Return : TProc<String>) : boolean; overload;
    class function findParameter(AParameter : string) : boolean;
  end;



  function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle; cdecl; external libc name _PU + 'popen';
  function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
  function fgets(buffer: pointer; size: int32; Stream: TStreamHAndle): pointer; cdecl; external libc name _PU + 'fgets';


implementation

class function TLinuxUtils.RunCommandLine(ACommand : string) : TStringList;
var
  Handle: TStreamHandle;
  Data: array[0..511] of uint8;
  M : TMarshaller;

begin
  Result := TStringList.Create;
  try
    Handle := popen(M.AsAnsi(PWideChar(ACommand)).ToPointer,'r');
    try
      while fgets(@data[0],Sizeof(Data),Handle)<>nil do begin
        Result.Add(Copy(UTF8ToString(@Data[0]),1,UTF8ToString(@Data[0]).Length -1));//,sizeof(Data)));
      end;
    finally
      pclose(Handle);
    end;
  except
    on E: Exception do
      Result.Add(E.ClassName + ': ' + E.Message);
  end;
end;

class function TLinuxUtils.RunCommandLine(Acommand : string; Return : TProc<string>) : boolean;
var
  Handle: TStreamHandle;
  Data: array[0..511] of uint8;
  M : TMarshaller;

begin
  Result := false;
  try
    Handle := popen(M.AsAnsi(PWideChar(ACommand)).ToPointer,'r');
    try
      while fgets(@data[0],Sizeof(Data),Handle)<>nil do begin
        Return(Copy(UTF8ToString(@Data[0]),1,UTF8ToString(@Data[0]).Length -1));//,sizeof(Data)));
      end;
    finally
      pclose(Handle);
    end;
  except
    on E: Exception do
      Return(E.ClassName + ': ' + E.Message);
  end;
end;

class function TLinuxUtils.findParameter(AParameter : string) : boolean;
var
  I : Integer;
begin
  Result := false;
  for I := 0 to Pred(ParamCount) do
  begin
    Result := AParameter.ToUpper = ParamStr(i).ToUpper;
    if Result then
      Break;
  end;
end;

You do not have to worry about MarshaledString. The RunCommandLine function has 2 ways to be called. The first you have the return on a TStringList with all the lines that the console will return. The second you can pass an anonymous method that will treat line by line of return of the command line.

Upvotes: 0

MichaSchumann
MichaSchumann

Reputation: 1493

Davids hint pointed me to an example that helped creating the solution. The most tricky part was finding out how to convert a Delphi string to a MarshaledAString as the example used a const string as argument for popen. I tested on RHEL 7.3, runs like a charm.

uses
  ...
  System.SysUtils,
  Posix.Base,
  Posix.Fcntl,
  ...;

type
  TStreamHandle = pointer;

function popen(const command: MarshaledAString; const _type: MarshaledAString): TStreamHandle; cdecl;
      external libc name _PU + 'popen';
function pclose(filehandle: TStreamHandle): int32; cdecl; external libc name _PU + 'pclose';
function fgets(buffer: pointer; size: int32; Stream: TStreamHandle): pointer; cdecl; external libc name _PU + 'fgets';

function runCommand(const acommand: MarshaledAString): String;
// run a linux shell command and return output
// Adapted from http://chapmanworld.com/2017/04/06/calling-linux-commands-from-delphi/
var
  handle: TStreamHandle;
  data: array [0 .. 511] of uint8;

  function bufferToString(buffer: pointer; maxSize: uint32): string;
  var
    cursor: ^uint8;
    endOfBuffer: nativeuint;
  begin
    if not assigned(buffer) then
      exit;
    cursor := buffer;
    endOfBuffer := nativeuint(cursor) + maxSize;
    while (nativeuint(cursor) < endOfBuffer) and (cursor^ <> 0) do
    begin
      result := result + chr(cursor^);
      cursor := pointer(succ(nativeuint(cursor)));
    end;
  end;

begin
  result := '';
  handle := popen(acommand, 'r');
  try
    while fgets(@data[0], sizeof(data), handle) <> nil do
    begin
      result := result + bufferToString(@data[0], sizeof(data));
    end;
  finally
    pclose(handle);
  end;
end;

function createQRCode(id, fn: string): string;
// Create qr-code using qrencode package
begin
  deletefile(fn);
  if fileExists(fn) then
    raise Exception.create('Old file not deleted!');
  // I am targeting rhel for now, so I know the path for sure
  result := runCommand(MarshaledAString(UTF8STring('/usr/bin/qrencode -o ' + fn + ' ''' + id + '''')));
  if not fileExists(fn) then
    raise Exception.create('New file not created!');
end;

function testqr: String;
// Test QR Code creation with error handling
// QREncode does not output anything but who knows ;-)
begin
  try
    result := createQRCode('08154711', '/tmp/myqrcode.png');
  except
    on e: Exception do
    begin
      result := 'Error: ' + e.message;
    end;
  end;
end;

Upvotes: 2

Related Questions