Commit: 263 - dzlargetextview (svn) - dzLargeTextViewer

R/O
SSH
HTTPS

dzlargetextview: Commit

Commit MetaInfo

Revision	263 (tree)
Zeit	2016-05-30 00:51:05
Autor	twm

Log Message

* No longer uses a TInt64List but a Tint64ListFile which is stored in a file. Can now fully index and display the 48 gig dump of Wikipedia containing roughly 790 million lines.
* updated manifest for Windows 10

Ändern Zusammenfassung

modified: trunk/src/dzLargeTextViewer.dpr (diff)
modified: trunk/src/dzLargeTextViewer.dproj (diff)
modified: trunk/src/dzLargeTextViewer.manifest.in (diff)
modified: trunk/src/dzLargeTextViewer_version.ini (diff)
modified: trunk/src/u_Int64List.pas (diff)
added: trunk/src/u_Int64ListFile.pas (diff)
added: trunk/src/u_LargeTextAccess.pas (diff)
modified: trunk/src/u_TextFileIndexer.pas (diff)
modified: trunk/src/w_LargeTextViewer.dfm (diff)
modified: trunk/src/w_LargeTextViewer.pas (diff)
modified: trunk/src/w_Search.dfm (diff)
modified: trunk/src/w_Search.pas (diff)

Diff

--- trunk/src/dzLargeTextViewer.dpr (revision 262)

+++ trunk/src/dzLargeTextViewer.dpr (revision 263)

		@@ -7,14 +7,19 @@
7	7	u_Int64List in 'u_Int64List.pas',
8	8	w_GotoLine in 'w_GotoLine.pas' {f_GotoLine},
9	9	w_Search in 'w_Search.pas' {f_Search},
10		- JclUnicode in '..\libs\jcl\source\common\JclUnicode.pas';
	10	+ JclUnicode in '..\libs\jcl\source\common\JclUnicode.pas',
	11	+ u_LargeTextAccess in 'u_LargeTextAccess.pas',
	12	+ u_Int64ListFile in 'u_Int64ListFile.pas';
11	13
12	14	{$R *_version.res}
13	15	{$R *_icon.res}
14	16
	17	+var
	18	+ f_Search: Tf_Search;
15	19	begin
16	20	Application.Initialize;
17	21	Application.MainFormOnTaskbar := True;
	22	+// Application.CreateForm(Tf_Search, f_Search);
18	23	Application.CreateForm(Tf_LargeTextViewer, f_LargeTextViewer);
19	24	Application.Run;
20	25	end.

--- trunk/src/dzLargeTextViewer.dproj (revision 262)

+++ trunk/src/dzLargeTextViewer.dproj (revision 263)

		@@ -103,6 +103,278 @@
