Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/MojuUtils.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.10.2.1 - (hide annotations) (download) (as text)
Tue May 17 13:39:53 2005 UTC (18 years, 11 months ago) by h677
Branch: remodeling
CVS Tags: v1_50_0_581, v1_50_0_580, v1_50_0_585, v1_50_0_582, v1_50_0_577, v1_50_0_584, v_step1, v1_50_0_576, v1_50_0_578, v1_50_0_579
Changes since 1.10: +128 -17 lines
File MIME type: text/x-pascal
(none)

1 h677 1.1 unit MojuUtils;
2 h677 1.3 //******************************************************************************
3 h677 1.5 // 文字列置換関数 CustomStringReplace
4 h677 1.3 // 使い方は、
5     // CustomStringReplace(
6     //  元の文字列(StringもしくはTStringList),
7     //  検索文字列(String),
8     // 置換文字列(String),
9     // 大文字小文字(Boolean)True:区別しない false or 省略:区別する
10     //
11     // Delphi-MLの記事69334に載っていたコードを丸パクリしました。
12     //******************************************************************************
13 h677 1.1
14     interface
15    
16     uses
17 h677 1.2 Windows, Classes, SysUtils;
18    
19 h677 1.5 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
20     function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
21     function ReplaceString(const S, OldPattern, NewPattern: string): string;
22     function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
23    
24     function CustomStringReplace(S , OldPattern: String;const NewPattern: string): String; overload;
25     function CustomStringReplace(S , OldPattern: String;const NewPattern: string; IgnoreCase : Boolean): String; overload;
26     procedure CustomStringReplace(var S : TStringList; OldPattern: String;const NewPattern: string);overload;
27     procedure CustomStringReplace(var S : TStringList; OldPattern: String;const NewPattern: string; IgnoreCase : Boolean);overload;
28 h677 1.1
29 h677 1.5 function ZenToHan(const s: string): string;
30     function VaguePos(const Substr, S: string): Integer;
31 h677 1.1
32 h677 1.10.2.1 function ReplaseNoValidateChar( inVal : String): String;
33     function IsNoValidID( inID :String): Boolean;
34    
35     procedure LoadFromFile(Strings: TStrings; const FileName: String);
36 h677 1.1 implementation
37 h677 1.5 // ポインター&アセンブラによる高速ポス
38 h677 1.2 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
39     asm
40 h677 1.10.2.1 PUSH EBX
41 h677 1.5 PUSH ESI
42 h677 1.10.2.1 PUSH EDI
43 h677 1.2
44 h677 1.10.2.1 MOV ESI,ECX { Point ESI to substr }
45     MOV EDI,EAX { Point EDI to s }
46 h677 1.2
47     MOV ECX,EDX { ECX = search length }
48     SUB ECX,EAX
49    
50     MOV EDX,SubstrEnd
51     SUB EDX,ESI
52    
53     DEC EDX { EDX = Length(substr) - 1 }
54     JS @@fail { < 0 ? return 0 }
55     MOV AL,[ESI] { AL = first char of substr }
56     INC ESI { Point ESI to 2'nd char of substr }
57    
58     SUB ECX,EDX { #positions in s to look at }
59     { = Length(s) - Length(substr) + 1 }
60     JLE @@fail
61     @@loop:
62     REPNE SCASB
63     JNE @@fail
64     MOV EBX,ECX { save outer loop counter }
65     PUSH ESI { save outer loop substr pointer }
66     PUSH EDI { save outer loop s pointer }
67    
68     MOV ECX,EDX
69     REPE CMPSB
70     POP EDI { restore outer loop s pointer }
71     POP ESI { restore outer loop substr pointer }
72     JE @@found
73     MOV ECX,EBX { restore outer loop counter }
74     JMP @@loop
75    
76     @@fail:
77     XOR EAX,EAX
78     JMP @@exit
79    
80     @@found:
81     MOV EAX,EDI { EDI points of char after match }
82     DEC EAX
83     @@exit:
84     POP EDI
85     POP ESI
86     POP EBX
87     end;
88 h677 1.5 // AnsiPosの高速版
89 h677 1.2 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
90     var
91 h677 1.3 L2: Cardinal;
92     ByteType : TMbcsByteType;
93 h677 1.2 begin
94 h677 1.3 Result := nil;
95     if (StrStart = nil) or (StrStart^ = #0) or
96     (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
97    
98     L2 := SubstrEnd - SubstrStart;
99     Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
100    
101     while (Result <> nil) and (StrEnd - Result >= L2) do begin
102     ByteType := StrByteType(StrStart, Integer(Result-StrStart));
103     if (ByteType <> mbTrailByte) and
104     (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
105     then Exit;
106     if (ByteType = mbLeadByte) then Inc(Result);
107     Inc(Result);
108     Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
109     end;
110     Result := nil;
111 h677 1.2 end;
112    
113 yoffy 1.4 {$R-}
114 h677 1.5 //高速文字列置換関数(大文字小文字の違いを無視しない)
115 h677 1.2 function ReplaceString(const S, OldPattern, NewPattern: string): string;
116     var
117 h677 1.3 ReplaceCount: Integer;
118     DestIndex: Integer;
119 yoffy 1.4 i, l: Integer;
120 h677 1.3 p, e, ps, pe: PChar;
121     Count: Integer;
122 h677 1.2 begin
123 h677 1.3 Result := S;
124     if OldPattern = '' then Exit;
125 h677 1.2 p := PChar(S);
126     e := p + Length(S);
127     ps := PChar(OldPattern);
128     pe := ps + Length(OldPattern);
129     ReplaceCount := 0;
130     while p < e do begin
131 h677 1.3 p := AnsiStrPosEx(p, e, ps, pe);
132     if p = nil then Break;
133     Inc(ReplaceCount);
134     Inc(p, Length(OldPattern));
135 h677 1.1 end;
136 h677 1.2 if ReplaceCount = 0 then Exit;
137     SetString(Result, nil, Length(S) +
138 h677 1.3 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
139 h677 1.2 p := PChar(S);
140     DestIndex := 1;
141 yoffy 1.4 l := Length( NewPattern );
142 h677 1.2 for i := 0 to ReplaceCount - 1 do begin
143 h677 1.3 Count := AnsiStrPosEx(p, e, ps, pe) - p;
144     Move(p^, Result[DestIndex], Count);
145     Inc(p, Count);//p := pp;
146     Inc(DestIndex, Count);
147 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
148 h677 1.3 Inc(p, Length(OldPattern));
149 yoffy 1.4 Inc(DestIndex, l);
150 h677 1.2 end;
151     Move(p^, Result[DestIndex], e - p);
152 h677 1.1 end;
153 h677 1.5 //高速文字列置換関数(大文字小文字の違いを無視する)
154 h677 1.3 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
155     var
156 h677 1.5 ReplaceCount: Integer;
157     DestIndex: Integer;
158     i, l: Integer;
159     p, e{, ps, pe}: PChar;
160     p2, e2, ps2, pe2: PChar;
161     Count: Integer;
162     bufferS : String;
163     bufferOldPattern : String;
164 h677 1.3 begin
165 h677 1.5 Result := S;
166     bufferS := AnsiLowerCase(S);
167     bufferOldPattern := AnsiLowerCase(OldPattern);
168    
169     if OldPattern = '' then Exit;
170     p := PChar(S);
171     p2 := PChar(bufferS);
172     e := p + Length(S);
173     e2 := p2 + Length(bufferS);
174     //ps := PChar(OldPattern);
175     ps2 := PChar(bufferOldPattern);
176     //pe := ps + Length(OldPattern);
177     pe2 := ps2 + Length(bufferOldPattern);
178    
179     ReplaceCount := 0;
180     while p2 < e2 do begin
181     p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
182     if p2 = nil then Break;
183     Inc(ReplaceCount);
184     Inc(p2, Length(bufferOldPattern));
185     end;
186     if ReplaceCount = 0 then Exit;
187     SetString(Result, nil, Length(bufferS) +
188     (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
189     p2 := PChar(bufferS);
190     DestIndex := 1;
191     l := Length( NewPattern );
192     for i := 0 to ReplaceCount - 1 do begin
193     Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
194     Move(p^, Result[DestIndex], Count);
195     Inc(p, Count);//p := pp;
196     Inc(p2, Count);//p := pp;
197     Inc(DestIndex, Count);
198     Move(NewPattern[1], Result[DestIndex], l);
199     Inc(p, Length(OldPattern));
200     Inc(p2, Length(OldPattern));
201     Inc(DestIndex, l);
202     end;
203     Move(p^, Result[DestIndex], e - p);
204 h677 1.3 end;
205 yoffy 1.4 {$IFDEF DEBUG}
206     {$R+}
207     {$ENDIF}
208 h677 1.3
209 h677 1.5 //高速文字列置換関数(プリミティブ)
210 h677 1.3 function CustomStringReplace(
211     S ,OldPattern: String;
212 h677 1.5 const NewPattern: string
213 h677 1.3 ): String;
214    
215     begin
216 h677 1.5 Result := ReplaceString(S,OldPattern,NewPattern);
217 h677 1.3 end;
218    
219 h677 1.5 //高速文字列置換関数(汎用版1)
220 h677 1.3 function CustomStringReplace(
221     S , OldPattern: String;
222 h677 1.5 const NewPattern: string;
223     IgnoreCase : Boolean
224 h677 1.3 ): String;
225     begin
226 h677 1.5 Result := '';
227     if not IgnoreCase then begin
228     Result := ReplaceString(S,OldPattern,NewPattern);
229     end else begin
230     Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
231     end;
232 h677 1.3 end;
233    
234 h677 1.5 //高速文字列置換関数(汎用版2)
235 h677 1.3 procedure CustomStringReplace(
236     var S : TStringList;
237 h677 1.5 OldPattern: String;
238     const NewPattern: string;
239     IgnoreCase : Boolean
240 h677 1.3 );
241     var
242 h677 1.5 i : Integer;
243 h677 1.3 begin
244 h677 1.5 S.BeginUpdate;
245     if not IgnoreCase then begin
246     for i := 0 to S.Count - 1 do begin
247     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
248     end;
249     end else begin
250     for i := 0 to S.Count - 1 do begin
251     S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
252     end;
253     end;
254     S.EndUpdate;
255 h677 1.3 end;
256    
257 h677 1.5 //高速文字列置換関数(汎用版3)
258 h677 1.3 procedure CustomStringReplace(
259     var S : TStringList;
260 h677 1.5 OldPattern: String;
261     const NewPattern: string
262 h677 1.3 );
263     var
264 h677 1.5 i : Integer;
265 h677 1.3 begin
266 h677 1.5 S.BeginUpdate;
267 h677 1.3 for i := 0 to S.Count - 1 do begin
268     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
269 h677 1.5 end;
270     S.EndUpdate;
271     end;
272    
273     (*************************************************************************
274     * 全角→半角
275     * from HotZonu
276     *************************************************************************)
277     function ZenToHan(const s: string): string;
278     var
279 h677 1.6 //Chr: array [0..1024] of char;
280     Chr: string;
281 yoffy 1.8 ChrLen : Integer;
282 h677 1.5 begin
283 yoffy 1.8 SetLength(Chr, Length(s));
284     ChrLen := Windows.LCMapString(
285 h677 1.5 GetUserDefaultLCID(),
286     // LCMAP_HALFWIDTH,
287     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
288     PChar(s),
289 yoffy 1.8 Length(s),
290 h677 1.6 PChar(Chr),
291     Length(Chr)
292 h677 1.5 );
293 yoffy 1.8 Result := Copy(Chr, 1, ChrLen);
294 h677 1.3 end;
295    
296 h677 1.5 (*************************************************************************
297     * 全角半角ひらがなかたかなを区別しない凄いPos
298     *************************************************************************)
299     function VaguePos(const Substr, S: string): Integer;
300     begin
301     Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
302     end;
303 h677 1.9 (*************************************************************************
304     * FAT/NTFSのファイル名に許されない文字(\,/,*,>,<,|)を全角に置換する
305     *************************************************************************)
306     function ReplaseNoValidateChar( inVal : String): String;
307     begin
308     Result := CustomStringReplace(inVal, '\', '¥');
309     Result := CustomStringReplace(Result, '/', '/');
310     Result := CustomStringReplace(Result, '*', '*');
311 h677 1.10.2.1 Result := CustomStringReplace(Result, '>', '>');
312     Result := CustomStringReplace(Result, '<', '<');
313     Result := CustomStringReplace(Result, '|', '|');
314 h677 1.9 end;
315 h677 1.10 (*************************************************************************
316     * 無効なIDかのチェック(無効例:ID:??? , ID:???0)
317     *************************************************************************)
318     function IsNoValidID( inID :String): Boolean;
319     begin
320 h677 1.10.2.1 inID := Trim(inID);
321     if inID = '' then Result := True
322     else begin
323     inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
324     inID := CustomStringReplace(inID, '?', '');
325     if (inID = '') or (inID = '0') then Result := True
326     else Result := False;
327     end;
328 h677 1.10 end;
329 h677 1.10.2.1 {***********************************************************************
330     高速なLoadFromFile : メモリの使用量がファイルサイズ + 8kB
331     ***********************************************************************}
332     procedure LoadFromFile(Strings: TStrings; const FileName: String);
333     const
334     BufferSize = $2000;
335     var
336     I, ReadCount, LineCount: Integer;
337     LineRemained: Boolean;
338     S, Str: String;
339     Buffer, P, Start: PChar;
340     Fs: TFileStream;
341     begin
342     Strings.BeginUpdate;
343     try
344     Strings.Clear;
345     Fs := TFileStream.Create(FileName, fmOpenRead);
346     try
347     Buffer := StrAlloc(BufferSize + 1);
348     try
349     // #13#10 をカウントする #26 以降は読み込まない
350     LineCount := 0;
351     LineRemained := False;
352     repeat
353     ReadCount := Fs.Read(Buffer^, BufferSize);
354     if ReadCount > 0 then
355     LineRemained := False;
356     Buffer[ReadCount] := #0;
357     P := Buffer;
358     // バッファによって #13#10 が分断された場合のために
359     if P^ = #10 then Inc(P);
360    
361     while not(P^ in [#0, #26]) do
362     begin
363    
364     while not (P^ in [#0, #10, #13, #26]) do Inc(P);
365    
366     if P^ in [#10, #13] then
367     Inc(LineCount)
368     else
369     LineRemained := True;
370    
371     if P^ = #13 then Inc(P);
372    
373     if P^ = #10 then Inc(P);
374     end;
375     if P^ = #26 then Break;
376     until ReadCount = 0;
377    
378     if LineRemained then
379     Inc(LineCount);
380    
381     // 取得した行数分の Capacity を確保
382     for I := 0 to LineCount - 1 do
383     Strings.Add('');
384    
385     // バッファを利用して読み込み #26 以降は読み込まない
386     Fs.Seek(0, 0);
387     LineCount := 0;
388     Str := '';
389     repeat
390     ReadCount := Fs.Read(Buffer^, BufferSize);
391     Buffer[ReadCount] := #0;
392     P := Buffer;
393     // バッファによって #13#10 が分断された場合のために
394     if P^ = #10 then Inc(P);
395    
396     while not(P^ in [#0, #26]) do
397     begin
398     Start := P;
399     while not (P^ in [#0, #10, #13, #26]) do Inc(P);
400    
401     SetString(S, Start, P - Start);
402     if P^ in [#0, #26] then
403     Str := S
404     else
405     begin
406     if Str <> '' then
407     begin
408     S := Str + S;
409     Str := '';
410     end;
411     Strings[LineCount] := S;
412     Inc(LineCount);
413     end;
414    
415     if P^ = #13 then Inc(P);
416    
417     if P^ = #10 then Inc(P);
418     end;
419    
420     if P^ = #26 then Break;
421    
422     until ReadCount = 0;
423    
424     if Str <> '' then
425     Strings[LineCount] := Str;
426     finally
427     StrDispose(Buffer);
428     end;
429     finally
430     Fs.Free;
431     end;
432     finally
433     Strings.EndUpdate;
434     end;
435     end;
436    
437    
438 h677 1.10
439 h677 1.1 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26