MojuUtils.pas

   1 unit MojuUtils;
   2 //******************************************************************************
   3 //      \95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94 CustomStringReplace
   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         function ZenToHan(const s: string): string;
  30         function VaguePos(const Substr, S: string): Integer;
  31
  32 implementation
  33 // \83|\83C\83\93\83^\81[\81\95\83A\83Z\83\93\83u\83\89\82É\82æ\82é\8d\82\91¬\83|\83X
  34 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  35 asm
  36         PUSH    EBX
  37                 PUSH    ESI
  38         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 //\81@AnsiPos\82Ì\8d\82\91¬\94Å
  85 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  86 var
  87     L2: Cardinal;
  88     ByteType : TMbcsByteType;
  89 begin
  90     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 end;
 108
 109 {$R-}
 110 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\91å\95¶\8e\9a\8f¬\95¶\8e\9a\82Ì\88á\82¢\82ð\96³\8e\8b\82µ\82È\82¢\81j
 111 function ReplaceString(const S, OldPattern, NewPattern: string): string;
 112 var
 113     ReplaceCount: Integer;
 114     DestIndex: Integer;
 115     i, l: Integer;
 116     p, e, ps, pe: PChar;
 117     Count: Integer;
 118 begin
 119     Result := S;
 120     if OldPattern = '' then Exit;
 121     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         p := AnsiStrPosEx(p, e, ps, pe);
 128         if p = nil then Break;
 129         Inc(ReplaceCount);
 130         Inc(p, Length(OldPattern));
 131     end;
 132     if ReplaceCount = 0 then Exit;
 133     SetString(Result, nil, Length(S) +
 134     (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
 135     p := PChar(S);
 136     DestIndex := 1;
 137     l := Length( NewPattern );
 138     for i := 0 to ReplaceCount - 1 do begin
 139         Count := AnsiStrPosEx(p, e, ps, pe) - p;
 140         Move(p^, Result[DestIndex], Count);
 141         Inc(p, Count);//p := pp;
 142         Inc(DestIndex, Count);
 143         Move(NewPattern[1], Result[DestIndex], l);
 144         Inc(p, Length(OldPattern));
 145         Inc(DestIndex, l);
 146     end;
 147     Move(p^, Result[DestIndex], e - p);
 148 end;
 149 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\91å\95¶\8e\9a\8f¬\95¶\8e\9a\82Ì\88á\82¢\82ð\96³\8e\8b\82·\82é\81j
 150 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
 151 var
 152         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 begin
 161         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 end;
 201 {$IFDEF DEBUG}
 202 {$R+}
 203 {$ENDIF}
 204
 205 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\83v\83\8a\83~\83e\83B\83u\81j
 206 function CustomStringReplace(
 207         S ,OldPattern: String;
 208         const NewPattern: string
 209 ): String;
 210
 211 begin
 212         Result := ReplaceString(S,OldPattern,NewPattern);
 213 end;
 214
 215 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82P\81j
 216 function CustomStringReplace(
 217         S , OldPattern: String;
 218         const  NewPattern: string;
 219         IgnoreCase : Boolean
 220 ): String;
 221 begin
 222         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 end;
 229
 230 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82Q\81j
 231 procedure CustomStringReplace(
 232         var S : TStringList;
 233         OldPattern: String;
 234         const  NewPattern: string;
 235         IgnoreCase : Boolean
 236 );
 237 var
 238         i : Integer;
 239 begin
 240         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 end;
 252
 253 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82R\81j
 254 procedure CustomStringReplace(
 255         var S : TStringList;
 256         OldPattern: String;
 257         const  NewPattern: string
 258 );
 259 var
 260         i : Integer;
 261 begin
 262         S.BeginUpdate;
 263         for i := 0 to S.Count - 1 do begin
 264                 S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);;
 265         end;
 266         S.EndUpdate;
 267 end;
 268
 269 (*************************************************************************
 270  * \91S\8ap\81¨\94¼\8ap
 271  * from HotZonu
 272  *************************************************************************)
 273 function ZenToHan(const s: string): string;
 274 var
 275         Chr: array [0..255] of char;
 276 begin
 277         Windows.LCMapString(
 278                  GetUserDefaultLCID(),
 279 //               LCMAP_HALFWIDTH,
 280                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
 281                  PChar(s),
 282                  Length(s) + 1,
 283                  chr,
 284                  Sizeof(chr)
 285                  );
 286         Result := Chr;
 287 end;
 288
 289 (*************************************************************************
 290  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
 291  *************************************************************************)
 292 function VaguePos(const Substr, S: string): Integer;
 293 begin
 294         Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
 295 end;
 296
 297 end.