www.pudn.com > DriveRescuev1.8.zip > main.pas
//: Drive Rescue Main Module
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, Grids, ComCtrls, pdiskio, ldiskio, diskfs,
helpers, drvdlg, inputdlg, shellapi, ToolWin, Buttons, registry,
ImgList, debugbox, optdlg, devices;
const
sFormCaption = 'Drive Rescue';
sRegKey = '\SOFTWARE\Alexander Grau\Drive Rescue\1.8beta3';
sHomePage = 'http://skyscraper.fortunecity.com/amd/887/rescue/index.html';
sIBrowserExec = 'explorer ';
// image list indices
idxFolderClosed = 0;
idxFolderOpen = 1;
idxRecycle = 2;
idxFolderFound = 3;
idxFileFound = 4;
idxFile = 5;
idxFolderClosedDel = 6;
idxFolderOpenDel = 7;
idxFileDel = 8;
// debug levels
debugOff = 0; // always displayed
debugLow = 1;
debugMed = 2;
debugHigh = 3;
// work states
state_NoDriveSelected = 1;
state_DriveSelected = 2;
type
PFileData = ^TFileData;
TFileData = record
name: shortstring;
attr: byte;
cluster: longword;
time, date: word;
size: longword;
deleted: boolean;
condition: byte;
end;
PDirData = ^TDirData;
TDirData = record
dir: shortstring;
name: shortstring;
cluster: longword;
expanded: boolean;
deleted: boolean;
end;
TMainForm = class(TForm)
MainMenu1: TMainMenu;
MenuObject: TMenuItem;
MenuExit: TMenuItem;
N1: TMenuItem;
MenuDrive: TMenuItem;
MenuInfo: TMenuItem;
MenuDrvInfo: TMenuItem;
StatusBar1: TStatusBar;
ImageListSmallFolders: TImageList;
MenuView: TMenuItem;
MenuLargeIcons: TMenuItem;
MenuSmallIcons: TMenuItem;
MenuList: TMenuItem;
MenuDetails: TMenuItem;
MenuHelp: TMenuItem;
MenuHelpTopic: TMenuItem;
N4: TMenuItem;
MenuAbout: TMenuItem;
ImageListLargeFolders: TImageList;
Toolbar1: TPanel;
ButtonFindLostData: TSpeedButton;
MenuEdit: TMenuItem;
MenuSelectAll: TMenuItem;
MenuInvertselection: TMenuItem;
ButtonViewIcon: TSpeedButton;
ButtonViewSmallIcon: TSpeedButton;
ButtonViewList: TSpeedButton;
ButtonViewReport: TSpeedButton;
PopupMenuBrowseFile: TPopupMenu;
PopupMenuSaveFileTo: TMenuItem;
ButtonHelp: TSpeedButton;
SaveDialog1: TSaveDialog;
N8: TMenuItem;
MenuSysInfo: TMenuItem;
MenuDriveRescueHomepage: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
PopupMenuViewAsHex: TMenuItem;
N2: TMenuItem;
MenuSaveTo: TMenuItem;
MenuRename: TMenuItem;
N3: TMenuItem;
MenuFind: TMenuItem;
MenuViewAs: TMenuItem;
MenuViewAsHex: TMenuItem;
MenuViewAsText: TMenuItem;
Notebook1: TNotebook;
N5: TMenuItem;
MenuOptions: TMenuItem;
MenuProperties: TMenuItem;
ButtonFind: TSpeedButton;
ButtonSaveTo: TSpeedButton;
ButtonOpenDrive: TSpeedButton;
N6: TMenuItem;
MenuToolbar: TMenuItem;
MenuStatusbar: TMenuItem;
N7: TMenuItem;
MenuArrangeItems: TMenuItem;
MenuArrangebyName: TMenuItem;
MenuArrangebySize: TMenuItem;
MenuArangebydate: TMenuItem;
MenuArrangebytype: TMenuItem;
N9: TMenuItem;
MenuArrangeAscendingOrder: TMenuItem;
MenuArrangeDescendingOrder: TMenuItem;
Splitter1: TSplitter;
Notebook2: TNotebook;
ListView1: TListView;
StatusBar2: TStatusBar;
Timer1: TTimer;
ButtonParentDir: TSpeedButton;
MenuTools: TMenuItem;
MenuFindLostData: TMenuItem;
PopupMenuViewAsText: TMenuItem;
N12: TMenuItem;
PopupMenuProperties: TMenuItem;
PopupMenuRename: TMenuItem;
Notebook3: TNotebook;
TreeView: TTreeView;
StatusBar3: TStatusBar;
// Form methods...
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
// Controls methods...
procedure TreeViewExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
procedure TreeViewChange(Sender: TObject; Node: TTreeNode);
procedure TreeViewExpanded(Sender: TObject; Node: TTreeNode);
procedure TreeViewCollapsed(Sender: TObject; Node: TTreeNode);
procedure ListView1DblClick(Sender: TObject);
procedure ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
// Menu methods...
procedure MenuDriveClick(Sender: TObject);
procedure MenuDetailsClick(Sender: TObject);
procedure MenuLargeIconsClick(Sender: TObject);
procedure MenuSmallIconsClick(Sender: TObject);
procedure MenuListClick(Sender: TObject);
procedure MenuAboutClick(Sender: TObject);
procedure MenuHelpTopicClick(Sender: TObject);
procedure MenuFindLostDataClick(Sender: TObject);
procedure MenuSelectAllClick(Sender: TObject);
procedure MenuInvertselectionClick(Sender: TObject);
procedure MenuDriveRescueHomepageClick(Sender: TObject);
procedure PopupMenuSaveFileToClick(Sender: TObject);
// Button methods...
procedure ButtonFindLostDataClick(Sender: TObject);
procedure ButtonHelpClick(Sender: TObject);
procedure ButtonViewIconClick(Sender: TObject);
procedure ButtonViewSmallIconClick(Sender: TObject);
procedure ButtonViewListClick(Sender: TObject);
procedure ButtonViewReportClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure MenuOptionsClick(Sender: TObject);
procedure ListView1Edited(Sender: TObject; Item: TListItem;
var S: String);
procedure ListView1ColumnClick(Sender: TObject; Column: TListColumn);
procedure ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
procedure MenuFindClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure MenuToolbarClick(Sender: TObject);
procedure MenuStatusbarClick(Sender: TObject);
procedure ButtonParentDirClick(Sender: TObject);
procedure TreeViewClick(Sender: TObject);
procedure MenuSaveToClick(Sender: TObject);
procedure ButtonOpenDriveClick(Sender: TObject);
procedure ButtonSaveToClick(Sender: TObject);
procedure ButtonFindClick(Sender: TObject);
procedure MenuRenameClick(Sender: TObject);
procedure TreeViewEdited(Sender: TObject; Node: TTreeNode;
var S: String);
procedure TreeViewEnter(Sender: TObject);
procedure ListView1Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure MenuArrangebyNameClick(Sender: TObject);
procedure MenuArrangebySizeClick(Sender: TObject);
procedure MenuArangebydateClick(Sender: TObject);
procedure MenuArrangeDescendingOrderClick(Sender: TObject);
procedure MenuArrangeAscendingOrderClick(Sender: TObject);
procedure MenuDrvInfoClick(Sender: TObject);
procedure MenuViewAsHexClick(Sender: TObject);
procedure MenuViewAsTextClick(Sender: TObject);
procedure PopupMenuViewAsHexClick(Sender: TObject);
procedure PopupMenuViewAsTextClick(Sender: TObject);
procedure MenuPropertiesClick(Sender: TObject);
procedure MenuArrangebytypeClick(Sender: TObject);
procedure PopupMenuPropertiesClick(Sender: TObject);
procedure PopupMenuRenameClick(Sender: TObject);
procedure MenuSysInfoClick(Sender: TObject);
procedure ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure ListView1Click(Sender: TObject);
procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
debugbox1: tdebugbox;
FFirstDriveSelect: boolean;
currTreeNode: TTreeNode;
AppStarted: boolean;
NmbTreeViewChangeEvents: integer;
FListViewUpdate: integer;
FListViewIdx : integer;
FListViewUseAsc: boolean;
procedure AddDriveToTree;
procedure SaveLostData;
function RenameItem(item: TObject; var s: string): boolean;
procedure updateControls;
procedure ShowHint(Sender: TObject);
{ Private-Deklarationen }
public
{ Public-Deklarationen }
DevList: TDeviceList; // Device list
DrvList: TDriveList; // Drive list
currDev: TDevice; // points to current device
currDrv: TCustomDrive; // points to current drive
RNode, DNode, LNode, SNode: TTreeNode;
Options: TOptions;
workstate: integer;
stopAction: boolean; // für länger andauerende Aktionen (bei TRUE Routine sofort verlassen! (wird bei Programmende gesetzt)
ImageListSmallSys: TImageList; // system image list (small icons)
ImageListLargeSys: TImageList; // system image list (large icons)
procedure ProcessMessages;
procedure ProcessOptions;
function DetectDrives: boolean;
procedure ShowDirInfo;
procedure SetWorkState(state: integer);
procedure ExpandCurrTreeNode(item: TCustomDirectory);
procedure LoadListView;
procedure ListViewBeginUpdate;
procedure ListViewEndUpdate;
end;
procedure Debug(data: string; level: byte);
Procedure HexDump(data: array of byte; len: integer);
var
MainForm: TMainForm;
implementation
uses aboutdlg, dirseldlg, statusdlg, secdlg, clusdlg, welcodlg, dinfodlg,
viewerdlg, FATdlg, propdlg, sysinfo;
{$R *.DFM}
procedure Debug(data: string; level: byte);
begin
if MainForm.Options.DebugLevel >= level then MainForm.debugbox1.add(data);
end;
Procedure HexDump(data: array of byte; len: integer);
var
i,j : integer;
str: shortstring;
begin
i := 0; str:='';
Debug('Hexdump: ', debugHigh);
repeat
str:=word2hex(i*16)+'h : ';
for j:=0 to 15 do str:=str+ ' '+byte2hex(data[i*16+j]) ;
str := str + ' : ';
for j:=0 to 15 do if data[i*16+j]>10 then str:=str+ chr(data[i*16+j])
else str:=str + '.';
str := str + #10;
Debug(str, debugHigh);
inc(i);
until (i*16 >=len);
Debug('', debugHigh);
//Form1.memo1.text:=Form1.memo1.text+str;
end;
procedure TMainForm.ProcessMessages;
begin
application.ProcessMessages;
end;
// -------------------------------------------------------------------------------
// M A I N F O R M S T U F F
// -------------------------------------------------------------------------------
procedure TMainForm.Timer1Timer(Sender: TObject);
var
i: uint;
status: THeapStatus;
begin
status:=GetHeapStatus;
StatusBar1.Panels[2].Text := format('Memory usage: %d Bytes',
[status.TotalAllocated]);
(*if assigned(currTreeNode) then
StatusBar1.Panels[1].Text := format('Current Tree Node: %s',
[currTreeNode.text]);*)
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
StatusBar1.Panels[0].Text := GetLongHint(Application.Hint);
end;
procedure TMainForm.SetWorkState(state: integer);
var
i: integer;
m: TMenuItem;
c: TControl;
begin
workstate:=state;
for i:=0 to MainForm.ComponentCount-1 do
begin
if MainForm.Components[i] is TMenuItem then
begin
m:=TMenuItem(MainForm.Components[i]);
if (m.parent <> MainMenu1.items) AND (m.parent <> MenuHelp)
AND (m.parent <> MenuView) AND (m.parent <> MenuArrangeItems) then
m.enabled:=false;
end{ else if (MainForm.components[i] is TSpeedButton) then
begin
c:=TControl(MainForm.Components[i]);
c.Enabled:=false;
end; }
end;
MenuExit.Enabled:=true;
MenuDrive.enabled:=true;
MenuViewAs.enabled:=true;
MenuOptions.enabled:=true;
MenuSysInfo.enabled:=true;
ButtonOpenDrive.enabled:=true;
ButtonHelp.enabled:=true;
ButtonViewList.enabled:=true;
ButtonViewIcon.enabled:=true;
ButtonViewSmallIcon.enabled:=true;
ButtonViewReport.enabled:=true;
case workstate of
state_NoDriveSelected: begin
Notebook1.activePage:='DummyPage';
end;
state_DriveSelected: begin
Notebook1.activePage:='BrowserPage';
MenuSelectAll.enabled:=true;
MenuInvertSelection.enabled:=true;
MenuFindLostData.enabled:=true;
MenuDrvInfo.enabled:=true;
MenuFind.enabled:=true;
ButtonFind.enabled:=true;
ButtonFindLostData.enabled:=true;
end;
end;
end;
{: Update program controls etc. according to current options }
procedure TMainForm.ProcessOptions;
begin
TreeView.font:=Options.FileListFont;
ListView1.font:=Options.FileListFont;
LDiskIO.optUseINT25:=Options.UseINT25;
PDiskIO.OptUseINT13:=Options.UseINT13;
PDiskIO.OptUseINT13EXT:=Options.UseINT13EXT;
optCacheEnabled:=Options.EnableCache;
// Prevent error messages being displayed by Windows?
if Options.EnableWinErrorMsg then SetErrorMode(0)
else SetErrorMode(SEM_FAILCRITICALERRORS);
end;
procedure TMainForm.FormCreate(Sender: TObject);
var
i: integer;
alabel: tlabel;
apanel: tpanel;
agroupbox: TGroupBox;
aEdit: Tedit;
aSHFi: TSHFileInfo;
begin
try
Options := TOptions.Create;
Options.ReadOptions;
ProcessOptions;
debugbox1:=tdebugbox.create(nil);
if (paramcount > 0) then
begin
if paramstr(1) = 'DEBUG' then debugbox1.Visible:=true;
end;
debug('application started', debugLow);
devList:=TDeviceList.create;
drvList:=TDriveList.create;
NmbTreeViewChangeEvents:=0;
FListViewUpdate:=0;
AppStarted:=false;
FFirstDriveSelect:=true;
Application.OnHint := ShowHint;
SetWorkState(state_NoDriveSelected);
(*ImageListSmallSys := TImageList.Create(Self);
ImageListSmallSys.ShareImages := true; // DON'T FREE THE SYSTEM IMAGE LIST!
ImageListSmallSys.Handle := ShellGetSystemImageList(FALSE);*)
if options.UseSystemIcons then
ListView1.SmallImages := ImageListSmallSys
else ListView1.SmallImages := ImageListSmallFolders;
except
on E : Exception do
begin
MessageDlg('An exception has occured while starting application:'#10 + E.Message, mtError, [mbOK], 0);
end;
end;
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
(*TreeView.height:=notebook1.height-40;
ListView1.height:=notebook1.height-40;
ListView1.width:=notebook1.width-treeview.width-10;*)
Statusbar1.panels[0].width:=mainform.width-400;
end;
procedure TMainForm.FormActivate(Sender: TObject);
begin
if AppStarted then exit;
// the application is startet...
AppStarted:=true;
if 1=1 {regWelcomeDialogBox} then
begin
WelcomeDialog.execute;
//regWelcomeDialogBox:=NOT (WelcomeDialog.checkbox1.checked);
MainForm.SetFocus;
end;
end;
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
stopAction:=true;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
debug('application closed', debugLow);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Options.free;
devList.free;
drvList.free;
end;
// -------------------------------------------------------------------------------
// M E N U C O M M A N D S
// -------------------------------------------------------------------------------
procedure TMainForm.MenuSaveToClick(Sender: TObject);
begin
SaveLostData;
end;
procedure TMainForm.PopupMenuSaveFileToClick(Sender: TObject);
begin
SaveLostData;
end;
function TMainForm.DetectDrives: boolean;
var
dev: TDevice;
i: integer;
begin
DevList.clear;
DrvList.clear;
StatusDialog.SetStatus('Scanning devices', '', 'Please wait...', '', '', false, false);
StatusDialog.show;
processMessages;
devList.detectDevices(statusdialog); // detect Devices
if NOT StatusDialog.UserCancel then
begin
StatusDialog.SetStatus('Scanning drives', '', 'Please wait...', '', '', false, false);
for i:=0 to devList.count-1 do
begin
dev:=devList.GetDevice(i);
StatusDialog.UpdateStatus('Scanning drives', format('On device: %s', [dev.name]), 'Please wait...', '', '');
processMessages;
if StatusDialog.UserCancel then break;
drvList.DetectDrives(dev); // detect Drives on device
end;
end;
StatusDialog.hide;
if StatusDialog.UserCancel then result:=false
else result:=true;
end;
procedure TMainForm.MenuDriveClick(Sender: TObject);
var
res: boolean;
sDev: string;
devIdx: integer;
begin
if FFirstDriveSelect then
begin
FFirstDriveSelect:=false;
res:=DetectDrives;
end;
if not res then exit;
if drivedlg.execute then
begin
// logical drive selected...
currDrv:=DrvList.GetDrive(drivedlg.drvSelected);
currDev:=currDrv.dev;
if currDrv is TFATDrive then
begin
(currDrv as TFATDrive).useFAT:=drivedlg.useFAT;
(currDrv as TFATDrive).skipBadMarkedClus:=drivedlg.SkipBadClus;
end;
(*devIdx:=DevList.IndexOf(currDev);
if devIdx <> -1 then
sDev:=DevList.GetDeviceText(devIdx, false)
else sDev:='';
StatusBar3.Panels[0].Text := format('Drive: %s',[currDrv.name]);*)
StatusBar3.Panels[0].Text := 'Folders';
debug(format('drive selected: %s', [currDrv.name]), debugLow);
//messagebox(0, pchar(inttostr(cphys)), pchar(inttostr(clog)), mb_ok);
SetWorkState(state_driveSelected);
AddDriveToTree;
ListView1.Columns.clear;
currDrv.AddListViewColumns(ListView1);
end;
end;
procedure TMainForm.MenuOptionsClick(Sender: TObject);
begin
if Options.execute then
begin
ProcessOptions;
LoadListView;
end;
end;
procedure TMainForm.MenuDetailsClick(Sender: TObject);
begin
ListView1.viewstyle:=vsReport;
MenuDetails.checked:=true;
end;
procedure TMainForm.MenuLargeIconsClick(Sender: TObject);
begin
ListView1.viewstyle:=vsIcon;
MenuLargeIcons.checked:=true;
end;
procedure TMainForm.MenuSmallIconsClick(Sender: TObject);
begin
ListView1.viewstyle:=vsSmallIcon;
MenuSmallIcons.checked:=true;
end;
procedure TMainForm.MenuListClick(Sender: TObject);
begin
ListView1.viewstyle:=vsList;
MenuList.checked:=true;
end;
procedure TMainForm.MenuFindLostDataClick(Sender: TObject);
begin
LNode.DeleteChildren; // Delete TreeView-Nodes
currDrv.FindLostData(StatusDialog);
LNode.HasChildren:=currDrv.RootDirLost.ChildIsSubDir;
LNode.Expanded:=false;
TreeView.selected:=LNode;
TreeView.Setfocus;
LNode.Expand(false);
TreeViewChange(sender, LNode);
end;
procedure TMainForm.MenuHelpTopicClick(Sender: TObject);
begin
//htmlHelp(windowhandle, 'rescue.chm', HELP_CONTENTS, 0);
winexec('hh.exe rescue.chm', SW_SHOWNORMAL);
end;
procedure TMainForm.MenuDriveRescueHomepageClick(Sender: TObject);
begin
winexec(sIBrowserExec + sHomePage, SW_SHOWNORMAL);
end;
procedure TMainForm.MenuAboutClick(Sender: TObject);
begin
AboutDialog.showmodal;
end;
procedure TMainForm.MenuSelectAllClick(Sender: TObject);
var
j: integer;
begin
Listview1.Items.beginUpdate;
for j:=0 to ListView1.items.count-1 do ListView1.items[j].selected:=true;
ListView1.Items.EndUpdate;
updateControls;
ShowDirInfo;
end;
procedure TMainForm.MenuInvertselectionClick(Sender: TObject);
var
j: integer;
begin
for j:=0 to ListView1.items.count-1 do
if ListView1.items[j].selected then ListView1.items[j].selected:=false
else ListView1.items[j].selected:=true;
end;
procedure TMainForm.MenuFindClick(Sender: TObject);
begin
SNode.DeleteChildren; // Delete TreeView-Nodes
if currDrv.FindFiles then
begin
SNode.HasChildren:=currDrv.RootDirSearched.ChildIsSubDir;
SNode.Expanded:=false;
TreeView.selected:=SNode;
TreeView.SetFocus;
SNode.Expand(false);
TreeViewChange(sender, SNode);
end;
end;
procedure TMainForm.MenuExitClick(Sender: TObject);
begin
application.terminate;
end;
procedure TMainForm.MenuToolbarClick(Sender: TObject);
var
c: boolean;
begin
MenuToolbar.checked:=NOT MenuToolbar.checked;
if MenuToolbar.checked then Toolbar1.show
else Toolbar1.hide;
end;
procedure TMainForm.MenuStatusbarClick(Sender: TObject);
begin
MenuStatusbar.checked:=NOT MenuStatusbar.checked;
if MenuStatusbar.checked then Statusbar1.show
else Statusbar1.hide;
end;
procedure TMainForm.MenuRenameClick(Sender: TObject);
var
Item: TListItem;
Node: TTreeNode;
begin
if ListView1.Focused then
begin
Item := ListView1.Selected;
if Assigned(Item) then
begin
Item.EditCaption;
end;
end
else if TreeView.Focused then
begin
Node := TreeView.Selected;
if Assigned(Node) then
begin
Node.EditText;
end;
end;
end;
procedure TMainForm.MenuArrangebyNameClick(Sender: TObject);
begin
FListViewIdx := 0;
ListView1.alphasort;
end;
procedure TMainForm.MenuArrangebytypeClick(Sender: TObject);
begin
FListViewIdx := 5;
ListView1.alphasort;
end;
procedure TMainForm.MenuArrangebySizeClick(Sender: TObject);
begin
FListViewIdx := 1;
ListView1.alphasort;
end;
procedure TMainForm.MenuArangebydateClick(Sender: TObject);
begin
FListViewIdx := 2;
ListView1.alphasort;
end;
procedure TMainForm.MenuArrangeDescendingOrderClick(Sender: TObject);
begin
FListViewUseAsc:=FALSE;
ListView1.alphasort;
end;
procedure TMainForm.MenuArrangeAscendingOrderClick(Sender: TObject);
begin
FListViewUseAsc:=TRUE;
ListView1.alphasort;
end;
procedure TMainForm.MenuDrvInfoClick(Sender: TObject);
begin
DriveInfoDialog.execute(currDev);
end;
procedure TMainForm.MenuSysInfoClick(Sender: TObject);
begin
DialogSystemInfo.execute;
end;
procedure TMainForm.MenuPropertiesClick(Sender: TObject);
var
fitem: TfatFile;
ditem: TfatDirectory;
item: TListItem;
finddeleted: boolean;
idx: integer;
begin
if ListView1.Focused then
begin
Item := ListView1.Selected;
if Assigned(Item) AND assigned(item.data) then
begin
if TObject(item.data) is TfatFile then
begin
fitem:=TfatFile(item.data);
ItemPropertiesDialog.ItemName:=ReplaceDeletedChar(fitem.name);
ItemPropertiesDialog.ItemSize:=fitem.size;
ItemPropertiesDialog.ItemCluster:=fitem.cluster;
end else if TObject(item.Data) is TfatDirectory then
begin
ditem:=TfatDirectory(item.data);
ItemPropertiesDialog.ItemName:=ReplaceDeletedChar(ditem.name);
ItemPropertiesDialog.ItemSize:=0;
ItemPropertiesDialog.ItemCluster:=ditem.cluster;
end;
if ItemPropertiesDialog.execute then
begin
if TObject(item.data) is TfatFile then
begin
fitem.name:=ItemPropertiesDialog.ItemName;
fitem.size:=ItemPropertiesDialog.ItemSize;
fitem.cluster:=ItemPropertiesDialog.ItemCluster;
fitem.ChangeListViewItem(ListView1.Selected);
end else if TObject(item.Data) is TfatDirectory then
begin
ditem.name:=ItemPropertiesDialog.ItemName;
ditem.cluster:=ItemPropertiesDialog.ItemCluster;
// update ListView...
ditem.ChangeListViewItem(ListView1.Selected);
end;
//LoadListView; { this will redraw all items...not necessary!}
idx:=Listview1.Selected.Index;
ListView1.UpdateItems(idx, idx);
end;
end;
end;
end;
procedure TMainForm.MenuViewAsHexClick(Sender: TObject);
var
listitem: tlistitem;
item: TFatfile;
FATno: byte;
drv: TfatDrive;
i: integer;
begin
if NOT (currDrv is TfatDrive) then exit;
drv:=currDrv as TfatDrive;
with FATSelectDialog do
begin
ComboBoxFAT.clear;
ComboBoxFAT.items.add('no FAT (consecutive)');
for i:=1 to drv.BootSec.BPB_NumFATs do
ComboBoxFAT.items.add('FAT '+inttostr(i));
if (treeview.selected=DNode) OR (treeview.selected.HasAsParent(DNode)) then
begin
ComboBoxFAT.itemindex:=0; // no FAT for undeleted files!!
end
else begin
ComboBoxFAT.itemindex:=drv.useFAT;
end;
end;
if FATSelectDialog.execute then
begin
FATno:=FATSelectDialog.FATno;
listitem:=ListView1.selected;
item:=Tfatfile(listitem.data);
ViewerDialog.ViewAsHex(drv, ReplaceDeletedChar(item.name), item.cluster, item.size, FATno);
end;
end;
procedure TMainForm.MenuViewAsTextClick(Sender: TObject);
var
listitem: tlistitem;
item: Tfatfile;
FATno: byte;
drv: TfatDrive;
i: integer;
begin
if NOT (currDrv is TfatDrive) then exit;
drv:=currDrv as TfatDrive;
with FATSelectDialog do
begin
ComboBoxFAT.clear;
ComboBoxFAT.items.add('no FAT (consecutive)');
for i:=1 to drv.BootSec.BPB_NumFATs do
ComboBoxFAT.items.add('FAT '+inttostr(i));
if (treeview.selected=DNode) OR (treeview.selected.HasAsParent(DNode)) then
begin
ComboBoxFAT.itemindex:=0; // no FAT for undeleted files!!
end
else begin
ComboBoxFAT.itemindex:=drv.useFAT;
end;
end;
if FATSelectDialog.execute then
begin
FATno:=FATSelectDialog.FATno;
listitem:=ListView1.selected;
item:=listitem.data;
ViewerDialog.ViewAsText(drv, ReplaceDeletedChar(item.name), item.cluster, item.size, FATno);
end;
end;
procedure TMainForm.PopupMenuViewAsHexClick(Sender: TObject);
begin
MenuViewAsHexClick(sender);
end;
procedure TMainForm.PopupMenuViewAsTextClick(Sender: TObject);
begin
MenuViewAsTextClick(sender);
end;
procedure TMainForm.PopupMenuPropertiesClick(Sender: TObject);
begin
MenuPropertiesClick(Sender);
end;
procedure TMainForm.PopupMenuRenameClick(Sender: TObject);
begin
MenuRenameClick(Sender);
end;
// -------------------------------------------------------------------------------
// I C O N B U T T O N S S T U F F
// -------------------------------------------------------------------------------
procedure TMainForm.ButtonOpenDriveClick(Sender: TObject);
begin
MenuDriveClick(sender);
end;
procedure TMainForm.ButtonSaveToClick(Sender: TObject);
begin
MenuSaveToClick(sender);
end;
procedure TMainForm.ButtonFindClick(Sender: TObject);
begin
MenuFindClick(sender);
end;
procedure TMainForm.ButtonFindLostDataClick(Sender: TObject);
begin
MenuFindLostDataClick(sender);
end;
procedure TMainForm.ButtonParentDirClick(Sender: TObject);
var
node: TTreeNode;
item: TCustomDirectory;
finddeleted: boolean;
begin
if assigned(currTreeNode) AND assigned(currTreeNode.parent) then
begin
node:=currTreeNode.parent;
node.Selected:=true;
if assigned(node.data) then
begin
item := TCustomDirectory(node.Data);
finddeleted:=false;
if (node=DNode) OR (node.HasAsParent(DNode)) then finddeleted:=true;
item.AddChildrenToListView(ListView1, finddeleted);
ListView1.setfocus;
CurrTreeNode:=node;
ShowDirInfo;
end;
end;
end;
procedure TMainForm.ButtonViewIconClick(Sender: TObject);
begin
ListView1.viewstyle:=vsIcon;
end;
procedure TMainForm.ButtonViewSmallIconClick(Sender: TObject);
begin
ListView1.viewstyle:=vsSmallIcon;
end;
procedure TMainForm.ButtonViewListClick(Sender: TObject);
begin
ListView1.viewstyle:=vsList;
end;
procedure TMainForm.ButtonViewReportClick(Sender: TObject);
begin
ListView1.viewstyle:=vsReport;
end;
procedure TMainForm.ButtonHelpClick(Sender: TObject);
begin
MenuHelpTopicClick(sender);
end;
// ----------------------------------------------------------------------------
// TreeView and ListView controls handling
// ----------------------------------------------------------------------------
procedure TMainForm.AddDriveToTree;
begin
ListView1.Items.Clear;
FListViewIdx := 0;
FListViewUseAsc := TRUE;
TreeView.Selected := nil;
TreeView.Items.Clear;
TreeView.ShowHint:=false;
TreeView.ParentShowHint:=false;
currDrv.AddDriveToTree(TreeView);
end;
procedure TMainForm.updateControls;
var
item: TListItem;
begin
if ListView1.selcount > 0 then
begin
// items selected...
Item := ListView1.Selected;
PopupMenuSaveFileTo.enabled:=true;
ButtonSaveTo.enabled:=true;
MenuSaveTo.enabled:=true;
if (ListView1.selcount = 1) AND Assigned(Item) then
begin
// only 1 item selected...
MenuRename.enabled:=true;
MenuProperties.enabled:=true;
PopupMenuProperties.enabled:=true;
PopupMenuRename.enabled:=true;
if (TObject(Item.data) is TCustomFile) then
begin
// item is file...
MenuViewAsHex.enabled:=true;
MenuViewAsText.enabled:=true;
PopupMenuViewAsText.enabled:=TRUE;
PopupMenuViewAsHex.enabled:=TRUE;
end else if (TObject(Item.data) is TCustomDirectory) then
begin
// item is directory...
end
end else
begin
// more than 1 item selected...
PopupMenuProperties.enabled:=false;
PopupMenuRename.enabled:=false;
PopupMenuViewAsText.enabled:=false;
PopupMenuViewAsHex.enabled:=false;
MenuRename.enabled:=false;
MenuProperties.enabled:=false;
MenuViewAsHex.enabled:=false;
MenuViewAsText.enabled:=false;
end;
end else
begin
PopupMenuSaveFileTo.enabled:=false;
PopupMenuViewAsText.enabled:=false;
PopupMenuViewAsHex.enabled:=false;
PopupMenuProperties.enabled:=false;
PopupMenuRename.enabled:=false;
ButtonSaveTo.enabled:=false;
MenuSaveTo.enabled:=false;
MenuRename.enabled:=false;
MenuProperties.enabled:=false;
MenuViewAsHex.enabled:=false;
MenuViewAsText.enabled:=false;
end;
end;
{ (Re-)Load list view items }
procedure TMainForm.LoadListView;
var
item: TCustomDirectory;
finddeleted: boolean;
begin
if NOT (assigned(currTreeNode) AND assigned(currTreeNode.data)) then exit;
item := TCustomDirectory(currTreeNode.data);
finddeleted:=false;
if (currTreeNode=DNode) OR (currTreeNode.HasAsParent(DNode)) then finddeleted:=true;
item.AddChildrenToListView(ListView1, finddeleted);
ShowDirInfo;
end;
// Ereignis beim anklicken der Kreuzchen...
procedure TMainForm.TreeViewExpanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var
item: TCustomDirectory;
j: integer;
finddeleted: boolean;
begin
try
if assigned(node.data) then
begin
item:= TCustomDirectory(node.data);
finddeleted:=false;
if (node = DNode) OR (node.HasAsParent(DNode)) then finddeleted:=true;
item.AddDirToTree(TreeView, node, finddeleted);
AllowExpansion:=true;
end;
except
on E: Exception do
begin
MessageDlg(E.Message, mtError, [mbOK], 0);
AllowExpansion:=false;
TreeView.Items.EndUpdate;
end;
end;
end;
procedure TMainForm.TreeViewEdited(Sender: TObject; Node: TTreeNode;
var S: String);
var
item: TCustomDirectory;
begin
if not assigned(node.data) then exit;
if TObject(node.data) is TCustomDirectory then
begin
item:=node.data;
item.rename(s);
end;
end;
procedure TMainForm.TreeViewClick(Sender: TObject);
begin
if assigned(TreeView.selected) then
begin
if TreeView.selected <> currTreeNode then
TreeViewChange(sender, TreeView.selected);
end;
end;
procedure TMainForm.TreeViewEnter(Sender: TObject);
begin
ListView1.Selected:=NIL;
end;
//: User selects entry in left Tree View...
procedure TMainForm.TreeViewChange(Sender: TObject; Node: TTreeNode);
var
item: TCustomDirectory;
cluster: longint;
tickcount: longint;
events: integer;
finddeleted: boolean;
begin
inc(NmbTreeViewChangeEvents);
events:=NmbTreeViewChangeEvents;
tickcount:=gettickcount;
repeat
application.ProcessMessages;
until (gettickcount > tickcount + 100) OR (NmbTreeViewChangeEvents > events);
if NmbTreeViewChangeEvents = events then
begin
with TreeView do
begin
if Visible and Assigned(Selected) then
begin
if assigned (TreeView.selected.data) then
begin
if TObject(TreeView.selected.data) is TCustomDirectory then
begin
item := TCustomDirectory(TreeView.Selected.Data);
finddeleted:=false;
if (node=DNode) OR (node.HasAsParent(DNode)) then finddeleted:=true;
item.AddChildrenToListView(ListView1, finddeleted);
CurrTreeNode:=node;
ShowDirInfo;
end;
end else ListView1.items.clear;
end;
end;
NmbTreeViewChangeEvents:=0;
end;
end;
procedure TMainForm.TreeViewExpanded(Sender: TObject; Node: TTreeNode);
var
item: TCustomDirectory;
begin
if (node <> DNode) AND (node <> LNode) AND (node <> SNode) then
begin
if assigned(Node.data) then
begin
item := Node.data;
if (item.flags AND item_deleted <> 0) then
begin
node.imageindex:=idxFolderOpenDel;
node.selectedindex:=idxFolderOpenDel;
end else begin
node.imageindex:=idxFolderOpen;
node.SelectedIndex:=idxFolderOpen;
end;
end;
end;
end;
procedure TMainForm.TreeViewCollapsed(Sender: TObject; Node: TTreeNode);
var
item: TCustomDirectory;
begin
if (node <> DNode) AND (node <> LNode) AND (node <> SNode) then
begin
if assigned(Node.data) then
begin
item := Node.data;
if (item.flags AND item_deleted <> 0) then
begin
node.imageindex:=idxFolderClosedDel;
node.Selectedindex:=idxFolderClosedDel;
end else begin
node.imageindex:=idxFolderClosed;
node.SelectedIndex:=idxFolderClosed;
end;
end;
end;
end;
procedure TMainForm.ExpandCurrTreeNode(item: TCustomDirectory);
var
i: integer;
begin
if assigned(currTreeNode) then
begin
currTreeNode.expand(false);
for i:=0 to currTreeNode.count-1 do
begin
if (assigned(currTreeNode.item[i].data)) then
begin
if TCustomDirectory(currTreeNode.item[i].data) = item then
begin
currTreeNode:=currTreeNode.item[i];
break;
end;
end;
end;
end;
end;
procedure TMainForm.ListView1Click(Sender: TObject);
begin
updateControls;
ShowDirInfo;
end;
procedure TMainForm.ListView1DblClick(Sender: TObject);
var
listitem: tlistitem;
cluster: longint;
item: tcustomdirectory;
finddeleted: boolean;
begin
if listview1.Selcount = 0 then exit;
listitem:=listview1.selected;
if (assigned(listitem.data)) then
begin
if tobject(listitem.data) is TCustomDirectory then
begin
item:=listitem.data;
ExpandCurrTreeNode(item);
finddeleted:=false;
if (currTreeNode=DNode) OR (currTreeNode.HasAsParent(DNode)) then finddeleted:=true;
item.AddChildrenToListView(listview1, finddeleted);
ListView1.setfocus;
ShowDirInfo;
end;
end;
end;
procedure TMainForm.ListView1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case key of
vk_return: ListView1DblClick(sender);
vk_back: ButtonParentDirClick(sender);
end;
updateControls;
ShowDirInfo;
end;
procedure TMainForm.ListView1Change(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
// WARNING: do not use this event - it's slow !!!
// this one is called each time a single item is processed... (even if multiple items are selected)
end;
procedure TMainForm.ListView1SelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
// WARNING: do not use this event - it's slow !!!
// this one is called each time a single item is processed... (even if multiple items are selected)
end;
function TMainForm.RenameItem(item: TObject; var s: string): boolean;
var
i: integer;
pitem, ditem: TCustomDirectory;
fitem: TCustomfile;
oldname: string;
begin
result:=FALSE;
if not assigned(item) then exit;
if item is TCustomFile then
begin
fitem:=TCustomFile(item);
oldname:=ReplaceDeletedChar(fitem.name);
if NOT assigned(fitem.parent) then exit;
pitem:=fitem.parent;
end else if item is TCustomDirectory then
begin
ditem:=TCustomDirectory(item);
oldname:=ReplaceDeletedChar(ditem.name);
if NOT assigned(ditem.parent) then exit;
pitem:=ditem.parent;
end;
with pitem.children do
begin
for i:=0 to count-1 do
begin
if ((TObject(Items[i]) is TCustomFile) AND (ReplaceDeletedChar(TCustomFile(Items[i]).name) = s)) OR
((TObject(Items[i]) is TCustomDirectory) AND (ReplaceDeletedChar(TCustomDirectory(Items[i]).name) = s)) then
begin
MessageDlg(format('%s cannot be renamed: an item with this name already exists. Please choose another name.',
[oldname]), mtInformation, [mbOK], 0);
s:=oldname;
exit;
end;
end;
end;
if item is TCustomDirectory then
ditem.Rename(s)
else if item is TCustomFile then
fitem.rename(s);
result:=TRUE;
end;
procedure TMainForm.ListView1Edited(Sender: TObject; Item: TListItem;
var S: String);
begin
RenameItem(item.data, s);
end;
function customsortproc(item1, item2: tlistitem; paramsort: integer): integer; stdcall;
var
ditem, dparent: TCustomDirectory;
fitem: TCustomFile;
g: TMainForm;
begin
g:=TMainForm(pointer(paramsort));
if NOT ((assigned(item1.data)) AND (assigned(item2.data))) then
begin
result:=0; exit;
end;
if TObject(item1.data) is TCustomFile then
begin
fitem:=item1.data;
if assigned(fitem.parent) then dparent:=fitem.parent;
end
else if TObject(item1.data) is TCustomDirectory then
begin
ditem:=item1.data;
if assigned(ditem.parent) then dparent:=ditem.parent;
end;
if (assigned(dparent)) then
begin
//messagebox(0, pchar(dparent.name), 'dparent info', mb_ok);
result:=dparent.CompareChildren(item1, item2, g.FListViewIdx);
// wenn wir nicht aufsteigen soritieren, invertiere das Ergebnis
if not g.FListViewUseAsc then result := -result;
end else result:=0;
end;
procedure TMainForm.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
var
g: TMainForm;
begin
// Verlgeiche den Spalten-Index mit dem Letzten, wenn nicht gleich, setzte asc
// (aufsteigendes Sortieren) auf TRUE
if (column.index <> FListViewIdx) then FListViewUseAsc := TRUE
else FListViewUseAsc := NOT FListViewUseAsc;
FListViewIdx := column.index;
ListView1.alphasort;
(*g:=MainForm;
listview1.CustomSort(@customsortproc, integer(g));*)
end;
//: is called if two ListView entries has to be compared
procedure TMainForm.ListView1Compare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
var
ditem, dparent: TCustomDirectory;
fitem: TCustomFile;
begin
if NOT ((assigned(item1.data)) AND (assigned(item2.data))) then
begin
compare:=0; exit;
end;
if TObject(item1.data) is TCustomFile then
begin
fitem:=item1.data;
if assigned(fitem.parent) then dparent:=fitem.parent;
end
else if TObject(item1.data) is TCustomDirectory then
begin
ditem:=item1.data;
if assigned(ditem.parent) then dparent:=ditem.parent;
end;
if (assigned(dparent)) then
begin
//messagebox(0, pchar(dparent.name), 'dparent info', mb_ok);
compare:=dparent.CompareChildren(item1, item2, FListViewIdx);
// wenn wir nicht aufsteigen soritieren, invertiere das Ergebnis
if not FListViewUseAsc then compare := -compare;
end else compare:=0;
end;
procedure TMainForm.ListViewBeginUpdate;
begin
inc(FListViewUpdate);
end;
procedure TMainForm.ListViewEndUpdate;
begin
if FListViewUpdate > 0 then dec(FListViewUpdate);
end;
procedure TMainForm.ShowDirInfo;
var
ditem: TCustomDirectory;
fitem: TCustomFile;
itemcount: longword;
listitem: TListItem;
i: integer;
size: longword;
events: integer;
tickcount: longint;
begin
if FListViewUpdate > 0 then exit;
if assigned(ListView1.items) then
begin
if assigned(currTreeNode) AND assigned (currTreeNode.data) then
begin
ditem:=TCustomDirectory(currTreeNode.data);
StatusBar2.Panels[0].Text := format('Content of ''%s''', [AbbreviatePath(ditem.GetPath(NIL), 15)]);
end;
if ListView1.selcount > 0 then
begin
// items selected...
listitem:=ListView1.selected;
size:=0;
for i:=0 to ListView1.selcount-1 do
begin
if TObject(listitem.data) is TfatFile then
begin
fitem:=TfatFile(listitem.data);
inc(size, fitem.size);
end;
listitem:=ListView1.GetNextItem(listitem, sdAll, [isSelected]);
end;
StatusBar1.Panels[0].Text := format('%d Object(s) selected',[ListView1.selcount]);
StatusBar1.Panels[1].Text := format('%d KB',[size div 1024]);
end else
begin
// no items selected...
size:=0;
for i:=0 to ListView1.items.count-1 do
begin
if TObject(listview1.items[i].data) is TfatFile then
begin
fitem:=TfatFile(listview1.items[i].data);
inc(size, fitem.size);
end;
end;
StatusBar1.Panels[0].Text := format('%d Object(s)',[listview1.items.count]);
StatusBar1.Panels[1].Text := format('%d KB',[size div 1024]);
end;
end;
if assigned(currTreeNode) AND assigned (currTreeNode.data) then
begin
ditem:=TCustomDirectory(currTreeNode.data);
if assigned(ditem.parent) then
ButtonParentDir.enabled:=true
else
ButtonParentDir.enabled:=false;
end else ButtonParentDir.enabled:=false;
end;
procedure TMainForm.ListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
P: TPoint;
begin
updateControls;
ShowDirInfo;
if (sender is TControl) then
begin
P.X:=X;
P.Y:=Y;
P:=(sender as TControl).ClientToScreen(P);
if (button = mbRight) then PopupMenuBrowseFile.Popup(P.X, P.Y);
end;
end;
// --------------------------------------------------------------------------
procedure TMainForm.SaveLostData;
var
listitem: tlistitem;
drv: TCustomDrive;
begin
if ListView1.selcount > 0 then
begin
listitem:=ListView1.selected;
if assigned(listitem.data) then
begin
drv:=NIL;
if TObject(listitem.data) is TCustomDirectory then
drv:=TCustomDirectory(listitem.data).drive
else if TObject(listitem.data) is TCustomFile then
drv:=TCustomFile(listitem.data).drive;
if assigned (drv) then drv.SaveListViewItems(ListView1);
end;
end;
end;
// -----------------------------------------------------------------------------
end.