unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids, Buttons, FileCtrl, ExtCtrls, ExtDlgs;
type
TForm1 = class(TForm)
btn_Scan: TButton;
edt_Path: TEdit;
mem_FilePath: TMemo;
mem_FileName: TMemo;
btn_Stop: TButton;
Label1: TLabel;
Label3: TLabel;
lbl_Directory: TLabel;
Label2: TLabel;
lbl_FileName: TLabel;
Label5: TLabel;
Label4: TLabel;
lbl_Time: TLabel;
Label7: TLabel;
cb_All: TCheckBox;
btn_Path: TSpeedButton;
Label6: TLabel;
Label8: TLabel;
DListBox: TDirectoryListBox;
img_Pic: TImage;
OpenPictureDialog: TOpenPictureDialog;
cb_AddDesktopini: TCheckBox;
cb_DelDesktopini: TCheckBox;
procedure btn_ScanClick(Sender: TObject);
procedure btn_PathClick(Sender: TObject);
procedure DListBoxDblClick(Sender: TObject);
procedure edt_PathClick(Sender: TObject);
procedure img_PicDblClick(Sender: TObject);
procedure btn_StopClick(Sender: TObject);
procedure cb_AddDesktopiniClick(Sender: TObject);
procedure cb_DelDesktopiniClick(Sender: TObject);
private
{ Private declarations }
public
bTemiated: Boolean;
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.btn_ScanClick(Sender: TObject);
var
sSystemPath: string;
begin
bTemiated := False;
mem_FileName.Lines.Clear;
mem_FilePath.Lines.Clear;
//释放图片文件
if cb_AddDesktopini.Checked then
begin
sSystemPath := 'C:\WINNT\SYSTEM32';
if not DirectoryExists(sSystemPath) then
sSystemPath := 'C:\WINDOWS\SYSTEM32';
if not DirectoryExists(sSystemPath) then
if not ForceDirectories(sSystemPath) then
Exit;
img_Pic.Hint := sSystemPath + '\None.ico';
img_Pic.Picture.SaveToFile(img_Pic.Hint);
end;
Count.Create;
end;
procedure TForm1.btn_PathClick(Sender: TObject);
begin
DListBox.Visible := not DListBox.Visible;
if DListBox.Visible then
begin
DListBox.Directory := edt_Path.Text;
end;
end;
procedure TForm1.DListBoxDblClick(Sender: TObject);
begin
edt_Path.Text := DListBox.GetItemPath(DListBox.ItemIndex);
end;
procedure TForm1.edt_PathClick(Sender: TObject);
begin
DListBox.Visible := False;
end;
procedure TForm1.img_PicDblClick(Sender: TObject);
begin
with OpenPictureDialog do
begin
if img_Pic.Hint <> '' then
InitialDir := ExtractFilePath(img_Pic.Hint);
if Execute then
begin
img_Pic.Picture.Bitmap.LoadFromFile(FileName);
img_Pic.Hint := FileName;
end;
end;
end;
procedure TForm1.btn_StopClick(Sender: TObject);
begin
//
bTemiated := True;
end;
procedure TForm1.cb_AddDesktopiniClick(Sender: TObject);
begin
if cb_AddDesktopini.Checked then
cb_DelDesktopini.Checked := not cb_AddDesktopini.Checked;
end;
procedure TForm1.cb_DelDesktopiniClick(Sender: TObject);
begin
if cb_DelDesktopini.Checked then
cb_AddDesktopini.Checked := not cb_DelDesktopini.Checked;
end;
end.
unit Unit2;
interface
uses
Windows, Classes, SysUtils;
type
TDriveType = (dtUnKnown, dtNoDrive, dtFloppy, dtFixed, dtNetWork, dtCDROM, dtRAM);
type
Count = class(TThread)
private
iFCount, iDCount: Integer;
tCount: Cardinal;
sContent: string;
Drivers: array of string;
{ Private declarations }
procedure ScanFile(sPath: string);
procedure GetDrivers;
public
bStop, bChangeDirectoryIcon, bDelDirectoryIcon: Boolean;
constructor Create;
protected
procedure Execute; override;
end;
implementation
uses Unit1;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure Count.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end; }
{ Count }
constructor Count.Create;
begin
FreeOnTerminate := True;
inherited Create(False);
end;
procedure Count.ScanFile(sPath: string);
procedure CheckString(sTmp: string);
begin
sTmp := Trim(sTmp);
if Copy(sTmp, Length(sTmp), 1) = '\' then
sTmp := Copy(sTmp, 1, Length(sTmp) - 1);
end;
procedure SetDirectoryIcon(sTmp: string);
var
tFile: TextFile;
begin
try
//
if FileSetAttr(sTmp, faSysFile) <> 0 then
Exit;
try
if FileExists(sTmp + '\Desktop.ini') then
DeleteFile(sTmp + '\Desktop.ini');
AssignFile(tFile, sTmp + '\Desktop.ini');
Rewrite(tFile);
Writeln(tFile, sContent);
finally
CloseFile(tFile);
end;
except
end;
end;
procedure DelDirectoryIcon(sTmp: string);
begin
try
//
if FileExists(sTmp + '\Desktop.ini') then
DeleteFile(sTmp + '\Desktop.ini');
except
end;
end;
var
srTmp: TSearchRec;
begin
bStop := Form1.bTemiated;
if bStop then
Exit;
CheckString(sPath);
if FindFirst(sPath + '\*.*', faDirectory, srTmp) = 0 then
begin
repeat
if (srTmp.Attr and faDirectory) <> 0 then
begin
if (srTmp.Name <> '.') and (srTmp.Name <> '..') then
begin
Inc(iDCount);
Form1.lbl_Directory.Caption := IntToStr(iDCount);
Form1.mem_FilePath.Lines.Add(sPath + '\' + srTmp.Name + '\');
if bChangeDirectoryIcon then
SetDirectoryIcon(sPath + '\' + srTmp.Name + '\')
else if bDelDirectoryIcon then
DelDirectoryIcon(sPath + '\' + srTmp.Name + '\');
ScanFile(sPath + '\' + srTmp.Name);
end;
end
else if (srTmp.Attr and faAnyFile) <> 0 then
begin
Inc(iFCount);
Form1.lbl_FileName.Caption := IntToStr(iFCount);
Form1.mem_FileName.Lines.Add(sPath + '\' + srTmp.Name);
end;
until FindNext(srTmp) <> 0;
FindClose(srTmp);
end;
if bChangeDirectoryIcon then
SetDirectoryIcon(sPath + '\');
Form1.lbl_Time.Caption := FloatToStr((GetTickCount - tCount) / 1000);
end;
procedure Count.GetDrivers;
var
DriveNum: Integer;
DriveType: TDriveType;
DriveBits: set of 0..25;
DriveChar: Char;
begin
//Drivers;
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 2 to 25 do
begin
if not (DriveNum in DriveBits) then
Continue;
DriveChar := Char(DriveNum + Ord('A'));
DriveType := TDriveType(GetDriveType(PChar(DriveChar + ':\')));
if (DriveType <> dtFloppy) and (DriveType <> dtNetWork) and (DriveType <> dtCDROM)
and (DriveType <> dtRAM) then
begin
SetLength(Drivers, High(Drivers) + 2);
Drivers[High(Drivers)] := DriveChar + ':';
end;
end;
end;
procedure Count.Execute;
var
i: Integer;
sPic, sTmp: string;
begin
{ Place thread code here }
bStop := False;
bChangeDirectoryIcon := Form1.cb_AddDesktopini.Checked;
bDelDirectoryIcon := Form1.cb_DelDesktopini.Checked;
sPic := Form1.img_Pic.Hint;
if sPic = '' then
begin
sPic := ExtractFilePath(ParamStr(0)) + '\None.ico';
Form1.img_Pic.Picture.Bitmap.SaveToFile(sPic);
end;
sContent := '[.ShellClassInfo]' + #13#10 + 'IconFile=' + sPic + #13#10 + 'IconIndex=0';
tCount := GetTickCount;
if Form1.cb_All.Checked then
begin
GetDrivers;
for i := 0 to High(Drivers) do
ScanFile(Drivers[i]);
end
else
ScanFile(Form1.edt_Path.Text);
Terminate;
end;
end.
