paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-29 19:20:38 +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 var
strofpaths : string; strofpaths : string;
function SystemTags(const command: PChar; const tags: array of DWord): LongInt;
begin
SystemTags:=SystemTagList(command,@tags);
end;
function getpathstring: string; function getpathstring: string;
var var
f : text; f : text;
s : string; s : string;
found : boolean; found : boolean;
temp : string[255]; temp : string[255];
tmpBat: string[31];
tmpList: string[31];
begin begin
found := true; found := true;
temp := ''; temp := '';
tmpBat:='T:'+HexStr(FindTask(nil)); { Alternatively, this could use PIPE: handler on systems which
tmpList:=tmpBat+'_path.tmp'; have this by default (not the case on classic Amiga), but then
tmpBat:=tmpBat+'_path.sh'; the child process should be started async, which for a simple
Path command probably isn't worth the trouble. (KB) }
assign(f,tmpBat); assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
rewrite(f); 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); close(f);
exec('C:Execute',tmpBat);
erase(f);
assign(f,tmpList);
reset(f); reset(f);
{ skip the first line, garbage } { skip the first line, garbage }
if not eof(f) then readln(f,s); if not eof(f) then readln(f,s);
@ -914,7 +916,7 @@ begin
if found then begin if found then begin
temp := s; temp := s;
found := false; found := false;
end else begin; end else begin
if (length(s) + length(temp)) < 255 then if (length(s) + length(temp)) < 255 then
temp := temp + ';' + s; temp := temp + ';' + s;
end; end;

26
rtl/amicommon/sysutils.pp
View File

@ -618,28 +618,30 @@ end;
var var
StrOfPaths: String; StrOfPaths: String;
function SystemTags(const command: PChar; const tags: array of DWord): LongInt;
begin
SystemTags:=SystemTagList(command,@tags);
end;
function GetPathString: String; function GetPathString: String;
var var
f : text; f : text;
s : string; s : string;
tmpBat: string;
tmpList: string;
begin begin
s := ''; s := '';
result := ''; result := '';
tmpBat:='T:'+HexStr(FindTask(nil)); { Alternatively, this could use PIPE: handler on systems which
tmpList:=tmpBat+'_path.tmp'; have this by default (not the case on classic Amiga), but then
tmpBat:=tmpBat+'_path.sh'; the child process should be started async, which for a simple
Path command probably isn't worth the trouble. (KB) }
assign(f,tmpBat); assign(f,'T:'+HexStr(FindTask(nil))+'_path.tmp');
rewrite(f); 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); close(f);
exec('C:Execute',tmpBat);
erase(f);
assign(f,tmpList);
reset(f); reset(f);
{ skip the first line, garbage } { skip the first line, garbage }
if not eof(f) then readln(f,s); if not eof(f) then readln(f,s);
@ -647,7 +649,7 @@ begin
readln(f,s); readln(f,s);
if result = '' then if result = '' then
result := s result := s
else else
result := result + ';' + s; result := result + ';' + s;
end; end;
close(f); close(f);