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.4 - (show annotations) (download) (as text)
Mon Mar 8 08:53:40 2004 UTC (20 years, 1 month ago) by yoffy
Branch: MAIN
CVS Tags: b47
Branch point for: BRANCH_TORA, stable
Changes since 1.3: +12 -6 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
30 implementation
31
32 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
33 asm
34 PUSH EBX
35 PUSH ESI
36 PUSH EDI
37
38 MOV ESI,ECX { Point ESI to substr }
39 MOV EDI,EAX { Point EDI to s }
40
41 MOV ECX,EDX { ECX = search length }
42 SUB ECX,EAX
43
44 MOV EDX,SubstrEnd
45 SUB EDX,ESI
46
47 DEC EDX { EDX = Length(substr) - 1 }
48 JS @@fail { < 0 ? return 0 }
49 MOV AL,[ESI] { AL = first char of substr }
50 INC ESI { Point ESI to 2'nd char of substr }
51
52 SUB ECX,EDX { #positions in s to look at }
53 { = Length(s) - Length(substr) + 1 }
54 JLE @@fail
55 @@loop:
56 REPNE SCASB
57 JNE @@fail
58 MOV EBX,ECX { save outer loop counter }
59 PUSH ESI { save outer loop substr pointer }
60 PUSH EDI { save outer loop s pointer }
61
62 MOV ECX,EDX
63 REPE CMPSB
64 POP EDI { restore outer loop s pointer }
65 POP ESI { restore outer loop substr pointer }
66 JE @@found
67 MOV ECX,EBX { restore outer loop counter }
68 JMP @@loop
69
70 @@fail:
71 XOR EAX,EAX
72 JMP @@exit
73
74 @@found:
75 MOV EAX,EDI { EDI points of char after match }
76 DEC EAX
77 @@exit:
78 POP EDI
79 POP ESI
80 POP EBX
81 end;
82
83 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
84 var
85 L2: Cardinal;
86 ByteType : TMbcsByteType;
87 begin
88 Result := nil;
89 if (StrStart = nil) or (StrStart^ = #0) or
90 (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
91
92 L2 := SubstrEnd - SubstrStart;
93 Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
94
95 while (Result <> nil) and (StrEnd - Result >= L2) do begin
96 ByteType := StrByteType(StrStart, Integer(Result-StrStart));
97 if (ByteType <> mbTrailByte) and
98 (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
99 then Exit;
100 if (ByteType = mbLeadByte) then Inc(Result);
101 Inc(Result);
102 Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
103 end;
104 Result := nil;
105 end;
106
107 {$R-}
108 function ReplaceString(const S, OldPattern, NewPattern: string): string;
109 var
110 ReplaceCount: Integer;
111 DestIndex: Integer;
112 i, l: Integer;
113 p, e, ps, pe: PChar;
114 Count: Integer;
115 begin
116 Result := S;
117 if OldPattern = '' then Exit;
118 p := PChar(S);
119 e := p + Length(S);
120 ps := PChar(OldPattern);
121 pe := ps + Length(OldPattern);
122 ReplaceCount := 0;
123 while p < e do begin
124 p := AnsiStrPosEx(p, e, ps, pe);
125 if p = nil then Break;
126 Inc(ReplaceCount);
127 Inc(p, Length(OldPattern));
128 end;
129 if ReplaceCount = 0 then Exit;
130 SetString(Result, nil, Length(S) +
131 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
132 p := PChar(S);
133 DestIndex := 1;
134 l := Length( NewPattern );
135 for i := 0 to ReplaceCount - 1 do begin
136 Count := AnsiStrPosEx(p, e, ps, pe) - p;
137 Move(p^, Result[DestIndex], Count);
138 Inc(p, Count);//p := pp;
139 Inc(DestIndex, Count);
140 Move(NewPattern[1], Result[DestIndex], l);
141 Inc(p, Length(OldPattern));
142 Inc(DestIndex, l);
143 end;
144 Move(p^, Result[DestIndex], e - p);
145 end;
146
147 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
148 var
149 ReplaceCount: Integer;
150 DestIndex: Integer;
151 i, l: Integer;
152 p, e{, ps, pe}: PChar;
153 p2, e2, ps2, pe2: PChar;
154 Count: Integer;
155 bufferS : String;
156 bufferOldPattern : String;
157 begin
158 Result := S;
159 bufferS := AnsiLowerCase(S);
160 bufferOldPattern := AnsiLowerCase(OldPattern);
161
162 if OldPattern = '' then Exit;
163 p := PChar(S);
164 p2 := PChar(bufferS);
165 e := p + Length(S);
166 e2 := p2 + Length(bufferS);
167 //ps := PChar(OldPattern);
168 ps2 := PChar(bufferOldPattern);
169 //pe := ps + Length(OldPattern);
170 pe2 := ps2 + Length(bufferOldPattern);
171
172 ReplaceCount := 0;
173 while p2 < e2 do begin
174 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
175 if p2 = nil then Break;
176 Inc(ReplaceCount);
177 Inc(p2, Length(bufferOldPattern));
178 end;
179 if ReplaceCount = 0 then Exit;
180 SetString(Result, nil, Length(bufferS) +
181 (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
182 p2 := PChar(bufferS);
183 DestIndex := 1;
184 l := Length( NewPattern );
185 for i := 0 to ReplaceCount - 1 do begin
186 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
187 Move(p^, Result[DestIndex], Count);
188 Inc(p, Count);//p := pp;
189 Inc(p2, Count);//p := pp;
190 Inc(DestIndex, Count);
191 Move(NewPattern[1], Result[DestIndex], l);
192 Inc(p, Length(OldPattern));
193 Inc(p2, Length(OldPattern));
194 Inc(DestIndex, l);
195 end;
196 Move(p^, Result[DestIndex], e - p);
197 end;
198 {$IFDEF DEBUG}
199 {$R+}
200 {$ENDIF}
201
202 function CustomStringReplace(
203 S ,OldPattern: String;
204 const NewPattern: string
205 ): String;
206
207 begin
208 Result := ReplaceString(S,OldPattern,NewPattern);
209 end;
210
211
212 function CustomStringReplace(
213 S , OldPattern: String;
214 const NewPattern: string;
215 IgnoreCase : Boolean
216 ): String;
217 begin
218 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 end;
225
226
227 procedure CustomStringReplace(
228 var S : TStringList;
229 OldPattern: String;
230 const NewPattern: string;
231 IgnoreCase : Boolean
232 );
233 var
234 i : Integer;
235 begin
236 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 end;
248
249
250 procedure CustomStringReplace(
251 var S : TStringList;
252 OldPattern: String;
253 const NewPattern: string
254 );
255 var
256 i : Integer;
257 begin
258 S.BeginUpdate;
259 for i := 0 to S.Count - 1 do begin
260 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
261 end;
262 S.EndUpdate;
263 end;
264
265
266 end.

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