Develop and Download Open Source Software

Browse CVS Repository

Diff of /gikonavigoeson/gikonavi/MojuUtils.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by h677, Tue Nov 25 18:22:43 2003 UTC revision 1.3 by h677, Wed Nov 26 03:57:24 2003 UTC
# Line 1  Line 1 
1  unit MojuUtils;  unit MojuUtils;
2  //**************************  //******************************************************************************
3  //      今の所、文字列置換関数 CustomStringReplace だけ。  //      今の所、文字列置換関数 CustomStringReplace だけ。
4  //**************************  //  使い方は、
5    // CustomStringReplace(
6    //     元の文字列(StringもしくはTStringList),
7    //     検索文字列(String),
8    //              置換文字列(String),
9    //      大文字小文字(Boolean)True:区別しない false or 省略:区別する
10    //
11    // Delphi-MLの記事69334に載っていたコードを丸パクリしました。
12    //******************************************************************************
13    
14  interface  interface
15    
# Line 11  uses Line 19  uses
19      function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;      function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
20      function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;      function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
21      function ReplaceString(const S, OldPattern, NewPattern: string): string;      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;      function CustomStringReplace(S , OldPattern: String;const  NewPattern: string): String; overload;
25      function CustomStringReplace(S , OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean): String; overload;      function CustomStringReplace(S , OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean): String; overload;
# Line 20  uses Line 29  uses
29    
30  implementation  implementation
31    
 function CustomStringReplace(  
         S ,OldPattern: String;  
     const NewPattern: string  
 ): String;  
 {  
 var  
         position : Integer;  
     lenOld : Integer;//OldPatternの長さ  
 }  
 begin  
     Result := ReplaceString(S,OldPattern,NewPattern);  
 {  
     position := 0;  
     lenOld := Length(OldPattern);  
     Result := '';  
     position := AnsiPos( OldPattern, S);  
     while  position  <> 0  do begin  
         Result := Result + Copy(S,1,position -1 ) + NewPattern;  
         Delete(S,1, position + lenOld - 1);  
         position := AnsiPos( OldPattern, S);  
     end;  
     if Length( S ) > 0 then begin  
         Result := Result + S;  
     end;  
 }  
   
 end;  
 function CustomStringReplace(  
         S , OldPattern: String;  
     const  NewPattern: string;  
     IgnoreCase : Boolean  
 ): String;  
 var  
         position : Integer;  
     lenOld : Integer;//OldPatternの長さ  
     buffer : String;  
 begin  
     position := 0;  
     lenOld := Length(OldPattern);  
     Result := '';  
     if not IgnoreCase then begin  
         Result := ReplaceString(S,OldPattern,NewPattern);  
     end else begin  
         buffer := AnsiLowerCase(S);  
         OldPattern := AnsiLowerCase(OldPattern);  
         position := AnsiPos( OldPattern, buffer);  
         while  position  <> 0  do begin  
             Result := Result + Copy(S,1,position -1 ) + NewPattern;  
             Delete(S,1, position + lenOld - 1);  
             Delete(buffer,1, position + lenOld - 1);  
             position := AnsiPos( OldPattern, buffer);  
         end;  
         if Length( S ) > 0 then begin  
             Result := Result + S;  
         end;  
     end;  
 end;  
 procedure CustomStringReplace(  
         var S : TStringList;  
     OldPattern: String;  
     const  NewPattern: string;  
     IgnoreCase : Boolean  
 );  
 var  
     i : Integer;  
 begin  
     if not IgnoreCase then begin  
         for i := 0 to S.Count - 1 do begin  
                 S.Strings[i] := ReplaceString(S.Strings[i],OldPattern,NewPattern);  
         end;  
     end else begin  
         for i := 0 to S.Count - 1 do begin  
                 S.Strings[i] := CustomStringReplace( S.Strings[i], OldPattern, NewPattern,IgnoreCase );  
         end;  
     end;  
 end;  
 procedure CustomStringReplace(  
         var S : TStringList;  
     OldPattern: String;  
     const  NewPattern: string  
 );  
 var  
     i : Integer;  
 begin  
         for i := 0 to S.Count - 1 do begin  
         S.Strings[i] := ReplaceString(S.Strings[i],OldPattern,NewPattern);  
     end;  
 end;  
   
32  function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;  function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
33  asm  asm
34          PUSH    EBX          PUSH    EBX
# Line 162  end; Line 82  end;
82    
83  function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;  function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
84  var  var
85    L2: Cardinal;      L2: Cardinal;
86    ByteType : TMbcsByteType;      ByteType : TMbcsByteType;
87  begin  begin
88    Result := nil;      Result := nil;
89    if (StrStart = nil) or (StrStart^ = #0) or      if (StrStart = nil) or (StrStart^ = #0) or
90      (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;          (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
91    L2 := SubstrEnd - SubstrStart;  
92    Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);      L2 := SubstrEnd - SubstrStart;
93    while (Result <> nil) and (StrEnd - Result >= L2) do begin      Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
94      ByteType := StrByteType(StrStart, Integer(Result-StrStart));  
95      if (ByteType <> mbTrailByte) and      while (Result <> nil) and (StrEnd - Result >= L2) do begin
96        (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)          ByteType := StrByteType(StrStart, Integer(Result-StrStart));
97  then Exit;          if (ByteType <> mbTrailByte) and
98      if (ByteType = mbLeadByte) then Inc(Result);                  (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
99      Inc(Result);          then Exit;
100      Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);          if (ByteType = mbLeadByte) then Inc(Result);
101    end;          Inc(Result);
102    Result := nil;          Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
103        end;
104        Result := nil;
105  end;  end;
106    
107  function ReplaceString(const S, OldPattern, NewPattern: string): string;  function ReplaceString(const S, OldPattern, NewPattern: string): string;
108  var  var
109    ReplaceCount: Integer;      ReplaceCount: Integer;
110    DestIndex: Integer;      DestIndex: Integer;
111    i: Integer;      i: Integer;
112    p, e, ps, pe: PChar;      p, e, ps, pe: PChar;
113    Count: Integer;      Count: Integer;
114  begin  begin
115    Result := S;      Result := S;
116    if OldPattern = '' then Exit;      if OldPattern = '' then Exit;
117      p := PChar(S);      p := PChar(S);
118      e := p + Length(S);      e := p + Length(S);
119      ps := PChar(OldPattern);      ps := PChar(OldPattern);
120      pe := ps + Length(OldPattern);      pe := ps + Length(OldPattern);
121      ReplaceCount := 0;      ReplaceCount := 0;
122      while p < e do begin      while p < e do begin
123        p := AnsiStrPosEx(p, e, ps, pe);          p := AnsiStrPosEx(p, e, ps, pe);
124        if p = nil then Break;          if p = nil then Break;
125        Inc(ReplaceCount);          Inc(ReplaceCount);
126        Inc(p, Length(OldPattern));          Inc(p, Length(OldPattern));
127      end;      end;
128      if ReplaceCount = 0 then Exit;      if ReplaceCount = 0 then Exit;
129      SetString(Result, nil, Length(S) +      SetString(Result, nil, Length(S) +
130        (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);      (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
131      p := PChar(S);      p := PChar(S);
132      DestIndex := 1;      DestIndex := 1;
133      for i := 0 to ReplaceCount - 1 do begin      for i := 0 to ReplaceCount - 1 do begin
134        Count := AnsiStrPosEx(p, e, ps, pe) - p;          Count := AnsiStrPosEx(p, e, ps, pe) - p;
135        Move(p^, Result[DestIndex], Count);          Move(p^, Result[DestIndex], Count);
136        Inc(p, Count);//p := pp;          Inc(p, Count);//p := pp;
137        Inc(DestIndex, Count);          Inc(DestIndex, Count);
138        Move(NewPattern[1], Result[DestIndex], Length(NewPattern));          Move(NewPattern[1], Result[DestIndex], Length(NewPattern));
139        Inc(p, Length(OldPattern));          Inc(p, Length(OldPattern));
140        Inc(DestIndex, Length(NewPattern));          Inc(DestIndex, Length(NewPattern));
141      end;      end;
142      Move(p^, Result[DestIndex], e - p);      Move(p^, Result[DestIndex], e - p);
143  end;  end;
144    
145    function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
146    var
147        ReplaceCount: Integer;
148        DestIndex: Integer;
149        i: Integer;
150        p, e{, ps, pe}: PChar;
151        p2, e2, ps2, pe2: PChar;
152        Count: Integer;
153        bufferS : String;
154        bufferOldPattern : String;
155    begin
156        Result := S;
157        bufferS := AnsiLowerCase(S);
158        bufferOldPattern := AnsiLowerCase(OldPattern);
159    
160        if OldPattern = '' then Exit;
161        p   := PChar(S);
162        p2  := PChar(bufferS);
163        e   := p + Length(S);
164        e2  := p2 + Length(bufferS);
165        //ps        := PChar(OldPattern);
166        ps2 := PChar(bufferOldPattern);
167        //pe        := ps + Length(OldPattern);
168        pe2 := ps2 + Length(bufferOldPattern);
169    
170        ReplaceCount := 0;
171        while p2 < e2 do begin
172            p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
173            if p2 = nil then Break;
174            Inc(ReplaceCount);
175            Inc(p2, Length(bufferOldPattern));
176        end;
177        if ReplaceCount = 0 then Exit;
178        SetString(Result, nil, Length(bufferS) +
179        (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
180        p2 := PChar(bufferS);
181        DestIndex := 1;
182        for i := 0 to ReplaceCount - 1 do begin
183            Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
184            Move(p^, Result[DestIndex], Count);
185            Inc(p, Count);//p := pp;
186            Inc(p2, Count);//p := pp;
187            Inc(DestIndex, Count);
188            Move(NewPattern[1], Result[DestIndex], Length(NewPattern));
189            Inc(p, Length(OldPattern));
190            Inc(p2, Length(OldPattern));
191            Inc(DestIndex, Length(NewPattern));
192        end;
193        Move(p^, Result[DestIndex], e - p);
194    end;
195    
196    function CustomStringReplace(
197            S ,OldPattern: String;
198        const NewPattern: string
199    ): String;
200    
201    begin
202        Result := ReplaceString(S,OldPattern,NewPattern);
203    end;
204    
205    
206    function CustomStringReplace(
207            S , OldPattern: String;
208        const  NewPattern: string;
209        IgnoreCase : Boolean
210    ): String;
211    begin
212        Result := '';
213        if not IgnoreCase then begin
214            Result := ReplaceString(S,OldPattern,NewPattern);
215        end else begin
216            Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
217        end;
218    end;
219    
220    
221    procedure CustomStringReplace(
222            var S : TStringList;
223        OldPattern: String;
224        const  NewPattern: string;
225        IgnoreCase : Boolean
226    );
227    var
228        i : Integer;
229    begin
230        S.BeginUpdate;
231        if not IgnoreCase then begin
232            for i := 0 to S.Count - 1 do begin
233                S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
234            end;
235        end else begin
236            for i := 0 to S.Count - 1 do begin
237                S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
238            end;
239        end;
240        S.EndUpdate;
241    end;
242    
243    
244    procedure CustomStringReplace(
245            var S : TStringList;
246        OldPattern: String;
247        const  NewPattern: string
248    );
249    var
250        i : Integer;
251    begin
252        S.BeginUpdate;
253            for i := 0 to S.Count - 1 do begin
254                    S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
255        end;
256        S.EndUpdate;
257    end;
258    
259    
260  end.  end.

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

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