Question

如何从在Delphi 10.2 Tokyo中创建的Linux控制台应用程序执行外部程序？

我想要做的是执行带有

等参数的shell命令

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

我不需要程序的输出，但应该同步执行。

在Windows环境中很容易，但是由于Delphi中的64位Linux支持（在Kylix之后）是一个很新的，我现在在网上找不到任何提示。

非常感谢帮助我解决问题的任何提示。

提前致谢！

Answer 1

戴维斯的提示向我指出了一个帮助创建解决方案的例子。最棘手的部分是找出如何将Delphi字符串转换为MarshaledAString，因为该示例使用const字符串作为popen的参数。我在RHEL 7.3上测试过，就像一个魅力。

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;

Answer 2

我写了这段代码来完成这项任务

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;

您不必担心MarshaledString。 RunCommandLine函数有两种方法可以调用。第一个是TStringList上的返回，其中包含控制台将返回的所有行。第二种，您可以传递一个匿名方法，该方法将逐行处理命令行。

从Linux / Delphi 10.2控制台应用程序执行外部程序

2 个答案: