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.4 - (hide 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 h677 1.1 unit MojuUtils;
2 h677 1.3 //******************************************************************************
3 h677 1.1 // 篁?????????絖???臀???∽? 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     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 h677 1.3 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
23 h677 1.1
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 h677 1.2 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 h677 1.3 L2: Cardinal;
86     ByteType : TMbcsByteType;
87 h677 1.2 begin
88 h677 1.3 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 h677 1.2 end;
106    
107 yoffy 1.4 {$R-}
108 h677 1.2 function ReplaceString(const S, OldPattern, NewPattern: string): string;
109     var
110 h677 1.3 ReplaceCount: Integer;
111     DestIndex: Integer;
112 yoffy 1.4 i, l: Integer;
113 h677 1.3 p, e, ps, pe: PChar;
114     Count: Integer;
115 h677 1.2 begin
116 h677 1.3 Result := S;
117     if OldPattern = '' then Exit;
118 h677 1.2 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 h677 1.3 p := AnsiStrPosEx(p, e, ps, pe);
125     if p = nil then Break;
126     Inc(ReplaceCount);
127     Inc(p, Length(OldPattern));
128 h677 1.1 end;
129 h677 1.2 if ReplaceCount = 0 then Exit;
130     SetString(Result, nil, Length(S) +
131 h677 1.3 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
132 h677 1.2 p := PChar(S);
133     DestIndex := 1;
134 yoffy 1.4 l := Length( NewPattern );
135 h677 1.2 for i := 0 to ReplaceCount - 1 do begin
136 h677 1.3 Count := AnsiStrPosEx(p, e, ps, pe) - p;
137     Move(p^, Result[DestIndex], Count);
138     Inc(p, Count);//p := pp;
139     Inc(DestIndex, Count);
140 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
141 h677 1.3 Inc(p, Length(OldPattern));
142 yoffy 1.4 Inc(DestIndex, l);
143 h677 1.2 end;
144     Move(p^, Result[DestIndex], e - p);
145 h677 1.1 end;
146 h677 1.3
147     function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
148     var
149     ReplaceCount: Integer;
150     DestIndex: Integer;
151 yoffy 1.4 i, l: Integer;
152 h677 1.3 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 yoffy 1.4 l := Length( NewPattern );
185 h677 1.3 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 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
192 h677 1.3 Inc(p, Length(OldPattern));
193     Inc(p2, Length(OldPattern));
194 yoffy 1.4 Inc(DestIndex, l);
195 h677 1.3 end;
196     Move(p^, Result[DestIndex], e - p);
197     end;
198 yoffy 1.4 {$IFDEF DEBUG}
199     {$R+}
200     {$ENDIF}
201 h677 1.3
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 h677 1.2
266 h677 1.1 end.

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