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: String; const OldPattern: String; const NewPattern: string): String;
  22         function IgnoCaseReplaceString(const S: String; const OldPattern:String; const NewPattern: string): String;
  23
  24         function CustomStringReplace(const S: String; const OldPattern: String; const  NewPattern: string; IgnoreCase : Boolean = False): String; overload;
  25         procedure CustomStringReplace(var S : TStringList;const OldPattern: String;const  NewPattern: string; IgnoreCase : Boolean = False); overload;
  26
  27         function ZenToHan(const s: string): string;
  28         function VaguePos(const Substr: String; const 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         function RemoveToken(var s: string;const delimiter: string): string;
  35         // \96³\8aQ\89»(& -> &amp; " -> &auot; \82É\95Ï\8a·\82·\82é)
  36         function Sanitize(const s: String): String;
  37         // \96³\8aQ\89»\89ð\8f\9c(&amp; -> & &auot; -> " \82É\95Ï\8a·\82·\82é)
  38         function UnSanitize(const s: String): String;
  39
  40 implementation
  41 // \83|\83C\83\93\83^\81[\81\95\83A\83Z\83\93\83u\83\89\82É\82æ\82é\8d\82\91¬\83|\83X
  42 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  43 asm
  44                 PUSH    EBX
  45                 PUSH    ESI
  46                 PUSH    EDI
  47
  48                 MOV    ESI,ECX        { Point ESI to substr                  }
  49                 MOV    EDI,EAX        { Point EDI to s                        }
  50
  51                 MOV    ECX,EDX        { ECX = search length                  }
  52         SUB    ECX,EAX
  53
  54         MOV    EDX,SubstrEnd
  55         SUB    EDX,ESI
  56
  57         DEC    EDX            { EDX = Length(substr) - 1              }
  58         JS      @@fail        { < 0 ? return 0                        }
  59         MOV    AL,[ESI]      { AL = first char of substr            }
  60         INC    ESI            { Point ESI to 2'nd char of substr      }
  61
  62         SUB    ECX,EDX        { #positions in s to look at            }
  63                               { = Length(s) - Length(substr) + 1      }
  64         JLE    @@fail
  65 @@loop:
  66         REPNE  SCASB
  67         JNE    @@fail
  68         MOV    EBX,ECX        { save outer loop counter              }
  69         PUSH    ESI            { save outer loop substr pointer        }
  70         PUSH    EDI            { save outer loop s pointer            }
  71
  72         MOV    ECX,EDX
  73         REPE    CMPSB
  74         POP    EDI            { restore outer loop s pointer          }
  75         POP    ESI            { restore outer loop substr pointer    }
  76         JE      @@found
  77         MOV    ECX,EBX        { restore outer loop counter            }
  78         JMP    @@loop
  79
  80 @@fail:
  81         XOR    EAX,EAX
  82         JMP    @@exit
  83
  84 @@found:
  85         MOV    EAX,EDI        { EDI points of char after match        }
  86         DEC    EAX
  87 @@exit:
  88         POP    EDI
  89         POP    ESI
  90         POP    EBX
  91 end;
  92 //\81@AnsiPos\82Ì\8d\82\91¬\94Å
  93 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  94 var
  95     L2: Cardinal;
  96     ByteType : TMbcsByteType;
  97 begin
  98     Result := nil;
  99     if (StrStart = nil) or (StrStart^ = #0) or
 100         (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
 101
 102     L2 := SubstrEnd - SubstrStart;
 103     Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
 104
 105     while (Result <> nil) and (StrEnd - Result >= L2) do begin
 106                 ByteType := StrByteType(StrStart, Integer(Result-StrStart));
 107                 if (ByteType <> mbTrailByte) and
 108                         (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
 109                 then Exit;
 110         if (ByteType = mbLeadByte) then Inc(Result);
 111         Inc(Result);
 112         Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
 113     end;
 114     Result := nil;
 115 end;
 116
 117 //\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
 118 function ReplaceString(const S: String; const OldPattern: String; const NewPattern: string): String;
 119 var
 120         ReplaceCount: Integer;
 121         DestIndex: Integer;
 122         i, l: Integer;
 123         p, e, ps, pe: PChar;
 124         Count: Integer;
 125         olen: Integer;
 126 begin
 127         Result := S;
 128         olen := Length(OldPattern);
 129         if olen = 0 then Exit;
 130         p := PChar(S);
 131         e := p + Length(S);
 132         ps := PChar(OldPattern);
 133         pe := ps + olen;
 134         ReplaceCount := 0;
 135         while p < e do begin
 136                 p := AnsiStrPosEx(p, e, ps, pe);
 137                 if p = nil then Break;
 138                 Inc(ReplaceCount);
 139                 Inc(p, olen);
 140         end;
 141         if ReplaceCount = 0 then Exit;
 142         SetString(Result, nil, Length(S) +
 143         (Length(NewPattern) - olen) * ReplaceCount);
 144         p := PChar(S);
 145         DestIndex := 1;
 146         l := Length( NewPattern );
 147         for i := 0 to ReplaceCount - 1 do begin
 148                 Count := AnsiStrPosEx(p, e, ps, pe) - p;
 149                 Move(p^, Result[DestIndex], Count);
 150                 Inc(p, Count);//p := pp;
 151                 Inc(DestIndex, Count);
 152                 Move(NewPattern[1], Result[DestIndex], l);
 153                 Inc(p, olen);
 154                 Inc(DestIndex, l);
 155         end;
 156         Move(p^, Result[DestIndex], e - p);
 157 end;
 158 //\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
 159 function IgnoCaseReplaceString(const S: String;const OldPattern:String;const NewPattern: string): String;
 160 var
 161         ReplaceCount: Integer;
 162         DestIndex: Integer;
 163         i, l: Integer;
 164         p, e{, ps, pe}: PChar;
 165         p2, e2, ps2, pe2: PChar;
 166         Count: Integer;
 167         bufferS : String;
 168         bufferOldPattern : String;
 169 begin
 170         Result := S;
 171         bufferS := AnsiLowerCase(S);
 172         bufferOldPattern := AnsiLowerCase(OldPattern);
 173
 174         if OldPattern = '' then Exit;
 175         p       := PChar(S);
 176         p2      := PChar(bufferS);
 177         e       := p + Length(S);
 178         e2      := p2 + Length(bufferS);
 179         //ps    := PChar(OldPattern);
 180         ps2     := PChar(bufferOldPattern);
 181         //pe    := ps + Length(OldPattern);
 182         pe2     := ps2 + Length(bufferOldPattern);
 183
 184         ReplaceCount := 0;
 185         while p2 < e2 do begin
 186                 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
 187                 if p2 = nil then Break;
 188                 Inc(ReplaceCount);
 189                 Inc(p2, Length(bufferOldPattern));
 190         end;
 191         if ReplaceCount = 0 then Exit;
 192         SetString(Result, nil, Length(bufferS) +
 193         (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
 194         p2 := PChar(bufferS);
 195         DestIndex := 1;
 196         l := Length( NewPattern );
 197         for i := 0 to ReplaceCount - 1 do begin
 198                 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
 199                 Move(p^, Result[DestIndex], Count);
 200                 Inc(p, Count);//p := pp;
 201                 Inc(p2, Count);//p := pp;
 202                 Inc(DestIndex, Count);
 203                 Move(NewPattern[1], Result[DestIndex], l);
 204                 Inc(p, Length(OldPattern));
 205                 Inc(p2, Length(OldPattern));
 206                 Inc(DestIndex, l);
 207         end;
 208         Move(p^, Result[DestIndex], e - p);
 209 end;
 210 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82P\81j
 211 function CustomStringReplace(
 212         const S :String;
 213         const OldPattern: String;
 214         const  NewPattern: string;
 215         IgnoreCase : Boolean
 216 ): String;
 217 begin
 218         if not IgnoreCase then begin
 219                 Result := ReplaceString(S,OldPattern,NewPattern);
 220         end else begin
 221                 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
 222         end;
 223 end;
 224
 225 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82Q\81j
 226 procedure CustomStringReplace(
 227         var S : TStringList;
 228         const OldPattern: String;
 229         const  NewPattern: string;
 230         IgnoreCase : Boolean
 231 );
 232 var
 233         i : Integer;
 234 begin
 235         S.BeginUpdate;
 236         if not IgnoreCase then begin
 237                 for i := 0 to S.Count - 1 do begin
 238                         S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
 239                 end;
 240         end else begin
 241                 for i := 0 to S.Count - 1 do begin
 242                         S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
 243                 end;
 244         end;
 245         S.EndUpdate;
 246 end;
 247
 248 (*************************************************************************
 249  * \91S\8ap\81¨\94¼\8ap
 250  * from HotZonu
 251  *************************************************************************)
 252 function ZenToHan(const s: string): string;
 253 var
 254         ChrLen  : Integer;
 255 begin
 256         SetLength(Result, 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(Result),
 264                  Length(Result)
 265                  );
 266         SetLength(Result, 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:String; const 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:???X)
 293  *************************************************************************)
 294 function IsNoValidID( inID :String): Boolean;
 295 var
 296     bTail : Boolean;
 297 begin
 298     Result := True;
 299         inID := Trim(inID);
 300         if (Length(inID) > 0) then begin
 301                 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
 302         bTail := False;
 303         // \96\96\94ö\82ª?\88È\8aO\82©
 304         if Length(inID) > 0 then begin
 305             bTail := (inID[Length(inID)] <> '?');
 306         end;
 307                 inID := CustomStringReplace(inID, '?', '');
 308                 if (Length(inID) > 0) and (not
 309             ((Length(inID) = 1) and (bTail))) then begin
 310                     Result := False;
 311         end;
 312         end;
 313 end;
 314
 315 // *************************************************************************
 316 // HTML\92\86\82Ì<font>\83^\83O\82ð\8dí\8f\9c\82·\82é
 317 // *************************************************************************
 318 function        DeleteFontTag(
 319          inSource : string    //\83^\83O\82ð\8dí\8f\9c\82·\82é\95¶\8e\9a\97ñ
 320 ) : string;             //\83^\83O\8dí\8f\9c\8cê\82Ì\95¶\8e\9a\97ñ
 321 var
 322         pos : Integer;
 323 begin
 324         Result := '';
 325
 326         //</font>\82ð\8dí\8f\9c
 327         inSource := CustomStringReplace( inSource, '</font>', '', True);
 328         //<font \82ð\91S\82Ä\8f¬\95¶\8e\9a\82É\95Ï\8a·\82·\82é
 329         inSource := CustomStringReplace( inSource, '<font', '<font', True);
 330         //<font \81` \82ð\8dí\8f\9c\82·\82é
 331         pos := AnsiPos('<font', inSource);
 332         while (pos > 0) do begin
 333                 Result := Result + Copy(inSource, 1, pos - 1);
 334                 Delete(inSource, 1, pos);
 335                 //\83^\83O\82ð\95Â\82¶\82é'>'\82Ü\82Å\82ð\8dí\8f\9c
 336         pos := AnsiPos('>', inSource);
 337                 Delete(inSource, 1, pos);
 338                 pos := AnsiPos('<font', inSource);
 339         end;
 340
 341         Result := Result + inSource;
 342
 343
 344 end;
 345 // *************************************************************************
 346
 347
 348 (*************************************************************************
 349  *
 350  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
 351  *************************************************************************)
 352 function RemoveToken(var s: string;const delimiter: string): string;
 353 var
 354         p: Integer;
 355         pos : PChar;
 356         pds, pde : PChar;
 357         pss, pse : PChar;
 358 begin
 359         pss := PChar(s);
 360         pse := pss + Length(s);
 361         pds := PChar(delimiter);
 362         pde := pds + Length(delimiter);
 363
 364         pos := StrPosEx(pss, pse, pds, pde);
 365         if pos <> nil then begin
 366                 p := pos - pss;
 367                 SetString(Result, pss, p);
 368                 Delete(s, 1, p + Length(delimiter));
 369         if (Length(Result) > 0) then begin
 370                 if (StrByteType(PChar(Result), Length(Result)-1) = mbLeadByte) then begin
 371                         SetLength(Result, Length(Result) - 1);
 372                     end;
 373         end;
 374         end else begin
 375                 Result := s;
 376                 s := '';
 377         end;
 378 end;
 379
 380 //! \96³\8aQ\89»(& -> &amp; " -> &quot; \82É\95Ï\8a·\82·\82é)
 381 function Sanitize(const s: String): String;
 382 begin
 383     // \97]\95ª\82É\83T\83j\83^\83C\83Y\82³\82ê\82È\82¢\82æ\82¤\82É\82¢\82Á\82½\82ñ\8c³\82É\96ß\82·
 384     Result := UnSanitize(s);
 385         Result := CustomStringReplace(Result, '&', '&amp;');
 386         Result := CustomStringReplace(Result, '"', '&quot;');
 387 end;
 388 //! \96³\8aQ\89»\89ð\8f\9c(&amp; -> & &quot; -> " \82É\95Ï\8a·\82·\82é)
 389 function UnSanitize(const s: String): String;
 390 begin
 391         Result := CustomStringReplace(s, '&quot;', '"');
 392         Result := CustomStringReplace(Result, '&amp;', '&');
 393 end;
 394
 395 end.