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.20 - (show annotations) (download) (as text)
Fri Dec 9 17:06:30 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
CVS Tags: v1_51_1_639, v1_51_0_626, b51, v1_52_0_643, v1_51_0_634, v1_51_0_635, v1_51_0_636, v1_51_0_637, v1_51_0_632, v1_51_0_633, v1_51_0_638, v1_52_0_642, v1_51_1_640, v1_51_0_630, v1_51_0_631, v1_51_0_628, root-of-Bb51, v1_51_0_629, v1_51_0_627, v1_51_1_641
Branch point for: Bb51
Changes since 1.19: +22 -68 lines
File MIME type: text/x-pascal
HTML文字列作成関係のリファクタリング中

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
36 implementation
37 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
38 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
39 asm
40 PUSH EBX
41 PUSH ESI
42 PUSH EDI
43
44 MOV ESI,ECX { Point ESI to substr }
45 MOV EDI,EAX { Point EDI to s }
46
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 //??AnsiPos???????
89 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
90 var
91 L2: Cardinal;
92 ByteType : TMbcsByteType;
93 begin
94 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 end;
112
113 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
114 function ReplaceString(const S: String; const OldPattern: String; const NewPattern: string): String;
115 var
116 ReplaceCount: Integer;
117 DestIndex: Integer;
118 i, l: Integer;
119 p, e, ps, pe: PChar;
120 Count: Integer;
121 olen: Integer;
122 begin
123 Result := S;
124 olen := Length(OldPattern);
125 if olen = 0 then Exit;
126 p := PChar(S);
127 e := p + Length(S);
128 ps := PChar(OldPattern);
129 pe := ps + olen;
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, olen);
136 end;
137 if ReplaceCount = 0 then Exit;
138 SetString(Result, nil, Length(S) +
139 (Length(NewPattern) - olen) * 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, olen);
150 Inc(DestIndex, l);
151 end;
152 Move(p^, Result[DestIndex], e - p);
153 end;
154 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
155 function IgnoCaseReplaceString(const S: String;const OldPattern:String;const 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 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
207 function CustomStringReplace(
208 const S :String;
209 const OldPattern: String;
210 const NewPattern: string;
211 IgnoreCase : Boolean
212 ): String;
213 begin
214 if not IgnoreCase then begin
215 Result := ReplaceString(S,OldPattern,NewPattern);
216 end else begin
217 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
218 end;
219 end;
220
221 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
222 procedure CustomStringReplace(
223 var S : TStringList;
224 const OldPattern: String;
225 const NewPattern: string;
226 IgnoreCase : Boolean
227 );
228 var
229 i : Integer;
230 begin
231 S.BeginUpdate;
232 if not IgnoreCase then begin
233 for i := 0 to S.Count - 1 do begin
234 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
235 end;
236 end else begin
237 for i := 0 to S.Count - 1 do begin
238 S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
239 end;
240 end;
241 S.EndUpdate;
242 end;
243
244 (*************************************************************************
245 * ???????茹?
246 * from HotZonu
247 *************************************************************************)
248 function ZenToHan(const s: string): string;
249 var
250 ChrLen : Integer;
251 begin
252 SetLength(Result, Length(s));
253 ChrLen := Windows.LCMapString(
254 GetUserDefaultLCID(),
255 // LCMAP_HALFWIDTH,
256 LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
257 PChar(s),
258 Length(s),
259 PChar(Result),
260 Length(Result)
261 );
262 SetLength(Result, ChrLen);
263 end;
264
265 (*************************************************************************
266 * ?????茹??蚊?????????????????阪?ャ??????????Pos
267 *************************************************************************)
268 function VaguePos(const Substr:String; const S: string): Integer;
269 begin
270 Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
271 end;
272 (*************************************************************************
273 * FAT/NTFS?????<?ゃ??????┗??????????絖?鐚?\,/,:,.,;,*,>,<,|鐚????????舟??????
274 *************************************************************************)
275 function ReplaseNoValidateChar( inVal : String): String;
276 begin
277 Result := CustomStringReplace(inVal, '\', '鐃?#39;);
278 Result := CustomStringReplace(Result, '/', '鐚?39;);
279 Result := CustomStringReplace(Result, ':', '鐚?');
280 Result := CustomStringReplace(Result, '.', '鐚?#39;);
281 Result := CustomStringReplace(Result, ';', '鐚?');
282 Result := CustomStringReplace(Result, '*', '鐚?');
283 Result := CustomStringReplace(Result, '>', '鐚?');
284 Result := CustomStringReplace(Result, '<', '鐚?');
285 Result := CustomStringReplace(Result, '|', '鐔?');
286 end;
287 (*************************************************************************
288 * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , ID:???0)
289 *************************************************************************)
290 function IsNoValidID( inID :String): Boolean;
291 begin
292 inID := Trim(inID);
293 if inID = '' then Result := True
294 else begin
295 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
296 inID := CustomStringReplace(inID, '?', '');
297 if (inID = '') or (inID = '0') then Result := True
298 else Result := False;
299 end;
300 end;
301
302 // *************************************************************************
303 // HTML筝???lt;font>?帥?違?????ゃ????
304 // *************************************************************************
305 function DeleteFontTag(
306 inSource : string //?帥?違?????ゃ??????絖???
307 ) : string; //?帥?医???よ?????絖???
308 var
309 pos : Integer;
310 begin
311 Result := '';
312
313 //</font>??????/span>
314 inSource := CustomStringReplace( inSource, '</font>', '', True);
315 //<font ?????????絖??????????
316 inSource := CustomStringReplace( inSource, '<font', '<font', True);
317 //<font ?? ?????ゃ????
318 pos := AnsiPos('<font', inSource);
319 while (pos > 0) do begin
320 Result := Result + Copy(inSource, 1, pos - 1);
321 Delete(inSource, 1, pos);
322 //?帥?違????????'>'?障?с??????/span>
323 pos := AnsiPos('>', inSource);
324 Delete(inSource, 1, pos);
325 pos := AnsiPos('<font', inSource);
326 end;
327
328 Result := Result + inSource;
329
330
331 end;
332 // *************************************************************************
333
334
335 (*************************************************************************
336 *
337 *?????????泣?ゃ??????????????/span>
338 *************************************************************************)
339 function RemoveToken(var s: string;const delimiter: string): string;
340 var
341 p: Integer;
342 pos : PChar;
343 pds, pde : PChar;
344 pss, pse : PChar;
345 begin
346 pss := PChar(s);
347 pse := pss + Length(s);
348 pds := PChar(delimiter);
349 pde := pds + Length(delimiter);
350
351 pos := AnsiStrPosEx(pss, pse, pds, pde);
352 if pos <> nil then begin
353 p := pos - pss;
354 SetString(Result, pss, p);
355 Delete(s, 1, p + Length(delimiter));
356 end else begin
357 Result := s;
358 s := '';
359 end;
360 end;
361
362
363 end.

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