paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 23:21:57 +02:00
Code Issues Packages Projects Releases Wiki Activity

amicommon: a better and less hacky way to retrive the path. additionally this variant also works properly on AROS

Browse Source 
git-svn-id: trunk@28513 -
This commit is contained in:
Károly Balogh 2014-08-23 14:03:51 +00:00
parent 0f9e8f84bb
commit 8169fd6255
2 changed files with 28 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
rtl/amicommon/dos.pp
View File

@ -882,30 +882,32 @@ end;
var
strofpaths : string;
function SystemTags(const command: PChar; const tags: array of DWord): LongInt;
begin
SystemTags:=SystemTagList(command,@tags);
end;
function getpathstring: string;
var
f : text;
s : string;
found : boolean;
temp : string[255];
tmpBat: string[31];
tmpList: string[31];
begin
found := true;
temp := '';
tmpBat:='T:'+HexStr(FindTask(nil));
tmpList:=tmpBat+'_path.tmp';
tmpBat:=tmpBat+'_path.sh';
assign(f,tmpBat);
{ Alternatively, this could use PIPE: handler on systems which
have this by default (not the case on classic Amiga), but then
the child process should be started async, which for a simple
Path command probably isn't worth the trouble. (KB) }
assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
rewrite(f);
writeln(f,'path >'+tmpList);
{ This is a pretty ugly stunt, combining Pascal and Amiga system
functions, but works... }
SystemTags('C:Path',[SYS_Input, 0, SYS_Output, TextRec(f).Handle, TAG_END]);
close(f);
exec('C:Execute',tmpBat);
erase(f);
assign(f,tmpList);
reset(f);
{ skip the first line, garbage }
if not eof(f) then readln(f,s);
@ -914,7 +916,7 @@ begin
if found then begin
temp := s;
found := false;
end else begin;
end else begin
if (length(s) + length(temp)) < 255 then
temp := temp + ';' + s;
end;

26
rtl/amicommon/sysutils.pp
View File

@ -618,28 +618,30 @@ end;
var
StrOfPaths: String;
function SystemTags(const command: PChar; const tags: array of DWord): LongInt;
begin
SystemTags:=SystemTagList(command,@tags);
end;
function GetPathString: String;
var
f : text;
s : string;
tmpBat: string;
tmpList: string;
begin
s := '';
result := '';
tmpBat:='T:'+HexStr(FindTask(nil));
tmpList:=tmpBat+'_path.tmp';
tmpBat:=tmpBat+'_path.sh';
assign(f,tmpBat);
{ Alternatively, this could use PIPE: handler on systems which
have this by default (not the case on classic Amiga), but then
the child process should be started async, which for a simple
Path command probably isn't worth the trouble. (KB) }
assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
rewrite(f);
writeln(f,'path >'+tmpList);
{ This is a pretty ugly stunt, combining Pascal and Amiga system
functions, but works... }
SystemTags('C:Path',[SYS_Input, 0, SYS_Output, TextRec(f).Handle, TAG_END]);
close(f);
exec('C:Execute',tmpBat);
erase(f);
assign(f,tmpList);
reset(f);
{ skip the first line, garbage }
if not eof(f) then readln(f,s);
@ -647,7 +649,7 @@ begin
readln(f,s);
if result = '' then
result := s
else
else
result := result + ';' + s;
end;
close(f);