unit model.listdirs; /// Demo service for use in "How to create a plugin" \\\
{$mode ObjFPC}{$H+} /// Public Domain \\\
/// Winders specific implementation provided by @Hansvb from Lazarus-forum \\\
interface
uses classes, sysutils, istrlist, cdbc.inodes;
const
{ consts pertaining to IListDirs }
SGUIDIListDirs = '{637CC463-635E-4637-8975-EC178D9A7792}';
type
{ IListDirs is a service that can tell you information about a directory on unices, you
create it via a call to "GetListDirs" :: it's a COM-object }
IListDirs = interface(IInterface)['{637CC463-635E-4637-8975-EC178D9A7792}']
procedure set_Debug(aValue: boolean);
{ returns the unix-timestamp for a directory's last modification time, while
at the same time spitting out the timestamp in the form of a 'TDateTime' }
function DirAge(const aDirName: rawbytestring; out asDaTi: TDateTime): ptrint;
{ returns the unix-timestamp for a file's last modification time, while
at the same time spitting out the timestamp in the form of a 'TDateTime' }
function FileAge(const aFileName: rawbytestring; out asDaTi: TDateTime): ptrint;
{ returns an INodeList with the results from a recursive directory-scan }
function GetDirContent(aDirName: string;IncludeFullPath: boolean = false): INodeList;
{ returns a stringlist with the directory-names (only) found in directory; NO files & NO recursion }
function GetDirs(aDirName: string;IncludeFullPath: boolean = false): IStringList;
{ returns a stringlist with the filenames (only) found in directory; NO dirs & NO recursion }
function GetFiles(aDirName: string;IncludeFullPath: boolean = false): IStringList;
end;
{ TiListDirs implements the interface / service }
TiListDirs = class(TInterfacedObject,IListDirs)
private
fDbg: boolean;
procedure set_Debug(aValue: boolean);
public
destructor Destroy; override;
{ returns the unix-timestamp for a directory's last modification time, while
at the same time spitting out the timestamp in the form of a 'TDateTime' }
function DirAge(const aDirName: rawbytestring; out asDaTi: TDateTime): ptrint;
{ returns the unix-timestamp for a file's last modification time, while
at the same time spitting out the timestamp in the form of a 'TDateTime' }
function FileAge(const aFileName: rawbytestring; out asDaTi: TDateTime): ptrint;
{ returns an INodeList with the results from a recursive directory-scan }
function GetDirContent(aDirName: string;{%H-}IncludeFullPath: boolean = false): INodeList;
{ returns a stringlist with the directory-names (only) found in directory; NO files & NO recursion }
function GetDirs(aDirName: string;IncludeFullPath: boolean = false): IStringList;
{ returns a stringlist with the filenames (only) found in directory; NO dirs & NO recursion }
function GetFiles(aDirName: string;IncludeFullPath: boolean = false): IStringList;
end;
{ service factory for IListDirs :o) }
function GetListDirs: IListDirs;
implementation // Changed
{$ifdef Unix}
uses baseunix;
{$endif}
{$ifdef Windows}
uses windows;
{$endif}
function GetListDirs: IListDirs;
begin
Result:= TiListDirs.Create as IListDirs;
end;
{ TiListDirs }
procedure TiListDirs.set_Debug(aValue: boolean);
begin
fDbg:= aValue;
end;
destructor TiListDirs.Destroy;
begin
if fDbg then writeln('(¤) IListDirs destroyed');
inherited Destroy;
end;
function TiListDirs.DirAge(const aDirName: rawbytestring; out asDaTi: TDateTime): ptrint;
{$ifdef Unix}
var Info: baseunix.stat;
{$endif}
{$ifdef Windows}
var FindHandle: THandle;
FindData: WIN32_FIND_DATA;
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
{$endif}
begin
{$ifdef Unix}
if fpstat(pansichar(aDirName), Info) < 0 then begin
asDaTi:= MinDateTime;
exit(-1);
end;
Result:= Info.st_mtime;
asDaTi:= FileDateToDateTime(Result);
{$endif}
{$ifdef Windows}
FindHandle:= FindFirstFile(PChar(string(aDirName)), FindData);
if FindHandle = INVALID_HANDLE_VALUE then begin
asDaTi:= MinDateTime;
exit(-1);
end;
// Windows uses TFileTime (64-bit)
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToSystemTime(LocalFileTime, SystemTime);
asDaTi:= SystemTimeToDateTime(SystemTime);
// Convert to st_mtime compatible format (Unix timestamp)
Result:= DateTimeToFileDate(asDaTi);
Windows.FindClose(FindHandle);
{$endif}
end;
function TiListDirs.FileAge(const aFileName: rawbytestring; out asDaTi: TDateTime): ptrint;
{$ifdef Unix}
var Info: baseunix.stat; SystemFileName: rawbytestring;
{$endif}
{$ifdef Windows}
var FindHandle: THandle;
FindData: WIN32_FIND_DATA;
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
{$endif}
begin
{$ifdef Unix}
SystemFileName:= ToSingleByteFileSystemEncodedFileName(aFileName); { compiler magic }
if fpstat(pansichar(SystemFileName), Info) < 0 then begin
asDaTi:= MinDateTime;
exit(-1);
end
else begin
Result:= Info.st_mtime; { we're mostly interested in 'modified' }
asDaTi:= FileDateToDateTime(Result); { just convenience for the user }
end;
{$endif}
{$ifdef Windows}
FindHandle:= FindFirstFile(PChar(string(aFileName)), FindData);
if FindHandle = INVALID_HANDLE_VALUE then begin
asDaTi:= MinDateTime;
exit(-1);
end;
{ Use ftLastWriteTime – this is the Windows counterpart of st_mtime }
FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
FileTimeToSystemTime(LocalFileTime, SystemTime);
asDaTi:= SystemTimeToDateTime(SystemTime);
{ Convert to Unix timestamp format (same as Info.st_mtime) }
Result:= DateTimeToFileDate(asDaTi);
Windows.FindClose(FindHandle);
{$endif}
end;
function TiListDirs.GetDirContent(aDirName: string; IncludeFullPath: boolean): INodeList;
var lvl: integer = -1;
{$ifdef Windows}
procedure ScanDirWin(aDir, anExt: string; aNodelist: INodeList; aRecursive: boolean);
var FindHandle: THandle;
FindData: WIN32_FIND_DATA;
lnode: PFSNode;
dirs: TStrings;
i: integer;
ls: string;
begin
aDir:= IncludeTrailingPathDelimiter(aDir);
inc(lvl);
lnode:= aNodelist.AddItem;
lnode^.fnType:= 1; // folder / dir
lnode^.fnDir:= aDir;
lnode^.fnInclude:= true;
lnode^.fnLevel:= lvl;
ls:= PickLastDir(aDir);
dirs:= TStringList.Create;
FindHandle:= FindFirstFile(PChar(aDir + anExt), FindData);
if FindHandle <> INVALID_HANDLE_VALUE then begin
repeat
if (FindData.cFileName[0] <> '.') and
(FindData.cFileName <> 'backup') and
(FindData.cFileName <> 'lib') and
(FindData.cFileName <> 'published') then
begin
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
dirs.Add(aDir + FindData.cFileName)
else begin
lnode:= aNodelist.AddItem;
lnode^.fnType:= 0; // file
lnode^.fnFile:= FindData.cFileName;
lnode^.fnDir:= ls;
lnode^.fnInclude:= true;
lnode^.fnLevel:= lvl + 1;
end;
end;
until not FindNextFile(FindHandle, FindData);
Windows.FindClose(FindHandle);
end;
if aRecursive then
for i:= 0 to dirs.Count - 1 do
ScanDirWin(dirs[i], anExt, aNodelist, aRecursive);
dirs.Free;
dec(lvl);
end;
{$endif}
{$ifdef Unix}
procedure ScanDirUnix(aDir, anExt: string; aNodelist: INodeList; aRecursive: boolean);
var lnode: PFSNode; finished: longint; found: TSearchRec; dirs: TStrings; i: longint; ls: string;
begin
aDir:= IncludeTrailingPathDelimiter(aDir);
inc(lvl);
lnode:= aNodelist.AddItem;
lnode^.fnType:= 1;
lnode^.fnDir:= aDir;
lnode^.fnInclude:= true;
lnode^.fnLevel:= lvl;
ls:= PickLastDir(aDir);
dirs:= TStringList.Create;
finished:= FindFirst(aDir + anExt, faAnyFile, found);
while finished = 0 do begin
if ((found.Name[1] <> '.') and (found.Name <> 'backup') and
(found.Name <> 'lib') and (found.Name <> 'published')) then begin
if (found.Attr and faDirectory = faDirectory) then
dirs.Add(aDir + found.Name)
else begin
lnode:= aNodelist.AddItem;
lnode^.fnType:= 0;
lnode^.fnFile:= found.Name;
lnode^.fnDir:= ls;
lnode^.fnInclude:= true;
lnode^.fnLevel:= lvl+1;
end;
end;
finished:= FindNext(found);
end;
FindClose(found);
if aRecursive then for i:= 0 to dirs.Count - 1 do ScanDirUnix(dirs[i],anExt,aNodelist,aRecursive);
dirs.Free;
dec(lvl);
end;
{$endif}
begin { GetDirContent }
Result:= CreINodeList();
{$ifdef Unix}
ScanDirUnix(aDirName, '*', Result, true);
{$endif}
{$ifdef Windows}
ScanDirWin(aDirName, '*', Result, true);
{$endif}
end;
function TiListDirs.GetDirs(aDirName: string; IncludeFullPath: boolean): IStringList;
{$ifdef Windows}
var FindHandle: THandle;
FindData: WIN32_FIND_DATA;
{$endif}
{$ifdef Unix}
var finished: longint; found: TSearchRec;
{$endif}
begin
Result:= CreStrings;
if aDirName = '' then exit(Result);
aDirName:= IncludeTrailingPathDelimiter(aDirName);
{$ifdef Unix}
finished:= FindFirst(aDirName + '*', faAnyFile, found);
while finished = 0 do begin
if (found.Name[1] <> '.') then begin
if (found.Attr and faDirectory = faDirectory) then
if IncludeFullPath then Result.Append(aDirName + found.Name + DirectorySeparator)
else Result.Append(found.Name + DirectorySeparator);
end;
finished:= FindNext(found);
end;
FindClose(found);
{$endif}
{$ifdef Windows}
FindHandle:= FindFirstFile(PChar(aDirName + '*'), FindData);
if FindHandle <> INVALID_HANDLE_VALUE then
begin
repeat
// Skip . en ..
if (FindData.cFileName[0] <> '.') then begin
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY then
if IncludeFullPath then Result.Append(aDirName + FindData.cFileName + DirectorySeparator)
else Result.Append(FindData.cFileName + DirectorySeparator);
end;
until not FindNextFile(FindHandle, FindData);
Windows.FindClose(FindHandle);
end;
{$endif}
end;
function TiListDirs.GetFiles(aDirName: string; IncludeFullPath: boolean): IStringList;
{$ifdef Windows}
var FindHandle: THandle;
FindData: WIN32_FIND_DATA;
{$endif}
{$ifdef Unix}
var finished: longint; found: TSearchRec;
{$endif}
begin
{$ifdef usepli} Result:= CreStrList; {$else} Result:= CreStrings; {$endif}
if aDirName = '' then exit(Result);
aDirName:= IncludeTrailingPathDelimiter(aDirName);
{$ifdef Unix}
finished:= FindFirst(aDirName + '*', faAnyFile, found);
while finished = 0 do begin
if (found.Name[1] <> '.') then begin
if (found.Attr and faDirectory <> faDirectory) then
if IncludeFullPath then Result.Append(aDirName + found.Name)
else Result.Append(found.Name);
end;
finished:= FindNext(found);
end;
FindClose(found);
{$endif}
{$ifdef Windows}
FindHandle:= FindFirstFile(PChar(aDirName + '*'), FindData);
if FindHandle <> INVALID_HANDLE_VALUE then begin
repeat
// Skip . en ..
if (FindData.cFileName[0] <> '.') then begin
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY then
if IncludeFullPath then Result.Append(aDirName + FindData.cFileName)
else Result.Append(FindData.cFileName);
end;
until not FindNextFile(FindHandle, FindData);
Windows.FindClose(FindHandle);
end;
{$endif}
end;
end.
Recent
