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.17 - (show annotations) (download) (as text)
Tue Dec 6 14:09:23 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
Changes since 1.16: +17 -3 lines
File MIME type: text/x-pascal
・ケ・?ホHTMLコ?ョ、ホコヌナャイス

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, GikoSystem;
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; IgnoreCase : Boolean = False): String; overload;
25 procedure CustomStringReplace(var S : TStringList; OldPattern: String;const NewPattern: string; IgnoreCase : Boolean = False); overload;
26
27 function ZenToHan(const s: string): string;
28 function VaguePos(const Substr, S: string): Integer;
29
30 function ReplaseNoValidateChar( inVal : String): String;
31 function IsNoValidID( inID :String): Boolean;
32 //<font>繧ソ繧ー繧貞?縺ヲ蜑企勁縺吶k
33 function DeleteFontTag( inSource : string) : string;
34 procedure DivideStrLine(Line: string; PRes: PResRec);
35 function RemoveToken(var s: string;const delimiter: string): string;
36
37 implementation
38 // 繝昴う繝ウ繧ソ繝シ??い繧サ繝ウ繝悶Λ縺ォ繧医k鬮倬?溘?繧ケ
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 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?亥、ァ譁?ュ怜ー乗枚蟄励?驕輔>繧堤┌隕悶@縺ェ縺?シ?/span>
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 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?亥、ァ譁?ュ怜ー乗枚蟄励?驕輔>繧堤┌隕悶☆繧具シ?/span>
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 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?域ア守畑迚茨シ托シ?/span>
211 function CustomStringReplace(
212 S , OldPattern: String;
213 const NewPattern: string;
214 IgnoreCase : Boolean
215 ): String;
216 begin
217 Result := '';
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 //鬮倬?滓枚蟄怜?鄂ョ謠幃未謨ー?域ア守畑迚茨シ抵シ?/span>
226 procedure CustomStringReplace(
227 var S : TStringList;
228 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 * 蜈ィ隗停?蜊願ァ?/span>
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 * 蜈ィ隗貞濠隗偵?繧峨′縺ェ縺九◆縺九↑繧貞玄蛻・縺励↑縺??縺Пos
271 *************************************************************************)
272 function VaguePos(const Substr, S: string): Integer;
273 begin
274 Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
275 end;
276 (*************************************************************************
277 * FAT/NTFS縺ョ繝輔ぃ繧、繝ォ蜷阪↓險ア縺輔l縺ェ縺?枚蟄暦シ?,/,:,.,;,*,>,<,|?峨r蜈ィ隗偵↓鄂ョ謠帙☆繧?/span>
278 *************************************************************************)
279 function ReplaseNoValidateChar( inVal : String): String;
280 begin
281 Result := CustomStringReplace(inVal, '\', '?・');
282 Result := CustomStringReplace(Result, '/', '??#39;);
283 Result := CustomStringReplace(Result, ':', '??#39;);
284 Result := CustomStringReplace(Result, '.', '??#39;);
285 Result := CustomStringReplace(Result, ';', '??#39;);
286 Result := CustomStringReplace(Result, '*', '??#39;);
287 Result := CustomStringReplace(Result, '>', '??#39;);
288 Result := CustomStringReplace(Result, '<', '??#39;);
289 Result := CustomStringReplace(Result, '|', '??#39;);
290 end;
291 (*************************************************************************
292 * 辟。蜉ケ縺ェID縺九?繝√ぉ繝?け?育┌蜉ケ萓具シ唔D:??? , ID:???0)
293 *************************************************************************)
294 function IsNoValidID( inID :String): Boolean;
295 begin
296 inID := Trim(inID);
297 if inID = '' then Result := True
298 else begin
299 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
300 inID := CustomStringReplace(inID, '?', '');
301 if (inID = '') or (inID = '0') then Result := True
302 else Result := False;
303 end;
304 end;
305
306 // *************************************************************************
307 // HTML荳ュ縺ョ<font>繧ソ繧ー繧貞炎髯、縺吶k
308 // *************************************************************************
309 function DeleteFontTag(
310 inSource : string //繧ソ繧ー繧貞炎髯、縺吶k譁?ュ怜?
311 ) : string; //繧ソ繧ー蜑企勁隱槭?譁?ュ怜?
312 var
313 pos : Integer;
314 begin
315 Result := '';
316
317 //</font>繧貞炎髯、
318 inSource := CustomStringReplace( inSource, '</font>', '', True);
319 //<font 繧貞?縺ヲ蟆乗枚蟄励↓螟画鋤縺吶k
320 inSource := CustomStringReplace( inSource, '<font', '<font', True);
321 //<font 縲 繧貞炎髯、縺吶k
322 pos := AnsiPos('<font', inSource);
323 while (pos > 0) do begin
324 Result := Result + Copy(inSource, 1, pos - 1);
325 Delete(inSource, 1, pos);
326 //繧ソ繧ー繧帝哩縺倥k'>'縺セ縺ァ繧貞炎髯、
327 pos := AnsiPos('>', inSource);
328 Delete(inSource, 1, pos);
329 pos := AnsiPos('<font', inSource);
330 end;
331
332 Result := Result + inSource;
333
334
335 end;
336 // *************************************************************************
337
338 {!
339 \brief dat繝輔ぃ繧、繝ォ縺ョ荳?繝ゥ繧、繝ウ繧貞?隗」
340 \param Line dat繝輔ぃ繧、繝ォ繧呈ァ区?縺吶k 1 陦?/span>
341 \return 繝ャ繧ケ諠??ア
342 }
343 procedure DivideStrLine(Line: string; PRes: PResRec);
344 const
345 delimiter = '<>';
346 var
347 pds, pde : PChar;
348 pss, pse : PChar;
349 begin
350 pss := PChar(Line);
351 pse := pss + Length(Line);
352 pds := PChar(delimiter);
353 pde := pds + Length(delimiter);
354
355 if AnsiStrPosEx(pss, pse, pds, pde) = nil then begin
356 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
357 Line := CustomStringReplace(Line, ',', '<>');
358 Line := CustomStringReplace(Line, '????', ',');
359 end;
360 //Delim := '<>';
361 {Result.FType := glt2chNew;
362 //Trim縺励※縺ッ縺?¢縺ェ縺?ー励′縺吶k縲?by繧ゅ§繧?/span>
363 Result.FName := RemoveToken(Line, delimiter);
364 Result.FMailTo := RemoveToken(Line, delimiter);
365 Result.FDateTime := RemoveToken(Line, delimiter);
366 Result.FBody := RemoveToken(Line, delimiter);
367 //?偵■繧?s縺ュ繧九→縺九□縺ィ縲∵悽譁??蜈磯?ュ縺ォ?代▽蜊願ァ堤ゥコ逋ス縺悟?縺」縺ヲ縺?k縺ョ縺ァ蜑企勁縺吶k
368 //莉悶?謗イ遉コ譚ソ縺ァ縲√Ξ繧ケ閾ェ菴薙?遨コ逋ス縺九b縺励l縺ェ縺?¢縺ゥ縺昴l縺ッ隲ヲ繧√k
369 Result.FBody := TrimLeft(Result.FBody);
370 //遨コ縺?縺ィ蝠城。後′襍キ縺阪k縺九i縲∫ゥコ逋ス繧定ィュ螳壹☆繧?/span>
371 if Result.FBody = '' then
372 Result.FBody := '&nbsp;';
373
374 Result.FTitle := RemoveToken(Line, delimiter);
375 }
376 PRes^.FType := glt2chNew;
377 //Trim縺励※縺ッ縺?¢縺ェ縺?ー励′縺吶k縲?by繧ゅ§繧?/span>
378 PRes^.FName := RemoveToken(Line, delimiter);
379 PRes^.FMailTo := RemoveToken(Line, delimiter);
380 PRes^.FDateTime := RemoveToken(Line, delimiter);
381 PRes^.FBody := RemoveToken(Line, delimiter);
382 //?偵■繧?s縺ュ繧九→縺九□縺ィ縲∵悽譁??蜈磯?ュ縺ォ?代▽蜊願ァ堤ゥコ逋ス縺悟?縺」縺ヲ縺?k縺ョ縺ァ蜑企勁縺吶k
383 //莉悶?謗イ遉コ譚ソ縺ァ縲√Ξ繧ケ閾ェ菴薙?遨コ逋ス縺九b縺励l縺ェ縺?¢縺ゥ縺昴l縺ッ隲ヲ繧√k
384 PRes^.FBody := TrimLeft(PRes^.FBody);
385 //遨コ縺?縺ィ蝠城。後′襍キ縺阪k縺九i縲∫ゥコ逋ス繧定ィュ螳壹☆繧?/span>
386 if PRes^.FBody = '' then
387 PRes^.FBody := '&nbsp;';
388
389 PRes^.FTitle := RemoveToken(Line, delimiter);
390 end;
391
392 (*************************************************************************
393 *
394 *縺ゥ縺薙°縺ョ繧オ繧、繝医°繧峨?繝代け繝ェ
395 *************************************************************************)
396 function RemoveToken(var s: string;const delimiter: string): string;
397 var
398 p: Integer;
399 pos : PChar;
400 pds, pde : PChar;
401 pss, pse : PChar;
402 begin
403 pss := PChar(s);
404 pse := pss + Length(s);
405 pds := PChar(delimiter);
406 pde := pds + Length(delimiter);
407
408 pos := AnsiStrPosEx(pss, pse, pds, pde);
409 if pos <> nil then begin
410 p := pos - pss;
411 SetString(Result, pss, p);
412 Delete(s, 1, p + Length(delimiter));
413 end else begin
414 Result := s;
415 s := '';
416 end;
417 end;
418
419
420 end.

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