Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/MojuUtils.pas

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


Revision 1.4.2.2 - (show annotations) (download) (as text)
Thu Sep 9 16:20:33 2004 UTC (19 years, 7 months ago) by yoffy
Branch: stable
Changes since 1.4.2.1: +129 -95 lines
File MIME type: text/x-pascal
・ミ・ソ48、ヒ・゙。シ・ク。」

1 unit MojuUtils;
2 //******************************************************************************
3 // 譁?ュ怜?鄂ョ謠幃未謨ー CustomStringReplace
4 // 菴ソ縺?婿縺ッ縲?/span>
5 //縲?CustomStringReplace(
6 //縲? 蜈??譁?ュ怜???tring繧ゅ@縺上?TStringList),
7 //縲? 讀懃エ「譁?ュ怜???tring),
8 // 鄂ョ謠帶枚蟄怜???tring),
9 // 螟ァ譁?ュ怜ー乗枚蟄暦シ?oolean)True:蛹コ蛻・縺励↑縺???false or 逵∫払:蛹コ蛻・縺吶k
10 //
11 // Delphi-ML縺ョ險倅コ?9334縺ォ霈峨▲縺ヲ縺?◆繧ウ繝シ繝峨r荳ク繝代け繝ェ縺励∪縺励◆縲?/span>
12 //******************************************************************************
13
14 interface
15
16 uses
17 Windows, Classes, SysUtils;
18
19 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
29 function ZenToHan(const s: string): string;
30 function VaguePos(const Substr, S: string): Integer;
31
32 implementation
33 // 繝昴う繝ウ繧ソ繝シ??い繧サ繝ウ繝悶Λ縺ォ繧医k鬮倬?溘?繧ケ
34 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
35 asm
36 PUSH EBX
37 PUSH ESI
38 PUSH EDI
39
40 MOV ESI,ECX { Point ESI to substr }
41 MOV EDI,EAX { Point EDI to s }
42
43 MOV ECX,EDX { ECX = search length }
44 SUB ECX,EAX
45
46 MOV EDX,SubstrEnd
47 SUB EDX,ESI
48
49 DEC EDX { EDX = Length(substr) - 1 }
50 JS @@fail { < 0 ? return 0 }
51 MOV AL,[ESI] { AL = first char of substr }
52 INC ESI { Point ESI to 2'nd char of substr }
53
54 SUB ECX,EDX { #positions in s to look at }
55 { = Length(s) - Length(substr) + 1 }
56 JLE @@fail
57 @@loop:
58 REPNE SCASB
59 JNE @@fail
60 MOV EBX,ECX { save outer loop counter }
61 PUSH ESI { save outer loop substr pointer }
62 PUSH EDI { save outer loop s pointer }
63
64 MOV ECX,EDX
65 REPE CMPSB
66 POP EDI { restore outer loop s pointer }
67 POP ESI { restore outer loop substr pointer }
68 JE @@found
69 MOV ECX,EBX { restore outer loop counter }
70 JMP @@loop
71
72 @@fail:
73 XOR EAX,EAX
74 JMP @@exit
75
76 @@found:
77 MOV EAX,EDI { EDI points of char after match }
78 DEC EAX
79 @@exit:
80 POP EDI
81 POP ESI
82 POP EBX
83 end;
84 //縲?AnsiPos縺ョ鬮倬?溽沿
85 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
86 var
87 L2: Cardinal;
88 ByteType : TMbcsByteType;
89 begin
90 Result := nil;
91 if (StrStart = nil) or (StrStart^ = #0) or
92 (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
93
94 L2 := SubstrEnd - SubstrStart;
95 Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
96
97 while (Result <> nil) and (StrEnd - Result >= L2) do begin
98 ByteType := StrByteType(StrStart, Integer(Result-StrStart));
99 if (ByteType <> mbTrailByte) and
100 (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
101 then Exit;
102 if (ByteType = mbLeadByte) then Inc(Result);
103 Inc(Result);
104 Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
105 end;
106 Result := nil;
107 end;
108
109 {$R-}
110 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?亥、ァ譁?ュ怜ー乗枚蟄励?驕輔>繧堤┌隕悶@縺ェ縺?シ?/span>
111 function ReplaceString(const S, OldPattern, NewPattern: string): string;
112 var
113 ReplaceCount: Integer;
114 DestIndex: Integer;
115 i, l: Integer;
116 p, e, ps, pe: PChar;
117 Count: Integer;
118 begin
119 Result := S;
120 if OldPattern = '' then Exit;
121 p := PChar(S);
122 e := p + Length(S);
123 ps := PChar(OldPattern);
124 pe := ps + Length(OldPattern);
125 ReplaceCount := 0;
126 while p < e do begin
127 p := AnsiStrPosEx(p, e, ps, pe);
128 if p = nil then Break;
129 Inc(ReplaceCount);
130 Inc(p, Length(OldPattern));
131 end;
132 if ReplaceCount = 0 then Exit;
133 SetString(Result, nil, Length(S) +
134 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
135 p := PChar(S);
136 DestIndex := 1;
137 l := Length( NewPattern );
138 for i := 0 to ReplaceCount - 1 do begin
139 Count := AnsiStrPosEx(p, e, ps, pe) - p;
140 Move(p^, Result[DestIndex], Count);
141 Inc(p, Count);//p := pp;
142 Inc(DestIndex, Count);
143 Move(NewPattern[1], Result[DestIndex], l);
144 Inc(p, Length(OldPattern));
145 Inc(DestIndex, l);
146 end;
147 Move(p^, Result[DestIndex], e - p);
148 end;
149 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?亥、ァ譁?ュ怜ー乗枚蟄励?驕輔>繧堤┌隕悶☆繧具シ?/span>
150 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
151 var
152 ReplaceCount: Integer;
153 DestIndex: Integer;
154 i, l: Integer;
155 p, e{, ps, pe}: PChar;
156 p2, e2, ps2, pe2: PChar;
157 Count: Integer;
158 bufferS : String;
159 bufferOldPattern : String;
160 begin
161 Result := S;
162 bufferS := AnsiLowerCase(S);
163 bufferOldPattern := AnsiLowerCase(OldPattern);
164
165 if OldPattern = '' then Exit;
166 p := PChar(S);
167 p2 := PChar(bufferS);
168 e := p + Length(S);
169 e2 := p2 + Length(bufferS);
170 //ps := PChar(OldPattern);
171 ps2 := PChar(bufferOldPattern);
172 //pe := ps + Length(OldPattern);
173 pe2 := ps2 + Length(bufferOldPattern);
174
175 ReplaceCount := 0;
176 while p2 < e2 do begin
177 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
178 if p2 = nil then Break;
179 Inc(ReplaceCount);
180 Inc(p2, Length(bufferOldPattern));
181 end;
182 if ReplaceCount = 0 then Exit;
183 SetString(Result, nil, Length(bufferS) +
184 (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
185 p2 := PChar(bufferS);
186 DestIndex := 1;
187 l := Length( NewPattern );
188 for i := 0 to ReplaceCount - 1 do begin
189 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
190 Move(p^, Result[DestIndex], Count);
191 Inc(p, Count);//p := pp;
192 Inc(p2, Count);//p := pp;
193 Inc(DestIndex, Count);
194 Move(NewPattern[1], Result[DestIndex], l);
195 Inc(p, Length(OldPattern));
196 Inc(p2, Length(OldPattern));
197 Inc(DestIndex, l);
198 end;
199 Move(p^, Result[DestIndex], e - p);
200 end;
201 {$IFDEF DEBUG}
202 {$R+}
203 {$ENDIF}
204
205 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?医?繝ェ繝溘ユ繧」繝厄シ?/span>
206 function CustomStringReplace(
207 S ,OldPattern: String;
208 const NewPattern: string
209 ): String;
210
211 begin
212 Result := ReplaceString(S,OldPattern,NewPattern);
213 end;
214
215 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?域ア守畑迚茨シ托シ?/span>
216 function CustomStringReplace(
217 S , OldPattern: String;
218 const NewPattern: string;
219 IgnoreCase : Boolean
220 ): String;
221 begin
222 Result := '';
223 if not IgnoreCase then begin
224 Result := ReplaceString(S,OldPattern,NewPattern);
225 end else begin
226 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
227 end;
228 end;
229
230 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?域ア守畑迚茨シ抵シ?/span>
231 procedure CustomStringReplace(
232 var S : TStringList;
233 OldPattern: String;
234 const NewPattern: string;
235 IgnoreCase : Boolean
236 );
237 var
238 i : Integer;
239 begin
240 S.BeginUpdate;
241 if not IgnoreCase then begin
242 for i := 0 to S.Count - 1 do begin
243 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
244 end;
245 end else begin
246 for i := 0 to S.Count - 1 do begin
247 S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
248 end;
249 end;
250 S.EndUpdate;
251 end;
252
253 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?域ア守畑迚茨シ難シ?/span>
254 procedure CustomStringReplace(
255 var S : TStringList;
256 OldPattern: String;
257 const NewPattern: string
258 );
259 var
260 i : Integer;
261 begin
262 S.BeginUpdate;
263 for i := 0 to S.Count - 1 do begin
264 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
265 end;
266 S.EndUpdate;
267 end;
268
269 (*************************************************************************
270 * 蜈ィ隗停?蜊願ァ?/span>
271 * from HotZonu
272 *************************************************************************)
273 function ZenToHan(const s: string): string;
274 var
275 //Chr: array [0..1024] of char;
276 Chr: string;
277 ChrLen : Integer;
278 begin
279 SetLength(Chr, Length(s));
280 ChrLen := Windows.LCMapString(
281 GetUserDefaultLCID(),
282 // LCMAP_HALFWIDTH,
283 LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
284 PChar(s),
285 Length(s),
286 PChar(Chr),
287 Length(Chr)
288 );
289 Result := Copy(Chr, 1, ChrLen);
290 end;
291
292 (*************************************************************************
293 * 蜈ィ隗貞濠隗偵?繧峨′縺ェ縺九◆縺九↑繧貞玄蛻・縺励↑縺??縺Пos
294 *************************************************************************)
295 function VaguePos(const Substr, S: string): Integer;
296 begin
297 Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
298 end;
299
300 end.

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