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.12 - (hide annotations) (download) (as text)
Sun Jul 31 10:27:25 2005 UTC (18 years, 8 months ago) by h677
Branch: MAIN
Changes since 1.11: +5 -2 lines
File MIME type: text/x-pascal
602-603の修正を適応

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

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