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