paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-22 02:09:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

atari: implemented sysutils/ExecuteProcess

Browse Source 
git-svn-id: trunk@35208 -
This commit is contained in:
Károly Balogh 2016-12-28 16:22:19 +00:00
parent 9ce4184dd9
commit c663c09b7b
2 changed files with 24 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
rtl/atari/gemdos.inc
View File

@ -133,6 +133,7 @@ function gemdos_tgetdate: longint; syscall 1 42;
function gemdos_tgettime: longint; syscall 1 44; function gemdos_tgettime: longint; syscall 1 44;
function gemdos_getdta: PDTA; syscall 1 47; function gemdos_getdta: PDTA; syscall 1 47;
function gemdos_sversion: smallint; syscall 1 48;
function gemdos_dfree(buf: PDISKINFO; driveno: smallint): smallint; syscall 1 54; function gemdos_dfree(buf: PDISKINFO; driveno: smallint): smallint; syscall 1 54;
@ -152,7 +153,7 @@ function gemdos_dgetpath(path: pchar; driveno: smallint): smallint; syscall 1 71
function gemdos_malloc(number: dword): pointer; syscall 1 72; function gemdos_malloc(number: dword): pointer; syscall 1 72;
function gemdos_free(block: pointer): dword; syscall 1 73; function gemdos_free(block: pointer): dword; syscall 1 73;
function gemdos_mshrink(zero: word; block: pointer; newsiz: longint): longint; syscall 1 74; function gemdos_mshrink(zero: word; block: pointer; newsiz: longint): longint; syscall 1 74;
function gemdos_pexec(mode: word; name: pchar; cmdline: pchar; env: pchar): longint; syscall 1 75;
procedure gemdos_pterm(returncode: smallint); syscall 1 76; procedure gemdos_pterm(returncode: smallint); syscall 1 76;
function gemdos_fsfirst(filename: pchar; attr: smallint): longint; syscall 1 78; function gemdos_fsfirst(filename: pchar; attr: smallint): longint; syscall 1 78;

24
rtl/atari/sysutils.pp
View File

@ -469,9 +469,29 @@ end;
function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]): function ExecuteProcess (const Path: RawByteString; const ComLine: RawByteString;Flags:TExecuteFlags=[]):
integer; integer;
var
tmpPath: RawByteString;
pcmdline: ShortString;
CommandLine: RawByteString;
E: EOSError;
begin begin
{writeln('Unimplemented ExecuteProcess');} tmpPath:=ToSingleByteFileSystemEncodedFileName(Path);
result:=-1; pcmdline:=ToSingleByteFileSystemEncodedFileName(ComLine);
{ the zero offset for cmdline is actually correct here. pexec() expects
pascal formatted string for cmdline, so length in first byte }
result:=gemdos_pexec(0,PChar(tmpPath),@pcmdline[0],nil);
if result < 0 then begin
if ComLine = '' then
CommandLine := Path
else
CommandLine := Path + ' ' + ComLine;
E := EOSError.CreateFmt (SExecuteProcessFailed, [CommandLine, result]);
E.ErrorCode := result;
raise E;
end;
end; end;
function ExecuteProcess (const Path: RawByteString; function ExecuteProcess (const Path: RawByteString;