103	103
104	104
105	105
	106	+
	107	+
	108	+
	109	+
	110	+
	111	+
	112	+
	113	+
	114	+
	115	+
	116	+
	117	+
	118	+
	119	+
	120	+
	121	+
	122	+
	123	+
	124	+
	125	+
	126	+
	127	+
	128	+
	129	+
	130	+
	131	+
	132	+
	133	+
	134	+
	135	+
	136	+
	137	+
	138	+
	139	+
	140	+
	141	+
	142	+
	143	+
	144	+
	145	+
	146	+
	147	+
	148	+
	149	+
	150	+
	151	+
	152	+
	153	+
	154	+
	155	+
	156	+
	157	+
	158	+
	159	+
	160	+
	161	+
	162	+
	163	+
	164	+
	165	+
	166	+
	167	+
	168	+
	169	+
	170	+
	171	+
	172	+
	173	+
	174	+
	175	+
	176	+
	177	+
	178	+
	179	+
	180	+
	181	+
	182	+
	183	+
	184	+
	185	+
	186	+
	187	+
	188	+
	189	+
	190	+
	191	+
	192	+
	193	+
	194	+
	195	+
	196	+
	197	+
	198	+
	199	+
	200	+
	201	+
	202	+
	203	+
	204	+
	205	+
	206	+
	207	+
	208	+
	209	+
	210	+
	211	+
	212	+
	213	+
	214	+
	215	+
	216	+
	217	+
	218	+
	219	+
	220	+
	221	+
	222	+
	223	+
	224	+
	225	+
	226	+
	227	+
	228	+
	229	+
	230	+
	231	+
	232	+
	233	+
	234	+
	235	+
	236	+
	237	+
	238	+
	239	+
	240	+
	241	+
	242	+
	243	+
	244	+
	245	+
	246	+
	247	+
	248	+
	249	+
	250	+
	251	+
	252	+
	253	+
	254	+
	255	+
	256	+
	257	+
	258	+
	259	+
	260	+
	261	+
	262	+
	263	+
	264	+
	265	+
	266	+
	267	+
	268	+
	269	+
	270	+
	271	+
	272	+
	273	+
	274	+
	275	+
	276	+
	277	+
	278	+
	279	+
	280	+
	281	+
	282	+
	283	+
	284	+
	285	+
	286	+
	287	+
	288	+
	289	+
	290	+
	291	+
	292	+
	293	+
	294	+
	295	+
	296	+
	297	+
	298	+
	299	+
	300	+
	301	+
	302	+
	303	+
	304	+
	305	+
	306	+
	307	+
	308	+
	309	+
	310	+
	311	+
	312	+
	313	+
	314	+
	315	+
	316	+
	317	+
	318	+
	319	+
	320	+
	321	+
	322	+
	323	+
	324	+
	325	+
	326	+
	327	+
	328	+
	329	+
	330	+
	331	+
	332	+
	333	+
	334	+
	335	+
	336	+
	337	+
	338	+
	339	+
	340	+
	341	+
	342	+
	343	+
	344	+
	345	+
	346	+
	347	+
	348	+
	349	+
	350	+
	351	+
	352	+
	353	+
	354	+
	355	+
	356	+
	357	+
	358	+
	359	+
	360	+
	361	+
	362	+
	363	+
	364	+
	365	+
	366	+
	367	+
	368	+
	369	+
	370	+
	371	+
	372	+
	373	+
	374	+
	375	+
	376	+
	377	+
106	378	<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
107	379	<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
108	380	<Excluded_Packages Name="$(BDS)\bin\bcbie100.bpl">File c:\program files (x86)\codegear\rad studio\5.0\bin\bcbie100.bpl not found</Excluded_Packages>

		@@ -133,6 +405,8 @@
133	405	</DelphiCompile>
134	406	<DCCReference Include="..\libs\jcl\source\common\JclUnicode.pas" />
135	407	<DCCReference Include="u_Int64List.pas" />
	408	+ <DCCReference Include="u_Int64ListFile.pas" />
	409	+ <DCCReference Include="u_LargeTextAccess.pas" />
136	410	<DCCReference Include="u_TextFileIndexer.pas" />
137	411	<DCCReference Include="w_GotoLine.pas">
138	412	<Form>f_GotoLine</Form>

--- trunk/src/dzLargeTextViewer.manifest.in (revision 262)

+++ trunk/src/dzLargeTextViewer.manifest.in (revision 263)

		@@ -33,6 +33,8 @@
33	33	<supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
34	34	<!-- We support Windows 8.1 -->
35	35	<supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
	36	+ <!-- We support Windows 10 -->
	37	+ <supportedOS Id="{8e0f7a12-bfb3-4fe8-b9a5-48fd50a15a9a}"/>
36	38	</application>
37	39	</compatibility>
38	40

--- trunk/src/dzLargeTextViewer_version.ini (revision 262)

+++ trunk/src/dzLargeTextViewer_version.ini (revision 263)

		@@ -1,6 +1,6 @@
1	1	[Version Info]
2	2	AutoIncBuild=0
3		-Build=97
	3	+Build=190
4	4	MajorVer=1
5	5	MinorVer=0
6	6	Release=0

		@@ -7,7 +7,7 @@
7	7	Revision=0
8	8
9	9	[Version Info Keys]
10		-FileVersion=1.0.0.97
	10	+FileVersion=1.0.0.190
