⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 该程序用D5编译
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    if FavoTree.Items[0].HasChildren  then
    begin
      //tempNode:=nil; // just remove warning;
      for i:=1 to FavoTree.Items[0].Count do
      begin
        TempNode := FavoTree.Items[0].Item[i-1];
        if TempNode.data <> nil then
        try
          writeln(f,trimright(pMyTreeItem(TempNode.data)^.group));
          writeln(f,TempNode.text);
        except {do nothing} end;
      end;
      //caption:=tempNode.text; // just remove warning;
    end;

    FavoTree.Items.EndUpdate;

    CloseFile(f);
  end
  except {do nothing} end;
  
end;

{procedure TMainForm.BringFront;
begin
  Application.BringToFront;
end;}

procedure TMainForm.MyListViewClick(Sender: TObject);
var
  DirName,FileName,GroupName    : string;
  DirSearcher                   : TSearchDirThread;
  Exe                           : TExecuteThread;
  NewListItem,RunItem           : Tlistitem;
  TemListView                   : TListView;
  ListItemPtr                   : PListItem;
  TabDataPtr                    : pTabData;
begin

  RunItem:= (Sender as TListView).Selected;
  if (RunItem=nil) then exit;
  
  FileName:= RunItem.Caption;
 
  DirName:=pTabData(ClientPageCtrl.ActivePage.Tag).MyDir;

  GroupName:=pTabData(ClientPageCtrl.ActivePage.Tag).MyGroup;
  if GroupName[length(GroupName)]=#0
  then delete(GroupName,length(GroupName),1);

  if pFileItem(RunItem.Data).fType=IsDir then  //folder
  begin
    tabsheetx:=ttabsheet.Create(Self);
    tabsheetx.PageControl := ClientPageCtrl;
    DirName:=DirName+'\'+FileName;
    tabsheetx.Caption := DirName;
    tabsheetx.Repaint;
    
    TemListView:=TListView.Create(tabsheetx);
    with TemListView do
    begin
      Parent := tabsheetx;
      Align := alclient;
      Visible := true;
      OnDblClick := MyListviewClick;
      PopupMenu := ListViewPopupMenu;
      ViewStyle := vssmallicon;
      SmallImages := imagelist1;
      MultiSelect := true;
      //FlatScrollBars := true;
      DragMode := dmAutomatic;
      //BorderStyle := bsNone;
      OnMouseDown := BrowseListViewMouseDown;  //##$$##
    end;
    ClientPageCtrl.ActivePageIndex :=tabsheetx.TabIndex;
    //RightPageCtrl.ActivePageIndex:=1;
    DirSearcher:=TSearchDirThread.create(true);
    DirSearcher.mydir := DirName;
    //DirSearcher.mygroup := groupname;
    DirSearcher.myList := TemListView;
    //DirSearcher.Rlist := ShareListView;
    CurListView:=TemListView;

    NewListItem:=ShareListview.Items.Insert(0);
    NewListItem.Caption := extractfilename(DirSearcher.mydir);
    New(ListItemPtr);
    ListItemPtr.index := TabSheetX.TabIndex;
    ListItemPtr.count := -1;  //old history
    NewListItem.data:= ListItemPtr;
    NewListItem.SubItems.Add(DirName);
    NewListItem.SubItems.Add(GroupName);
    NewListItem.ImageIndex := 6;

    //===================================================
    if CurDirItem <> nil then
    begin
      PListItem(CurDirItem.Data)^.NextDirItem := NewListItem;
      // uplink
      PListItem(NewListItem.Data)^.UpDirItem := CurDirItem;
    end;

    ListItemPtr^.PrevDirItem := CurDirItem;
    CurDirItem := NewListItem;
    PListItem(CurDirItem.Data)^.NextDirItem := nil;

    ToolBtnBack.Enabled := true;
    ChangeBtnStatus;
    //===================================================

    new(TabDataPtr);
    TabDataPtr.MyGroup := GroupName;
    TabDataPtr.MyDir := DirName;
    TabDataPtr.MyRListItem :=NewListItem;
    TabSheetX.Tag := integer(TabDataPtr);


    AddCap(GroupName,DirName);

    DirSearcher.RListItem := NewListItem;
    DirSearcher.ClickType := InListView;
    DirSearcher.FreeOnTerminate := true;
    DirSearcher.Resume;
  end
  //****************************
  else
  begin
    Exe:=TExecuteThread.Create(true);
    Exe.exeFile := DirName+'\'+filename;
    Exe.exeDir := DirName;
    Exe.FreeOnTerminate := true;
    Exe.Resume;
    //ExecuteFile(dir+'\'+filename,'',dir,SW_SHOW);
  end;

