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

* fixed chdir with drive changing

Browse Source 
* updated checklfn from mailinglist
This commit is contained in:
peter 1998-08-28 10:48:04 +00:00
parent 480a335a24
commit 211a219d75
1 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
rtl/dos/go32v2/system.pp
View File

@ -984,9 +984,26 @@ end;
procedure chdir(const s : string);[IOCheck]; procedure chdir(const s : string);[IOCheck];
var
regs : trealregs;
begin begin
If InOutRes <> 0 then If InOutRes <> 0 then
exit; exit;
{ First handle Drive changes }
if (length(s)>=2) and (s[2]=':') then
begin
regs.realedx:=(ord(s[1]) and (not 32))-ord('A');
regs.realeax:=$0e00;
sysrealintr($21,regs);
regs.realeax:=$1900;
sysrealintr($21,regs);
if byte(regs.realeax)<>byte(regs.realedx) then
begin
Inoutres:=15;
exit;
end;
end;
{ do the normal dos chdir }
DosDir($3b,s); DosDir($3b,s);
end; end;
@ -1050,21 +1067,22 @@ end;
function CheckLFN:boolean; function CheckLFN:boolean;
var var
regs : TRealRegs; regs : TRealRegs;
Buffers,
RootName : pchar; RootName : pchar;
begin begin
RootName:='C:\'+#0; { Check LFN API on drive c:\ }
Buffers:=' '+#0; RootName:='C:\';
syscopytodos(longint(RootName),strlen(RootName)+1); syscopytodos(longint(RootName),strlen(RootName)+1);
{ Call 'Get Volume Information' ($71A0) }
regs.realeax:=$71a0; regs.realeax:=$71a0;
regs.reales:=tb_segment; regs.reales:=tb_segment;
regs.realedi:=tb_offset; regs.realedi:=tb_offset;
regs.realecx:=strlen(Buffers)+1; regs.realecx:=32;
regs.realds:=tb_segment; regs.realds:=tb_segment;
regs.realedx:=tb_offset; regs.realedx:=tb_offset;
regs.realflags:=carryflag;
sysrealintr($21,regs); sysrealintr($21,regs);
syscopyfromdos(longint(Buffers),strlen(Buffers)+1); { If carryflag=0 and LFN API bit in ebx is set then use Long file names }
CheckLFN:=(regs.realecx=255); CheckLFN:=(regs.realflags and carryflag=0) and (regs.realebx and $4000=$4000);
end; end;
{$endif RTLLITE} {$endif RTLLITE}
@ -1088,7 +1106,11 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.17 1998-08-27 10:30:51 pierre Revision 1.18 1998-08-28 10:48:04 peter
* fixed chdir with drive changing
* updated checklfn from mailinglist
Revision 1.17 1998/08/27 10:30:51 pierre
* go32v1 RTL did not compile (LFNsupport outside go32v2 defines !) * go32v1 RTL did not compile (LFNsupport outside go32v2 defines !)
I renamed tb_selector to tb_segment because I renamed tb_selector to tb_segment because
it is a real mode segment as opposed to it is a real mode segment as opposed to