Solved: Sort Disk files or files in a directory (Very Urgent)

Here's an demo for you. I used a cliendataset and grid instead of a listbox as it is easier to show the data in columns this way. You could quite easily build a function to build a TString list by cycling through the records in the dataset.

pas file:
---------
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, DB, DBClient, Grids, DBGrids, DBCtrls,
ExtCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
btnSelectDir: TButton;
Panel1: TPanel;
inpFileCount: TLabel;
Label8: TLabel;
DBGrid1: TDBGrid;
btnRefresh: TButton;
DataSource1: TDataSource;
dsFiles: TClientDataSet;
dsFilesFileName: TStringField;
dsFileslocation: TStringField;
dsFilesSize: TIntegerField;
dsFilesFTStamp: TDateTimeField;
dsFilesDateCreated: TDateTimeField;
dsFilesDateModified: TDateTimeField;
dsFilesDateAccessed: TDateTimeField;
dsFilesSumSize: TAggregateField;
Panel2: TPanel;
lbDirs: TListBox;
btnClear: TButton;
btnRemove: TButton;
cbSubDirs: TCheckBox;
DBText1: TDBText;
procedure btnSelectDirClick(Sender: TObject);
procedure btnRemoveClick(Sender: TObject);
procedure btnClearClick(Sender: TObject);
procedure DBGrid1TitleClick(Column: TColumn);
procedure btnRefreshClick(Sender: TObject);
private
procedure PopulateList;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btnSelectDirClick(Sender: TObject);
var dir: string;
begin
if SelectDirectory('Select directory', 'c:\', dir)
then lbDirs.Items.Add(dir);
end;

procedure TForm1.PopulateList;
var
Dirs: TStringList;
sr: TSearchRec;
ft: TFileTime;
st: TSystemTime;
i: integer;
begin
Dirs:= TStringList.Create;
Dirs.Duplicates:= dupError;
Dirs.Sorted:= true;

//Add base directory locations
for i:= 0 to lbDirs.Count -1
do Dirs.Add(lbDirs.Items[i]);

//build locations list
if cbSubDirs.Checked then
begin
i:= -1;
repeat
Inc(i);
if FindFirst(Dirs[i]+'\*.*', faDirectory, sr) = 0 then
repeat
try
if (sr.Attr and faDirectory) > 0 then
if (sr.Name <> '.') AND (sr.Name <> '..')
then Dirs.Add(Dirs[i]+'\'+sr.Name);
except on E: Exception
do ShowMessage(E.Message);
end;
until FindNext(sr) <> 0;
FindClose(sr);
until i = Dirs.Count -1;
end;

//Populate List
Screen.Cursor:= crHourglass;
dsFiles.DisableControls;
dsFiles.EmptyDataSet;
for i:= 0 to Dirs.Count-1 do
begin
if NOT DirectoryExists(Dirs[i])
then ShowMessage('Directory not found: '+ Dirs[i])
else begin
if FindFirst(Dirs[i] + '\*.*', (faAnyFile - faDirectory), sr) = 0 then
begin
repeat
dsFiles.Append;
dsFiles['FileName']:= sr.Name;
dsFiles['Location']:= Dirs[i]; //ExtractFilePath(sr.Name);
dsFiles['Size']:= sr.Size;
dsFiles['FTStamp']:= FileDateToDateTime(sr.Time);

FileTimeToLocalFileTime(sr.FindData.ftCreationTime, ft);
FileTimeToSystemTime(ft, st);
dsFiles['DateCreated']:= SystemTimeToDateTime(st);

FileTimeToLocalFileTime(sr.FindData.ftLastWriteTime, ft);
FileTimeToSystemTime(ft, st);
dsFiles['DateModified']:= SystemTimeToDateTime(st);

FileTimeToLocalFileTime(sr.FindData.ftLastAccessTime, ft);
FileTimeToSystemTime(ft, st);
dsFiles['DateAccessed']:= SystemTimeToDateTime(st);
dsFiles.Post;
inpFileCount.Caption:= 'Files Listed: '+IntToStr(dsFiles.RecordCount);
inpFileCount.Update;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;
end;
dsFiles.EnableControls;
Screen.Cursor:= crArrow;

Dirs.Clear;
Dirs.Free;
end;

procedure TForm1.btnRemoveClick(Sender: TObject);
begin
lbDirs.DeleteSelected;
end;

procedure TForm1.btnClearClick(Sender: TObject);
begin
lbDirs.Clear;
end;

procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
dsFiles.IndexFieldNames:= Column.FieldName;
end;

procedure TForm1.btnRefreshClick(Sender: TObject);
begin
PopulateList;
end;

end.

dfm file:
---------
object Form1: TForm1
Left = 192
Top = 114
Width = 696
Height = 480
Caption = 'Form1'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Times New Roman'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 15
object Panel1: TPanel
Left = 0
Top = 113
Width = 688
Height = 333
Align = alClient
TabOrder = 0
DesignSize = (
688
333)
object inpFileCount: TLabel
Left = 8
Top = 308
Width = 73
Height = 15
Anchors = [akLeft, akBottom]
Caption = 'Files Listed: 0'
end
object Label8: TLabel
Left = 184
Top = 308
Width = 55
Height = 15
Anchors = [akLeft, akBottom]
Caption = 'Total Size:'
end
object DBText1: TDBText
Left = 248
Top = 309
Width = 97
Height = 15
Anchors = [akLeft, akBottom]
DataField = 'SumSize'
DataSource = DataSource1
end
object DBGrid1: TDBGrid
Left = 1
Top = 1
Width = 686
Height = 295
Hint = 'Click a column heading to sort'
Align = alTop
Anchors = [akLeft, akTop, akRight, akBottom]
BorderStyle = bsNone
DataSource = DataSource1
Options = [dgTitles, dgIndicator, dgColumnResize, dgColLines, dgTabs, dgRowSelect, dgConfirmDelete, dgCancelOnExit]
ReadOnly = True
TabOrder = 0
TitleFont.Charset = ANSI_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -13
TitleFont.Name = 'Times New Roman'
TitleFont.Style = []
OnTitleClick = DBGrid1TitleClick
Columns = <
item
Expanded = False
FieldName = 'FileName'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end
item
Expanded = False
FieldName = 'Location'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end
item
Expanded = False
FieldName = 'Size'
Title.Alignment = taRightJustify
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end
item
Expanded = False
FieldName = 'FTStamp'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = False
end
item
Expanded = False
FieldName = 'DateCreated'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end
item
Expanded = False
FieldName = 'DateAccessed'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end
item
Expanded = False
FieldName = 'DateModified'
Title.Font.Charset = ANSI_CHARSET
Title.Font.Color = clWindowText
Title.Font.Height = -13
Title.Font.Name = 'Times New Roman'
Title.Font.Style = [fsBold]
Visible = True
end>
end
object btnRefresh: TButton
Left = 607
Top = 304
Width = 75
Height = 23
Anchors = [akRight, akBottom]
Caption = 'Refresh'
TabOrder = 1
OnClick = btnRefreshClick
end
object cbSubDirs: TCheckBox
Left = 448
Top = 307
Width = 152
Height = 17
Alignment = taLeftJustify
Caption = 'Include Sub-directories'
TabOrder = 2
end
end
object Panel2: TPanel
Left = 0
Top = 0
Width = 688
Height = 113
Align = alTop
TabOrder = 1
DesignSize = (
688
113)
object Label1: TLabel
Left = 16
Top = 16
Width = 58
Height = 15
Caption = 'Directories'
end
object btnSelectDir: TButton
Left = 600
Top = 14
Width = 78
Height = 22
Anchors = [akTop, akRight]
Caption = 'Add'
TabOrder = 0
OnClick = btnSelectDirClick
end
object lbDirs: TListBox
Left = 80
Top = 8
Width = 513
Height = 97
Anchors = [akLeft, akTop, akRight]
ItemHeight = 15
TabOrder = 1
end
object btnClear: TButton
Left = 600
Top = 62
Width = 78
Height = 22
Anchors = [akTop, akRight]
Caption = 'Clear'
TabOrder = 2
OnClick = btnClearClick
end
object btnRemove: TButton
Left = 600
Top = 38
Width = 78
Height = 22
Anchors = [akTop, akRight]
Caption = 'Remove'
TabOrder = 3
OnClick = btnRemoveClick
end
end
object DataSource1: TDataSource
DataSet = dsFiles
Left = 120
Top = 176
end
object dsFiles: TClientDataSet
Active = True
Aggregates = <>
AggregatesActive = True
FieldDefs = <
item
Name = 'FileName'
DataType = ftString
Size = 260
end
item
Name = 'Location'
DataType = ftString
Size = 260
end
item
Name = 'Size'
DataType = ftInteger
end
item
Name = 'FTStamp'
DataType = ftDateTime
end
item
Name = 'DateCreated'
DataType = ftDateTime
end
item
Name = 'DateModified'
DataType = ftDateTime
end
item
Name = 'DateAccessed'
DataType = ftDateTime
end
item
Name = 'BakAction'
DataType = ftInteger
end>
IndexDefs = <>
Params = <>
StoreDefs = True
Left = 152
Top = 176
Data = {
C10000009619E0BD010000001800000008000000000003000000C1000846696C
654E616D650200490000000100055749445448020002000401084C6F63617469
6F6E02004900000001000557494454480200020004010453697A650400010000
0000000746545374616D7008000800000000000B446174654372656174656408
000800000000000C446174654D6F64696669656408000800000000000C446174
65416363657373656408000800000000000942616B416374696F6E0400010000
0000000000}
object dsFilesFileName: TStringField
DisplayWidth = 30
FieldName = 'FileName'
Size = 260
end
object dsFileslocation: TStringField
DisplayWidth = 30
FieldName = 'Location'
Size = 260
end
object dsFilesSize: TIntegerField
DisplayWidth = 12
FieldName = 'Size'
DisplayFormat = '#,##0'
end
object dsFilesFTStamp: TDateTimeField
FieldName = 'FTStamp'
Visible = False
end
object dsFilesDateCreated: TDateTimeField
DisplayLabel = 'Created'
DisplayWidth = 22
FieldName = 'DateCreated'
end
object dsFilesDateModified: TDateTimeField
DisplayLabel = 'Modified'
DisplayWidth = 22
FieldName = 'DateModified'
end
object dsFilesDateAccessed: TDateTimeField
DisplayLabel = 'Accessed'
DisplayWidth = 22
FieldName = 'DateAccessed'
end
object dsFilesSumSize: TAggregateField
FieldName = 'SumSize'
Active = True
DisplayFormat = '#,##0'
Expression = 'SUM(Size)'
end
end
end

Regards
Pierre

Pierre Cornelius

Forgot to mention, if you click on a column title heading it will sort by that field. It simply sets the datasets indexfieldnames property to the selected fieldname. This would sort in ascending order but if you need descending order, you would have to create an index for this. E.g. in the OnTitleClick event do this:

...
dsFiles.IndexDefs.Clear;
dsFiles.IndexDefs.Add('ix', Column.FieldName, [ixDescending]);
dsFiles.IndexName:= 'ix';
...

FarajLY

try this
uses
ShellApi;

ExecuteShellCommand('dir /b /o-d c:\ >c:\log.log', True);

if FileExists('c:\log.log') Then
ListBox1.Items.LoadFromFile('c:\log.log');

Mike Littlewood

Undeclared identifier 'ExecuteShellCommand'

Doesnt seem to be part of ShellApi

Which version of delphi are you using?

aikimark

1. you should also specify which date is used for the ordering
2. you should also specify that no directories be listed, since you want to list files
Exampe
dir /b /o-d /tc /a-d

3. you might also consider using StdOut and StdIn streams as alternative to the file

saravananvg

ASKER

Hello Sir,

I shall check them and reply at the earliest. I could not check as I was a bit busy.

with regards,
padmaja.

saravananvg

ASKER

Hello Sir,

I used the following code to do the same by using a Memo box and a Button on the form.

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
PFileRecord = ^TFileRecord;
TFileRecord = record
Name: string;
Time: Integer;
Size: Integer;
end;

type
TForm1 = class(TForm)
Button1: TButton;
M1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
s : TList;
implementation

{$R *.dfm}

function CompareFileRecord(Item1, Item2: Pointer): Integer;
begin
// Used to sort the list on date/time first, name second. Don't worry about converting the date. No need for this.
if (PFileRecord(Item1).Time < PFileRecord(Item2).Time) then begin
Result := -1;
end
else if (PFileRecord(Item1).Time > PFileRecord(Item2).Time) then begin
Result := 1;
end
else if (PFileRecord(Item1).Name < PFileRecord(Item2).Name) then begin
Result := -1;
end
else if (PFileRecord(Item1).Name > PFileRecord(Item2).Name) then begin
Result := 1;
end
else begin
Result := 0;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec: TSearchRec;
List: TList;
Item: PFileRecord;
I: Integer;
begin
// Create the lists.
List := TList.Create;
// Fill the lists.
if (FindFirst('C:\AddToFolder\*.avi', faAnyfile - faDirectory, SearchRec) = 0) then begin
repeat
New(Item);
Item.Name := SearchRec.Name;
Item.Time := SearchRec.Time;
Item.Size := SearchRec.Size;
List.Add(Item);
until (FindNext(SearchRec) <> 0);
FindClose(SearchRec);
end;
// Sort the lists.
List.Sort(CompareFileRecord);
M1.Clear;
for I := 0 to (List.Count)-1 do
begin
Item := List.Items[i];
M1.Lines.Add(Item.Name)
end;
end;

end.

with regards,
padmaja.

Pierre Cornelius

Sorry to disagree, but my example was quite comprehensive. Also Padmaja's own solution employs the same code as in my example to list the files and determine the creation date.