求助－－－模拟windows包含文字查找功能

[jsprite]

如题，想要实现这个功能请各位高手帮忙！（主要是针对word文档）

[jackie168]

//轉伴水老大的貼子：
unit ScanFilesUnit;

{$WARN UNIT_PLATFORM OFF}

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, ExtCtrls, Buttons, ComCtrls, Menus, ImgList;

const
WM_TABCONTROLSEARCHCHANGE = WM_USER + $1001;

type
TFormScanFiles = class(TForm)
TabControlSearch: TTabControl;
ListViewResults: TListView;
BitBtnSearch: TBitBtn;
PanelDirectory: TPanel;
Panel2: TPanel;
ComboBoxFilter: TComboBox;
ComboBoxSearch: TComboBox;
PopupMenu1: TPopupMenu;
StatusBar1: TStatusBar;
MenuItemSearchSelection: TMenuItem;
MenuItemSelectAll: TMenuItem;
CheckBoxIgnoreCase: TCheckBox;
MenuItemCopyFileName: TMenuItem;
CheckBoxClearLastResult: TCheckBox;
ComboBoxDirectory: TComboBox;
SpeedButtonDirectory: TSpeedButton;
ImageListSort: TImageList;
procedure BitBtnSearchClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure TabControlSearchChange(Sender: TObject);
procedure ComboBoxSearchChange(Sender: TObject);
procedure ListViewResultsCompare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
procedure ListViewResultsColumnClick(Sender: TObject;
Column: TListColumn);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure ComboBoxSearchKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure TabControlSearchChanging(Sender: TObject;
var AllowChange: Boolean);
procedure FormDestroy(Sender: TObject);
procedure MenuItemSearchSelectionClick(Sender: TObject);
procedure MenuItemSelectAllClick(Sender: TObject);
procedure ListViewResultsCustomDrawItem(Sender: TCustomListView;
Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure MenuItemCopyFileNameClick(Sender: TObject);
procedure ListViewResultsDblClick(Sender: TObject);
procedure ComboBoxSearchSelect(Sender: TObject);
procedure ComboBoxFilterChange(Sender: TObject);
procedure SpeedButtonDirectoryClick(Sender: TObject);
private
{ Private declarations }
FSearching: Boolean;
FSearchText: string;
FChanging: Boolean;
FFilterText: string;
FSearchResults: TStringList;
procedure SetSearching(const Value: Boolean);
procedure WMTABCONTROLSEARCHCHANGE(var Msg: TMessage); message WM_TABCONTROLSEARCHCHANGE;
public
{ Public declarations }
property Searching: Boolean read FSearching write SetSearching;
end;

var
FormScanFiles: TFormScanFiles;

implementation

{$R *.dfm}

uses EncdDecd, IniFiles, Clipbrd, ShellAPI, CommCtrl;

function StrLeft(const mStr: string; mDelimiter: string): string;
{ 殿隙酘煦路趼睫揹 }
begin
Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
end; { StrLeft }

function ListCount(mList: string; mDelimiter: string = ','): Integer;
{ 殿隙蹈桶杅 }
var
I, L: Integer;
begin
Result := 0;
if mList = '' then Exit;
L := Length(mList);
I := Pos(mDelimiter, mList);
while I > 0 do begin
mList := Copy(mList, I + Length(mDelimiter), L);
I := Pos(mDelimiter, mList);
Inc(Result);
end;
Inc(Result);
end; { ListCount }

function ListValue(mList: string; mIndex: Integer; mDelimiter: string = ','): string;
{ 殿隙蹈桶硌隅弇离腔啋匼 }
var
I, L, K: Integer;
begin
L := Length(mList);
I := Pos(mDelimiter, mList);
K := 0;
Result := '';
while (I > 0) and (K <> mIndex) do begin
mList := Copy(mList, I + Length(mDelimiter), L);
I := Pos(mDelimiter, mList);
Inc(K);
end;
if K = mIndex then Result := StrLeft(mList + mDelimiter, mDelimiter);
end; { ListValue }

function HexToStr(mHex: string): string;
var
I: Integer;
begin
Result := '';
mHex := StringReplace(mHex, #32, '', [rfReplaceAll]);
for I := 1 to Length(mHex) div 2 do
Result := Result + Chr(StrToIntDef('$' + Copy(mHex, I * 2 - 1, 2), 0));
end; { HexToStr }

function StrToHex(mStr: string; mSpace: Boolean): string;
const
cSpaceStr: array[Boolean] of string = ('', #32);
var
I: Integer;
begin
Result := '';
for I := 1 to Length(mStr) do
Result := Format('%s%s%.2x', [Result, cSpaceStr[mSpace], Ord(mStr[I])]);
if mSpace then Delete(Result, 1, 1);
end; { StrToHex }

function StringToDisplay(mString: string): string;
var
I: Integer;
S: string;
begin
Result := '';
S := '';
for I := 1 to Length(mString) do
if mString[I] in [#32..#127] then
S := S + mString[I]
else begin
if S <> '' then begin
Result := Result + QuotedStr(S);
S := '';
end;
Result := Result + Format('#$%x', [Ord(mString[I])]);
end;
if S <> '' then Result := Result + QuotedStr(S);
end; { StringToDisplay }

function DisplayToString(mDisplay: string): string;
var
I: Integer;
S: string;
B: Boolean;
begin
Result := '';
B := False;
mDisplay := mDisplay;
for I := 1 to Length(mDisplay) do
if B then case mDisplay[I] of
'''': begin
if S <> '' then Result := Result + StringReplace(S, '''''', '''', [rfReplaceAll]);
if Copy(mDisplay, I + 1, 1) = '''' then Result := Result + '''';
S := '';
B := False;
end;
else S := S + mDisplay[I];
end
else case mDisplay[I] of
'#', '''': begin
if S <> '' then Result := Result + Chr(StrToIntDef(S, 0));
S := '';
B := mDisplay[I] = '''';
end;
'$', '0'..'9', 'a'..'f', 'A'..'F': S := S + mDisplay[I];
end;
if (not B) and (S <> '') then Result := Result + Chr(StrToIntDef(S, 0));
end; { DisplayToString }

function ScanStream(mStream: TStream; mStr: string;
mIgnoreCase: Boolean = False): Integer;
const
cBufferSize = $8000;
var
S: string;
T: string;
I: Integer;
L: Integer;
begin
Result := -1;
if not Assigned(mStream) then Exit;
if mStr = '' then Exit;
L := Length(mStr);
mStream.Position := 0;
SetLength(S, cBufferSize);
T := '';
if mIgnoreCase then mStr := UpperCase(mStr);
for I := 1 to mStream.Size div cBufferSize do begin
mStream.Read(S[1], cBufferSize);
if mIgnoreCase then S := UpperCase(S);
Result := Pos(mStr, T + S) - 1;
T := Copy(S, cBufferSize - L, MaxInt); //2004-03-28 Zswang No.1
if Result >= 0 then begin
Result := Result + Pred(I) * cBufferSize - Length(T);
mStream.Seek(Result, soBeginning);
Exit;
end;
end;
I := mStream.Size mod cBufferSize;
SetLength(S, I);
if I > 0 then begin
mStream.Read(S[1], I);
if mIgnoreCase then S := UpperCase(S);
Result := Pos(mStr, T + S) - 1;
if Result >= 0 then begin
Result := Result + mStream.Size - I - Length(T);
mStream.Seek(Result, soBeginning);
Exit;
end;
end;
end; { ScanStream }

function ListViewHeaderImages(mListView: TListView; mImages: TImageList): Boolean;
var
vHandle: THandle;
begin
Result := False;
if not Assigned(mListView) then Exit;
vHandle := ListView_GetHeader(mListView.Handle);
if Assigned(mImages) then
Header_SetImageList(vHandle, mImages.Handle)
else Header_SetImageList(vHandle, 0);
Result := True;
end; { ListViewHeaderImages }

function ListColumnImageIndex(mColumn: TListColumn;
mImageIndex: Integer; mRight: Boolean = True): Boolean;
var
vHandle: THandle;
vHDItem: THDItem;
begin
Result := False;
if not Assigned(mColumn) then Exit;
vHandle := ListView_GetHeader(TListView(mColumn.Collection.Owner).Handle);
FillChar(vHDItem, SizeOf(vHDItem), 0);
Header_GetItem(vHandle, mColumn.Index, vHDItem);

[jackie168]

if mImageIndex < 0 then begin
vHDItem.Mask := HDI_FORMAT;
vHDItem.fmt := HDF_STRING;
end else begin
vHDItem.Mask := HDI_IMAGE or HDI_FORMAT;
vHDItem.iImage := mImageIndex;
vHDItem.fmt := HDF_STRING or HDF_IMAGE or
(HDF_BITMAP_ON_RIGHT * Ord(mRight));
end;
Header_SetItem(vHandle, mColumn.Index, vHDItem);
end; { ListColumnImageIndex }

procedure TFormScanFiles.BitBtnSearchClick(Sender: TObject);
procedure pSearch(mDir: string);
var
vPathName: string;
K: Integer;
vSearchRec: TSearchRec;
vFileStream: TFileStream;
I: Integer;
J: Integer;
begin
vPathName := mDir + '\' + '*.*';
K := FindFirst(vPathName, faDirectory, vSearchRec);
while K = 0 do begin
if (vSearchRec.Attr and faDirectory > 0) and
(Pos(vSearchRec.Name, '..') = 0) then
pSearch(mDir + '\' + vSearchRec.Name);
K := FindNext(vSearchRec);
Application.ProcessMessages;
if not FSearching then Exit;
end;
FindClose(vSearchRec);
for J := 0 to ListCount(FFilterText, ';') - 1 do begin
if ListValue(FFilterText, J, ';') = '' then Continue;
vPathName := mDir + '\' + ListValue(FFilterText, J, ';');
K := FindFirst(vPathName, faAnyFile and not faDirectory, vSearchRec);
while K = 0 do begin
if Pos(vSearchRec.Name, '..') = 0 then begin
StatusBar1.SimpleText := mDir + '\' + vSearchRec.Name;
if FSearchText = '' then begin
with ListViewResults.Items.Add do begin
Caption := vSearchRec.Name;
SubItems.Text := Format('%s'#13#10'%d'#13#10'%s'#13#10'%d'#13#10'%s'#13#10,
[mDir, vSearchRec.Size,
FormatDateTime('yyyy-mm-dd hh:nn:ss',
FileDateToDateTime(vSearchRec.Time)), 0,
StringToDisplay(FSearchText)]);
end;
end else begin
vFileStream := TFileStream.Create(mDir + '\' + vSearchRec.Name, fmShareDenyNone);
try
I := ScanStream(vFileStream, FSearchText, CheckBoxIgnoreCase.Checked);
if I >= 0 then begin
with ListViewResults.Items.Add do begin
Caption := vSearchRec.Name;
SubItems.Text := Format('%s'#13#10'%d'#13#10'%s'#13#10'%d'#13#10'%s'#13#10,
[mDir, vSearchRec.Size,
FormatDateTime('yyyy-mm-dd hh:nn:ss',
FileDateToDateTime(vSearchRec.Time)), I,
StringToDisplay(FSearchText)]);
end;
end;
finally
vFileStream.Free;
end;
end;
end;
Application.ProcessMessages;
if not FSearching then Exit;
K := FindNext(vSearchRec);
end;
FindClose(vSearchRec);
end;
end;
var
vTickCount: DWORD;
vOldItemCount: Integer;
I: Integer;
begin
vTickCount := GetTickCount;
Searching := not Searching;
if Searching then begin
with ComboBoxSearch do if FSearchText <> '' then begin
I := Items.IndexOf(StringToDisplay(FSearchText));
if I < 0 then
Items.Insert(0, StringToDisplay(FSearchText))
else begin
Items.Move(I, 0);
TabControlSearchChange(TabControlSearch);
end;
end;
with ComboBoxFilter do if Text <> '' then begin
I := Items.IndexOf(Text);
if I < 0 then
Items.Insert(0, Text)
else begin
Items.Move(I, 0);
ItemIndex := 0;
end;
end;

with ComboBoxDirectory do if Text <> '' then begin
I := Items.IndexOf(Text);
if I < 0 then
Items.Insert(0, Text)
else begin
Items.Move(I, 0);
ItemIndex := 0;
end;
end;

if CheckBoxClearLastResult.Checked then FSearchResults.Clear;
if CheckBoxClearLastResult.Checked then ListViewResults.Items.Clear;
vOldItemCount := ListViewResults.Items.Count;
FFilterText := ComboBoxFilter.Text;
pSearch(ExcludeTrailingPathDelimiter(ComboBoxDirectory.Text));
if Searching then begin
Searching := False;
StatusBar1.SimpleText := Format('[俇傖] 瘧奀:%d; 殿隙:%d',
[GetTickCount - vTickCount, ListViewResults.Items.Count - vOldItemCount]);
end else begin
StatusBar1.SimpleText := Format('[礿砦] 瘧奀:%d; 殿隙:%d',
[GetTickCount - vTickCount, ListViewResults.Items.Count - vOldItemCount]);
end;
if ComboBoxSearch.CanFocus then ComboBoxSearch.SetFocus;
end;
end;

procedure TFormScanFiles.FormCreate(Sender: TObject);
begin
Font.Name := '冼极';
Font.Size := 9;
Application.Title := '恅璃刲坰 1.1';
Caption := Application.Title;
FSearchResults := TStringList.Create;
with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'config.ini') do try
ComboBoxFilter.Items.Text := DecodeString(ReadString('ComboBoxFilter', 'Items.Text',
EncodeString(ComboBoxFilter.Items.Text)));
FSearchText := DecodeString(ReadString('FormScanFiles', 'SearchText',
EncodeString(FSearchText)));
ComboBoxSearch.Items.Text := DecodeString(ReadString('ComboBoxSearch', 'Items.Text',
EncodeString(ComboBoxSearch.Items.Text)));
ComboBoxFilter.Text := ReadString('ComboBoxFilter', 'Text', ComboBoxFilter.Text);
TabControlSearch.TabIndex := ReadInteger('TabControlSearch','TabIndex', 0)
mod TabControlSearch.Tabs.Count;
ComboBoxDirectory.Text :=
ReadString('ComboBoxDirectory', 'Text',
ExtractFilePath(ParamStr(0)));
ComboBoxDirectory.Items.Text := DecodeString(ReadString('ComboBoxDirectory', 'Items.Text',
EncodeString(ComboBoxDirectory.Items.Text)));
CheckBoxClearLastResult.Checked := ReadBool('CheckBoxClearLastResult',
'Checked', CheckBoxClearLastResult.Checked);
CheckBoxIgnoreCase.Checked := ReadBool('CheckBoxIgnoreCase',
'Checked', CheckBoxIgnoreCase.Checked);
finally
Free;
end;
TabControlSearchChange(TabControlSearch);
ListViewHeaderImages(ListViewResults, ImageListSort);
BitBtnSearch.Enabled := ComboBoxFilter.Text <> '';
end;

procedure TFormScanFiles.TabControlSearchChange(Sender: TObject);
begin
case TabControlSearch.TabIndex of
0: ComboBoxSearch.Text := FSearchText;
1: ComboBoxSearch.Text := StrToHex(FSearchText, True);
2: ComboBoxSearch.Text := EncodeString(FSearchText);
3: ComboBoxSearch.Text := StringToDisplay(FSearchText);
end;
end;

procedure TFormScanFiles.ComboBoxSearchChange(Sender: TObject);
begin
if FChanging then Exit;
FSearchText := TComboBox(Sender).Text;
case TabControlSearch.TabIndex of
0: ;
1: FSearchText := HexToStr(FSearchText);
2: begin
try
FSearchText := DecodeString(FSearchText);
except
end;
end;
3: FSearchText := DisplayToString(FSearchText);
end;
end;

procedure TFormScanFiles.ListViewResultsCompare(Sender: TObject; Item1,
Item2: TListItem; Data: Integer; var Compare: Integer);
var
I: Integer;
A, B: string;
vDataA, vDataB: Extended;
begin
I := TListView(Sender).Tag;
if I = 0 then Exit;
if Abs(I) = 1 then begin
A := Item1.Caption;
B := Item2.Caption;
end else begin
if Abs(I) - 2 < Item1.SubItems.Count then
A := Item1.SubItems[Abs(I) - 2]
else A := '';
if Abs(I) - 2 < Item2.SubItems.Count then
B := Item2.SubItems[Abs(I) - 2]
else B := '';
end;
if TryStrToFloat(A, vDataA) and TryStrToFloat(B, vDataB) then
Compare := Trunc(I * vDataA - I * vDataB)
else Compare := CompareText(A, B) * I;
end;

[jackie168]

procedure TFormScanFiles.ListViewResultsColumnClick(Sender: TObject;
Column: TListColumn);
var
I: Integer;
begin
if Abs(TListView(Sender).Tag) = Column.Index + 1 then
TListView(Sender).Tag := -TListView(Sender).Tag
else TListView(Sender).Tag := Column.Index + 1;
TListView(Sender).AlphaSort;

for I := 0 to TListView(Sender).Columns.Count - 1 do
ListColumnImageIndex(TListView(Sender).Columns[I], -1);
ListColumnImageIndex(Column, Ord(TListView(Sender).Tag > 0));
end;

procedure TFormScanFiles.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
FSearching := False;
end;

procedure TFormScanFiles.SetSearching(const Value: Boolean);
begin
FSearching := Value;
CheckBoxIgnoreCase.Enabled := not FSearching;
ComboBoxSearch.Enabled := not FSearching;
ComboBoxDirectory.Enabled := not FSearching;
ComboBoxFilter.Enabled := not FSearching;
ComboBoxDirectory.Enabled := not FSearching;
SpeedButtonDirectory.Enabled := not FSearching;
if FSearching then begin
BitBtnSearch.Caption := '礿砦(&S)';
end else begin
BitBtnSearch.Caption := '刲坰(&S)';
end;
end;

procedure TFormScanFiles.ComboBoxSearchKeyDown(Sender: TObject;
var Key: Word; Shift: TShiftState);
begin
if FSearching then Exit;
case Key of
VK_RETURN: BitBtnSearch.Click;
VK_TAB: if ssCtrl in Shift then begin
TabControlSearch.TabIndex :=
(TabControlSearch.TabIndex + 1) mod TabControlSearch.Tabs.Count;
TabControlSearchChange(TabControlSearch);
end;
end;
end;

procedure TFormScanFiles.TabControlSearchChanging(Sender: TObject;
var AllowChange: Boolean);
begin
AllowChange := not FSearching;
end;

procedure TFormScanFiles.FormDestroy(Sender: TObject);
begin
with TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'config.ini') do try
WriteString('ComboBoxFilter', 'Items.Text', EncodeString(ComboBoxFilter.Items.Text));
WriteString('ComboBoxFilter', 'Text', ComboBoxFilter.Text);
WriteString('ComboBoxSearch', 'Items.Text', EncodeString(ComboBoxSearch.Items.Text));
WriteString('FormScanFiles', 'SearchText', EncodeString(FSearchText));
WriteInteger('TabControlSearch', 'TabIndex', TabControlSearch.TabIndex);
WriteString('ComboBoxDirectory', 'Text', ComboBoxDirectory.Text);
WriteString('ComboBoxDirectory', 'Items.Text', EncodeString(ComboBoxDirectory.Items.Text));
WriteBool('CheckBoxClearLastResult', 'Checked', CheckBoxClearLastResult.Checked);
WriteBool('CheckBoxIgnoreCase', 'Checked', CheckBoxIgnoreCase.Checked);
finally
Free;
end;
if Assigned(FSearchResults) then FSearchResults.Free;
end;

procedure TFormScanFiles.MenuItemSearchSelectionClick(Sender: TObject);
var
I, J: Integer;
vFileStream: TFileStream;
begin
with ComboBoxSearch do if FSearchText <> '' then begin
I := Items.IndexOf(StringToDisplay(FSearchText));
if I < 0 then
Items.Insert(0, StringToDisplay(FSearchText))
else begin
Items.Move(I, 0);
TabControlSearchChange(TabControlSearch);
end;
end;

FSearchResults.Clear;
for J := 0 to ListViewResults.Items.Count - 1 do
with ListViewResults.Items[J] do begin
if not Selected then Continue;
vFileStream :=
TFileStream.Create(SubItems[0] + '\' + Caption, fmShareDenyNone);
try
I := ScanStream(vFileStream, FSearchText, CheckBoxIgnoreCase.Checked);
if I >= 0 then FSearchResults.Add(SubItems[0] + '\' + Caption);
finally
vFileStream.Free;
end;
end;
ListViewResults.Refresh;
ListViewResults.Selected := nil;
end;

procedure TFormScanFiles.MenuItemSelectAllClick(Sender: TObject);
begin
ListViewResults.SelectAll;
end;

procedure TFormScanFiles.ListViewResultsCustomDrawItem(
Sender: TCustomListView; Item: TListItem; State: TCustomDrawState;
var DefaultDraw: Boolean);
begin
if FSearchResults.IndexOf(Item.SubItems[0] + '\' + Item.Caption) >= 0 then begin
Sender.Canvas.Font.Color := clRed;
Sender.Canvas.Brush.Color := clMoneyGreen;
end;
end;

procedure TFormScanFiles.MenuItemCopyFileNameClick(Sender: TObject);
var
J: Integer;
S: string;
begin
S := '';
for J := 0 to ListViewResults.Items.Count - 1 do begin
with ListViewResults.Items[J] do begin
if not Selected then Continue;
S := S + #13#10 + SubItems[0] + '\' + Caption;
end;
end;
Delete(S, 1, 2);
if S <> '' then Clipboard.AsText := S;
end;

procedure TFormScanFiles.ListViewResultsDblClick(Sender: TObject);
begin
if Assigned(ListViewResults.ItemFocused) then
with ListViewResults.ItemFocused do
ShellExecute(Handle, nil,
PChar(SubItems[0] + '\' + Caption), nil, nil, SW_SHOW);
end;

procedure TFormScanFiles.ComboBoxSearchSelect(Sender: TObject);
begin
if TComboBox(Sender).ItemIndex < 0 then Exit;
FSearchText :=
DisplayToString(TComboBox(Sender).Items[TComboBox(Sender).ItemIndex]);

PostMessage(Handle, WM_TABCONTROLSEARCHCHANGE, 0, 0);
end;

procedure TFormScanFiles.WMTABCONTROLSEARCHCHANGE(var Msg: TMessage);
begin
TabControlSearchChange(TabControlSearch);
end;

procedure TFormScanFiles.ComboBoxFilterChange(Sender: TObject);
begin
BitBtnSearch.Enabled := ComboBoxFilter.Text <> '';
end;

procedure TFormScanFiles.SpeedButtonDirectoryClick(Sender: TObject);
var
vDirectory: string;
begin
vDirectory := ComboBoxDirectory.Text;
if not SelectDirectory('恁寁繚噤', '', vDirectory) then Exit;
ComboBoxDirectory.Text := vDirectory;
end;

end.

[飞天揽月]

当成文本，读出查找，