end;

procedure TMainForm.FormCreate(Sender: TObject);
var
  GetDomainThread       : TGetDomainThread;
  TabDataPtr            : pTabData;
begin

  AppDir:=ExtractFilePath(ParamStr(0));
  OS:=GetOSVersion;
  //if os=oswinxp then showmessage('ok,xp');
  FileList := TStringList.Create;

  CurDirItem := nil; //###
  IsDoPrevNext := false;

  cbScanMode.ItemIndex := 0;

  //TrayIcon := TTrayIcon.Create(Self, Application, TrayPopup, Handle, false);

  //InfoPanel.BevelOuter := bvNone;
  ClientPanel.BevelOuter := bvNone;
  LeftPanel.BevelOuter:=bvNone;
  //RightPanel.BevelOuter:=bvNone;
  BottomPanel.BevelOuter:=bvNone;

  StrListAll:=TStringList.Create;
  StrListSearch:=TStringList.Create;
  StrListMp3:=TStringList.Create;
  StrListMovie:=TStringList.Create;

  GroupNum:=0;
  FinishNum:=0;
  ThreadNum:=3;
  CanOpen:=false;
  //OldFileCount:=0;
  GetDomainThread:=TGetDomainThread.Create(true);
  GetDomainThread.MyLanTree := SearchTree;
  GetDomainThread.Resume;

  recursive:=false;
  stop:=false;
  bAutoSearch:=true;

  OpenIni;
  OpenFavorite;
  OpenHistory;

  BrowseListView.OnDblClick := MyListViewClick;

  new(TabDataPtr);
  TabDataPtr.MyGroup := '';
  TabDataPtr.MyDir := '';
  TabDataPtr.MyRListItem := nil;
  ShareTabSheet.Tag := integer(TabDataPtr);

  with ClientPageCtrl do
  begin
    // remove PageControl border
    FOriginalPageControlWndProc1 := WindowProc;
    WindowProc := PageControlWndProc1;
    Realign;
    ActivePageIndex := 0;
  end;

  {with RightPageCtrl do
  begin
    // remove PageControl border
    FOriginalPageControlWndProc2 := WindowProc;
    WindowProc := PageControlWndProc2;
    Realign;
    ActivePageIndex := 0;
  end;}

  with LeftPageCtrl do
  begin
    // remove PageControl border
    FOriginalPageControlWndProc3 := WindowProc;
    WindowProc := PageControlWndProc3;
    Realign;
    ActivePageIndex := 0;
  end;

  with BottomPageCtrl do
  begin
    // remove PageControl border
    FOriginalPageControlWndProc4 := WindowProc;
    WindowProc := PageControlWndProc4;
    Realign;
    ActivePageIndex := 0;
  end;

  with SearchPageCtrl do
  begin
    // remove PageControl border
    FOriginalPageControlWndProc5 := WindowProc;
    WindowProc := PageControlWndProc5;
    Realign;
    ActivePageIndex := 0;
  end;

  CopyFileList := TStringList.Create;

end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //Hide; // if the history tree is very big...

  SaveIni;
  SaveFavorite;
  SaveHistory; // if the history tree is very big, this is time-consuming

  StrListAll.Free;
  StrListSearch.Free;
  StrListMp3.Free;
  StrListMovie.Free;
  FileList.Free;

  DisposeLanTree(SearchTree);
  DisposeLanTree(FavoTree);
  DisposeLanTree(FindTree);
  DisposeLanTree(HistoryTree); // if the history tree is very big, this is time-consuming
  DisposeListView;
  DisposeTabData;
  DisposeRightList(ShareListView);

end;

procedure TMainForm.DisposeRightList(LV: TListView);
var
  i: integer;
begin

  for i := 0 to LV.Items.Count-1 do
  begin
    if LV.Items[i].Data <> nil then
    begin
      try
        Dispose(PListItem(LV.Items[i].Data));
        LV.Items[i].Data := nil;
      except {do nothing} end;
    end;
  end;
  
end;

procedure TMainForm.DisposeTabData;
var
  i: integer;
begin
  for i := 0 to ClientPageCtrl.PageCount - 1 do
  begin
     if ClientPageCtrl.Pages[i].Tag<>0 then
     begin
       try
         dispose(pTabData(ClientPageCtrl.Pages[i].Tag));
         ClientPageCtrl.Pages[i].Tag := 0;
       except {do nothing} end;
     end;
  end;
end;

