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.7 - (hide annotations) (download) (as text)
Wed Aug 4 12:46:39 2004 UTC (19 years, 8 months ago) by h677
Branch: MAIN
Changes since 1.6: +5 -2 lines
File MIME type: text/x-pascal
ZenToHan関数の255バイト制限をとったときに、変換した文字列中に'#0'が
現れる不具合を起こしていたので、それを解消。

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

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