searchdirthreadunit.pas

最好的局域网搜索软件

unit SearchDirThreadUnit;

interface

uses Windows, Messages, SysUtils, Classes,ComCtrls,Dialogs,ShellAPI,Controls,
     Main,ConFig,FmxUtils,Graphics;

type
TSearchDirThread=class(TThread)
private
  FileName      : string;
  ftype         : FileType;
  FileNum       : integer;
  bEmptyDir     : boolean;
  FileSize      : DWORD;
public
  MyGroup,MyDir : string;
  MyList{,RList}: TListview;
  RListItem     : TListItem;
  MyTree        : TTreeView;
  Mynode        : TTreeNode;
  ClickType     : OwnerType;
protected
  procedure Execute; override;
  Procedure AddFile;
  procedure addnode;
  procedure FindIcon;
  end;

implementation

procedure TSearchDirThread.FindIcon;
var
  FileInfo: TSHFileInfo;
  //bm:TBitmap;
begin

  if bSysIcon then
   with MyList do
   begin
      SmallImages:=TImageList.CreateSize(16,16);
      SmallImages.Handle:=ShGetFileInfo('',0,FileInfo, SizeOf(FileInfo),
                          SHGFI_SMALLICON or SHGFI_ICON or SHGFI_SYSICONINDEX );
      {bm := TBitmap.Create;
      MainForm.imagelist1.GetBitmap(2,bm);
      MyList.SmallImages.Add(bm,bm);}
   end
  else Mylist.SmallImages := MainForm.imagelist1;

end;

procedure TSearchDirThread.AddFile;
var
  tems          : string;
  tnode         : TTreeNode;
  newListItem   : TListItem;

  MyItemPtr     : PMyTreeItem;
  fPtr          : pFileItem;