11	11	ProductVersion={today}
12	12	FileDescription=Viewer for large text files
13	13	OriginalFilename=dzLargeTextViewer.exe

--- trunk/src/u_Int64List.pas (revision 262)

+++ trunk/src/u_Int64List.pas (revision 263)

		@@ -14,12 +14,13 @@
14	14	FCapacity: integer;
15	15	FCount: integer;
16	16	procedure Grow;
17		- procedure SetCapacity(_NewCapacity: Integer);
	17	+ procedure SetCapacity(_NewCapacity: integer);
18	18	function GetItems(_Idx: integer): Int64;
19	19	procedure SetItems(_Idx: integer; const Value: Int64);
20	20	public
21	21	function Add(_Value: Int64): integer;
22	22	property Items[_Idx: integer]: Int64 read GetItems write SetItems;
	23	+ property Capacity: integer read FCapacity write SetCapacity;
23	24	property Count: integer read FCount;
24	25	end;
25	26

		@@ -41,7 +42,7 @@
41	42
42	43	procedure TInt64List.Grow;
43	44	var
44		- Delta: Integer;
	45	+ Delta: integer;
45	46	begin
46	47	if FCapacity > 64 then
47	48	Delta := FCapacity div 4

		@@ -52,7 +53,7 @@
52	53	SetCapacity(FCapacity + Delta);
53	54	end;
54	55
55		-procedure TInt64List.SetCapacity(_NewCapacity: Integer);
	56	+procedure TInt64List.SetCapacity(_NewCapacity: integer);
56	57	begin
57	58	if (_NewCapacity < FCount) or (_NewCapacity > MaxListSize) then
58	59	raise Exception.CreateFmt(_('List capacity out of bounds (%d)'), [_NewCapacity]);

		@@ -75,4 +76,3 @@
75	76	end;
76	77
77	78	end.
78		-

--- trunk/src/u_Int64ListFile.pas (nonexistent)

+++ trunk/src/u_Int64ListFile.pas (revision 263)

		@@ -0,0 +1,96 @@
	1	+unit u_Int64ListFile;
	2	+
	3	+interface
	4	+
	5	+uses
	6	+ Windows,
	7	+ SysUtils,
	8	+ Classes,
	9	+ u_dzTranslator,
	10	+ u_dzFileStreams,
	11	+ u_dzFileUtils;
	12	+
	13	+type
	14	+ TInt64ListFile = class
	15	+ private
	16	+ FTempDir: IUniqueTempDir;
	17	+ FBuffer: array[0..1023] of Int64;
	18	+ FOffset: Int64;
	19	+ FCount: Int64;
	20	+ FTempFile: TdzFile;
	21	+ function GetItems(_Idx: Int64): Int64;
	22	+ procedure SetItems(_Idx: Int64; const Value: Int64);
	23	+ procedure AssureBufferFor(_Idx: integer);
	24	+ public
	25	+ constructor Create(_fn: string = '');
	26	+ destructor Destroy; override;
	27	+ function Add(_Value: Int64): Int64;
	28	+ property Items[_Idx: Int64]: Int64 read GetItems write SetItems;
	29	+ property Count: Int64 read FCount;
	30	+ end;
	31	+
	32	+implementation
	33	+
	34	+uses
	35	+ RTLConsts;
	36	+
	37	+{ TInt64ListFile }
	38	+
	39	+constructor TInt64ListFile.Create(_fn: string);
	40	+begin
	41	+ inherited Create;
	42	+ if _fn = '' then begin
	43	+ FTempDir := TFileSystem.CreateUniqueTempDir();
	44	+ _fn := FTempDir.PathBS + 'index.dat';
	45	+ end;
	46	+ FTempFile := TdzFile.Create(_fn);
	47	+ FTempFile.AccessMode := faReadWrite;
	48	+ FTempFile.ShareMode := fsNoSharing;
	49	+ FTempFile.CreateDisposition := fcCreateFailIfExists;
	50	+ FTempFile.Open;
	51	+ ZeroMemory(@FBuffer, SizeOf(FBuffer));
	52	+ FOffset := 0;
	53	+end;
	54	+
	55	+destructor TInt64ListFile.Destroy;
	56	+begin
	57	+ FreeAndNil(FTempFile);
	58	+ inherited;
	59	+end;
	60	+
	61	+function TInt64ListFile.Add(_Value: Int64): Int64;
	62	+begin
	63	+ Result := FCount;
	64	+ AssureBufferFor(Result);
	65	+ FBuffer[Result - FOffset] := _Value;
	66	+ Inc(FCount);
	67	+end;
	68	+
	69	+procedure TInt64ListFile.AssureBufferFor(_Idx: integer);
	70	+begin
	71	+ if (_Idx < FOffset) or (_Idx >= FOffset + Length(FBuffer)) then begin
	72	+ FTempFile.Position := FOffset * SizeOf(Int64);
	73	+ FTempFile.WriteBuffer(FBuffer, SizeOf(FBuffer));
	74	+ FOffset := (_Idx div Length(FBuffer)) * Length(FBuffer);
	75	+ if FOffset * SizeOf(Int64) < FTempFile.Size then begin
	76	+ FTempFile.Position := FOffset * SizeOf(Int64);
	77	+ FTempFile.ReadBuffer(FBuffer, SizeOf(FBuffer));
	78	+ end else
	79	+ ZeroMemory(@FBuffer, SizeOf(FBuffer));
	80	+ end;
	81	+end;
	82	+
	83	+function TInt64ListFile.GetItems(_Idx: Int64): Int64;
	84	+begin
	85	+ if (_Idx < 0) or (_Idx >= FCount) then
	86	+ raise Exception.CreateFmt(_('List index out of bounds (%d)'), [_Idx]);
	87	+ AssureBufferFor(_Idx);
	88	+ Result := FBuffer[_Idx - FOffset];
	89	+end;
	90	+
	91	+procedure TInt64ListFile.SetItems(_Idx: Int64; const Value: Int64);
	92	+begin
	93	+
	94	+end;
	95	+
	96	+end.

