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.10 - (hide annotations) (download) (as text)
Wed Mar 23 13:07:19 2005 UTC (19 years, 1 month ago) by h677
Branch: MAIN
CVS Tags: v1_50_0_572, v1_50_0_574, v1_50_0_573, root-of-remodel
Branch point for: remodeling
Changes since 1.9: +16 -1 lines
File MIME type: text/x-pascal
非スキンのIDポップアップで、無効なIDのチェックをするようにした。

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 h677 1.9 function ReplaseNoValidateChar( inVal : String): String;
33 h677 1.10 function IsNoValidID( inID :String): Boolean;
34 h677 1.1 implementation
35 h677 1.5 // ???ゃ?潟?帥?種??≪?祉?潟??????????蕭???????/span>
36 h677 1.2 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
37     asm
38     PUSH EBX
39 h677 1.5 PUSH ESI
40 h677 1.2 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 h677 1.5 //??AnsiPos???????
87 h677 1.2 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
88     var
89 h677 1.3 L2: Cardinal;
90     ByteType : TMbcsByteType;
91 h677 1.2 begin
92 h677 1.3 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 h677 1.2 end;
110    
111 yoffy 1.4 {$R-}
112 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴???????鐚?
113 h677 1.2 function ReplaceString(const S, OldPattern, NewPattern: string): string;
114     var
115 h677 1.3 ReplaceCount: Integer;
116     DestIndex: Integer;
117 yoffy 1.4 i, l: Integer;
118 h677 1.3 p, e, ps, pe: PChar;
119     Count: Integer;
120 h677 1.2 begin
121 h677 1.3 Result := S;
122     if OldPattern = '' then Exit;
123 h677 1.2 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 h677 1.3 p := AnsiStrPosEx(p, e, ps, pe);
130     if p = nil then Break;
131     Inc(ReplaceCount);
132     Inc(p, Length(OldPattern));
133 h677 1.1 end;
134 h677 1.2 if ReplaceCount = 0 then Exit;
135     SetString(Result, nil, Length(S) +
136 h677 1.3 (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
137 h677 1.2 p := PChar(S);
138     DestIndex := 1;
139 yoffy 1.4 l := Length( NewPattern );
140 h677 1.2 for i := 0 to ReplaceCount - 1 do begin
141 h677 1.3 Count := AnsiStrPosEx(p, e, ps, pe) - p;
142     Move(p^, Result[DestIndex], Count);
143     Inc(p, Count);//p := pp;
144     Inc(DestIndex, Count);
145 yoffy 1.4 Move(NewPattern[1], Result[DestIndex], l);
146 h677 1.3 Inc(p, Length(OldPattern));
147 yoffy 1.4 Inc(DestIndex, l);
148 h677 1.2 end;
149     Move(p^, Result[DestIndex], e - p);
150 h677 1.1 end;
151 h677 1.5 //蕭?????絖???臀???∽?逸?紊ф??絖?絨??絖??????????∴?????鐚?
152 h677 1.3 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
153     var
154 h677 1.5 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 h677 1.3 begin
163 h677 1.5 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 h677 1.3 end;
203 yoffy 1.4 {$IFDEF DEBUG}
204     {$R+}
205     {$ENDIF}
206 h677 1.3
207 h677 1.5 //蕭?????絖???臀???∽?逸??????????c??鐚?
208 h677 1.3 function CustomStringReplace(
209     S ,OldPattern: String;
210 h677 1.5 const NewPattern: string
211 h677 1.3 ): String;
212    
213     begin
214 h677 1.5 Result := ReplaceString(S,OldPattern,NewPattern);
215 h677 1.3 end;
216    
217 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
218 h677 1.3 function CustomStringReplace(
219     S , OldPattern: String;
220 h677 1.5 const NewPattern: string;
221     IgnoreCase : Boolean
222 h677 1.3 ): String;
223     begin
224 h677 1.5 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 h677 1.3 end;
231    
232 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
233 h677 1.3 procedure CustomStringReplace(
234     var S : TStringList;
235 h677 1.5 OldPattern: String;
236     const NewPattern: string;
237     IgnoreCase : Boolean
238 h677 1.3 );
239     var
240 h677 1.5 i : Integer;
241 h677 1.3 begin
242 h677 1.5 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 h677 1.3 end;
254    
255 h677 1.5 //蕭?????絖???臀???∽?逸?羆?????鐚?鐚?
256 h677 1.3 procedure CustomStringReplace(
257     var S : TStringList;
258 h677 1.5 OldPattern: String;
259     const NewPattern: string
260 h677 1.3 );
261     var
262 h677 1.5 i : Integer;
263 h677 1.3 begin
264 h677 1.5 S.BeginUpdate;
265 h677 1.3 for i := 0 to S.Count - 1 do begin
266     S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
267 h677 1.5 end;
268     S.EndUpdate;
269     end;
270    
271     (*************************************************************************
272     * ???????茹?
273     * from HotZonu
274     *************************************************************************)
275     function ZenToHan(const s: string): string;
276     var
277 h677 1.6 //Chr: array [0..1024] of char;
278     Chr: string;
279 yoffy 1.8 ChrLen : Integer;
280 h677 1.5 begin
281 yoffy 1.8 SetLength(Chr, Length(s));
282     ChrLen := Windows.LCMapString(
283 h677 1.5 GetUserDefaultLCID(),
284     // LCMAP_HALFWIDTH,
285     LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
286     PChar(s),
287 yoffy 1.8 Length(s),
288 h677 1.6 PChar(Chr),
289     Length(Chr)
290 h677 1.5 );
291 yoffy 1.8 Result := Copy(Chr, 1, ChrLen);
292 h677 1.3 end;
293    
294 h677 1.5 (*************************************************************************
295     * ?????茹??蚊?????????????????阪?ャ??????????Pos
296     *************************************************************************)
297     function VaguePos(const Substr, S: string): Integer;
298     begin
299     Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
300     end;
301 h677 1.9 (*************************************************************************
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 h677 1.10 (*************************************************************************
314     * ?≦?鴻??D???????с??????≦?剛?鐚?ID:??? , ID:???0)
315     *************************************************************************)
316     function IsNoValidID( inID :String): Boolean;
317     begin
318     inID := Trim(inID);
319     if inID = '' then Result := True
320     else begin
321     inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
322     inID := CustomStringReplace(inID, '?', '');
323     if (inID = '') or (inID = '0') then Result := True
324     else Result := False;
325     end;
326     end;
327    
328 h677 1.1 end.

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