begin
 with MainForm do
 begin
   //add to list view
  newListItem := Mylist.items.Add;
  newListItem.caption := FileName;
  if ftype = IsFile then
  begin
    if FileSize > 1024 then
      newListItem.SubItems.Add(FormatFloat('#,###" KB"',  FileSize/ 1024))
    else
      newListItem.SubItems.Add(inttostr(FileSize)+'B');
  end;
  new(fPtr); 
  fPtr.ftype := ftype;
  fPtr.size := FileSize;
  newListItem.Data := fPtr;

  if not bSysIcon then
  begin
    case ftype of
    IsDir: newListItem.ImageIndex := 0;
    else  newListItem.ImageIndex := GetImgIndex(FileName);
    end  //end of case
  end
  else
  begin
    newListItem.ImageIndex:=GetFileIconIndex(MyDir+'\'+FileName);
  end;
  
  //add to tree
  if ClickType=InTreeView then  //search or explor in tree
  begin

   tems:=pMyTreeitem(Mynode.data)^.Group;
   if tems[length(tems)]=#0 then delete(tems,length(tems),1); // delete#0

   if (ftype=IsDir) then    // folder
   begin
        if MyDir[length(MyDir)]='\' then delete(MyDir,length(MyDir),1);
        AllListbox.Items.Insert(0, MyDir+'\'+FileName);
        //StrListAll.Add('工作组:'+GroupFunc(tems)+' 地址:'+MyDir+'\'+FileName);
        New(MyItemPtr);
        MyItemPtr^.DirName := MyDir+'\'+FileName;
        tnode:=Mytree.Items.AddChild(Mynode,FileName);
        MyItemPtr^.Group := pMyTreeItem(Mynode.data)^.Group;
        tnode.Data := MyItemPtr;
        tnode.ImageIndex := 0;
   end
   else
   begin
        AllListbox.Items.Insert(0, MyDir+'\'+FileName);
        //StrListAll.Add('工作组:'+GroupFunc(tems)+' 地址:'+MyDir+'\'+FileName);
   end;
  end;   //end of choice=1 or 4

  //AllListbox.TopIndex := AllListbox.Items.Count-1;

  CheckFile(FileName, MyDir, MyGroup, 1, FileSize);

 end;
end;

procedure TSearchDirThread.AddNode;
var
  result      :dWord;
  NR          : TNetResource;
begin

 with MainForm do
 begin

  if FileNum<>0 then
  begin
    if ClickType=InTreeView then
    begin
      Mynode.ImageIndex := 10;
      Mynode.selectedindex:=10;
      Mynode.StateIndex := 10;
      if Mytree.visible then try Mytree.setfocus
         except on EInvalidOperation do beep end;
         //pMyTreeItem(MyNode.data)^.MyListItem.ImageIndex := 10;
    end;
    RListItem.ImageIndex := 10;
  end
  else  //filenum=0
  begin
    if bEmptyDir then RListItem.ImageIndex := 31 else RListItem.ImageIndex := 11;
    if ClickType=InTreeView then
    begin  //03
         if bEmptyDir then
         begin
           Mynode.ImageIndex := 31;
           Mynode.selectedIndex := 31;
           Mynode.StateIndex := 31;
         end
         else
         begin
           Mynode.ImageIndex := 11;
           Mynode.selectedIndex := 11;
           Mynode.StateIndex := 11;
           if Mytree.visible then try Mytree.setfocus
           except on EInvalidOperation do beep end;

           // 以下检查是否设了密码
           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_ACCESS_DENIED             :ShowMessage(MyDir+' 访问被拒绝！');
          ERROR_ALREADY_ASSIGNED          :ShowMessage('ERROR_ALREADY_ASSIGNED         ');
          ERROR_BAD_DEV_TYPE              :ShowMessage('ERROR_BAD_DEV_TPYE             ');
          ERROR_BAD_DEVICE                :ShowMessage('ERROR_BAD_DEVICE               ');
          ERROR_BAD_NET_NAME              :ShowMessage(MyDir+' 该网络资源不存在。');
          ERROR_BAD_PROFILE               :ShowMessage('ERROR_BAD_PROFILE              ');
          ERROR_BAD_PROVIDER              :ShowMessage('ERROR_BAD_PROVIDER             ');
          ERROR_BUSY                      :ShowMessage(MyDir+' 网络太忙！');
          ERROR_CANCELLED                 :ShowMessage(MyDir+' 访问被拒绝！');
          ERROR_CANNOT_OPEN_PROFILE       :ShowMessage('ERROR_CANNOT_OPEN_PROFILE      ');
          ERROR_DEVICE_ALREADY_REMEMBERED :ShowMessage('ERROR_DEVICE_ALREADY_REMEMBERED');
          ERROR_EXTENDED_ERROR            :ShowMessage(MyDir+' 网络错误');
          ERROR_NO_NET_OR_BAD_PATH        :ShowMessage(MyDir+' 该网络资源不存在');
          ERROR_NO_NETWORK                :ShowMessage(MyDir+' 该网络资源不存在');
          ERROR_INVALID_PASSWORD:
          begin
               //ShowMessage('ERROR_INVALID_PASSWORD         ');
               Mynode.ImageIndex := 20;
               Mynode.selectedIndex := 20;
               Mynode.StateIndex := 20;
               if Mytree.visible then try Mytree.setfocus
                  except on EInvalidOperation do beep end;
          end
        end; // end of case
        WNetCancelConnection2('z:', CONNECT_UPDATE_PROFILE, FALSE);

      end;
    end; //03
  end;//02
 end;//end of with MainForm do
end;

procedure TSearchDirThread.Execute;
var
  Found         : integer;
  searchrec     : TSearchRec;
  CanOpenDir    : boolean;
begin

  if stop then exit;
  if terminated then exit;

  FileNum:=0;
  bEmptyDir:=false;
  CanOpenDir:=false;
  Synchronize(FindIcon);
  Found := FindFirst(MyDir+'\*.*',faAnyFile,searchrec);
  while Found = 0 do
  begin
    if ((searchrec.Attr and faDirectory)<>0)  then ftype:=IsDir else ftype:=IsFile;
    FileName := SearchRec.Name;
    FileSize := SearchRec.Size;
    CanOpenDir:=true;
    if (FileName<>'.')and(FileName<>'..') then
    begin
      inc(filenum);
      Synchronize(AddFile);
    end;
    Found := FindNext(SearchRec);
    {if stop then exit;
    if terminated then exit; }
  end;
  FindClose(SearchRec);
  if CanOpenDir and (FileNum=0) then bEmptyDir:=true;
  Synchronize(AddNode);

end;

end.