--- trunk/src/u_LargeTextAccess.pas (nonexistent)

+++ trunk/src/u_LargeTextAccess.pas (revision 263)

		@@ -0,0 +1,82 @@
	1	+unit u_LargeTextAccess;
	2	+
	3	+interface
	4	+
	5	+uses
	6	+ SysUtils,
	7	+ Classes,
	8	+ u_dzFileStreams;
	9	+
	10	+type
	11	+ TLargeTextAccess = class
	12	+ public
	13	+ type
	14	+ TOptimizeForEnum = (ofForward, ofBackward, ofBoth);
	15	+ private
	16	+ const
	17	+ BUFFER_SIZE = 1024 * 128;
	18	+ var
	19	+ FOptimizeFor: TOptimizeForEnum;
	20	+ FFilename: string;
	21	+ FStream: TdzFile;
	22	+ FLength: Int64;
	23	+ FOffset: Int64;
	24	+ FBuffer: array[0..BUFFER_SIZE - 1] of char;
	25	+ public
	26	+ constructor Create(const _fn: string; _OptimizeFor: TOptimizeForEnum = ofBoth);
	27	+ destructor Destroy; override;
	28	+ function GetChar(_Idx: Int64): char;
	29	+ function GetLength: Int64;
	30	+ end;
	31	+
	32	+implementation
	33	+
	34	+{ TLargeTextAccess }
	35	+
	36	+constructor TLargeTextAccess.Create(const _fn: string; _OptimizeFor: TOptimizeForEnum = ofBoth);
	37	+begin
	38	+ inherited Create;
	39	+ FFilename := _fn;
	40	+ FOptimizeFor := _OptimizeFor;
	41	+ FStream := TdzFile.Create(FFilename);
	42	+ FStream.OpenReadonly;
	43	+ FLength := FStream.Size;
	44	+ FOffset := -BUFFER_SIZE;
	45	+end;
	46	+
	47	+destructor TLargeTextAccess.Destroy;
	48	+begin
	49	+ FreeAndNil(FStream);
	50	+ inherited;
	51	+end;
	52	+
	53	+function TLargeTextAccess.GetChar(_Idx: Int64): char;
	54	+begin
	55	+ if (_Idx < 0) or (_Idx >= FLength) then
	56	+ raise Exception.CreateFmt('Index %d out of range.', [_Idx]);
	57	+
	58	+ if (_Idx < FOffset) or (_Idx >= FOffset + BUFFER_SIZE) then begin
	59	+ case FOptimizeFor of
	60	+ ofForward:
	61	+ FOffset := _Idx;
	62	+ ofBackward:
	63	+ FOffset := _Idx - BUFFER_SIZE + 1;
	64	+ else // ofBoth
	65	+ FOffset := _Idx - BUFFER_SIZE div 2 + 1;
	66	+ end;
	67	+ if FOffset < 0 then
	68	+ FOffset := 0;
	69	+ if FOffset >= FLength then
	70	+ FOffset := FLength - 1;
	71	+ FStream.Position := FOffset;
	72	+ FStream.Read(FBuffer, BUFFER_SIZE);
	73	+ end;
	74	+ Result := FBuffer[_Idx - FOffset]
	75	+end;
	76	+
	77	+function TLargeTextAccess.GetLength: Int64;
	78	+begin
	79	+ Result := FLength;
	80	+end;
	81	+
	82	+end.

