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

* findfirst is now more delphi alike

Browse Source
This commit is contained in:
peter 1998-10-16 08:55:26 +00:00
parent 852db81fd0
commit 4c17808c92
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
rtl/win32/dos.pp
View File

@ -92,6 +92,7 @@ Type
Searchrec = Packed Record Searchrec = Packed Record
FindHandle : THandle; FindHandle : THandle;
W32FindData : TWin32FindData; W32FindData : TWin32FindData;
ExcludeAttr : longint;
time : longint; time : longint;
size : longint; size : longint;
attr : longint; attr : longint;
@ -168,13 +169,13 @@ uses strings;
function GetLastError : DWORD; function GetLastError : DWORD;
external 'kernel32' name 'GetLastError'; external 'kernel32' name 'GetLastError';
function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : boolean; function FileTimeToDosDateTime(const ft :TFileTime;var data,time : word) : longbool;
external 'kernel32' name 'FileTimeToDosDateTime'; external 'kernel32' name 'FileTimeToDosDateTime';
function DosDateTimeToFileTime(date,time : word;var ft :TFileTime) : boolean; function DosDateTimeToFileTime(date,time : word;var ft :TFileTime) : longbool;
external 'kernel32' name 'DosDateTimeToFileTime'; external 'kernel32' name 'DosDateTimeToFileTime';
function FileTimeToLocalFileTime(const ft : TFileTime;var lft : TFileTime) : boolean; function FileTimeToLocalFileTime(const ft : TFileTime;var lft : TFileTime) : longbool;
external 'kernel32' name 'FileTimeToLocalFileTime'; external 'kernel32' name 'FileTimeToLocalFileTime';
function LocalFileTimeToFileTime(const lft : TFileTime;var ft : TFileTime) : boolean; function LocalFileTimeToFileTime(const lft : TFileTime;var ft : TFileTime) : longbool;
external 'kernel32' name 'LocalFileTimeToFileTime'; external 'kernel32' name 'LocalFileTimeToFileTime';
type type
@ -200,7 +201,7 @@ begin
end; end;
Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):boolean; Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool;
var var
lft : TFileTime; lft : TFileTime;
begin begin
@ -209,7 +210,7 @@ begin
end; end;
Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):boolean; Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):longbool;
var var
lft : TFileTime; lft : TFileTime;
begin begin
@ -494,9 +495,8 @@ procedure FindMatch(var f:searchrec);
Var Var
TheAttr : Longint; TheAttr : Longint;
begin begin
TheAttr:=DosToWinAttr(F.Attr);
{ Find file with correct attribute } { Find file with correct attribute }
While (F.W32FindData.dwFileAttributes and TheAttr)=0 do While (F.W32FindData.dwFileAttributes and F.ExcludeAttr)<>0 do
begin begin
if not FindNextFile (F.FindHandle,F.W32FindData) then if not FindNextFile (F.FindHandle,F.W32FindData) then
begin begin
@ -514,18 +514,22 @@ end;
procedure findfirst(const path : pathstr;attr : word;var f : searchRec); procedure findfirst(const path : pathstr;attr : word;var f : searchRec);
begin begin
writeln('a');
{ no error } { no error }
doserror:=0; doserror:=0;
F.Name:=Path; F.Name:=Path;
F.Attr:=attr; F.Attr:=attr;
F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume}
StringToPchar(f.name); StringToPchar(f.name);
{ FindFirstFile is a Win32 Call. } { FindFirstFile is a Win32 Call }
F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData); F.FindHandle:=FindFirstFile (pchar(@f.Name),F.W32FindData);
writeln('l1');
If longint(F.FindHandle)=Invalid_Handle_value then If longint(F.FindHandle)=Invalid_Handle_value then
begin begin
DosError:=Last2DosError(GetLastError); DosError:=Last2DosError(GetLastError);
exit; exit;
end; end;
writeln('l1');
{ Find file with correct attribute } { Find file with correct attribute }
FindMatch(f); FindMatch(f);
end; end;
@ -875,7 +879,10 @@ End;
end. end.
{ {
$Log$ $Log$
Revision 1.8 1998-08-16 09:12:11 michael Revision 1.9 1998-10-16 08:55:26 peter
* findfirst is now more delphi alike
Revision 1.8 1998/08/16 09:12:11 michael
Corrected fexpand behaviour. Corrected fexpand behaviour.
Revision 1.7 1998/06/10 10:39:13 peter Revision 1.7 1998/06/10 10:39:13 peter