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

📄 main.pas

📁 最好的局域网搜索软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      DirSearcher.FreeOnTerminate := true;
      DirSearcher.Resume;
    end
    else
    begin // IsFtp
      OldRListItem := pTabData(ClientPageCtrl.ActivePage.Tag)^.MyRListItem;

      TabSheetX := TTabSheet.Create(Self);
      TabSheetX.PageControl := ClientPageCtrl;
      DirName := CurDirName + '/' + FileName;
      ///SubFtpDir := CurFtpDir + '/' + FileName;
      SubFtpDir := PListItem(OldRListItem.Data)^.FtpDir + '/' + FileName;
      //Caption := SubFtpDir; ///
      tabsheetx.Caption := DirName;
      tabsheetx.Repaint;
    
      TemListView:=TListView.Create(tabsheetx);
      with TemListView do
      begin
        Parent := tabsheetx;
        Align := alclient;
        Visible := true;
        OnDblClick := MyListviewClick;
        PopupMenu := pmListItem;
        ViewStyle := vsSmallIcon;
        SmallImages := imagelist1;
        MultiSelect := true;
        //FlatScrollBars := true;
        DragMode := dmAutomatic;
        //BorderStyle := bsNone;
        OnMouseDown := BrowseListViewMouseDown;  //##$$##

        //-----------05.11.6----------
        col := TemListView.Columns.Add;
        col.Caption := '名称';
        col.Width := 400;
        col := TemListView.Columns.Add;
        col.Caption := '大小';
        col.Width := 100;
        TemListView.ColumnClick := false;
        //----------------------------
      end;
      ClientPageCtrl.ActivePageIndex := TabSheetX.TabIndex;
      
      CurListView:=TemListView;

      NewListItem:=ShareListview.Items.Insert(0);
      NewListItem.Caption := FileName; //SubFtpDir;
      New(ListItemPtr);
      ListItemPtr.index := TabSheetX.TabIndex;
      ListItemPtr.count := -1;  //old history
      ListItemPtr.FtpHandle := PListItem(OldRListItem.Data)^.FtpHandle;
      ListItemPtr.FtpDir := SubFtpDir; ///
      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 := 'ftp';
      TabDataPtr.MyDir := DirName;
      TabDataPtr.MyRListItem := NewListItem;
      TabSheetX.Tag := integer(TabDataPtr);

      FtpSub := TFtpSubDirThread.Create;
      FtpSub.Dir := SubFtpDir;
      FtpSub.FtpSvr := CurFtpSvr;
      FtpSub.ClickType := InListView;
      FtpSub.RListItem := NewListItem;
      FtpSub.FtpHandle := PListItem(FtpSub.RListItem.Data)^.FtpHandle;
      FtpSub.MyListView := CurListView;
      FtpSub.Resume;


      AddCap(GroupName, DirName);
    end;
  end
  //****************************
  else
  begin
    Exe:=TExecuteThread.Create(true);

    if (not IsFtp) then
    Exe.exeFile := DirName+'\'+filename
    else
    begin // FTP
      {
      ParseFtpUrl(DirName, FtpSvr, FtpDir);
      ConfigForm.GiveFtpUserPassWord(FtpSvr, FtpUsrName, FtpPassWord);

      if FtpDir = '/' then
        Exe.exeFile := 'ftp://'+FtpUsrName+':'+FtpPassWord+'@'+FtpSvr+'/'+filename
      else
        Exe.exeFile := 'ftp://'+FtpUsrName+':'+FtpPassWord+'@'+FtpSvr+FtpDir+'/'+filename;
      //ShowMessage(Exe.ExeFile); ///
      }
      Exe.exeFile := DirName+'/'+filename;
    end;

    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;
  SizeListAll := 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...
  ToolsForm.Hide;
  CopyToForm.Hide;
  ConfigForm.Hide;
  AboutForm.Hide;

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

  StrListAll.Free;
  SizeListAll.Free;
  {StrListSearch.Free;
  StrListMp3.Free;
  StrListMovie.Free; }
  FileList.Free;

  DisposeLanTree(SearchTree);
  DisposeLanTree(IpTree);
  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
        //if Node.ImageIndex < 113 then
        //dispose(pMyTreeItem(Node.Data))
        //else dispose(PFtpNodeType(Node.Data));
        dispose(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
    begin
      //if DTree.Items[0].Item[i].ImageIndex < 113 then // exclude ftp and http
      DisposeTreeNodeData(DTree.Items[0].Item[i]);
    end;

    //-------------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
        begin
          ///if DTree.Items[0].Item[i].ImageIndex < 113 then // exclude ftp and http
          DisposeTreeNodeData(TemNode.Item[i]);
        end;

      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;

  ftp: TFtpBrowseThread;
  FtpSvrName: string;
  FtpSub: TFtpSubDirThread;
  TemFtpNode: TTreeNode;
  FtpDir: string;
  FtpUsr, FtpPass: string;
  FtpRecursive: boolean;
  FtpDisplayDir: string;

  http: THttpGetThread;
  HttpSvrName: string;

  col: TListColumn;
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;

⌨️ 快捷键说明

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