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; IgnoreCase : Boolean = False): String; overload;
  25         procedure CustomStringReplace(var S : TStringList; OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean = False); overload;
  26
  27         function ZenToHan(const s: string): string;
  28         function VaguePos(const Substr, S: string): Integer;
  29
  30         function ReplaseNoValidateChar( inVal : String): String;
  31         function IsNoValidID( inID :String): Boolean;
  32         //<font>\83^\83O\82ð\91S\82Ä\8dí\8f\9c\82·\82é
  33         function        DeleteFontTag( inSource : string) : string;
  34
  35 implementation
  36 // \83|\83C\83\93\83^\81[\81\95\83A\83Z\83\93\83u\83\89\82É\82æ\82é\8d\82\91¬\83|\83X
  37 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  38 asm
  39                 PUSH    EBX
  40                 PUSH    ESI
  41                 PUSH    EDI
  42
  43                 MOV    ESI,ECX        { Point ESI to substr                  }
  44                 MOV    EDI,EAX        { Point EDI to s                        }
  45
  46         MOV    ECX,EDX        { ECX = search length                  }
  47         SUB    ECX,EAX
  48
  49         MOV    EDX,SubstrEnd
  50         SUB    EDX,ESI
  51
  52         DEC    EDX            { EDX = Length(substr) - 1              }
  53         JS      @@fail        { < 0 ? return 0                        }
  54         MOV    AL,[ESI]      { AL = first char of substr            }
  55         INC    ESI            { Point ESI to 2'nd char of substr      }
  56
  57         SUB    ECX,EDX        { #positions in s to look at            }
  58                               { = Length(s) - Length(substr) + 1      }
  59         JLE    @@fail
  60 @@loop:
  61         REPNE  SCASB
  62         JNE    @@fail
  63         MOV    EBX,ECX        { save outer loop counter              }
  64         PUSH    ESI            { save outer loop substr pointer        }
  65         PUSH    EDI            { save outer loop s pointer            }
  66
  67         MOV    ECX,EDX
  68         REPE    CMPSB
  69         POP    EDI            { restore outer loop s pointer          }
  70         POP    ESI            { restore outer loop substr pointer    }
  71         JE      @@found
  72         MOV    ECX,EBX        { restore outer loop counter            }
  73         JMP    @@loop
  74
  75 @@fail:
  76         XOR    EAX,EAX
  77         JMP    @@exit
  78
  79 @@found:
  80         MOV    EAX,EDI        { EDI points of char after match        }
  81         DEC    EAX
  82 @@exit:
  83         POP    EDI
  84         POP    ESI
  85         POP    EBX
  86 end;
  87 //\81@AnsiPos\82Ì\8d\82\91¬\94Å
  88 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  89 var
  90     L2: Cardinal;
  91     ByteType : TMbcsByteType;
  92 begin
  93     Result := nil;
  94     if (StrStart = nil) or (StrStart^ = #0) or
  95         (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
  96
  97     L2 := SubstrEnd - SubstrStart;
  98     Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
  99
 100     while (Result <> nil) and (StrEnd - Result >= L2) do begin
 101         ByteType := StrByteType(StrStart, Integer(Result-StrStart));
 102         if (ByteType <> mbTrailByte) and
 103                 (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
 104         then Exit;
 105         if (ByteType = mbLeadByte) then Inc(Result);
 106         Inc(Result);
 107         Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
 108     end;
 109     Result := nil;
 110 end;
 111
 112 {$R-}
 113 //\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
 114 function ReplaceString(const S, OldPattern, NewPattern: string): string;
 115 var
 116     ReplaceCount: Integer;
 117     DestIndex: Integer;
 118     i, l: Integer;
 119     p, e, ps, pe: PChar;
 120     Count: Integer;
 121 begin
 122     Result := S;
 123     if OldPattern = '' then Exit;
 124         p := PChar(S);
 125         e := p + Length(S);
 126         ps := PChar(OldPattern);
 127         pe := ps + Length(OldPattern);
 128         ReplaceCount := 0;
 129         while p < e do begin
 130                 p := AnsiStrPosEx(p, e, ps, pe);
 131                 if p = nil then Break;
 132                 Inc(ReplaceCount);
 133                 Inc(p, Length(OldPattern));
 134         end;
 135         if ReplaceCount = 0 then Exit;
 136         SetString(Result, nil, Length(S) +
 137     (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
 138     p := PChar(S);
 139     DestIndex := 1;
 140     l := Length( NewPattern );
 141     for i := 0 to ReplaceCount - 1 do begin
 142         Count := AnsiStrPosEx(p, e, ps, pe) - p;
 143         Move(p^, Result[DestIndex], Count);
 144         Inc(p, Count);//p := pp;
 145         Inc(DestIndex, Count);
 146         Move(NewPattern[1], Result[DestIndex], l);
 147         Inc(p, Length(OldPattern));
 148         Inc(DestIndex, l);
 149     end;
 150     Move(p^, Result[DestIndex], e - p);
 151 end;
 152 //\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
 153 function IgnoCaseReplaceString(const S, OldPattern, NewPattern: string): string;
 154 var
 155         ReplaceCount: Integer;
 156         DestIndex: Integer;
 157         i, l: Integer;
 158         p, e{, ps, pe}: PChar;
 159         p2, e2, ps2, pe2: PChar;
 160         Count: Integer;
 161         bufferS : String;
 162         bufferOldPattern : String;
 163 begin
 164         Result := S;
 165         bufferS := AnsiLowerCase(S);
 166         bufferOldPattern := AnsiLowerCase(OldPattern);
 167
 168         if OldPattern = '' then Exit;
 169         p       := PChar(S);
 170         p2      := PChar(bufferS);
 171         e       := p + Length(S);
 172         e2      := p2 + Length(bufferS);
 173         //ps    := PChar(OldPattern);
 174         ps2     := PChar(bufferOldPattern);
 175         //pe    := ps + Length(OldPattern);
 176         pe2     := ps2 + Length(bufferOldPattern);
 177
 178         ReplaceCount := 0;
 179         while p2 < e2 do begin
 180                 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
 181                 if p2 = nil then Break;
 182                 Inc(ReplaceCount);
 183                 Inc(p2, Length(bufferOldPattern));
 184         end;
 185         if ReplaceCount = 0 then Exit;
 186         SetString(Result, nil, Length(bufferS) +
 187         (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
 188         p2 := PChar(bufferS);
 189         DestIndex := 1;
 190         l := Length( NewPattern );
 191         for i := 0 to ReplaceCount - 1 do begin
 192                 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
 193                 Move(p^, Result[DestIndex], Count);
 194                 Inc(p, Count);//p := pp;
 195                 Inc(p2, Count);//p := pp;
 196                 Inc(DestIndex, Count);
 197                 Move(NewPattern[1], Result[DestIndex], l);
 198                 Inc(p, Length(OldPattern));
 199                 Inc(p2, Length(OldPattern));
 200                 Inc(DestIndex, l);
 201         end;
 202         Move(p^, Result[DestIndex], e - p);
 203 end;
 204 {$IFDEF DEBUG}
 205 {$R+}
 206 {$ENDIF}
 207
 208 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82P\81j
 209 function CustomStringReplace(
 210         S , OldPattern: String;
 211         const  NewPattern: string;
 212         IgnoreCase : Boolean
 213 ): String;
 214 begin
 215         Result := '';
 216         if not IgnoreCase then begin
 217                 Result := ReplaceString(S,OldPattern,NewPattern);
 218         end else begin
 219                 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
 220         end;
 221 end;
 222
 223 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82Q\81j
 224 procedure CustomStringReplace(
 225         var S : TStringList;
 226         OldPattern: String;
 227         const  NewPattern: string;
 228         IgnoreCase : Boolean
 229 );
 230 var
 231         i : Integer;
 232 begin
 233         S.BeginUpdate;
 234         if not IgnoreCase then begin
 235                 for i := 0 to S.Count - 1 do begin
 236                         S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
 237                 end;
 238         end else begin
 239                 for i := 0 to S.Count - 1 do begin
 240                         S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
 241                 end;
 242         end;
 243         S.EndUpdate;
 244 end;
 245
 246 (*************************************************************************
 247  * \91S\8ap\81¨\94¼\8ap
 248  * from HotZonu
 249  *************************************************************************)
 250 function ZenToHan(const s: string): string;
 251 var
 252         //Chr: array [0..1024] of char;
 253         Chr: string;
 254         ChrLen  : Integer;
 255 begin
 256         SetLength(Chr, Length(s));
 257         ChrLen := Windows.LCMapString(
 258                  GetUserDefaultLCID(),
 259 //               LCMAP_HALFWIDTH,
 260                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
 261                  PChar(s),
 262                  Length(s),
 263                  PChar(Chr),
 264                  Length(Chr)
 265                  );
 266         Result := Copy(Chr, 1, ChrLen);
 267 end;
 268
 269 (*************************************************************************
 270  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
 271  *************************************************************************)
 272 function VaguePos(const Substr, S: string): Integer;
 273 begin
 274         Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
 275 end;
 276 (*************************************************************************
 277  * 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é
 278  *************************************************************************)
 279 function ReplaseNoValidateChar( inVal : String): String;
 280 begin
 281         Result := CustomStringReplace(inVal, '\', '\81\8f');
 282         Result := CustomStringReplace(Result, '/', '\81^');
 283         Result := CustomStringReplace(Result, ':', '\81F');
 284         Result := CustomStringReplace(Result, '.', '\81D');
 285     Result := CustomStringReplace(Result, ';', '\81G');
 286         Result := CustomStringReplace(Result, '*', '\81\96');
 287         Result := CustomStringReplace(Result, '>', '\81\84');
 288         Result := CustomStringReplace(Result, '<', '\81\83');
 289         Result := CustomStringReplace(Result, '|', '\81b');
 290 end;
 291 (*************************************************************************
 292  * \96³\8cø\82ÈID\82©\82Ì\83`\83F\83b\83N\81i\96³\8cø\97á\81FID:??? , ID:???0)
 293  *************************************************************************)
 294 function IsNoValidID( inID :String): Boolean;
 295 begin
 296         inID := Trim(inID);
 297         if inID = '' then Result := True
 298         else begin
 299                 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
 300                 inID := CustomStringReplace(inID, '?', '');
 301                 if (inID = '') or (inID = '0') then Result := True
 302                 else Result := False;
 303         end;
 304 end;
 305
 306 // *************************************************************************
 307 // HTML\92\86\82Ì<font>\83^\83O\82ð\8dí\8f\9c\82·\82é
 308 // *************************************************************************
 309 function        DeleteFontTag(
 310          inSource : string    //\83^\83O\82ð\8dí\8f\9c\82·\82é\95¶\8e\9a\97ñ
 311 ) : string;             //\83^\83O\8dí\8f\9c\8cê\82Ì\95¶\8e\9a\97ñ
 312 var
 313         pos : Integer;
 314 begin
 315         Result := '';
 316
 317         //</font>\82ð\8dí\8f\9c
 318         inSource := CustomStringReplace( inSource, '</font>', '', True);
 319         //<font \82ð\91S\82Ä\8f¬\95¶\8e\9a\82É\95Ï\8a·\82·\82é
 320         inSource := CustomStringReplace( inSource, '<font', '<font', True);
 321         //<font \81` \82ð\8dí\8f\9c\82·\82é
 322         pos := AnsiPos('<font', inSource);
 323         while (pos > 0) do begin
 324                 Result := Result + Copy(inSource, 1, pos - 1);
 325                 Delete(inSource, 1, pos);
 326                 //\83^\83O\82ð\95Â\82¶\82é'>'\82Ü\82Å\82ð\8dí\8f\9c
 327         pos := AnsiPos('>', inSource);
 328                 Delete(inSource, 1, pos);
 329                 pos := AnsiPos('<font', inSource);
 330         end;
 331
 332         Result := Result + inSource;
 333
 334
 335 end;
 336 // *************************************************************************
 337
 338
 339 end.