MojuUtils.pas

   1 unit MojuUtils;
   2 //******************************************************************************
   3 //      \8d¡\82Ì\8f\8a\81A\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94 CustomStringReplace\81@\82¾\82¯\81B
   4 //  \8eg\82¢\95û\82Í\81A
   5 //\81@CustomStringReplace(
   6 //\81@    \8c³\82Ì\95¶\8e\9a\97ñ\81iString\82à\82µ\82\82ÍTStringList),
   7 //\81@    \8c\9f\8dõ\95¶\8e\9a\97ñ\81iString),
   8 //              \92u\8a·\95¶\8e\9a\97ñ\81iString),
   9 //      \91å\95¶\8e\9a\8f¬\95¶\8e\9a\81iBoolean)True:\8bæ\95Ê\82µ\82È\82¢\81@false or \8fÈ\97ª:\8bæ\95Ê\82·\82é
  10 //
  11 // Delphi-ML\82Ì\8bL\8e\9669334\82É\8dÚ\82Á\82Ä\82¢\82½\83R\81[\83h\82ð\8aÛ\83p\83N\83\8a\82µ\82Ü\82µ\82½\81B
  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 function ReplaceString(const S, OldPattern, NewPattern: string): string;
 108 var
 109     ReplaceCount: Integer;
 110     DestIndex: Integer;
 111     i: Integer;
 112     p, e, ps, pe: PChar;
 113     Count: Integer;
 114 begin
 115     Result := S;
 116     if OldPattern = '' then Exit;
 117     p := PChar(S);
 118     e := p + Length(S);
 119     ps := PChar(OldPattern);
 120     pe := ps + Length(OldPattern);
 121     ReplaceCount := 0;
 122     while p < e do begin
 123         p := AnsiStrPosEx(p, e, ps, pe);
 124         if p = nil then Break;
 125         Inc(ReplaceCount);
 126         Inc(p, Length(OldPattern));
 127     end;
 128     if ReplaceCount = 0 then Exit;
 129     SetString(Result, nil, Length(S) +
 130     (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
 131     p := PChar(S);
 132     DestIndex := 1;
 133     for i := 0 to ReplaceCount - 1 do begin
 134         Count := AnsiStrPosEx(p, e, ps, pe) - p;
 135         Move(p^, Result[DestIndex], Count);
 136         Inc(p, Count);//p := pp;
 137         Inc(DestIndex, Count);
 138         Move(NewPattern[1], Result[DestIndex], Length(NewPattern));
 139         Inc(p, Length(OldPattern));
 140         Inc(DestIndex, Length(NewPattern));
 141     end;
 142     Move(p^, Result[DestIndex], e - p);
 143 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.