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.9 - (show annotations) (download) (as text)
Sat Mar 19 13:47:48 2005 UTC (19 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_50_0_571
Changes since 1.8: +14 -1 lines
File MIME type: text/x-pascal
入力文字列中のファイル名に使えない文字を全角化する関数の新設

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

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