--- trunk/src/u_TextFileIndexer.pas (revision 262)

+++ trunk/src/u_TextFileIndexer.pas (revision 263)

		@@ -6,16 +6,21 @@
6	6	SysUtils,
7	7	Classes,
8	8	u_Int64List,
9		- u_dzCriticalSection;
	9	+ u_Int64ListFile,
	10	+ u_dzCriticalSection,
	11	+ u_LargeTextAccess;
10	12
11	13	type
12	14	TTextFileIndexer = class
13	15	private
	16	+ type
	17	+ TLineIndexes = TInt64ListFile;
	18	+ private
14	19	FCritSect: TdzCriticalSection;
15		- FLineIndexes: TInt64List;
	20	+ FLineIndexes: TLineIndexes;
16	21	FIsDone: boolean;
17	22	FFilename: string;
18		- FAbortRequested: Boolean;
	23	+ FAbortRequested: boolean;
19	24	function GetLineIndex(_Idx: integer): Int64;
20	25	function GetLineIndexCount: integer;
21	26	public

		@@ -31,6 +36,7 @@
31	36	implementation
32	37
33	38	uses
	39	+ u_dzConvertUtils,
34	40	u_dzFileStreams;
35	41
36	42	{ TTextFileIndexer }

		@@ -38,7 +44,8 @@
38	44	constructor TTextFileIndexer.Create(const _Filename: string);
39	45	begin
40	46	inherited Create;
41		- FLineIndexes := TInt64List.Create;
	47	+ FLineIndexes := TLineIndexes.Create;
	48	+// FLineIndexes.Capacity := MaxListSize; // OneGibiByte div SizeOf(Int64);
42	49	FFilename := _Filename;
43	50	FCritSect := TdzCriticalSection.Create;
44	51	end;

		@@ -51,43 +58,37 @@
51	58	end;
52	59
53	60	procedure TTextFileIndexer.Execute;
54		-const
55		- BUFFER_SIZE = 1024 * 128;
	61	+
	62	+ procedure AddIdx(_Idx: Int64);
	63	+ begin
	64	+ FCritSect.Enter;
	65	+ try
	66	+ FLineIndexes.Add(_Idx);
	67	+ finally
	68	+ FCritSect.Leave;
	69	+ end;
	70	+ end;
	71	+
56	72	var
57		- st: TdzFile;
58		- buffer: array[0..BUFFER_SIZE - 1] of char;
59		- Offset: Int64;
60		- BytesRead: Integer;
61		- i: Integer;
	73	+ i: Int64;
	74	+ lta: TLargeTextAccess;
62	75	begin
63	76	FAbortRequested := False;
64	77	FIsDone := False;
65		- st := TdzFile.Create(FFilename);
	78	+ lta := TLargeTextAccess.Create(FFilename, ofForward);
