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.10.2.2 - (show annotations) (download) (as text)
Wed Jun 22 15:25:17 2005 UTC (18 years, 10 months ago) by h677
Branch: remodeling
CVS Tags: v1_50_0_587, v1_50_0_586
Changes since 1.10.2.1: +44 -119 lines
File MIME type: text/x-pascal
DeleteFontTagを共通関数化してこっちに移動

1 unit MojuUtils;
2 //******************************************************************************
3 // ??絖???臀???∽? CustomStringReplace
4 // 篏帥???鴻????
5 //??CustomStringReplace(
6 //?? ??????絖???鐚?String???????StringList),
7 //?? 罎?膣∽??絖???鐚?String),
8 // 臀????絖???鐚?String),
9 // 紊ф??絖?絨??絖?鐚?Boolean)True:?阪?ャ????????false or ?????阪?ャ????
10 //
11 // Delphi-ML???篋?69334????c???????潟?若????筝吾?????????障??????
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 function ReplaseNoValidateChar( inVal : String): String;
33 function IsNoValidID( inID :String): Boolean;
34 //<font>?帥?違?????????ゃ????
35 function DeleteFontTag( inSource : string) : string;
36
37 implementation
38 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
39 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
40 asm
41 PUSH EBX
42 PUSH ESI
43 PUSH EDI
44
45 MOV ESI,ECX { Point ESI to substr }
46 MOV EDI,EAX { Point EDI to s }
47
48 MOV ECX,EDX { ECX = search length }
49 SUB ECX,EAX
50
51 MOV EDX,SubstrEnd
52 SUB EDX,ESI
53
54 DEC EDX { EDX = Length(substr) - 1 }
55 JS @@fail { < 0 ? return 0 }
56 MOV AL,[ESI] { AL = first char of substr }
57 INC ESI { Point ESI to 2'nd char of substr }
58
59 SUB ECX,EDX { #positions in s to look at }
60 { = Length(s) - Length(substr) + 1 }
61 JLE @@fail
62 @@loop:
63 REPNE SCASB
64 JNE @@fail
65 MOV EBX,ECX { save outer loop counter }
66 PUSH ESI { save outer loop substr pointer }
67 PUSH EDI { save outer loop s pointer }
68
69 MOV ECX,EDX
70 REPE CMPSB
71 POP EDI { restore outer loop s pointer }
72 POP ESI { restore outer loop substr pointer }
73 JE @@found
74 MOV ECX,EBX { restore outer loop counter }
75 JMP @@loop
76
77 @@fail:
78 XOR EAX,EAX
79 JMP @@exit
80
81 @@found:
82 MOV EAX,EDI { EDI points of char after match }
83 DEC EAX
84 @@exit:
85 POP EDI
86 POP ESI
87 POP EBX
88 end;
89 //??AnsiPos???????
90 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
91 var
92 L2: Cardinal;
93 ByteType : TMbcsByteType;
94 begin
95 Result := nil;
96 if (StrStart = nil) or (StrStart^ = #0) or
97 (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
98
99 L2 := SubstrEnd - SubstrStart;
100 Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
101
102 while (Result <> nil) and (StrEnd - Result >= L2) do begin
103 ByteType := StrByteType(StrStart, Integer(Result-StrStart));
104 if (ByteType <> mbTrailByte) and
105 (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
106 then Exit;
107 if (ByteType = mbLeadByte) then Inc(Result);
108 Inc(Result);
109 Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
110 end;
111 Result := nil;
112 end;
113
114 {$R-}
115 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
116 function ReplaceString(const S, OldPattern, NewPattern: string): string;
117 var
118 ReplaceCount: Integer;
119 DestIndex: Integer;
120 i, l: Integer;
121 p, e, ps, pe: PChar;
122 Count: Integer;
123 begin
124 Result := S;
125 if OldPattern = '' then Exit;
126 p := PChar(S);
127 e := p + Length(S);
128 ps := PChar(OldPattern);
129 pe := ps + Length(OldPattern);
130 ReplaceCount := 0;
131 while p < e do begin
132 p := AnsiStrPosEx(p, e, ps, pe);
133 if p = nil then Break;
134 Inc(ReplaceCount);
135 Inc(p, Length(OldPattern));
136 end;
137 if ReplaceCount = 0 then Exit;
138 SetString(Result, nil, Length(S) +
139 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
140 p := PChar(S);
141 DestIndex := 1;
142 l := Length( NewPattern );
143 for i := 0 to ReplaceCount - 1 do begin
144 Count := AnsiStrPosEx(p, e, ps, pe) - p;
145 Move(p^, Result[DestIndex], Count);
146 Inc(p, Count);//p := pp;
147 Inc(DestIndex, Count);
148 Move(NewPattern[1], Result[DestIndex], l);
149 Inc(p, Length(OldPattern));
150 Inc(DestIndex, l);
151 end;
152 Move(p^, Result[DestIndex], e - p);
153 end;
154 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
155 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
156 var
157 ReplaceCount: Integer;
158 DestIndex: Integer;
159 i, l: Integer;
160 p, e{, ps, pe}: PChar;
161 p2, e2, ps2, pe2: PChar;
162 Count: Integer;
163 bufferS : String;
164 bufferOldPattern : String;
165 begin
166 Result := S;
167 bufferS := AnsiLowerCase(S);
168 bufferOldPattern := AnsiLowerCase(OldPattern);
169
170 if OldPattern = '' then Exit;
171 p := PChar(S);
172 p2 := PChar(bufferS);
173 e := p + Length(S);
174 e2 := p2 + Length(bufferS);
175 //ps := PChar(OldPattern);
176 ps2 := PChar(bufferOldPattern);
177 //pe := ps + Length(OldPattern);
178 pe2 := ps2 + Length(bufferOldPattern);
179
180 ReplaceCount := 0;
181 while p2 < e2 do begin
182 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
183 if p2 = nil then Break;
184 Inc(ReplaceCount);
185 Inc(p2, Length(bufferOldPattern));
186 end;
187 if ReplaceCount = 0 then Exit;
188 SetString(Result, nil, Length(bufferS) +
189 (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
190 p2 := PChar(bufferS);
191 DestIndex := 1;
192 l := Length( NewPattern );
193 for i := 0 to ReplaceCount - 1 do begin
194 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
195 Move(p^, Result[DestIndex], Count);
196 Inc(p, Count);//p := pp;
197 Inc(p2, Count);//p := pp;
198 Inc(DestIndex, Count);
199 Move(NewPattern[1], Result[DestIndex], l);
200 Inc(p, Length(OldPattern));
201 Inc(p2, Length(OldPattern));
202 Inc(DestIndex, l);
203 end;
204 Move(p^, Result[DestIndex], e - p);
205 end;
206 {$IFDEF DEBUG}
207 {$R+}
208 {$ENDIF}
209
210 //蕭?????絖???臀???∽?逸??????????c??鐚?
211 function CustomStringReplace(
212 S ,OldPattern: String;
213 const NewPattern: string
214 ): String;
215
216 begin
217 Result := ReplaceString(S,OldPattern,NewPattern);
218 end;
219
220 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
221 function CustomStringReplace(
222 S , OldPattern: String;
223 const NewPattern: string;
224 IgnoreCase : Boolean
225 ): String;
226 begin
227 Result := '';
228 if not IgnoreCase then begin
229 Result := ReplaceString(S,OldPattern,NewPattern);
230 end else begin
231 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
232 end;
233 end;
234
235 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
236 procedure CustomStringReplace(
237 var S : TStringList;
238 OldPattern: String;
239 const NewPattern: string;
240 IgnoreCase : Boolean
241 );
242 var
243 i : Integer;
244 begin
245 S.BeginUpdate;
246 if not IgnoreCase then begin
247 for i := 0 to S.Count - 1 do begin
248 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
249 end;
250 end else begin
251 for i := 0 to S.Count - 1 do begin
252 S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
253 end;
254 end;
255 S.EndUpdate;
256 end;
257
258 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
259 procedure CustomStringReplace(
260 var S : TStringList;
261 OldPattern: String;
262 const NewPattern: string
263 );
264 var
265 i : Integer;
266 begin
267 S.BeginUpdate;
268 for i := 0 to S.Count - 1 do begin
269 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
270 end;
271 S.EndUpdate;
272 end;
273
274 (*************************************************************************
275 * ???????茹?
276 * from HotZonu
277 *************************************************************************)
278 function ZenToHan(const s: string): string;
279 var
280 //Chr: array [0..1024] of char;
281 Chr: string;
282 ChrLen : Integer;
283 begin
284 SetLength(Chr, Length(s));
285 ChrLen := Windows.LCMapString(
286 GetUserDefaultLCID(),
287 // LCMAP_HALFWIDTH,
288 LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
289 PChar(s),
290 Length(s),
291 PChar(Chr),
292 Length(Chr)
293 );
294 Result := Copy(Chr, 1, ChrLen);
295 end;
296
297 (*************************************************************************
298 * ?????茹??蚊?????????????????阪?ャ??????????Pos
299 *************************************************************************)
300 function VaguePos(const Substr, S: string): Integer;
301 begin
302 Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
303 end;
304 (*************************************************************************
305 * FAT/NTFS?????<?ゃ??????┗??????????絖?鐚?\,/,*,>,<,|鐚????????舟??????
306 *************************************************************************)
307 function ReplaseNoValidateChar( inVal : String): String;
308 begin
309 Result := CustomStringReplace(inVal, '\', '鐃?#39;);
310 Result := CustomStringReplace(Result, '/', '鐚?39;);
311 Result := CustomStringReplace(Result, '*', '鐚?');
312 Result := CustomStringReplace(Result, '>', '鐚?');
313 Result := CustomStringReplace(Result, '<', '鐚?');
314 Result := CustomStringReplace(Result, '|', '鐔?');
315 end;
316 (*************************************************************************
317 * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , ID:???0)
318 *************************************************************************)
319 function IsNoValidID( inID :String): Boolean;
320 begin
321 inID := Trim(inID);
322 if inID = '' then Result := True
323 else begin
324 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
325 inID := CustomStringReplace(inID, '?', '');
326 if (inID = '') or (inID = '0') then Result := True
327 else Result := False;
328 end;
329 end;
330
331 // *************************************************************************
332 // HTML筝???lt;font>?帥?違?????ゃ????
333 // *************************************************************************
334 function DeleteFontTag(
335 inSource : string //?帥?違?????ゃ??????絖???
336 ) : string; //?帥?医???よ?????絖???
337 var
338 pos : Integer;
339 begin
340 Result := '';
341
342 //</font>??????/span>
343 inSource := CustomStringReplace( inSource, '</font>', '', True);
344 //<font ?????????絖??????????
345 inSource := CustomStringReplace( inSource, '<font', '<font', True);
346 //<font ?? ?????ゃ????
347 pos := AnsiPos('<font', inSource);
348 while (pos > 0) do begin
349 Result := Result + Copy(inSource, 1, pos - 1);
350 Delete(inSource, 1, pos);
351 //?帥?違????????'>'?障?с??????/span>
352 pos := AnsiPos('>', inSource);
353 Delete(inSource, 1, pos);
354 pos := AnsiPos('<font', inSource);
355 end;
356
357 Result := Result + inSource;
358
359
360 end;
361 // *************************************************************************
362
363
364 end.

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