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

📄 results.pas

📁 文件搜索的代码
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit results;

interface

uses
  Windows, SysUtils, Classes, Graphics, Forms, JvPanel, jpeg, Menus, enhlv,
  Controls, ComCtrls, StdCtrls, ExtCtrls, ShellApi, ImgList, JvGIF,
  Dialogs, JvBaseDlg, JvBrowseFolder, JvComponent, JvThread, JvExExtCtrls,
  JvExStdCtrls, JvButton, JvFavoritesButton, ShlObj, ActiveX, ComObj;

type
  TFormResults = class(TForm)
    lblKeywords: TLabel;
    editKeywords: TEdit;
    btnSearch: TButton;
    StatusBar: TStatusBar;
    lblExtension: TLabel;
    editExtension: TEdit;
    Panel: TJvPanel;
    imgLogo: TImage;
    editText: TEdit;
    lblText: TLabel;
    lblBack: TLabel;
    PopupMenu1: TPopupMenu;
    Openfile1: TMenuItem;
    Opendirectory1: TMenuItem;
    listResults: TgfglListView;
    ImageList1: TImageList;
    cbDrives: TComboBox;
    lblSearchIn: TLabel;
    btnBrowse: TButton;
    GroupBox1: TGroupBox;
    cbFindAll: TCheckBox;
    cbCase: TCheckBox;
    BrowseDir: TJvBrowseForFolderDialog;
    Thread: TJvThread;
    cbNoHidden: TCheckBox;
    cbNoReadOnly: TCheckBox;
    cbSearchAll: TCheckBox;
    procedure cbSearchAllClick(Sender: TObject);
    procedure lblBackMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure lblBackClick(Sender: TObject);
    procedure editTextChange(Sender: TObject);
    procedure btnSearchClick(Sender: TObject);
    procedure Openfile1Click(Sender: TObject);
    procedure Opendirectory1Click(Sender: TObject);
    procedure listResults1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure listResultsColumnClick(Sender: TObject; Column: TListColumn);
    procedure FormCreate(Sender: TObject);
    procedure imgFirefoxClick(Sender: TObject);
    procedure btnBrowseClick(Sender: TObject);
    procedure ThreadExecute(Sender: TObject; params: Pointer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    IndexFile, ExtFile, Ext: string;

    procedure AddResult(tmp: string);
    procedure AddDir(tmp: string);
    procedure CheckText(Words: TStringList; tmp: string);
    procedure FindFiles(KWords, Txt, Extension, SearchPath: string; FindText, FindAll, CaseSensitive: boolean);
    function GetIEFavorites(const FavPath: string): TStrings;
  end;

var
  FormResults: TFormResults;
  LastSortedColumn: integer;
  Ascending: boolean;

implementation

uses main;

{$R *.dfm}

function quickconv(s: string): real;
var
 e: integer;
 j: real;
begin
 try
  val(s,j,e);
  quickconv := j;
 except
  quickconv := 0;
 end;
end;

function convfloat(i: real): string;
begin
 convfloat := FloatToStrf(i,ffFixed,6,2);
end;

///////////////////////////////////////////////////////////////////////////////
//                                                                           //
//  Search functions - "The File Seeker"                                     //
//                                                                           //
///////////////////////////////////////////////////////////////////////////////

procedure TFormResults.AddResult(tmp: string);
var
 Stream: file of Byte;
 FileInfo: TSHFILEINFO;
 Icon: TIcon;
 Size: string;
 Attr, Size1: integer;
begin
 try
  // If file exists
  if FileExists(tmp) then begin

   // Check file attributes
   Attr := FileGetAttr(tmp);
   if (cbNoHidden.Checked) and (Attr and faHidden <> 0) then Exit;
   if (cbNoReadOnly.Checked) and (Attr and faReadOnly <> 0) then Exit;

   // Get filesize
   try
    AssignFile(Stream, tmp);
    Reset(Stream);
    Size1 := FileSize(Stream);
    CloseFile(Stream);

    // Convert filesize to bytes, kbytes, mbytes...
    try
     if Size1/1024 > 1024 then
      Size := convfloat(Int((Size1 / 1048576 * 100)+0.5)/100) + ' MB';
     if Size1/1048576 > 1024 then
      Size := convfloat(Int((Size1 / 1024 * 100)+0.5)/100) + ' GB';
     if (Size1/1024 <= 1024) and (Size1 > 1024) then
      Size := convfloat(Int((Size1 / 1024 * 100)+0.5)/100) + ' KB';
     if Size1 <= 1024 then
      Size := IntToStr(Size1) + ' Bytes';
    except
     Size := 'Unknown';
    end;

    SHGetFileInfo(PChar(tmp), 0, FileInfo, SizeOf(FileInfo), SHGFI_ICON + SHGFI_SMALLICON + SHGFI_USEFILEATTRIBUTES + SHGFI_TYPENAME);

    Icon := TIcon.Create;
    Icon.Handle := FileInfo.hIcon;
    ImageList1.AddIcon(Icon);
    Icon.Free;
    if Name <> '' then
     // Add result to list
     with listResults.Items.Add do begin
      Caption := ExtractFileName(tmp);
      ImageIndex := ImageList1.Count-1;
      SubItems.Add(Size);
      SubItems.Add(ExtractFilePath(tmp));
     end;

   except end;
  end;
 except end;
end;

procedure TFormResults.AddDir(tmp: string);
var
 Dir, Path: string;
begin
 try
  // Check if directory exists
  if DirectoryExists(tmp) then begin

   // Delete last '\' if exists
   if LastDelimiter('\', tmp) = Length(tmp) then
    Delete(tmp, Length(tmp), 1);

   // Extract directory name and path is located
   Dir := ExtractFileName(tmp);
   Path := ExtractFilePath(tmp);

   if Dir <> '' then
    // Add result to list
    with listResults.Items.Add do begin
    Caption := Dir;
    ImageIndex := 0;
    SubItems.Add('Directory');
    SubItems.Add(Path);
   end;
  end;
 except end;
end;

procedure TFormResults.CheckText(Words: TStringList; tmp: string);
var
 TxtFile: TStringList;
 Temp, Temp2: string;
 i, j: integer;
 Found: boolean;
begin
 // Text not found
 Found := False;
 try
  // Open text file
  TxtFile := TStringList.Create;
  TxtFile.LoadFromFile(tmp);
  // Select word to search
  for i:=0 to Words.Count-1 do
   // If a word found, stop searching
   if Found then
    Break
   else begin
    Temp := lowercase(Words.Strings[i]);
    // Search word line-by-line
    for j:=0 to TxtFile.Count-1 do begin
     Temp2 := lowercase(TxtFile.Strings[j]);
     // If word found, add file to results
     if Copy(Temp2,pos(Temp,Temp2),Length(Temp)) = Temp then begin
      Found := True;
      AddResult(tmp);
      Break;
     end;
    end;
   end;
 // If a file cannot be opened, don't show an error message
 except end;
end;

procedure TFormResults.FindFiles(KWords, Txt, Extension, SearchPath: string; FindText, FindAll, CaseSensitive: boolean);
var
 Database: TextFile;
 Keywords, Extensions, Texts, Favorites: TStringList;
 pidl: PItemIDList;
 FavPath: array[0..MAX_PATH] of char;
 i, j, k, l: integer;
 line, filename, path, keyword, dirname: string;
 tmp, tmp1, tmp2: string;
 finished: boolean;
begin
 // Clear results list
 listResults.Clear;

 Keywords := TStringList.Create;
 if FindText then begin
  // Extract and add text file extensions to a StringList
  Extensions := TStringList.Create;
  tmp1 := Ext + ',';
  repeat
   tmp2 := Copy(tmp1, 0, pos(',',tmp1)-1);
   Delete(tmp1, 1, pos('.',tmp1));
   Delete(tmp1, 1, pos(',',tmp1));
   Extensions.Add(tmp2);
  until
   pos('.', tmp1) = 0;
 end;
 Texts := TStringList.Create;
 text := Txt;

 // Extract keywords and add them to a StringList
 repeat
  if Copy(KWords, 1, pos(' ', KWords)-1) = '' then break;
  Keywords.Add(Copy(KWords, 1, pos(' ', KWords)-1));
  Delete(KWords, 1, pos(' ', KWords));
 until
  Copy(KWords, 1, pos(' ', KWords)-1) = '';

 if FindText then begin
  // Extract words and add them to a StringList
  repeat
   if Copy(Txt, 1, pos(' ', Txt)-1) = '' then break;
   Texts.Add(Copy(Txt, 1, pos(' ', Txt)-1));
   Delete(Txt, 1, pos(' ', Txt));
  until
   Copy(Txt, 1, pos(' ', Txt)-1) = '';
 end;

 Keywords.Add(KWords);
 Texts.Add(Txt);

 // Open database file
 AssignFile(Database, IndexFile);
 Reset(Database);

 // Read all lines of database
 while not Eof(Database) do begin
  // Check if search is cancelled
  if btnSearch.Caption <> 'Search' then begin
   ReadLn(Database, line);

   // Check if line is a comment/empty line
   if ((pos('#', line) = 0) and (line <> '') and (pos('<', line) = 0)) then begin
    if CaseSensitive then
     filename := line
    else
     filename := lowercase(line);

    tmp := path + line;

    // Delete last '\' in search dir
    if LastDelimiter('\', SearchPath) = Length(SearchPath) then
     SearchPath := Copy(SearchPath, 0, Length(SearchPath)-1);

    // Check if file is in the path we're searching
    if (Copy(lowercase(path), 0, length(SearchPath)) = lowercase(SearchPath)) or (cbSearchAll.Checked) then begin

     // Search directory found.
     // Finish search when we finish searching files in the directory.
     finished := true;

     // Find all words
     if FindAll then begin

      // Reset counter
      j := -1;
      for i:=0 to Keywords.Count-1 do begin
       if CaseSensitive then
        keyword := Keywords.Strings[i]
       else
        keyword := lowercase(Keywords.Strings[i]);
       if Copy(Filename, pos(keyword, Filename), Length(keyword)) = keyword then j := j+1;
      end;

      // If file has all keywords
      if j = Keywords.Count-1 then begin

       // Check file extensions
        if FindText then begin
         for k:=0 to Extensions.Count-1 do
          if ExtractFileExt(Filename) = Extensions.Strings[k] then begin
           CheckText(Texts, tmp);
           Break;
          end;

        end else
         if Extension <> '*.*' then begin
          if ExtractFileExt(Filename) = ExtractFileExt(editExtension.Text) then
           AddResult(tmp);
         end else
          AddResult(tmp)

      end;

⌨️ 快捷键说明

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