66	79	try
67		- st.OpenReadonly;
68		- FCritSect.Enter;
69		- try
70		- FLineIndexes.Add(0);
71		- finally
72		- FCritSect.Leave;
73		- end;
74		- while not st.EOF do begin
75		- Offset := st.Position;
76		- BytesRead := st.Read(Buffer, SizeOf(Buffer));
77		- for i := 0 to BytesRead - 1 do
78		- if buffer[i] = #10 then begin
79		- FCritSect.Enter;
80		- try
81		- FLineIndexes.Add(Offset + i + 1);
82		- finally
83		- FCritSect.Leave;
84		- end;
85		- end;
	80	+ AddIdx(0);
	81	+ i := 0;
	82	+ while i < lta.GetLength do begin
	83	+ if lta.GetChar(i) = #10 then begin
	84	+ AddIdx(i + 1);
	85	+ end;
	86	+ Inc(i);
86	87	if FAbortRequested then
87	88	SysUtils.Abort;
88	89	end;
89	90	finally
90		- FreeAndNil(st);
	91	+ FreeAndNil(lta);
91	92	end;
92	93	FIsDone := true;
93	94	end;

		@@ -118,4 +119,3 @@
118	119	end;
119	120
120	121	end.
121		-

--- trunk/src/w_LargeTextViewer.pas (revision 262)

+++ trunk/src/w_LargeTextViewer.pas (revision 263)

		@@ -13,15 +13,15 @@
13	13	Forms,
14	14	Dialogs,
15	15	Grids,
	16	+ ExtCtrls,
	17	+ ComCtrls,
	18	+ Menus,
	19	+ ActnList,
16	20	c_dzVirtualStringGrid,
17	21	u_dzTranslator,
18	22	u_TextFileIndexer,
19	23	u_dzNamedThread,
20		- u_dzFileStreams,
21		- ExtCtrls,
22		- ComCtrls,
23		- Menus,
24		- ActnList;
	24	+ u_dzFileStreams;
25	25
26	26	type
27	27	TIndexerThread = class(TNamedThread)

		@@ -127,6 +127,7 @@
127	127	if Assigned(FIndexer) then
128	128	FIndexer.Abort;
129	129	FreeAndNil(FIndexThread);
	130	+ FreeAndNil(FIndexer);
130	131	inherited;
131	132	end;
132	133

		@@ -144,7 +145,7 @@
144	145
145	146	procedure Tf_LargeTextViewer.UpdateCurrentLineNo;
146	147	begin
147		- TheStatusBar.Panels[1].Text := Format(_('Current line: %d'), [sg_Display.Row + sg_Display.FixedRows + 1]);
	148	+ TheStatusBar.Panels[1].Text := Format(_('Current line: %s'), [FormatFloat('#,###,###,###,###,##0', sg_Display.Row + sg_Display.FixedRows + 1)]);
148	149	end;
149	150
150	151	procedure Tf_LargeTextViewer.act_LineCopyExecute(Sender: TObject);

		@@ -221,7 +222,7 @@
221	222	_State: TGridDrawState; var _Text: string; var _HAlign: TAlignment; var _VAlign: TdzCellVertAlign;
222	223	_Font: TFont; var _Color: TColor);
223	224	begin
224		- _Text := IntToStr(_Row - (_Sender as TdzVirtualStringGrid).FixedRows + 1);
	225	+ _Text := FormatFloat('#,###,###,###,###,##0', _Row - (_Sender as TdzVirtualStringGrid).FixedRows + 1);
225	226	_HAlign := taRightJustify;
226	227	end;
227	228

		@@ -244,9 +245,9 @@
244	245	sg_Display.RowCount := LineCount;
245	246	if FIndexer.isDone then begin
246	247	tim_Update.Enabled := False;
247		- TheStatusBar.Panels[0].Text := Format(_('Total lines: %d'), [LineCount]);
	248	+ TheStatusBar.Panels[0].Text := Format(_('Total lines: %s'), [FormatFloat('#,###,###,###,###,##0', LineCount)]);
