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

* fixed getdir() that was broken when a directory on a different drive

Browse Source 
was asked
This commit is contained in:
peter 2001-07-30 20:53:50 +00:00
parent 27c78aa247
commit f959b8e668
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
rtl/win32/system.pp
View File

@ -605,17 +605,17 @@ end;
Directory Handling Directory Handling
*****************************************************************************} *****************************************************************************}
function CreateDirectory(name : pointer;sec : pointer) : longint; function CreateDirectory(name : pointer;sec : pointer) : longbool;
external 'kernel32' name 'CreateDirectoryA'; external 'kernel32' name 'CreateDirectoryA';
function RemoveDirectory(name:pointer):longint; function RemoveDirectory(name:pointer):longbool;
external 'kernel32' name 'RemoveDirectoryA'; external 'kernel32' name 'RemoveDirectoryA';
function SetCurrentDirectory(name : pointer) : longint; function SetCurrentDirectory(name : pointer) : longbool;
external 'kernel32' name 'SetCurrentDirectoryA'; external 'kernel32' name 'SetCurrentDirectoryA';
function GetCurrentDirectory(bufsize : longint;name : pchar) : longint; function GetCurrentDirectory(bufsize : longint;name : pchar) : longbool;
external 'kernel32' name 'GetCurrentDirectoryA'; external 'kernel32' name 'GetCurrentDirectoryA';
type type
TDirFnType=function(name:pointer):word; TDirFnType=function(name:pointer):longbool;
procedure dirfn(afunc : TDirFnType;const s:string); procedure dirfn(afunc : TDirFnType;const s:string);
var var
@ -624,14 +624,14 @@ begin
move(s[1],buffer,length(s)); move(s[1],buffer,length(s));
buffer[length(s)]:=#0; buffer[length(s)]:=#0;
AllowSlash(pchar(@buffer)); AllowSlash(pchar(@buffer));
if aFunc(@buffer)=0 then if not aFunc(@buffer) then
begin begin
errno:=GetLastError; errno:=GetLastError;
Errno2InoutRes; Errno2InoutRes;
end; end;
end; end;
function CreateDirectoryTrunc(name:pointer):word; function CreateDirectoryTrunc(name:pointer):longbool;
begin begin
CreateDirectoryTrunc:=CreateDirectory(name,nil); CreateDirectoryTrunc:=CreateDirectory(name,nil);
end; end;
@ -669,11 +669,12 @@ begin
begin begin
byte(Drive[0]):=Drivenr+64; byte(Drive[0]):=Drivenr+64;
GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf); GetCurrentDirectory(SizeOf(SaveBuf),SaveBuf);
if SetCurrentDirectory(@Drive) <> 0 then if not SetCurrentDirectory(@Drive) then
begin begin
errno := word (GetLastError); errno := word (GetLastError);
Errno2InoutRes; Errno2InoutRes;
Dir := char (DriveNr + 64) + ':\'; Dir := char (DriveNr + 64) + ':\';
SetCurrentDirectory(@SaveBuf);
Exit; Exit;
end; end;
end; end;
@ -1565,7 +1566,11 @@ end.
{ {
$Log$ $Log$
Revision 1.15 2001-06-30 18:55:48 hajny Revision 1.16 2001-07-30 20:53:50 peter
* fixed getdir() that was broken when a directory on a different drive
was asked
Revision 1.15 2001/06/30 18:55:48 hajny
* GetDir fix for inaccessible drives * GetDir fix for inaccessible drives
Revision 1.14 2001/06/18 14:26:16 jonas Revision 1.14 2001/06/18 14:26:16 jonas