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

📄 searchhostthreadunit.pas

📁 vpn网上邻居搜索器 工作组 未打开的工作组 正在搜索的工作组 已打开的工作组 无法打开的工作组 主机 未打开的主机 正在搜索的主机 打开的主机(无须登录) 打开的主机(以gues
💻 PAS
字号:
unit SearchHostThreadUnit;

interface

uses Windows, Messages, SysUtils, Classes,ComCtrls,Dialogs,main;

type
TSearchHostThread=class(TThread)
private
  MyDir, FileName, FullFileName: string;
  FindfNode: TtreeNode;
  ftype: FileType;
  EverFound,NeedLogin,NoShareDir,NoShareFile,isWinNT,NeedPassWord,bPrinter: boolean;
  FileList: TStringList;
public
  MyTree: TTreeView;
  mynode: TtreeNode;
  MyGroup,MyHost: string;
  User, PassWord: string;
  //hFlag: THandle;
protected
  procedure Execute; override;
  procedure findf(dir:string);
  procedure AddDirNode;
  Procedure AddDir;
  Procedure AddFile;
  procedure CompareFile;
  procedure NotFound;
  procedure BeFound;
  procedure AddToHistory;  //###
  procedure GetUserPassWord;
end;

implementation
uses Config;

procedure TSearchHostThread.GetUserPassWord;
begin
  with ConfigForm do
  begin
    GiveUserPassWord(MyHost, User, PassWord);
  end;
end;

procedure TSearchHostThread.AddToHistory;
var
  TemHisNode, HisGroupNode: TTreeNode;
  i: integer;
  MyItemPtr     : PMyTreeItem;
begin
  with MainForm do
  begin
    //###############add to history tree##############
    HisGroupNode := nil;
    for i := 0 to HistoryTree.Items[0].Count - 1 do
    if UpperCase(trim(HistoryTree.Items[0].Item[i].Text)) = UpperCase(trim(MyGroup)) then
    begin
      HisGroupNode := HistoryTree.Items[0].Item[i];
    end;

    if HisGroupNode = nil then
    begin
      HisGroupNode := HistoryTree.Items.AddChild(HistoryTree.Items[0], MyGroup);
      HisGroupNode.ImageIndex := 9;
      HisGroupNode.SelectedIndex := 9;
      HistoryTree.Items[0].expand(false);
    end;

    for i := 0 to HisGroupNode.Count - 1 do
    if UpperCase(HisGroupNode.Item[i].Text) = UpperCase(myhost) then exit; //already exist
    New(MyItemPtr);
    MyItemPtr^.DirName :=MyHost;
    MyItemPtr^.Group :=MyGroup;
    TemHisNode := HistoryTree.Items.AddChild(HisGroupNode, myhost);
    TemHisNode.Data := MyItemPtr;
    TemHisNode.ImageIndex := 7;
    TemHisNode.SelectedIndex :=12;
    HisGroupNode.expand(false);

    //################################################
  end;
end;

procedure TSearchHostThread.AddFile;
begin
  with MainForm do
  begin
    AllListbox.items.insert(0, FullFileName);
  end;
end;

procedure TSearchHostThread.AddDir;  //in Right ListView
var
  ListItem      : TListitem;
  ListItemPtr   : PListItem;
begin
  with MainForm do
  begin

    if bAutoSearch then
    begin

      with ShareListView do
      begin
        ListItem:=Items.Insert(0);
        if bPrinter then ListItem.ImageIndex := 77
        else if EverFound then listitem.ImageIndex := 0
        else if NeedPassWord then ListItem.ImageIndex := 20
        else if NoShareFile then
        begin
          ListItem.ImageIndex := 30;
          ListItem.StateIndex  :=30;
        end
        else ListItem.ImageIndex:=19;

        ListItem.Caption := extractfilename(mydir);
        ListItem.SubItems.Add(mydir);
        ListItem.SubItems.Add(mygroup);

        //XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

        new(ListItemPtr);
        ListItemPtr.index := AllListBox.Items.Count;
        ListItemPtr.index := StrListAll.Count;
        //AllListbox.Items.AddStrings(FileList);
        //AllListbox.TopIndex := ListItemPtr.index;
        //StrListAll.Add(MyGroup);
        StrListAll.AddStrings(FileList);
        //ListItemPtr.count := AllListBox.Items.Count-OldFileCount;
        //OldFileCount:= AllListBox.Items.Count;
        ListItemPtr.count := FileList.Count;
        ListItem.data := ListItemPtr;

        //##################in the tree############3
        pMyTreeItem(findfnode.data)^.MyRightListItem := ListItem;

        CheckFile(MyDir,MyDir,MyGroup,0);
      end;

    end;
  end;
end;

procedure TSearchHostThread.AddDirNode;  //in left lan tree;
var
  item: TTreeNode;
  MyItemPtr     : PMyTreeItem;
begin
 with MainForm do
 begin
    // Add node to the tree
    New(MyItemPtr);
    MyItemPtr^.dirName := mydir;
    MyItemPtr^.group := pMyTreeItem(mynode.data)^.group;   //mynode is host
    item:=MyTree.Items.AddChild(mynode,extractfilename(mydir)); // item is share dir
    item.Data := MyItemPtr;
    if bPrinter then
    begin
      item.ImageIndex := 77;
      item.SelectedIndex := 77;
    end;
    findfNode:= item;
    //pmyitem(item.data)^.dirname:=mydir;
    mynode.ImageIndex :=8;
    mynode.SelectedIndex :=8;
    //OldFileCount:=AllListBox.Items.Count;
    {item.Selected := True;
    LanTreeClick(LanTree); }
 end;
end;

procedure TSearchHostThread.CompareFile;
begin
 with MainForm do
 begin
      if ftype= IsFile then CheckFile(FileName,MyDir,MyGroup,1)
      else CheckFile(FileName,MyDir,MyGroup,0);
 end;
end;

procedure TSearchHostThread.findf(dir:string);
var
  Found         : integer;
  searchrec     : TSearchRec;
  result        : dWord;
  NR            : TNetResource;
  CanOpenDir    : boolean;
  TemNode       : TTreeNode;

  MyItemPtr     : PMyTreeItem;
begin
  with MainForm do
  begin
    EverFound:=false;
    NoShareFile:=false;
    CanOpenDir:=false;

    findfnode.ImageIndex := 6;
    findfnode.SelectedIndex := 6;

    Found := FindFirst(dir+'\*.*', faAnyFile, searchrec);
    while Found = 0 do
    begin
      CanOpenDir:=true;
      if(searchrec.name<>'.')and(searchrec.name<>'..') then
      begin //add files or folders
        EverFound := true;
        filename := searchrec.name;
        if ((searchrec.Attr and faDirectory)<>0) then ftype:=IsDir else ftype:=IsFile;
        //temdir:=dir;

        //XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        if ftype = IsDir then FullFileName := dir+'\'+filename+'\' else FullFileName := dir+'\'+filename;
        Synchronize(AddFile);
        FileList.Add(FullFileName);

        //XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

        if ftype=IsDir then
        begin
          New(MyItemPtr);
          MyItemPtr^.DirName := FullFileName;
          MyItemPtr^.Group := MyGroup;
          TemNode := Mytree.Items.AddChild(findfnode,FileName);
          TemNode.Data := MyItemPtr;
          TemNode.ImageIndex := 0;

          if recursive then findf(dir+'\'+searchrec.name);   //递归搜索
        end;
        Synchronize(CompareFile);
      end;
      Found := FindNext(SearchRec);
      if stop then exit;
      if terminated then exit;
    end;
    FindClose(SearchRec);

    if EverFound then
    begin
      findfnode.ImageIndex := 10;
      findfnode.SelectedIndex := 10;
      pMyTreeItem(findfnode.data)^.tabindex := 0;  //#########
    end
    else  //not EverFound
    begin
      if CanOpenDir then
      begin
        findfnode.ImageIndex := 30;  //can open, but no file
        NoShareFile:=true;
      end
      else
      begin  //test password
        with NR do
        begin
            dwType := RESOURCETYPE_ANY;
            lpLocalName := pchar('z:');
            lpRemoteName := pchar(mydir);
            lpProvider := '';
        end;
        result:= WNetAddConnection2(NR, pchar(''), pchar('guest'),CONNECT_UPDATE_PROFILE);
        case result of
        ERROR_INVALID_PASSWORD:
        begin
            findfnode.ImageIndex := 20;
            findfnode.SelectedIndex :=20;
            findfnode.StateIndex := 20;
            NeedPassWord:=true;
        end;
        else findfnode.ImageIndex := 19;
        end; // end of case
        WNetCancelConnection2('z:', CONNECT_UPDATE_PROFILE, FALSE);
      end;  //end of test password
    end;
  end;

end;

procedure TSearchHostThread.NotFound;
begin

  with MainForm do
  begin
    //ListBox1.Items.Add(MyHost+inttostr(handle)); ///
    if not NeedLogin then
    begin
      if NoShareDir then
      begin
        mynode.ImageIndex :=27;
        mynode.SelectedIndex :=27;
      end
      else
      begin
        mynode.ImageIndex :=15;
        mynode.SelectedIndex :=15;
      end;
    end
    else
    begin
      mynode.ImageIndex :=26;
      mynode.SelectedIndex :=26;
    end;
  end;
 
end;

procedure TSearchHostThread.BeFound;
begin
 with MainForm do
 begin
    //ListBox1.Items.Add(MyHost+inttostr(handle)); ///
    if isWinNT then
    begin
        mynode.ImageIndex :=29;
        mynode.SelectedIndex :=29;
    end;
    mynode.expand(false);
 end;
end;

//-------------------------------------------------------------
function WinExecAndWait32(FileName:String; Visibility : integer):integer;
var
  zAppName      : array[0..512] of char;
  zCurDir       : array[0..255] of char;
  WorkDir       : String;
  StartupInfo   : TStartupInfo;
  ProcessInfo   : TProcessInformation;

  hStdIn        : THandle; // standard input handle
  irMacroBuf    : INPUT_RECORD; // array of input events
  dwBytesWritten: DWORD;

begin
  SetConsoleTitle('s');
  StrPCopy(zAppName,FileName);
  //MainForm.Caption := zappname;
  GetDir(0,WorkDir);
  StrPCopy(zCurDir,WorkDir);
  FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  StartupInfo.cb := Sizeof(StartupInfo);
  hStdIn := StartupInfo.hStdInput;
  StartupInfo.hStdInput := hStdIn;
  StartupInfo.lpTitle := @zAppName;
  StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESTDHANDLES;

  WriteConsoleInput(hStdIn,irMacroBuf,1,dwBytesWritten);

  StartupInfo.dwFlags := StartupInfo.dwFlags or STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := Visibility;
  if not CreateProcess(nil,
    zAppName,                      { pointer to command line string }
    nil,                           { pointer to process security attributes }
    nil,                           { pointer to thread security attributes }
    false,                         { handle inheritance flag }
    CREATE_NEW_CONSOLE or          { creation flags }
    NORMAL_PRIORITY_CLASS,
    nil,                           { pointer to new environment block }
    nil,                           { pointer to current directory name }
    StartupInfo,                   { pointer to STARTUPINFO }
    ProcessInfo) then Result := -1 { pointer to PROCESS_INF }

  else begin
    WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
    Result:=1;
  end;
end;

//-------------------------------------------------------------

procedure TSearchHostThread.Execute;
var
  EnumHandle                : THandle;
  DirRS                     : TNetResource;
  Buf                       : Array[1..500] of TNetResource;
  BufSize                   : DWord;
  Entries                   : DWord;
  Result                    : Integer;

  CmdStr                    : string;
  everFoundDir              : boolean;

begin
  //hFlag := 12345;

  if stop then exit;
  if terminated then exit;

  Synchronize(AddToHistory);  //add to history
  FileList := TStringList.Create;
  //if mygroup[length(mygroup)]=#0 then delete(mygroup,length(mygroup),1); // delete #

  everFoundDir:=false;
  NeedLogin:=false;
  NeedPassWord:=false;
  isWinNT:=false;
  NoShareDir:=false;
  MyHost := MyHost + #0;
  FillChar(DirRS, SizeOf(DirRS) , 0);
  With DirRS do begin
    dwScope := 2;
    dwType := 3;
    dwDisplayType := 1;
    dwUsage := 2;
    lpRemoteName := @MyHost[1];
  end;
  Result := WNetOpenEnum( RESOURCE_GLOBALNET,
                RESOURCETYPE_ANY,
                0,
                @DirRS,
                EnumHandle );

  if Result<>NO_ERROR then
  case Result of
    WN_EXTENDED_ERROR: beep;//showmessage('WN_EXTENDED_ERROR');
    WN_NOT_LOGGED_ON: beep;//showmessage('WN_NOT_LOGGED_ON');
    WN_ACCESS_DENIED:
      begin
        isWinNT:=true;  // NT system, haven't login before. 
        //---------------need login-------------
        //showmessage('WN_ACCESS_DENIED');
        //WNetGetUser(pchar(host),pchar('guest'),);

        {登录计算机的方法
        WinExec(Pchar('net use \\computername password /user:username',sw_Hide);
        注销计算机的方法
        WinExec(Pchar('net use \\computername /delete',sw_Hide);}
        PassWord := '';
        User := 'guest';
        Synchronize(GetUserPassWord);
        CmdStr := 'net use ' + trim(MyHost) + ' ' + PassWord;
        //if CmdStr[length(CmdStr)]=#0 then  delete(CmdStr,length(CmdStr),1);
        CmdStr := CmdStr + ' /user:' + User + #0;
        //MainForm.caption:=CmdStr;
        WinExecAndWait32(CmdStr,0);

          Result := WNetOpenEnum( RESOURCE_GLOBALNET,
                RESOURCETYPE_ANY,
                0,
                @DirRS,
                EnumHandle );

        {if Result=WN_ACCESS_DENIED then
        begin
          CmdStr:= 'net use '+host;
          if CmdStr[length(CmdStr)]=#0 then  delete(CmdStr,length(CmdStr),1);
          CmdStr:=CmdStr+' /user:administrator';
          WinExecAndWait32(CmdStr,0);
        end;}

        if Result=WN_ACCESS_DENIED then NeedLogin:=true;
      end;
    WN_NOT_AUTHENTICATED :beep;//showmessage('WN_NOT_AUTHENTICATED');
  end;//end of case
  if (Result=NO_ERROR) then NoShareDir:=true;

  if Result= NO_ERROR then
  Repeat
    //showmessage('no error');
    Entries := 1;
    BufSize := SizeOf(Buf);
   Result := WNetEnumResource( EnumHandle,Entries,@Buf,BufSize );
   If (Result = NO_ERROR) and (Entries = 1) then
   begin
      mydir := StrPas(Buf[1].lpRemoteName);
      if Buf[1].dwType = RESOURCETYPE_PRINT then bPrinter:= true
      else bPrinter := false;
      everFoundDir := true;
      Synchronize(AddDirNode);
      //-------------------------------------------------
      //############!!!
      FileList.Clear;
      if not bPrinter then if bAutoSearch then findf(mydir);
      //-------------------------------------------------

      Synchronize(AddDir);
    end ; //zw
    if stop then exit;
    if terminated then exit;
  Until (Entries <> 1) or (Result <> NO_ERROR);
  if everFoundDir  then NoShareDir:=false;

  WNetCloseEnum( EnumHandle );
  if (not everFoundDir) then Synchronize(NotFound) else Synchronize(BeFound);

  FileList.Free;
  if terminated then exit;

  //hFlag := 0;
  //SetEvent(hFlag);
  
end;

end.

⌨️ 快捷键说明

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