Develop and Download Open Source Software

Browse CVS Repository

Annotation of /gikonavigoeson/gikonavi/MojuUtils.pas

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


Revision 1.19 - (hide annotations) (download) (as text)
Wed Dec 7 15:48:16 2005 UTC (18 years, 4 months ago) by h677
Branch: MAIN
CVS Tags: v1_51_0_625
Changes since 1.18: +14 -26 lines
File MIME type: text/x-pascal
HTML作成部分の最適化

1 h677 1.1 unit MojuUtils;
2 h677 1.3 //******************************************************************************
3 h677 1.5 // ??絖???臀???∽? CustomStringReplace
4 h677 1.3 // 篏帥???鴻????
5     //??CustomStringReplace(
6     //?? ??????絖???鐚?String???????StringList),
7     //?? 罎?膣∽??絖???鐚?String),
8     // 臀????絖???鐚?String),
9     // 紊ф??絖?絨??絖?鐚?Boolean)True:?阪?ャ????????false or ?????阪?ャ????
10     //
11     // Delphi-ML???篋?69334????c???????潟?若????筝吾?????????障??????
12     //******************************************************************************
13 h677 1.1
14     interface
15    
16     uses
17 h677 1.13 Windows, Classes, SysUtils, GikoSystem;
18 h677 1.2
19 h677 1.5 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
20     function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
21 h677 1.18 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 h677 1.5
24 h677 1.18 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 h677 1.1
27 h677 1.5 function ZenToHan(const s: string): string;
28     function VaguePos(const Substr, S: string): Integer;
29 h677 1.1
30 h677 1.11 function ReplaseNoValidateChar( inVal : String): String;
31     function IsNoValidID( inID :String): Boolean;
32     //<font>?帥?違?????????ゃ????
33     function DeleteFontTag( inSource : string) : string;
34 h677 1.17 procedure DivideStrLine(Line: string; PRes: PResRec);
35 h677 1.13 function RemoveToken(var s: string;const delimiter: string): string;
36 h677 1.11
37 h677 1.1 implementation
38 h677 1.5 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
39 h677 1.2 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
40     asm
41 h677 1.11 PUSH EBX
42 h677 1.5 PUSH ESI
43 h677 1.11 PUSH EDI
44 h677 1.2
45 h677 1.11 MOV ESI,ECX { Point ESI to substr }
46     MOV EDI,EAX { Point EDI to s }
47 h677 1.2
48 h677 1.13 MOV ECX,EDX { ECX = search length }
49 h677 1.2 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 h677 1.5 //??AnsiPos???????
90 h677 1.2 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
91     var
92 h677 1.3 L2: Cardinal;
93     ByteType : TMbcsByteType;
94 h677 1.2 begin
95 h677 1.3 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 h677 1.2 end;
113    
114 yoffy 1.4 {$R-}
115 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
116 h677 1.18 function ReplaceString(const S: String; const OldPattern: String; const NewPattern: string): string;
117 h677 1.2 var
118 h677 1.3 ReplaceCount: Integer;
119     DestIndex: Integer;
120 yoffy 1.4 i, l: Integer;
121 h677 1.3 p, e, ps, pe: PChar;
122     Count: Integer;
123 h677 1.2 begin
124 h677 1.18 Result := S;
125     if OldPattern = '' then Exit;
126 h677 1.11 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 h677 1.18 (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 h677 1.2 end;
152     Move(p^, Result[DestIndex], e - p);
153 h677 1.1 end;
154 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
155 h677 1.18 function IgnoCaseReplaceString(const S: String;const OldPattern:String;const NewPattern: string): string;
156 h677 1.3 var
157 h677 1.5 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 h677 1.3 begin
166 h677 1.5 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 h677 1.3 end;
206 yoffy 1.4 {$IFDEF DEBUG}
207     {$R+}
208     {$ENDIF}
209 h677 1.3
210 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
211 h677 1.3 function CustomStringReplace(
212 h677 1.18 const S :String;
213     const OldPattern: String;
214 h677 1.5 const NewPattern: string;
215     IgnoreCase : Boolean
216 h677 1.3 ): String;
217     begin
218 h677 1.5 Result := '';
219     if not IgnoreCase then begin
220     Result := ReplaceString(S,OldPattern,NewPattern);
221     end else begin
222     Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
223     end;
224 h677 1.3 end;
225    
226 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
227 h677 1.3 procedure CustomStringReplace(
228     var S : TStringList;
229 h677 1.18 const OldPattern: String;
230 h677 1.5 const NewPattern: string;
231     IgnoreCase : Boolean
232 h677 1.3 );
233     var
234 h677 1.5 i : Integer;
235 h677 1.3 begin
236 h677 1.5 S.BeginUpdate;
237     if not IgnoreCase then begin
238     for i := 0 to S.Count - 1 do begin
239     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
240     end;
241     end else begin
242     for i := 0 to S.Count - 1 do begin
243     S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
244     end;
245     end;
246     S.EndUpdate;
247 h677 1.3 end;
248    
249 h677 1.5 (*************************************************************************
250     * ???????茹?
251     * from HotZonu
252     *************************************************************************)
253     function ZenToHan(const s: string): string;
254     var
255 yoffy 1.8 ChrLen : Integer;
256 h677 1.5 begin
257 h677 1.15 SetLength(Result, Length(s));
258 yoffy 1.8 ChrLen := Windows.LCMapString(
259 h677 1.5 GetUserDefaultLCID(),
260     // LCMAP_HALFWIDTH,
261     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
262     PChar(s),
263 yoffy 1.8 Length(s),
264 h677 1.15 PChar(Result),
265     Length(Result)
266 h677 1.5 );
267 h677 1.15 SetLength(Result, ChrLen);
268 h677 1.3 end;
269    
270 h677 1.5 (*************************************************************************
271     * ?????茹??蚊?????????????????阪?ャ??????????Pos
272     *************************************************************************)
273     function VaguePos(const Substr, S: string): Integer;
274     begin
275     Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
276     end;
277 h677 1.9 (*************************************************************************
278 h677 1.12 * FAT/NTFS?????<?ゃ??????┗??????????絖?鐚?\,/,:,.,;,*,>,<,|鐚????????舟??????
279 h677 1.9 *************************************************************************)
280     function ReplaseNoValidateChar( inVal : String): String;
281     begin
282     Result := CustomStringReplace(inVal, '\', '鐃?#39;);
283 h677 1.12 Result := CustomStringReplace(Result, '/', '鐚?39;);
284     Result := CustomStringReplace(Result, ':', '鐚?');
285     Result := CustomStringReplace(Result, '.', '鐚?#39;);
286     Result := CustomStringReplace(Result, ';', '鐚?');
287 h677 1.9 Result := CustomStringReplace(Result, '*', '鐚?');
288 h677 1.11 Result := CustomStringReplace(Result, '>', '鐚?');
289     Result := CustomStringReplace(Result, '<', '鐚?');
290     Result := CustomStringReplace(Result, '|', '鐔?');
291 h677 1.9 end;
292 h677 1.10 (*************************************************************************
293     * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , ID:???0)
294     *************************************************************************)
295     function IsNoValidID( inID :String): Boolean;
296     begin
297 h677 1.11 inID := Trim(inID);
298     if inID = '' then Result := True
299     else begin
300     inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
301     inID := CustomStringReplace(inID, '?', '');
302     if (inID = '') or (inID = '0') then Result := True
303     else Result := False;
304     end;
305     end;
306    
307     // *************************************************************************
308     // HTML筝???lt;font>?帥?違?????ゃ????
309     // *************************************************************************
310     function DeleteFontTag(
311     inSource : string //?帥?違?????ゃ??????絖???
312     ) : string; //?帥?医???よ?????絖???
313     var
314     pos : Integer;
315     begin
316     Result := '';
317    
318     //</font>??????/span>
319     inSource := CustomStringReplace( inSource, '</font>', '', True);
320     //<font ?????????絖??????????
321     inSource := CustomStringReplace( inSource, '<font', '<font', True);
322     //<font ?? ?????ゃ????
323     pos := AnsiPos('<font', inSource);
324     while (pos > 0) do begin
325     Result := Result + Copy(inSource, 1, pos - 1);
326     Delete(inSource, 1, pos);
327     //?帥?違????????'>'?障?с??????/span>
328     pos := AnsiPos('>', inSource);
329     Delete(inSource, 1, pos);
330     pos := AnsiPos('<font', inSource);
331     end;
332    
333     Result := Result + inSource;
334    
335    
336 h677 1.10 end;
337 h677 1.11 // *************************************************************************
338    
339 h677 1.16 {!
340     \brief dat???<?ゃ????????ゃ?潟????茹?/span>
341     \param Line dat???<?ゃ????罕??????? 1 茵?
342     \return ???号????/span>
343     }
344 h677 1.17 procedure DivideStrLine(Line: string; PRes: PResRec);
345 h677 1.14 const
346     delimiter = '<>';
347 h677 1.13 var
348 h677 1.14 pds, pde : PChar;
349     pss, pse : PChar;
350 h677 1.19 ppos : PChar;
351 h677 1.13 begin
352 h677 1.19 //?阪?
353     PRes.FType := glt2chNew;
354    
355 h677 1.14 pss := PChar(Line);
356     pse := pss + Length(Line);
357     pds := PChar(delimiter);
358     pde := pds + Length(delimiter);
359    
360 h677 1.19 ppos := AnsiStrPosEx(pss, pse, pds, pde);
361     if (ppos = nil) then begin
362 h677 1.13 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
363     Line := CustomStringReplace(Line, ',', '<>');
364     Line := CustomStringReplace(Line, '鐚?鐔?', ',');
365     end;
366 h677 1.17 //Trim??????????????羂?????????by??????
367 h677 1.19 PRes.FName := RemoveToken(Line, delimiter);
368     PRes.FMailTo := RemoveToken(Line, delimiter);
369     PRes.FDateTime := RemoveToken(Line, delimiter);
370     PRes.FBody := RemoveToken(Line, delimiter);
371 h677 1.17 //鐚??<????????????????????????????????ゅ??茹?腥榊?純???ャ?c?????????у???ゃ????
372     //篁???イ腓堺?帥?с?????壕???????純???????????????????????????
373 h677 1.19 PRes.FBody := TrimLeft(PRes.FBody);
374 h677 1.17 //腥冴?????馹???莎激??????????腥榊?純??荐??????
375 h677 1.19 if PRes.FBody = '' then
376     PRes.FBody := '&nbsp;';
377 h677 1.13
378 h677 1.19 PRes.FTitle := RemoveToken(Line, delimiter);
379 h677 1.13 end;
380    
381     (*************************************************************************
382     *
383     *?????????泣?ゃ??????????????/span>
384     *************************************************************************)
385     function RemoveToken(var s: string;const delimiter: string): string;
386     var
387     p: Integer;
388 h677 1.14 pos : PChar;
389     pds, pde : PChar;
390     pss, pse : PChar;
391 h677 1.13 begin
392 h677 1.14 pss := PChar(s);
393     pse := pss + Length(s);
394     pds := PChar(delimiter);
395     pde := pds + Length(delimiter);
396    
397     pos := AnsiStrPosEx(pss, pse, pds, pde);
398     if pos <> nil then begin
399     p := pos - pss;
400     SetString(Result, pss, p);
401     Delete(s, 1, p + Length(delimiter));
402     end else begin
403     Result := s;
404     s := '';
405     end;
406 h677 1.13 end;
407    
408 h677 1.10
409 h677 1.1 end.

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