main.pas

国外著名恢复软件Drive_Rescue 公布的早期源码 版本是1.8 delphi6环境开发的。

//: 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黵 l鋘ger 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;