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

* GetDir fix for inaccessible drives

Browse Source
This commit is contained in:
Tomas Hajny 2001-06-30 18:55:48 +00:00
parent 84cbeb937a
commit 268d2a4ab6
3 changed files with 24 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/go32v1/system.pp
View File

@ -546,6 +546,7 @@ var
temp : array[0..255] of char;
sof : pchar;
i : byte;
Err: boolean;
begin
sof:=pchar(@dir[4]);
{ dir[1..3] will contain '[drivenr]:\', but is not supplied by DOS,
@ -554,12 +555,19 @@ begin
asm
movb drivenr,%dl
movl sof,%esi
mov $0x47,%ah
movw $0x4700,%ax
movb %al,Err
int $0x21
jnc .LGetDir
movw %ax, InOutRes
incb Err
.LGetDir:
end;
if Err and (DriveNr <> 0) then
begin
Dir := char (DriveNr + 64) + ':\';
Exit;
end;
{ Now Dir should be filled with directory in ASCIIZ starting from dir[4] }
dir[0]:=#3;
dir[2]:=':';
@ -628,7 +636,10 @@ Begin
End.
{
$Log$
Revision 1.6 2001-06-19 20:46:07 hajny
Revision 1.7 2001-06-30 18:55:49 hajny
* GetDir fix for inaccessible drives
Revision 1.6 2001/06/19 20:46:07 hajny
* platform specific constants moved after systemh.inc, BeOS omission corrected
Revision 1.5 2001/06/13 22:22:59 hajny

6
rtl/go32v2/system.pp
View File

@ -1429,6 +1429,7 @@ begin
if (regs.realflags and carryflag) <> 0 then
Begin
GetInOutRes (lo(regs.realeax));
Dir := char (DriveNr + 64) + ':\';
exit;
end
else
@ -1547,7 +1548,10 @@ Begin
End.
{
$Log$
Revision 1.11 2001-06-18 14:26:16 jonas
Revision 1.12 2001-06-30 18:55:48 hajny
* GetDir fix for inaccessible drives
Revision 1.11 2001/06/18 14:26:16 jonas
* move platform independent constant declarations after inclusion of
systemh.inc

7
rtl/win32/system.pp
View File

@ -673,6 +673,8 @@ begin
begin
errno := word (GetLastError);
Errno2InoutRes;
Dir := char (DriveNr + 64) + ':\';
Exit;
end;
end;
GetCurrentDirectory(SizeOf(DirBuf),DirBuf);
@ -1563,7 +1565,10 @@ end.
{
$Log$
Revision 1.14 2001-06-18 14:26:16 jonas
Revision 1.15 2001-06-30 18:55:48 hajny
* GetDir fix for inaccessible drives
Revision 1.14 2001/06/18 14:26:16 jonas
* move platform independent constant declarations after inclusion of
systemh.inc