248	249	end else
249		- TheStatusBar.Panels[0].Text := Format(_('Indexing (%d lines)'), [LineCount]);
	250	+ TheStatusBar.Panels[0].Text := Format(_('Indexing (%s lines)'), [FormatFloat('#,###,###,###,###,##0', LineCount)]);
250	251	end;
251	252
252	253	end.

--- trunk/src/w_Search.pas (revision 262)

+++ trunk/src/w_Search.pas (revision 263)

		@@ -38,58 +38,119 @@
38	38
39	39	uses
40	40	StrUtils,
41		- JclUnicode,
42	41	u_dzVclUtils;
43	42
44		-///<summary>
45		-/// This is the Boyer-Moore-Horspool text searching algorithm taken from
46		-/// http://users.dcc.uchile.cl/~rbaeza/handbook/algs/7/713b.srch.p.html
47		-/// Modified to work with characters > chr(127) (It does not support unicode though.)
48		-/// and take an offset where to start.
49		-/// Also, it uses Exit rather than a boolean variable to terminate the while loop.
50		-/// @param Pattern is the string to search for
51		-/// @param Text is the string to search in </summary
	43	+type
	44	+ ITextBuffer = interface ['{8B4A019A-99CA-4E86-864D-D1E9E6020648}']
	45	+ function GetChar(_Idx: Int64): Char;
	46	+ function GetString(_Idx: Int64; _Len: integer): string;
	47	+ function GetLength: Int64;
	48	+ end;
52	49
53		-function BMHSearch(_Pattern: string; _Text: string; _Offset: Integer = 0): Integer;
54		-const
55		- MaxChar = Ord(High(Char));
56		-var
57		- i: Integer;
58		- PatternLen, TextLen: Integer;
59		- PatternIdx, TextIdx: Integer;
60		- skip: array of Integer;
	50	+//type
	51	+// TTextBuffer = class
	52	+// private
	53	+// function GetChar(_Idx: Int64): char;
	54	+// function GetLength: Int64;
	55	+// public
	56	+// constructor Create(const _fn: string);
	57	+// destructor Destroy;
	58	+// end;
	59	+
	60	+type
	61	+ TStringBuffer = class(TInterfacedObject, ITextBuffer)
	62	+ private
	63	+ FText: string;
	64	+ function GetChar(_Idx: Int64): Char;
	65	+ function GetString(_Idx: Int64; _Len: integer): string;
	66	+ function GetLength: Int64;
	67	+ public
	68	+ constructor Create(const _Text: string);
	69	+ end;
	70	+
	71	+{ TStringBuffer }
	72	+
	73	+constructor TStringBuffer.Create(const _Text: string);
61	74	begin
62		- PatternLen := Length(_Pattern);
63		- if PatternLen = 0 then begin
64		- Result := 1;
65		- Exit; //=>
	75	+ inherited Create;
	76	+ FText := _Text;
	77	+end;
	78	+
	79	+function TStringBuffer.GetChar(_Idx: Int64): Char;
	80	+begin
	81	+ Result := FText[_Idx];
	82	+end;
	83	+
	84	+function TStringBuffer.GetLength: Int64;
	85	+begin
	86	+ Result := Length(FText);
	87	+end;
	88	+
	89	+function TStringBuffer.GetString(_Idx: Int64; _Len: integer): string;
	90	+begin
	91	+ Result := Copy(FText, _Idx, _Len);
	92	+end;
	93	+
	94	+type
	95	+ TBMSearch = class
	96	+ private
	97	+ FSkip: array of integer;
	98	+ FPatternLen: integer;
	99	+ FPattern: string;
	100	+ public
	101	+ constructor Create(const _Pattern: string);
	102	+ function Find(_Text: ITextBuffer; var _Offset: Int64): Boolean;
66	103	end;
67	104
68		- Result := 0;
	105	+{ TBMSearch }
69	106
70		- SetLength(skip, MaxChar);
71		- for i := 0 to MaxChar do
72		- skip[i] := PatternLen; {* Preprocessing *}
73		- for i := 1 to PatternLen - 1 do
74		- skip[Ord(_Pattern[i])] := PatternLen - i;
	107	+constructor TBMSearch.Create(const _Pattern: string);
	108	+var
	109	+ i: integer;
	110	+begin
	111	+ FPattern := _Pattern;
	112	+ FPatternLen := Length(_Pattern);
	113	+ if FPatternLen = 0 then
	114	+ Exit;
