Memo 與 RichEdit 的不分大小寫大量搜尋取代 |
|
答題得分者是：jest0024
|
|
pcboy
版主   發表：177 回覆：1838 積分：1463 註冊：2004-01-13 發送簡訊給我 |
如果要做搜尋並取代, 大家有什麼好建議, 作法如何 ? </br>
(1) 搜尋某目錄下所有檔案(含子目錄), 檔案可能有上萬個 (用 UltraEdit 同時開啟超過 300 個檔案非常慢 , 500 個好像快當了) (2) 不分大小寫, 搜尋取代 (3) 開啟的檔案一定是純文字 (4) 大家建議用 Memo 或 RichEdit ? 或其他建議 ? (5) 處理純文字 Memo 會比較快 (因為都是純文字檔案) ? 但是 RichEdit 的 FindText 方法 Memo 沒有, 有替換方案嗎? (6) Memo 對檔案大小是否有限制 ? 或其他限制 ? RichEdit 的搜尋取代作法如下 (不分大小寫還在思考如何改) (Memo 的搜尋取代作法還在思考如何改, 不分大小寫也在思考如何改) <textarea class="delphi" rows="10" cols="60" name="code">// Delphi 7 Enterprise
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, FileCtrl, Grids,
ShellAPI, ComCtrls; type
TForm1 = class(TForm)
DirectoryListBox1: TDirectoryListBox;
DriveComboBox1: TDriveComboBox;
FileListBox1: TFileListBox;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
Button1: TButton;
ListBox1: TListBox;
ListBox2: TListBox;
Button2: TButton;
Button3: TButton;
Button4: TButton;
RichEdit1: TRichEdit;
Label4: TLabel;
Edit1: TEdit;
Button5: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject);
begin
DirectoryListBox1.Directory:='C:\'; Edit1.Text:= '*.asp';
Edit2.Clear;
Edit3.Clear; ListBox1.Clear;
ListBox2.Clear; RichEdit1.Clear;
RichEdit1.PlainText:=True; end; procedure TForm1.Button1Click(Sender: TObject);
var
i,X, ToEnd : integer;
Change: Boolean;
OldDir: String;
begin ListBox1.Clear;
ListBox2.Clear;
OldDir:=DirectoryListBox1.Directory;
ListBox2.AddItem(DirectoryListBox1.Directory , nil ); i:=0;
while i < ListBox2.Count do
begin
DirectoryListBox1.Directory:=ListBox2.Items[i];
Button4.Click;
i:=i 1;
// ListBox2.Items.Delete(0);
end; for i:=0 to ListBox2.Count-1 do
begin
DirectoryListBox1.Directory:=ListBox2.Items[i];
Button2.Click;
end; for i:=1 to ListBox1.Count-1 do
begin
RichEdit1.Lines.LoadFromFile(ListBox1.Items[i]);
Label1.Caption := '檔案名稱 : ' ListBox1.Items[i];
with RichEdit1 do
begin
X := 0;
ToEnd := length(Text) ;
X := FindText(Edit2.Text, X, ToEnd, []) ;
while X <> -1 do
begin
SetFocus;
SelStart := X;
SelLength := length(Edit2.Text);
SelText := Edit3.Text;
X := FindText(Edit2.Text,X length(Edit3.Text),ToEnd, []) ;
Change:=True;
end;
if Change then
RichEdit1.Lines.SaveToFile(ListBox1.Items[i]);
end;
end; DirectoryListBox1.Directory := OldDir;
ShowMessage('Find and Replace Finish !'); end; procedure TForm1.Button2Click(Sender: TObject);
var
sr: TSearchRec;
FileAttrs: Integer;
X, ToEnd : integer; begin
FileAttrs := faArchive;
if FindFirst(Edit1.Text, FileAttrs, sr) = 0 then
begin
repeat
if (sr.Attr and FileAttrs) = sr.Attr then
begin
ListBox1.AddItem(DirectoryListBox1.Directory '\' sr.Name, nil );
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end; procedure TForm1.Button3Click(Sender: TObject);
begin
ListBox1.Clear;
ListBox2.Clear;
end; procedure TForm1.Button4Click(Sender: TObject);
var
sr2: TSearchRec;
FileAttrs: Integer;
begin FileAttrs := faDirectory;
if FindFirst('*.*', FileAttrs, sr2) = 0 then
begin
repeat
if (sr2.Attr and FileAttrs) = sr2.Attr then
begin
if (sr2.Name<>'.') and (sr2.Name<>'..') then
begin
ListBox2.AddItem(DirectoryListBox1.Directory '\' sr2.Name, nil );
end;
end;
until FindNext(sr2) <> 0;
FindClose(sr2);
end;
end; procedure TForm1.Button5Click(Sender: TObject);
begin
Application.Terminate;
end; end.
</textarea>
發表人 - pcboy2 於 2005/06/23 18:04:25
------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！ 子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！ |
|
suda
一般會員   發表：17 回覆：63 積分：16 註冊：2002-05-10 發送簡訊給我 |
快的方法是使用兩個 stream 來做處理,參考一下,只要改用filestream 或LoadfromFile及savetofile就可以了,我想還有更快的方式吧!等其他高手發表吧!
procedure TForm1.Button1Click(Sender: TObject);
var
src: Tstringstream;
tar: Tstringstream;
c: char;
i: integer;
serachStr: string;
serachStrLength: integer;
replacestr: string;
replacestrLength: integer;
procedure readSrc;
begin
src.read(c, 1);
end;
begin
serachStr := 'abc';
serachStrLength := length(serachStr);
replacestr := 'def';
replacestrLength := length(replacestr);
// src:=tfilestream.create(Filename,fmOpenRead);
src := tstringstream.create('ababcdeftkgt');
tar := tstringstream.Create('');
i := 1;
while src.position < src.Size do
begin
readSrc;
if c = serachStr[i] then
begin
inc(i);
if i = serachStrLength 1 then
begin
tar.Write(replacestr[1], replacestrLength);
i := 1;
end;
end
else
begin //rollback
if i > 1 then
begin
src.Position := src.Position - i;
tar.CopyFrom(src, i - 1);
i := 1;
end
else
begin
tar.Write(c, 1);
end;
end;
end; // while
showmessage(format('src:%s tar:%s', [src.DataString, tar.DataString]));
end;
發表人 - suda 於 2005/06/23 20:20:49 發表人 - suda 於 2005/06/23 20:26:13
|
|
bruce0211
版主 發表：157 回覆：668 積分：279 註冊：2002-06-13 發送簡訊給我 |
|
|
pcboy
版主 發表：177 回覆：1838 積分：1463 註冊：2004-01-13 發送簡訊給我 |
感謝 bruce0211 兄嘗試改了, 因為沒安裝 BCB, 一些函數不清楚用途, 一些錯誤不知該如何改正確的 Delphi 語法 :
<textarea class="delphi" rows="10" cols="60" name="code">
TempStartPos := TempFoundAt FindText.Length -1;
MessageBox(0,message.c_str(),Application.Title.c_str(),MB_ICONINFORMATION MB_OK); //會有咚一聲
TempFoundAt := TempStartPos AllText.SubString(TempStartPos 1,StartPos-TempStartPos).Pos(FindText);
return;
FoundAt := StartPos AllText.SubString(StartPos 1,AllText.Length()-StartPos).Pos(FindText);
Memo1.SelLength := FindDialog1.FindText.Length;
FindDialog1.Options = FindDialog1.Options << frHideWholeWord; //關掉
</textarea>
------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！ 子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！ |
|
jest0024
高階會員 發表：11 回覆：310 積分：224 註冊：2002-11-24 發送簡訊給我 |
1.使用TMemoryStream
procedure FindTxt
var
Stream:TMemoryStream;
i :Integer;
s :String;
begin
Stream:=TMemoryStream.Create;
Stream.LoadFromFile(FileName);
i:=AnsiPos(Edit.Text,StrPas(Stream.Memory)); //<-使用AnsiPos代替FindText
S:=StringReplace(StrPas(List.Memory),Edit.Txt,NewText,[rfReplaceAll]);//<-或使用StringReplace來更換字串
if(S<>StrPas(List.Memory))then begin
List.WriteBuffer(PChar(s)^,List.Size);
List.SaveToFile(FileName);
end;
Stream.Free;
end; 2.使用TFileStream
procedure FindTxt
var
Stream:TFileStream;
i :Integer;
p :PChar;
begin
Stream:=TFileStream.Create(FileName,fmOpenRead);
GetMem(p,Stream.Size);
Stream.ReadBuffer(p^,Stream.Size); //<--分段載入搜尋，會得到更好的效益!!
i:=AnsiPos(Edit.Txt,StrPas(p)); //<--使用AnsiPos代替FindText
Stream.Free;
end;
發表人 - jest0024 於 2005/06/24 22:55:44
|
|
suda
一般會員 發表：17 回覆：63 積分：16 註冊：2002-05-10 發送簡訊給我 |
|
|
pcboy
版主 發表：177 回覆：1838 積分：1463 註冊：2004-01-13 發送簡訊給我 |
拼速度, suda 兄的建議不要用 UI 是好建議, 但是沒有處理大小寫比較, 逐字比較, 然後再 rollback 的作法感覺也有點奇怪, 好想比的太頻繁了
if c = serachStr[i] then 似乎要改成 if upcase(c) = upcase(serachStr[i]) then jest0024 兄的程式小弟有點看不懂 <textarea class="delphi" rows="10" cols="60" name="code"> Stream:=TMemoryStream.Create; // 建立 TMemoryStream 類別的物件 Stream
Stream.LoadFromFile(FileName); // 將檔案內容讀取放入 Stream
i:=AnsiPos(Edit.Text,StrPas(Stream.Memory)); //<-使用AnsiPos代替FindText , i 後來沒有用到 ???
S:=StringReplace(StrPas(List.Memory),Edit.Txt,NewText,[rfReplaceAll]);//<-或使用StringReplace來更換字串
// 突然蹦出的 List.Memory 是什麼 ? 是否是 Stream.Memory ?
// 不分大小寫該是 [rfReplaceAll, rfIgnoreCase]
if(S<>StrPas(List.Memory))then begin
List.WriteBuffer(PChar(s)^,List.Size);
List.SaveToFile(FileName);
end;
Stream.Free;</textarea>
簡潔的寫法似乎下面就可以達成
<textarea class="delphi" rows="10" cols="60" name="code">procedure TForm1.Button1Click(Sender: TObject); begin Memo1.Text:=StringReplace(Memo1.Text, 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]); end; </textarea>高速簡潔的寫法是否可以寫成 <textarea class="delphi" rows="10" cols="60" name="code">procedure TForm1.Button1Click(Sender: TObject); begin Stream:=TMemoryStream.Create; // 建立 TMemoryStream 類別的物件 Stream Stream.LoadFromFile(FileName); // 將檔案內容讀取放入 Stream Stream.Memory:=StringReplace(Stream.Memory, 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]); Stream.SaveToFile(FileName); end; </textarea>但是 Stream.Memory:=StringReplace(Stream.Memory, 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]); 有錯誤 [Error] Unit1.pas(36): Incompatible types: 'String' and 'Pointer' [Error] Unit1.pas(36): Cannot assign to a read-only property 因為需求, 某個版本的高速取代可以不限制用 UI 元件 (替換的是固定字串) 但是另一個版本程式, 必須用到 Memo 或 RichEdit (或其他文件編輯的 UI) 因為找到固定字串後, 使用者要手動編輯修改的內容不固定
------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！ 子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！ |
|
jest0024
高階會員 發表：11 回覆：310 積分：224 註冊：2002-11-24 發送簡訊給我 |
引言: 拼速度, suda 兄的建議不要用 UI 是好建議, 但是沒有處理大小寫比較, 逐字比較, 然後再 rollback 的作法感覺也有點奇怪, 好想比的太頻繁了 if c = serachStr[i] then 似乎要改成 if upcase(c) = upcase(serachStr[i]) then jest0024 兄的程式小弟有點看不懂[/code] 1. Stream.Memory:=StringReplace(Stream.Memory, 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]); //<-不要亂減掉源碼 var S:String; S:=StringReplace(StrPas(Stream.Memory), 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]); ... Stream.WriteBuffer(PCHar(S)^,...); 2.若是要指派Stream.Memory的值 var P:PByteArray; i:Integer; begin P:=Stream.Memory; for i:=0 to Stream.Size-1 do P[i]:=Ord('A'); ... 3.附註： Stream.Memory <-是指TMemoryStream分配出記憶指的指標所以 Stream.Memory:=StringReplace(... //<-這樣會造成錯誤，因為他指標不可以修已呀 [/code] 發表人 - jest0024 於 2005/06/28 16:46:23 |
|
pcboy
版主 發表：177 回覆：1838 積分：1463 註冊：2004-01-13 發送簡訊給我 |
成功了, THX
<textarea class="delphi" rows="10" cols="60" name="code">
procedure TForm1.Button1Click(Sender: TObject);
Var
Stream:TMemoryStream;
i :Integer;
s :String;
FileName : String;
begin
FileName:='C:\abc.txt';
Stream:=TMemoryStream.Create;
Stream.LoadFromFile(FileName);
// i:=AnsiPos(Edit1.Text,StrPas(Stream.Memory));
S:=StringReplace(StrPas(Stream.Memory), 'ABC', 'DEF', [rfReplaceAll, rfIgnoreCase]);
if(S<>StrPas(Stream.Memory))then begin
Stream.WriteBuffer(PCHar(S)^, Stream.Size);
Stream.SaveToFile(FileName);
end;
Stream.Free;
end; </textarea>
------
能力不足，求助於人；有能力時，幫幫別人；如果您滿意答覆，請適時結案！ 子曰：問有三種，不懂則問，雖懂有疑則問，雖懂而想知更多則問！ |
發表時間：2005-06-23 18:02:22
IP:203.204.xxx.xxx 未訂閱
系統時間：2024-07-02 10:52:24
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |