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, GikoSystem;
  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, 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         procedure DivideStrLine(Line: string; PRes: PResRec);
  35         function RemoveToken(var s: string;const delimiter: string): string;
  36
  37 implementation
  38 // \83|\83C\83\93\83^\81[\81\95\83A\83Z\83\93\83u\83\89\82É\82æ\82é\8d\82\91¬\83|\83X
  39 function StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  40 asm
  41                 PUSH    EBX
  42                 PUSH    ESI
  43                 PUSH    EDI
  44
  45                 MOV    ESI,ECX        { Point ESI to substr                  }
  46                 MOV    EDI,EAX        { Point EDI to s                        }
  47
  48                 MOV    ECX,EDX        { ECX = search length                  }
  49         SUB    ECX,EAX
  50
  51         MOV    EDX,SubstrEnd
  52         SUB    EDX,ESI
  53
  54         DEC    EDX            { EDX = Length(substr) - 1              }
  55         JS      @@fail        { < 0 ? return 0                        }
  56         MOV    AL,[ESI]      { AL = first char of substr            }
  57         INC    ESI            { Point ESI to 2'nd char of substr      }
  58
  59         SUB    ECX,EDX        { #positions in s to look at            }
  60                               { = Length(s) - Length(substr) + 1      }
  61         JLE    @@fail
  62 @@loop:
  63         REPNE  SCASB
  64         JNE    @@fail
  65         MOV    EBX,ECX        { save outer loop counter              }
  66         PUSH    ESI            { save outer loop substr pointer        }
  67         PUSH    EDI            { save outer loop s pointer            }
  68
  69         MOV    ECX,EDX
  70         REPE    CMPSB
  71         POP    EDI            { restore outer loop s pointer          }
  72         POP    ESI            { restore outer loop substr pointer    }
  73         JE      @@found
  74         MOV    ECX,EBX        { restore outer loop counter            }
  75         JMP    @@loop
  76
  77 @@fail:
  78         XOR    EAX,EAX
  79         JMP    @@exit
  80
  81 @@found:
  82         MOV    EAX,EDI        { EDI points of char after match        }
  83         DEC    EAX
  84 @@exit:
  85         POP    EDI
  86         POP    ESI
  87         POP    EBX
  88 end;
  89 //\81@AnsiPos\82Ì\8d\82\91¬\94Å
  90 function AnsiStrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd: PChar): PChar;
  91 var
  92     L2: Cardinal;
  93     ByteType : TMbcsByteType;
  94 begin
  95     Result := nil;
  96     if (StrStart = nil) or (StrStart^ = #0) or
  97         (SubstrStart = nil) or (SubstrStart^ = #0) then Exit;
  98
  99     L2 := SubstrEnd - SubstrStart;
 100     Result := StrPosEx(StrStart, StrEnd, SubstrStart, SubstrEnd);
 101
 102     while (Result <> nil) and (StrEnd - Result >= L2) do begin
 103         ByteType := StrByteType(StrStart, Integer(Result-StrStart));
 104         if (ByteType <> mbTrailByte) and
 105                 (CompareString(LOCALE_USER_DEFAULT, SORT_STRINGSORT, Result, L2, SubstrStart, L2) = 2)
 106         then Exit;
 107         if (ByteType = mbLeadByte) then Inc(Result);
 108         Inc(Result);
 109         Result := StrPosEx(Result, StrEnd, SubStrStart, SubStrEnd);
 110     end;
 111     Result := nil;
 112 end;
 113
 114 {$R-}
 115 //\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
 116 function ReplaceString(const S: String; const OldPattern: String; const NewPattern: string): string;
 117 var
 118     ReplaceCount: Integer;
 119     DestIndex: Integer;
 120     i, l: Integer;
 121     p, e, ps, pe: PChar;
 122     Count: Integer;
 123 begin
 124         Result := S;
 125         if OldPattern = '' then Exit;
 126         p := PChar(S);
 127         e := p + Length(S);
 128         ps := PChar(OldPattern);
 129         pe := ps + Length(OldPattern);
 130         ReplaceCount := 0;
 131         while p < e do begin
 132                 p := AnsiStrPosEx(p, e, ps, pe);
 133                 if p = nil then Break;
 134                 Inc(ReplaceCount);
 135                 Inc(p, Length(OldPattern));
 136         end;
 137         if ReplaceCount = 0 then Exit;
 138         SetString(Result, nil, Length(S) +
 139         (Length(NewPattern) - Length(OldPattern)) * ReplaceCount);
 140         p := PChar(S);
 141         DestIndex := 1;
 142         l := Length( NewPattern );
 143         for i := 0 to ReplaceCount - 1 do begin
 144                 Count := AnsiStrPosEx(p, e, ps, pe) - p;
 145                 Move(p^, Result[DestIndex], Count);
 146                 Inc(p, Count);//p := pp;
 147                 Inc(DestIndex, Count);
 148                 Move(NewPattern[1], Result[DestIndex], l);
 149                 Inc(p, Length(OldPattern));
 150                 Inc(DestIndex, l);
 151     end;
 152     Move(p^, Result[DestIndex], e - p);
 153 end;
 154 //\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
 155 function IgnoCaseReplaceString(const S: String;const OldPattern:String;const NewPattern: string): string;
 156 var
 157         ReplaceCount: Integer;
 158         DestIndex: Integer;
 159         i, l: Integer;
 160         p, e{, ps, pe}: PChar;
 161         p2, e2, ps2, pe2: PChar;
 162         Count: Integer;
 163         bufferS : String;
 164         bufferOldPattern : String;
 165 begin
 166         Result := S;
 167         bufferS := AnsiLowerCase(S);
 168         bufferOldPattern := AnsiLowerCase(OldPattern);
 169
 170         if OldPattern = '' then Exit;
 171         p       := PChar(S);
 172         p2      := PChar(bufferS);
 173         e       := p + Length(S);
 174         e2      := p2 + Length(bufferS);
 175         //ps    := PChar(OldPattern);
 176         ps2     := PChar(bufferOldPattern);
 177         //pe    := ps + Length(OldPattern);
 178         pe2     := ps2 + Length(bufferOldPattern);
 179
 180         ReplaceCount := 0;
 181         while p2 < e2 do begin
 182                 p2 := AnsiStrPosEx(p2, e2, ps2, pe2);
 183                 if p2 = nil then Break;
 184                 Inc(ReplaceCount);
 185                 Inc(p2, Length(bufferOldPattern));
 186         end;
 187         if ReplaceCount = 0 then Exit;
 188         SetString(Result, nil, Length(bufferS) +
 189         (Length(NewPattern) - Length(bufferOldPattern)) * ReplaceCount);
 190         p2 := PChar(bufferS);
 191         DestIndex := 1;
 192         l := Length( NewPattern );
 193         for i := 0 to ReplaceCount - 1 do begin
 194                 Count := AnsiStrPosEx(p2, e2, ps2, pe2) - p2;
 195                 Move(p^, Result[DestIndex], Count);
 196                 Inc(p, Count);//p := pp;
 197                 Inc(p2, Count);//p := pp;
 198                 Inc(DestIndex, Count);
 199                 Move(NewPattern[1], Result[DestIndex], l);
 200                 Inc(p, Length(OldPattern));
 201                 Inc(p2, Length(OldPattern));
 202                 Inc(DestIndex, l);
 203         end;
 204         Move(p^, Result[DestIndex], e - p);
 205 end;
 206 {$IFDEF DEBUG}
 207 {$R+}
 208 {$ENDIF}
 209
 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         Result := '';
 219         if not IgnoreCase then begin
 220                 Result := ReplaceString(S,OldPattern,NewPattern);
 221         end else begin
 222                 Result := IgnoCaseReplaceString(S,OldPattern,NewPattern);
 223         end;
 224 end;
 225
 226 //\8d\82\91¬\95¶\8e\9a\97ñ\92u\8a·\8aÖ\90\94\81i\94Ä\97p\94Å\82Q\81j
 227 procedure CustomStringReplace(
 228         var S : TStringList;
 229         const OldPattern: String;
 230         const  NewPattern: string;
 231         IgnoreCase : Boolean
 232 );
 233 var
 234         i : Integer;
 235 begin
 236         S.BeginUpdate;
 237         if not IgnoreCase then begin
 238                 for i := 0 to S.Count - 1 do begin
 239                         S.Strings[i] := ReplaceString(S.Strings[i], OldPattern,NewPattern);
 240                 end;
 241         end else begin
 242                 for i := 0 to S.Count - 1 do begin
 243                         S.Strings[i] := IgnoCaseReplaceString(S.Strings[i], OldPattern,NewPattern);
 244                 end;
 245         end;
 246         S.EndUpdate;
 247 end;
 248
 249 (*************************************************************************
 250  * \91S\8ap\81¨\94¼\8ap
 251  * from HotZonu
 252  *************************************************************************)
 253 function ZenToHan(const s: string): string;
 254 var
 255         ChrLen  : Integer;
 256 begin
 257         SetLength(Result, Length(s));
 258         ChrLen := Windows.LCMapString(
 259                  GetUserDefaultLCID(),
 260 //               LCMAP_HALFWIDTH,
 261                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
 262                  PChar(s),
 263                  Length(s),
 264                  PChar(Result),
 265                  Length(Result)
 266                  );
 267         SetLength(Result, ChrLen);
 268 end;
 269
 270 (*************************************************************************
 271  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
 272  *************************************************************************)
 273 function VaguePos(const Substr, S: string): Integer;
 274 begin
 275         Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
 276 end;
 277 (*************************************************************************
 278  * 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é
 279  *************************************************************************)
 280 function ReplaseNoValidateChar( inVal : String): String;
 281 begin
 282         Result := CustomStringReplace(inVal, '\', '\81\8f');
 283         Result := CustomStringReplace(Result, '/', '\81^');
 284         Result := CustomStringReplace(Result, ':', '\81F');
 285         Result := CustomStringReplace(Result, '.', '\81D');
 286     Result := CustomStringReplace(Result, ';', '\81G');
 287         Result := CustomStringReplace(Result, '*', '\81\96');
 288         Result := CustomStringReplace(Result, '>', '\81\84');
 289         Result := CustomStringReplace(Result, '<', '\81\83');
 290         Result := CustomStringReplace(Result, '|', '\81b');
 291 end;
 292 (*************************************************************************
 293  * \96³\8cø\82ÈID\82©\82Ì\83`\83F\83b\83N\81i\96³\8cø\97á\81FID:??? , ID:???0)
 294  *************************************************************************)
 295 function IsNoValidID( inID :String): Boolean;
 296 begin
 297         inID := Trim(inID);
 298         if inID = '' then Result := True
 299         else begin
 300                 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
 301                 inID := CustomStringReplace(inID, '?', '');
 302                 if (inID = '') or (inID = '0') then Result := True
 303                 else Result := False;
 304         end;
 305 end;
 306
 307 // *************************************************************************
 308 // HTML\92\86\82Ì<font>\83^\83O\82ð\8dí\8f\9c\82·\82é
 309 // *************************************************************************
 310 function        DeleteFontTag(
 311          inSource : string    //\83^\83O\82ð\8dí\8f\9c\82·\82é\95¶\8e\9a\97ñ
 312 ) : string;             //\83^\83O\8dí\8f\9c\8cê\82Ì\95¶\8e\9a\97ñ
 313 var
 314         pos : Integer;
 315 begin
 316         Result := '';
 317
 318         //</font>\82ð\8dí\8f\9c
 319         inSource := CustomStringReplace( inSource, '</font>', '', True);
 320         //<font \82ð\91S\82Ä\8f¬\95¶\8e\9a\82É\95Ï\8a·\82·\82é
 321         inSource := CustomStringReplace( inSource, '<font', '<font', True);
 322         //<font \81` \82ð\8dí\8f\9c\82·\82é
 323         pos := AnsiPos('<font', inSource);
 324         while (pos > 0) do begin
 325                 Result := Result + Copy(inSource, 1, pos - 1);
 326                 Delete(inSource, 1, pos);
 327                 //\83^\83O\82ð\95Â\82¶\82é'>'\82Ü\82Å\82ð\8dí\8f\9c
 328         pos := AnsiPos('>', inSource);
 329                 Delete(inSource, 1, pos);
 330                 pos := AnsiPos('<font', inSource);
 331         end;
 332
 333         Result := Result + inSource;
 334
 335
 336 end;
 337 // *************************************************************************
 338
 339 {!
 340 \brief dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
 341 \param Line dat\83t\83@\83C\83\8b\82ð\8d\\90¬\82·\82é 1 \8ds
 342 \return     \83\8c\83X\8fî\95ñ
 343 }
 344 procedure DivideStrLine(Line: string; PRes: PResRec);
 345 const
 346         delimiter = '<>';
 347 var
 348         pds, pde : PChar;
 349         pss, pse : PChar;
 350 begin
 351         pss := PChar(Line);
 352         pse := pss + Length(Line);
 353         pds := PChar(delimiter);
 354         pde := pds + Length(delimiter);
 355
 356         if AnsiStrPosEx(pss, pse, pds, pde) = nil then begin
 357                 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
 358                 Line := CustomStringReplace(Line, ',', '<>');
 359                 Line := CustomStringReplace(Line, '\81\97\81M', ',');
 360         end;
 361         //Delim := '<>';
 362         {Result.FType := glt2chNew;
 363         //Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82¶\82ã
 364         Result.FName := RemoveToken(Line, delimiter);
 365         Result.FMailTo := RemoveToken(Line, delimiter);
 366         Result.FDateTime := RemoveToken(Line, delimiter);
 367         Result.FBody := RemoveToken(Line, delimiter);
 368         //\82Q\82¿\82á\82ñ\82Ë\82é\82Æ\82©\82¾\82Æ\81A\96{\95¶\82Ì\90æ\93ª\82É\82P\82Â\94¼\8ap\8bó\94\92\82ª\93ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dí\8f\9c\82·\82é
 369         //\91¼\82Ì\8cf\8e¦\94Â\82Å\81A\83\8c\83X\8e©\91Ì\82Ì\8bó\94\92\82©\82à\82µ\82ê\82È\82¢\82¯\82Ç\82»\82ê\82Í\92ú\82ß\82é
 370         Result.FBody := TrimLeft(Result.FBody);
 371         //\8bó\82¾\82Æ\96â\91è\82ª\8bN\82«\82é\82©\82ç\81A\8bó\94\92\82ð\90Ý\92è\82·\82é
 372         if Result.FBody = '' then
 373                 Result.FBody := '&nbsp;';
 374
 375         Result.FTitle := RemoveToken(Line, delimiter);
 376         }
 377         PRes^.FType := glt2chNew;
 378         //Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82¶\82ã
 379         PRes^.FName := RemoveToken(Line, delimiter);
 380         PRes^.FMailTo := RemoveToken(Line, delimiter);
 381         PRes^.FDateTime := RemoveToken(Line, delimiter);
 382         PRes^.FBody := RemoveToken(Line, delimiter);
 383         //\82Q\82¿\82á\82ñ\82Ë\82é\82Æ\82©\82¾\82Æ\81A\96{\95¶\82Ì\90æ\93ª\82É\82P\82Â\94¼\8ap\8bó\94\92\82ª\93ü\82Á\82Ä\82¢\82é\82Ì\82Å\8dí\8f\9c\82·\82é
 384         //\91¼\82Ì\8cf\8e¦\94Â\82Å\81A\83\8c\83X\8e©\91Ì\82Ì\8bó\94\92\82©\82à\82µ\82ê\82È\82¢\82¯\82Ç\82»\82ê\82Í\92ú\82ß\82é
 385         PRes^.FBody := TrimLeft(PRes^.FBody);
 386         //\8bó\82¾\82Æ\96â\91è\82ª\8bN\82«\82é\82©\82ç\81A\8bó\94\92\82ð\90Ý\92è\82·\82é
 387         if PRes^.FBody = '' then
 388                 PRes^.FBody := '&nbsp;';
 389
 390         PRes^.FTitle := RemoveToken(Line, delimiter);
 391 end;
 392
 393 (*************************************************************************
 394  *
 395  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
 396  *************************************************************************)
 397 function RemoveToken(var s: string;const delimiter: string): string;
 398 var
 399         p: Integer;
 400         pos : PChar;
 401         pds, pde : PChar;
 402         pss, pse : PChar;
 403 begin
 404         pss := PChar(s);
 405         pse := pss + Length(s);
 406         pds := PChar(delimiter);
 407         pde := pds + Length(delimiter);
 408
 409         pos := AnsiStrPosEx(pss, pse, pds, pde);
 410         if pos <> nil then begin
 411                 p := pos - pss;
 412                 SetString(Result, pss, p);
 413                 Delete(s, 1, p + Length(delimiter));
 414         end else begin
 415                 Result := s;
 416                 s := '';
 417         end;
 418 end;
 419
 420
 421 end.