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.11.2.1 - (show annotations) (download) (as text)
Tue Jul 26 15:19:30 2005 UTC (18 years, 8 months ago) by h677
Branch: Bb50
CVS Tags: v1_50_2_606, v1_50_0_603, v1_50_0_604, v1_50_0_606, v1_50_2_604, v1_50_0_602, v1_50_0_601, v1_50_0_605
Changes since 1.11: +5 -2 lines
File MIME type: text/x-pascal
FAT/NTFSでファイル名に使えない文字に".",":",";"(ピリオド、コロン、セミコロン)を追加

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, 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>?帥?違?????????ゃ????
33 function DeleteFontTag( inSource : string) : string;
34
35 implementation
36 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
37 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
38 asm
39 PUSH EBX
40 PUSH ESI
41 PUSH EDI
42
43 MOV ESI,ECX { Point ESI to substr }
44 MOV EDI,EAX { Point EDI to s }
45
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 //??AnsiPos???????
88 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
89 var
90 L2: Cardinal;
91 ByteType : TMbcsByteType;
92 begin
93 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 end;
111
112 {$R-}
113 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
114 function ReplaceString(const S, OldPattern, 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 begin
122 Result := S;
123 if OldPattern = '' then Exit;
124 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 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
138 p := PChar(S);
139 DestIndex := 1;
140 l := Length( NewPattern );
141 for i := 0 to ReplaceCount - 1 do begin
142 Count := AnsiStrPosEx(p, e, ps, pe) - p;
143 Move(p^, Result[DestIndex], Count);
144 Inc(p, Count);//p := pp;
145 Inc(DestIndex, Count);
146 Move(NewPattern[1], Result[DestIndex], l);
147 Inc(p, Length(OldPattern));
148 Inc(DestIndex, l);
149 end;
150 Move(p^, Result[DestIndex], e - p);
151 end;
152 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
153 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
154 var
155 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 begin
164 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 end;
204 {$IFDEF DEBUG}
205 {$R+}
206 {$ENDIF}
207
208 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
209 function CustomStringReplace(
210 S , OldPattern: String;
211 const NewPattern: string;
212 IgnoreCase : Boolean
213 ): String;
214 begin
215 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 end;
222
223 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
224 procedure CustomStringReplace(
225 var S : TStringList;
226 OldPattern: String;
227 const NewPattern: string;
228 IgnoreCase : Boolean
229 );
230 var
231 i : Integer;
232 begin
233 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 end;
245
246 (*************************************************************************
247 * ???????茹?
248 * from HotZonu
249 *************************************************************************)
250 function ZenToHan(const s: string): string;
251 var
252 //Chr: array [0..1024] of char;
253 Chr: string;
254 ChrLen : Integer;
255 begin
256 SetLength(Chr, 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(Chr),
264 Length(Chr)
265 );
266 Result := Copy(Chr, 1, ChrLen);
267 end;
268
269 (*************************************************************************
270 * ?????茹??蚊?????????????????阪?ャ??????????Pos
271 *************************************************************************)
272 function VaguePos(const Substr, S: string): Integer;
273 begin
274 Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
275 end;
276 (*************************************************************************
277 * FAT/NTFS?????<?ゃ??????┗??????????絖?鐚?\,/,:,.,;,*,>,<,|鐚????????舟??????
278 *************************************************************************)
279 function ReplaseNoValidateChar( inVal : String): String;
280 begin
281 Result := CustomStringReplace(inVal, '\', '鐃?#39;);
282 Result := CustomStringReplace(Result, '/', '鐚?39;);
283 Result := CustomStringReplace(Result, ':', '鐚?');
284 Result := CustomStringReplace(Result, '.', '鐚?#39;);
285 Result := CustomStringReplace(Result, ';', '鐚?');
286 Result := CustomStringReplace(Result, '*', '鐚?');
287 Result := CustomStringReplace(Result, '>', '鐚?');
288 Result := CustomStringReplace(Result, '<', '鐚?');
289 Result := CustomStringReplace(Result, '|', '鐔?');
290 end;
291 (*************************************************************************
292 * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , 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筝???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 end;
336 // *************************************************************************
337
338
339 end.

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