procedure DisposeListViewData(LV: TListView);
var
  i: integer;
begin

  for i := 0 to LV.Items.Count - 1 do
  begin
    if LV.Items[i].Data <> nil then
    begin
      try
        Dispose(PFileItem(LV.Items[i].Data));
        LV.Items[i].Data := nil;
      except {do nothing} end;
    end;
  end;    

end;

procedure TMainForm.DisposeListView;
var
  i: integer;
begin
  DisposeListViewData(BrowseListView);
  for i := 1 to ClientPageCtrl.PageCount - 1 do
  begin
    DisposeListViewData(ClientPageCtrl.Pages[i].Components[0] as TListView);
  end;
end;

procedure DisposeTreeNodeData(Node: TTreeNode);
var
  i: integer;
begin
  try
    if {pMyTreeItem}(Node.data) <> nil then
    begin
      try
        dispose(pMyTreeItem(Node.Data));
        Node.Data := nil;
      except {do nothing} end;
    end;

    if Node.HasChildren then
    begin
      for i := 0 to Node.Count - 1 do
      begin
        try
          DisposeTreeNodeData(Node.Item[i]);
        except {do nothing} end;
      end;
    end;
  except on EInvalidPointer do {ShowMessage(Node.Text)};
  end; //end of try
end;

procedure TMainForm.DisposeLanTree(DTree:TTreeView);
var
  i: integer;
  TemNode: TTreeNode;
begin
  DTree.Items.BeginUpdate;
  if (DTree.Items.Count <> 0)and(DTree.Items[0].Count <> 0) then
  begin
    for i := 0 to DTree.Items[0].Count - 1 do DisposeTreeNodeData(DTree.Items[0].Item[i]);

    //-------------ohter top level nodes-------------
    TemNode:=DTree.Items[0].GetNextSibling;
    while TemNode<>nil do
    begin
      if TemNode.Count <> 0 then
        for i := 0 to TemNode.Count - 1 do DisposeTreeNodeData(TemNode.Item[i]);

      TemNode:=TemNode.GetNextSibling;
    end;
    //------------------------------------------------
  end;

  DTree.Items.EndUpdate;
end;

procedure TMainForm.LanTreeClick(LanTree:TTreeView);
var
  GroupSearcher : TSearchGroupThread;
  HostSearcher  : TSearchHostThread;
  DirSearcher   : TSearchDirThread;
  Exe           : TExecuteThread;
  TemListView   : TListView;
  ListItem      : TListItem;
  TemDirName    : string;
  ListItemPtr   : PListItem;
  TabDataPtr    : pTabData;
begin

  if (LanTree.Selected = nil)or(LanTree.Selected = LanTree.Items[0]) then exit;
  //OldFileCount:=AllListBox.Items.Count;

  case LanTree.Selected.ImageIndex of
  5,14:    //workgroup
  begin
    LanTree.Selected.ImageIndex := 16;
    LanTree.Selected.SelectedIndex := 16;
    GroupSearcher:=TSearchGroupThread.create(true);
    GroupSearcher.MyTree := LanTree;
    GroupSearcher.MyGroup := LanTree.Selected.Text;
    GroupSearcher.MyNode := LanTree.Selected;
    GroupSearcher.FreeOnTerminate := true;
    GroupSearcher.Resume;
  end;
  7,15,27:    //host
  begin
    LanTree.Selected.ImageIndex := 12;
    LanTree.Selected.SelectedIndex := 12;
    LanTree.selected.StateIndex := -1;
    LanTree.SetFocus;
    HostSearcher:=TSearchHostThread.create(true);
    HostSearcher.MyHost := LanTree.Selected.Text;
    HostSearcher.MyGroup := LanTree.Selected.Parent.Text;
    HostSearcher.MyTree:=LanTree;
    HostSearcher.MyNode:=LanTree.selected;
    HostSearcher.FreeOnTerminate := true;
    HostSearcher.Resume;
    //explordir.WaitFor;
  end;
  0,19,30: //closed folder
  begin
    LanTree.Selected.ImageIndex := 6;
    LanTree.Selected.SelectedIndex := 6;
    LanTree.selected.StateIndex := -1;
    CoolBar1.SetFocus;
    TabSheetX:=TTabSheet.Create(self);
    TabSheetX.PageControl := ClientPageCtrl;
    TemDirName:=pMyTreeItem(LanTree.Selected.data)^.dirname;
    if TemDirName[length(TemDirName)]='\'
    then delete(TemDirName,length(TemDirName),1);
    TabSheetX.Caption :=TemDirName;
    TabSheetX.Repaint;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -