unit udirlist;

interface

uses
	Windows, SysUtils, Classes;

type
	TFileInfo = record
		Time: Integer;
		Size: Integer;
		Attr: Integer;
		Name: string;
	end;

type
	TSortMode = (smName, smSize, smTime);
	TDirList = class
	public
		constructor Create;
		destructor  Destroy; override;
		procedure   Open(stPathMask: string);
		procedure   Close;
		function    Count: integer;
		procedure   Sort(SortMode: TSortMode);
	private
		List: TList;
		FBaseDir: string;
		FWorkDir: string;
		function    getItems(i: integer) : TFileInfo;
	public
		property    Items[i: integer]: TFileInfo read getItems; default;
		property    BaseDir: string read FBaseDir write FBaseDir;
		property    WorkDir: string read FWorkDir;
	public
		function    EvalFileNameMacro(n: integer; st: string): string;
	end;

implementation

function SortSearchRecByName(Item1, Item2: Pointer): Integer;
var
	PFileInfo1: ^TFileInfo absolute Item1;
	PFileInfo2: ^TFileInfo absolute Item2;
begin
	result := AnsiCompareStr(PFileInfo1^.Name, PFileInfo2^.Name);
end;

function SortSearchRecBySize(Item1, Item2: Pointer): Integer;
var
	PFileInfo1: ^TFileInfo absolute Item1;
	PFileInfo2: ^TFileInfo absolute Item2;
begin
	if PFileInfo1.Size = PFileInfo2.Size then
		result := 0
	else
	if PFileInfo1.Size < PFileInfo2.Size then
		result := 1
	else
		result := -1;
end;

function SortSearchRecByTime(Item1, Item2: Pointer): Integer;
var
	PFileInfo1: ^TFileInfo absolute Item1;
	PFileInfo2: ^TFileInfo absolute Item2;
begin
	if PFileInfo1.Time = PFileInfo2.Time then
		result := 0
	else
	if PFileInfo1.Time < PFileInfo2.Time then
		result := 1
	else
		result := -1;
end;

//-------------------------------------------------------------------

constructor TDirList.Create;
begin
	List := TList.Create;
end;

destructor  TDirList.Destroy;
begin
	Close;
	List.Free;
end;

procedure   TDirList.Open(stPathMask: string);
var
	SR: TSearchRec;
	PFileInfo: ^TFileInfo;
begin
	FWorkDir := ExtractFileDir(ExpandFileName(stPathMask));
	FBaseDir := FWorkDir;

	if FindFirst(stPathMask, faAnyFile, SR) <> 0 then exit;
	repeat
		if (SR.Name <> '.') and (SR.Name <> '..') then
		begin
			PFileInfo := AllocMem(sizeof(TFileInfo));
			PFileInfo.Time := SR.Time;
			PFileInfo.Size := SR.Size;
			PFileInfo.Attr := SR.Attr;
			PFileInfo.Name := SR.Name;
			List.Add(PFileInfo);
		end;
	until ( FindNext(SR) <> 0 );
	FindClose(SR);
end;

procedure   TDirList.Close;
var
	PFileInfo: ^TFileInfo;
begin
	while List.Count <> 0 do
	begin
		PFileInfo := List[0];
		FreeMem(PFileInfo);
		List.Delete(0);
	end;
end;

function    TDirList.Count: integer;
begin
	result := List.Count;
end;

procedure   TDirList.Sort(SortMode: TSortMode);
begin
	case SortMode of
	smName: List.Sort(SortSearchRecByName);
	smSize: List.Sort(SortSearchRecBySize);
	smTime: List.Sort(SortSearchRecByTime);
	end;
end;

function    TDirList.getItems(i: integer) : TFileInfo;
begin
	result := TFileInfo(List[i]^);
end;
(*
  ##	#
  #P	\BaseDirFromRoot\Filename.Ext
  #p	               .\Filename.Ext
  #D	\BaseDirFromRoot
  #d	  ..\RelativeFromBaseDir
  #f	                 Filename.Ext
  #n	                 Filename
  #e	                          Ext
  #U	\\Server\Share\BaseDirFromRoot\Filename.Ext
  #u	\\Server\Share
    #P == #d\#n.#e == #D\#d\#p
*)

function    SetDirMark(DirName: string): string;
begin
	result := DirName;
	if DirName[Length(DirName)] <> '\' then
		result := DirName + '\';
end;

function    TDirList.EvalFileNameMacro(n: integer; st: string): string;
var
	i: integer;
	ABaseDir,
	APath, RPath, AWorkDir, RWorkDir,
	FileNameExt, FileName, FileExt: string;
begin
	ABaseDir    := SetDirMark(FBaseDir);
	APath       := ExpandFileName(SetDirMark(FWorkDir) + Items[n].Name);
	RPath       := ExtractRelativePath(ABaseDir, APath);
	AWorkDir    := FWorkDir;
	RWorkDir    := ExtractRelativePath(ABaseDir, FWorkDir);
	FileNameExt := ExtractFileName(APath);
	FileName    := ChangeFileExt(FileNameExt, '');
	FileExt     := ExtractFileExt(FileNameExt);

	result := '';
	i := 1;
	while i <= Length(st) do
	begin
		if st[i] = '#' then
		begin
			case st[i+1] of
			'P': result := result + APath;
			'p': result := result + RPath;
			'D': result := result + AWorkDir;
			'd': result := result + RWorkDir;
			'f': result := result + FileNameExt;
			'n': result := result + FileName;
			'e': result := result + FileExt;
			else
				if i+1 <= Length(st) then
					result := result + st[i+1];
			end;
			i := i + 1;
		end else begin
			result := result + st[i];
		end;
		i := i + 1;
	end;
end;

end.