main.pas

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

      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.