75	115
76		- i := PatternLen + _Offset;
77		- TextLen := Length(_Text); {* Search *}
78		- while i <= TextLen do begin
	116	+ SetLength(FSkip, integer(High(Char)) + 1);
	117	+ for i := Low(FSkip) to High(FSkip) do
	118	+ FSkip[i] := FPatternLen;
	119	+ for i := 1 to FPatternLen - 1 do
	120	+ FSkip[integer(_Pattern[i])] := FPatternLen - i;
	121	+end;
	122	+
	123	+function TBMSearch.Find(_Text: ITextBuffer; var _Offset: Int64): Boolean;
	124	+var
	125	+ i: Int64;
	126	+ TextLen: Int64;
	127	+ TextIdx: Int64;
	128	+ PatternIdx: integer;
	129	+ s: string;
	130	+begin
	131	+ Result := False;
	132	+ if FPatternLen = 0 then
	133	+ Exit;
	134	+
	135	+ i := FPatternLen + (_Offset);
	136	+ TextLen := _Text.GetLength;
	137	+ while (not Result) and (i <= TextLen) do begin
79	138	TextIdx := i;
80		- PatternIdx := PatternLen;
81		- while (PatternIdx >= 1) do
82		- if _Text[TextIdx] <> _Pattern[PatternIdx] then
83		- PatternIdx := -1
84		- else begin
	139	+ PatternIdx := FPatternLen;
	140	+ while (PatternIdx >= 1) do begin
	141	+ if _Text.GetChar(TextIdx) = FPattern[PatternIdx] then begin
85	142	PatternIdx := PatternIdx - 1;
86	143	TextIdx := TextIdx - 1;
	144	+ end else
	145	+ PatternIdx := -1;
	146	+ if PatternIdx = 0 then begin
	147	+ _Offset := TextIdx;
	148	+ s := _Text.GetString(_Offset, FPatternLen);
	149	+ Result := True;
	150	+ Exit;
87	151	end;
88		- if PatternIdx = 0 then begin
89		- Result := TextIdx + 1;
90		- Exit; //=>
	152	+ i := i + FSkip[integer(_Text.GetChar(i))];
91	153	end;
92		- i := i + skip[Ord(_Text[i])];
93	154	end;
94	155	end;
95	156

		@@ -128,23 +189,17 @@
128	189	procedure Tf_Search.b_FindClick(Sender: TObject);
129	190	var
130	191	Pattern: string;
131		- Search: TUTBMSearch;
132		- Offset: Integer;
133		- Start: Integer;
134		- Stop: Integer;
135		- Text: WideString;
136		- StartP: PWideChar;
	192	+ Search: TBMSearch;
	193	+ Offset: Int64;
	194	+ Text: ITextBuffer;
137	195	begin
138	196	Pattern := ed_Pattern.Text;
139		- Search := TUTBMSearch.Create(nil);
	197	+ Search := TBMSearch.Create(Pattern);
140	198	try
141		- Search.FindPrepare(Pattern, [sfWholeWordOnly]);
142		- Offset := m_Text.SelStart + m_Text.SelLength;
143		- Text := m_Text.Lines.Text;
144		- StartP := @Text[1];
145		- Inc(StartP, Offset);
146		- if Search.FindFirst(StartP, Start, Stop) then begin
147		- m_Text.SelStart := Start + Offset;
	199	+ Offset := m_Text.SelStart + m_Text.SelLength + 1;
	200	+ Text := TStringBuffer.Create(m_Text.Lines.Text);
	201	+ if Search.Find(Text, Offset) then begin
	202	+ m_Text.SelStart := Offset;
148	203	m_Text.SelLength := Length(Pattern);
149	204	end;
150	205	finally

		@@ -157,4 +212,3 @@
157	212	end;
158	213
159	214	end.
160		-

Show on old repository browser