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.10.2.2 - (hide 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 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.2 Windows, Classes, SysUtils;
18    
19 h677 1.5 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 h677 1.1
29 h677 1.5 function ZenToHan(const s: string): string;
30     function VaguePos(const Substr, S: string): Integer;
31 h677 1.1
32 h677 1.10.2.1 function ReplaseNoValidateChar( inVal : String): String;
33     function IsNoValidID( inID :String): Boolean;
34 h677 1.10.2.2 //<font>?帥?違?????????ゃ????
35     function DeleteFontTag( inSource : string) : string;
36 h677 1.10.2.1
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.10.2.1 PUSH EBX
42 h677 1.5 PUSH ESI
43 h677 1.10.2.1 PUSH EDI
44 h677 1.2
45 h677 1.10.2.1 MOV ESI,ECX { Point ESI to substr }
46     MOV EDI,EAX { Point EDI to s }
47 h677 1.2
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 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.2 function ReplaceString(const S, OldPattern, NewPattern: string): string;
117     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.3 Result := S;
125     if OldPattern = '' then Exit;
126 h677 1.10.2.2 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.3 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
140 h677 1.2 p := PChar(S);
141     DestIndex := 1;
142 yoffy 1.4 l := Length( NewPattern );
143 h677 1.2 for i := 0 to ReplaceCount - 1 do begin
144 h677 1.3 Count := AnsiStrPosEx(p, e, ps, pe) - p;
145     Move(p^, Result[DestIndex], Count);
146     Inc(p, Count);//p := pp;
147     Inc(DestIndex, Count);
148 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
149 h677 1.3 Inc(p, Length(OldPattern));
150 yoffy 1.4 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.3 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
156     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 //蕭?????絖???臀???∽?逸??????????c??鐚?
211 h677 1.3 function CustomStringReplace(
212     S ,OldPattern: String;
213 h677 1.5 const NewPattern: string
214 h677 1.3 ): String;
215    
216     begin
217 h677 1.5 Result := ReplaceString(S,OldPattern,NewPattern);
218 h677 1.3 end;
219    
220 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
221 h677 1.3 function CustomStringReplace(
222     S , OldPattern: String;
223 h677 1.5 const NewPattern: string;
224     IgnoreCase : Boolean
225 h677 1.3 ): String;
226     begin
227 h677 1.5 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 h677 1.3 end;
234    
235 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
236 h677 1.3 procedure CustomStringReplace(
237     var S : TStringList;
238 h677 1.5 OldPattern: String;
239     const NewPattern: string;
240     IgnoreCase : Boolean
241 h677 1.3 );
242     var
243 h677 1.5 i : Integer;
244 h677 1.3 begin
245 h677 1.5 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 h677 1.3 end;
257    
258 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
259 h677 1.3 procedure CustomStringReplace(
260     var S : TStringList;
261 h677 1.5 OldPattern: String;
262     const NewPattern: string
263 h677 1.3 );
264     var
265 h677 1.5 i : Integer;
266 h677 1.3 begin
267 h677 1.5 S.BeginUpdate;
268 h677 1.3 for i := 0 to S.Count - 1 do begin
269     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
270 h677 1.5 end;
271     S.EndUpdate;
272     end;
273    
274     (*************************************************************************
275     * ???????茹?
276     * from HotZonu
277     *************************************************************************)
278     function ZenToHan(const s: string): string;
279     var
280 h677 1.6 //Chr: array [0..1024] of char;
281     Chr: string;
282 yoffy 1.8 ChrLen : Integer;
283 h677 1.5 begin
284 yoffy 1.8 SetLength(Chr, Length(s));
285     ChrLen := Windows.LCMapString(
286 h677 1.5 GetUserDefaultLCID(),
287     // LCMAP_HALFWIDTH,
288     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
289     PChar(s),
290 yoffy 1.8 Length(s),
291 h677 1.6 PChar(Chr),
292     Length(Chr)
293 h677 1.5 );
294 yoffy 1.8 Result := Copy(Chr, 1, ChrLen);
295 h677 1.3 end;
296    
297 h677 1.5 (*************************************************************************
298     * ?????茹??蚊?????????????????阪?ャ??????????Pos
299     *************************************************************************)
300     function VaguePos(const Substr, S: string): Integer;
301     begin
302     Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
303     end;
304 h677 1.9 (*************************************************************************
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 h677 1.10.2.1 Result := CustomStringReplace(Result, '>', '鐚?');
313     Result := CustomStringReplace(Result, '<', '鐚?');
314     Result := CustomStringReplace(Result, '|', '鐔?');
315 h677 1.9 end;
316 h677 1.10 (*************************************************************************
317     * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , ID:???0)
318     *************************************************************************)
319     function IsNoValidID( inID :String): Boolean;
320     begin
321 h677 1.10.2.1 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 h677 1.10 end;
330 h677 1.10.2.2
331     // *************************************************************************
332     // HTML筝???lt;font>?帥?違?????ゃ????
333     // *************************************************************************
334     function DeleteFontTag(
335     inSource : string //?帥?違?????ゃ??????絖???
336     ) : string; //?帥?医???よ?????絖???
337 h677 1.10.2.1 var
338 h677 1.10.2.2 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 h677 1.10.2.1 end;
356    
357 h677 1.10.2.2 Result := Result + inSource;
358    
359    
360     end;
361     // *************************************************************************
362 h677 1.10.2.1
363 h677 1.10
364 h677 1.1 end.

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