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, 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         function DivideStrLine(Line: string): TResRec;
  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, OldPattern, 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, OldPattern, 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         S , OldPattern: String;
 213         const  NewPattern: string;
 214         IgnoreCase : Boolean
 215 ): String;
 216 begin
 217         Result := '';
 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         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         //Chr: array [0..1024] of char;
 255         Chr: string;
 256         ChrLen  : Integer;
 257 begin
 258         SetLength(Chr, Length(s));
 259         ChrLen := Windows.LCMapString(
 260                  GetUserDefaultLCID(),
 261 //               LCMAP_HALFWIDTH,
 262                  LCMAP_HALFWIDTH or LCMAP_KATAKANA or LCMAP_LOWERCASE,
 263                  PChar(s),
 264                  Length(s),
 265                  PChar(Chr),
 266                  Length(Chr)
 267                  );
 268         Result := Copy(Chr, 1, ChrLen);
 269 end;
 270
 271 (*************************************************************************
 272  * \91S\8ap\94¼\8ap\82Ð\82ç\82ª\82È\82©\82½\82©\82È\82ð\8bæ\95Ê\82µ\82È\82¢\90¦\82¢Pos
 273  *************************************************************************)
 274 function VaguePos(const Substr, S: string): Integer;
 275 begin
 276         Result := AnsiPos(ZenToHan(Substr), ZenToHan(S));
 277 end;
 278 (*************************************************************************
 279  * 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é
 280  *************************************************************************)
 281 function ReplaseNoValidateChar( inVal : String): String;
 282 begin
 283         Result := CustomStringReplace(inVal, '\', '\81\8f');
 284         Result := CustomStringReplace(Result, '/', '\81^');
 285         Result := CustomStringReplace(Result, ':', '\81F');
 286         Result := CustomStringReplace(Result, '.', '\81D');
 287     Result := CustomStringReplace(Result, ';', '\81G');
 288         Result := CustomStringReplace(Result, '*', '\81\96');
 289         Result := CustomStringReplace(Result, '>', '\81\84');
 290         Result := CustomStringReplace(Result, '<', '\81\83');
 291         Result := CustomStringReplace(Result, '|', '\81b');
 292 end;
 293 (*************************************************************************
 294  * \96³\8cø\82ÈID\82©\82Ì\83`\83F\83b\83N\81i\96³\8cø\97á\81FID:??? , ID:???0)
 295  *************************************************************************)
 296 function IsNoValidID( inID :String): Boolean;
 297 begin
 298         inID := Trim(inID);
 299         if inID = '' then Result := True
 300         else begin
 301                 inID := Copy(inID, AnsiPos(':', inID) + 1, Length(inID) );
 302                 inID := CustomStringReplace(inID, '?', '');
 303                 if (inID = '') or (inID = '0') then Result := True
 304                 else Result := False;
 305         end;
 306 end;
 307
 308 // *************************************************************************
 309 // HTML\92\86\82Ì<font>\83^\83O\82ð\8dí\8f\9c\82·\82é
 310 // *************************************************************************
 311 function        DeleteFontTag(
 312          inSource : string    //\83^\83O\82ð\8dí\8f\9c\82·\82é\95¶\8e\9a\97ñ
 313 ) : string;             //\83^\83O\8dí\8f\9c\8cê\82Ì\95¶\8e\9a\97ñ
 314 var
 315         pos : Integer;
 316 begin
 317         Result := '';
 318
 319         //</font>\82ð\8dí\8f\9c
 320         inSource := CustomStringReplace( inSource, '</font>', '', True);
 321         //<font \82ð\91S\82Ä\8f¬\95¶\8e\9a\82É\95Ï\8a·\82·\82é
 322         inSource := CustomStringReplace( inSource, '<font', '<font', True);
 323         //<font \81` \82ð\8dí\8f\9c\82·\82é
 324         pos := AnsiPos('<font', inSource);
 325         while (pos > 0) do begin
 326                 Result := Result + Copy(inSource, 1, pos - 1);
 327                 Delete(inSource, 1, pos);
 328                 //\83^\83O\82ð\95Â\82¶\82é'>'\82Ü\82Å\82ð\8dí\8f\9c
 329         pos := AnsiPos('>', inSource);
 330                 Delete(inSource, 1, pos);
 331                 pos := AnsiPos('<font', inSource);
 332         end;
 333
 334         Result := Result + inSource;
 335
 336
 337 end;
 338 // *************************************************************************
 339
 340 (*************************************************************************
 341  * dat\83t\83@\83C\83\8b\82Ì\88ê\83\89\83C\83\93\82ð\95ª\89ð
 342  *************************************************************************)
 343 function DivideStrLine(Line: string): TResRec;
 344 var
 345         Delim: string;
 346 begin
 347         if AnsiPos('<>', Line) = 0 then begin
 348                 //Delim := ',';
 349                 //Result.FType := glt2chOld;
 350                 Line := CustomStringReplace(Line, '<>', '&lt;&gt;');
 351                 Line := CustomStringReplace(Line, ',', '<>');
 352                 Line := CustomStringReplace(Line, '\81\97\81M', ',');
 353         end;
 354         Delim := '<>';
 355         Result.FType := glt2chNew;
 356         //Trim\82µ\82Ä\82Í\82¢\82¯\82È\82¢\8bC\82ª\82·\82é\81@by\82à\82¶\82ã
 357         Result.FName := RemoveToken(Line, Delim);
 358         Result.FMailTo := RemoveToken(Line, Delim);
 359         Result.FDateTime := RemoveToken(Line, Delim);
 360         Result.FBody := RemoveToken(Line, Delim);
 361         //\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é
 362         //\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é
 363         Result.FBody := TrimLeft(Result.FBody);
 364         //\8bó\82¾\82Æ\96â\91è\82ª\8bN\82«\82é\82©\82ç\81A\8bó\94\92\82ð\90Ý\92è\82·\82é
 365         if Result.FBody = '' then
 366                 Result.FBody := '&nbsp;';
 367
 368         Result.FTitle := RemoveToken(Line, Delim);
 369
 370 end;
 371
 372 (*************************************************************************
 373  *
 374  *\82Ç\82±\82©\82Ì\83T\83C\83g\82©\82ç\82Ì\83p\83N\83\8a
 375  *************************************************************************)
 376 function RemoveToken(var s: string;const delimiter: string): string;
 377 var
 378         p: Integer;
 379 begin
 380         p := AnsiPos(delimiter, s);
 381         if p = 0 then
 382                 Result := s
 383         else
 384                 Result := Copy(s, 1, p - 1);
 385         Delete(s, 1, Length(Result) + Length(delimiter));
 386 end;
 387
 388
 389 end.