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.23 - (show annotations) (download) (as text)
Sat Jul 22 20:34:39 2006 UTC (17 years, 9 months ago) by h677
Branch: MAIN
CVS Tags: v1_56_0_715, v1_57_0_737, v1_57_0_735, v1_57_0_734, v1_57_0_733, v1_57_0_732, v1_57_0_731, v1_57_0_730, v1_57_0_739, v1_57_0_738, v1_53_0_671, v1_54_0_677, v1_54_0_676, v1_54_0_678, v1_56_0_707, v1_56_0_705, v1_56_0_704, v1_56_0_703, v1_56_0_702, v1_56_0_701, v1_56_0_700, v1_57_0_723, v1_57_0_725, v1_57_0_726, v1_57_0_727, v1_57_0_720, v1_57_0_722, v1_57_0_728, v1_57_0_729, v1_57_0_736, v1_57_0_719, v1_57_0_718, v1_56_0_716, v1_54_0_687, v1_56_0_710, v1_56_0_711, v1_56_1_717, v1_56_1_716, v1_54_0_688, v1_54_0_689, v1_54_0_684, v1_54_0_685, v1_53_0_669, v1_53_0_668, v1_55_0_692, v1_55_0_693, v1_55_0_696, v1_55_0_697, v1_55_0_694, v1_55_0_695, v1_54_1_691, v1_56_2_724, v1_56_2_722, v1_55_1_697, v1_56_0_714, v1_53_0_672, v1_53_0_670, v1_54_0_686, v1_54_0_680, v1_54_0_681, v1_56_0_712, v1_56_0_713, v1_54_0_682, v1_56_0_721, v1_54_0_683, v1_54_0_679, marged_bRESPOPUP, v1_54_0_675, v1_56_0_706, root-of-Bb53, v1_54_0_674, v1_54_0_690, v1_56_0_709, v1_56_0_708, v1_53_1_673, v1_56_0_699, v1_56_0_698
Branch point for: Bb56, Bb55, Bb53, bRESPOPUP, bListSU, Bb54
Changes since 1.22: +14 -5 lines
File MIME type: text/x-pascal
無効なIDの判定を修正。
ほかコメント追加したり,コメントアウトしたソースを削除したり。

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

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