bottleclient/BRegExp.pas

   1 unit BRegExp;
   2
   3 //=====================================================================
   4 // BRegExp.pas : Borland Delphi \97p BREGEXP.DLL \97\98\97p\83\86\83j\83b\83g
   5 //               1998/10/03\94Å      osamu@big.or.jp
   6 //
   7 // BREGEXP.DLL \82Í\81Ahttp://www.hi-ho.or.jp/~babaq/ \82É\82Ä\8cö\8aJ\82³\82ê\82Ä\82¢\82é
   8 // Perl5\8cÝ\8a·\82Ì\90³\8bK\95\\8c»\83G\83\93\83W\83\93 BREGEXP.DLL \82ð Borland Delphi \82©\82ç\97\98\97p
   9 // \82·\82é\82½\82ß\82Ì\83\86\83j\83b\83g\83t\83@\83C\83\8b\82Å\82·\81BDelphi 3 \82Å\8dì\90¬\82µ\82Ü\82µ\82½\82ª\81A32bit
  10 // \94Å\82Ì Delphi \82¨\82æ\82Ñ C++ Builder \82Å\93®\8dì\89Â\94\\82Æ\8ev\82¢\82Ü\82·\81B
  11 //
  12 // BREGEXP.DLL \82Ì\97\98\97p\8fð\8c\8f\82È\82Ç\82Í\81A\93¯\83z\81[\83\80\83y\81[\83W\82ð\82²\8eQ\8fÆ\89º\82³\82¢\81B\97L\97p\82È
  13 // \83\89\83C\83u\83\89\83\8a\82ð\96³\8f\9e\82Å\92ñ\8b\9f\89º\82³\82Á\82Ä\82¢\82é babaq \82³\82ñ\82É\8a´\8eÓ\82·\82é\82Æ\82Æ\82à\82É\81A
  14 // \8d¡\8cã\82Ì\82²\8a\88\96ô\82ð\8aú\91Ò\82µ\82Ä\82¢\82Ü\82·\81B
  15 //
  16 // \96{\83\86\83j\83b\83g\82Ì\92\98\8dì\8c \82É\82Â\82¢\82Ä\82Í\81A\82Æ\82â\82©\82\8c¾\82¤\82Â\82à\82è\82Í\82 \82è\82Ü\82¹\82ñ\81B\8dD\82«\82È
  17 // \82æ\82¤\82É\82¨\8eg\82¢\89º\82³\82¢\81B\82½\82¾\82µ\81A\97\98\97p\82É\93\96\82½\82Á\82Ä\82Í\82²\8e©\95ª\82Ì\90Ó\94C\82Ì\89º\82É\82¨\8aè
  18 // \82¢\82µ\82Ü\82·\81B\96{\83\86\83j\83b\83g\82É\8aÖ\82µ\82Ä osamu@big.or.jp \82Í\89½\82ç\90Ó\94C\82ð\95\89\82¤\82±\82Æ\82Í
  19 // \96³\82¢\82à\82Ì\82Æ\82µ\82Ü\82·\81B
  20 //
  21 // \96{\83\86\83j\83b\83g\82Í\81A DLL \82Æ\82Æ\82à\82É\94z\95z\82³\82ê\82Ä\82¢\82é\83w\83b\83_\83t\83@\83C\83\8b\8by\82Ñ\81A\8fã\8bL\83z\81[\83\80
  22 // \83y\81[\83W\82Å\8ds\82í\82ê\82½\83\86\81[\83U\83T\83|\81[\83g\82Ì\83\8d\83O\83t\83@\83C\83\8b\82ð\82à\82Æ\82É\8dì\90¬\82³\82ê\82Ü\82µ\82½\81B
  23 // \82¨\8bC\82Ã\82«\82Ì\93_\82È\82Ç\82 \82è\82Ü\82µ\82½\82ç\81Aosamu@big.or.jp \82Ü\82Å\93d\8eq\83\81\81[\83\8b\82É\82Ä
  24 // \82¨\92m\82ç\82¹\89º\82³\82ê\82Î\81A\8bC\95ª\8e\9f\91æ\82Å\82Í\82È\82ñ\82ç\82©\82Ì\91Î\8f\88\82ð\82·\82é\89Â\94\\90«\82ª\82 \82è\82Ü\82·\81B(^_^;
  25 //
  26 // \8eg\97p\95û\96@\82É\82Â\82¢\82Ä\82Í\95t\91®\82Ì\83w\83\8b\83v\83t\83@\83C\83\8b\82ð\82²\97\97\89º\82³\82¢\81B
  27 //=====================================================================
  28 //               2001/04/14\94Å      osamu@big.or.jp
  29 // \96{\89Æ\82Ì\83h\83L\83\85\83\81\83\93\83g\82Ì\83o\81[\83W\83\87\83\93\83A\83b\83v\82É\94º\82¢\94\8ao\82µ\82Ä\82¢\82½\83o\83O\82ð\8fC\90³
  30 // brx \8aÖ\90\94\82ð\93±\93ü
  31 // \8bó\95¶\8e\9a\82É\91Î\82·\82é\8c\9f\8dõ\82Ì\83G\83\89\81[\89ñ\94ð
  32 // MatchPos \82ð 1 \82©\82ç\90\94\82¦\8en\82ß\82é\82æ\82¤\82É\8ed\97l\95Ï\8dX
  33 // Subst \8cã\82É Strings[] \82ð\8eQ\8fÆ\89Â\94\\82É\82µ\82½
  34 // \82±\82ê\82É\94º\82¢\91å\97Ê\82Ì\95¶\8e\9a\97ñ\82É\91Î\82·\82é\92u\82«\8a·\82¦\93®\8dì\82Í\92x\82\82È\82Á\82½
  35 //=====================================================================
  36
  37 interface
  38
  39 uses SysUtils;
  40
  41 //=====================================================================
  42 // \96{\89Æ BREGEXP.H \82Æ\81A\83T\83|\81[\83g\83z\81[\83\80\83y\81[\83W\82Ì\83h\83L\83\85\83\81\83\93\83g\82æ\82è
  43 // BREGEXP.DLL \82Æ\92¼\8c\8b\82µ\82½\90é\8c¾
  44 //=====================================================================
  45
  46 const
  47 BREGEXP_ERROR_MAX= 80;  // \83G\83\89\81[\83\81\83b\83Z\81[\83W\82Ì\8dÅ\91å\92·
  48
  49 type
  50 PPChar=^PChar;
  51 TBRegExpRec=packed record
  52     outp: PChar;        // \92u\8a·\82¦\8c\8b\89Ê\90æ\93ª\83|\83C\83\93\83^
  53     outendp: PChar;     // \92u\8a·\82¦\8c\8b\89Ê\96\96\94ö\83|\83C\83\93\83^
  54     splitctr: Integer;  // split \8c\8b\89Ê\83J\83E\83\93\83^
  55     splitp: PPChar;     // split \8c\8b\89Ê\83|\83C\83\93\83^\83|\83C\83\93\83^
  56     rsv1: Integer;      // \97\\96ñ\8dÏ\82Ý
  57     parap: PChar;       // \83R\83}\83\93\83h\95¶\8e\9a\97ñ\90æ\93ª\83|\83C\83\93\83^ ('s/xxxxx/yy/gi')
  58     paraendp: PChar;    // \83R\83}\83\93\83h\95¶\8e\9a\97ñ\96\96\94ö\83|\83C\83\93\83^
  59     transtblp: PChar;   // tr \83e\81[\83u\83\8b\82Ö\82Ì\83|\83C\83\93\83^
  60     startp: PPChar;     // \83}\83b\83`\82µ\82½\95¶\8e\9a\97ñ\82Ö\82Ì\90æ\93ª\83|\83C\83\93\83^
  61     endp: PPChar;       // \83}\83b\83`\82µ\82½\95¶\8e\9a\97ñ\82Ö\82Ì\96\96\94ö\83|\83C\83\93\83^
  62     nparens: Integer;   // match/subst \92\86\82Ì\8a\87\8cÊ\82Ì\90\94
  63 end;
  64 pTBRegExpRec=^TBRegExpRec;
  65
  66 function BMatch(str, target, targetendp: PChar;
  67                 var rxp: pTBRegExpRec; msg: PChar): Boolean; cdecl;
  68     external 'bregexp.dll';
  69 function BSubst(str, target, targetendp: PChar;
  70                 var rxp: pTBRegExpRec; msg: PChar): Boolean; cdecl;
  71     external 'bregexp.dll';
  72 function BTrans(str, target, targetendp: PChar;
  73                 var rxp: pTBRegExpRec; msg: PChar): Boolean; cdecl;
  74     external 'bregexp.dll';
  75 function BSplit(str, target, targetendp: PChar; limit: Integer;
  76                 var rxp: pTBRegExpRec; msg: PChar): Boolean; cdecl;
  77     external 'bregexp.dll';
  78 procedure BRegFree(rx: pTBRegExpRec); cdecl;
  79     external 'bregexp.dll' name 'BRegfree';
  80 function BRegExpVersion: PChar; cdecl;
  81     external 'bregexp.dll' name 'BRegexpVersion';
  82
  83 //=====================================================================
  84 // TBRegExp : BREGEXP.DLL \82Ì\8b@\94\\82ð\83J\83v\83Z\83\8b\89»\82·\82é\83I\83u\83W\83F\83N\83g
  85 //=====================================================================
  86
  87 type
  88 EBRegExpError=class(Exception) end;
  89 TBRegExpMode=(brxNone, brxMatch, brxSplit);
  90 TBRegExp=class(TObject)
  91   private
  92     Mode: TBRegExpMode;
  93     pTargetString: PChar;
  94     pBRegExp: PTBRegExpRec;
  95     function GetMatchPos: Integer;
  96     function GetMatchLength: Integer;
  97     function GetSplitCount: Integer;
  98     function GetSplitStrings(index: Integer): string;
  99     function GetMatchStrings(index:Integer): string;
 100     function GetMatchCount: Integer;
 101     function GetCount: Integer;
 102     function GetStrings(index: Integer): string;
 103     function GetLastCommand: string;
 104     procedure CheckCommand(const Command: string);
 105   public
 106     destructor Destroy; override;
 107   public
 108     function Match(const Command, TargetString: string): Boolean;
 109     function Subst(const Command: string; var TargetString: string): Boolean;
 110     function Split(const Command, TargetString: string; Limit: Integer): Boolean;
 111     function Trans(const Command: string;var TargetString: string): Boolean;
 112     property LastCommand: string read GetLastCommand;
 113     property MatchPos: Integer read GetMatchPos;
 114     property MatchLength: Integer read GetMatchLength;
 115     property Count: Integer read GetCount;
 116     property Strings[index: Integer]: string read GetStrings; default;
 117 end;
 118
 119 //=====================================================================
 120 // \8e©\93®\93I\82É\8eÀ\91Ì\89»\81A\94j\8aü\82³\82ê\82é\83\86\81[\83e\83B\83\8a\83e\83B\83C\83\93\83X\83^\83\93\83X
 121 //=====================================================================
 122
 123 function brx: TBRegExp;
 124
 125 //=====================================================================
 126
 127 implementation
 128
 129 //=====================================================================
 130
 131 var fbrx: TBRegExp;
 132 function brx: TBRegExp;
 133 begin
 134     if fbrx=nil then fbrx:=TBRegExp.Create;
 135     Result:=fbrx;
 136 end;
 137
 138 //=====================================================================
 139
 140 destructor TBRegExp.Destroy;
 141 begin
 142     if pBRegExp<>nil then
 143         BRegFree(pBRegExp);
 144     inherited Destroy;
 145 end;
 146
 147 //=====================================================================
 148 // \91O\89ñ\82Ì\83R\83}\83\93\83h\95¶\8e\9a\97ñ\82ð\95Ô\82·
 149
 150 function TBRegExp.GetLastCommand: string;
 151 var len: Integer;
 152 begin
 153     if pBRegExp=nil then begin
 154         Result:= '';
 155     end else begin
 156         len:= Integer(pBRegExp^.paraendp)-Integer(pBRegExp^.parap);
 157         SetLength(Result, len);
 158         Move(pBRegExp^.parap^, Result[1], len);
 159     end;
 160 end;
 161
 162 //=====================================================================
 163 // \91O\89ñ\82Æ\88Ù\82È\82é\83R\83}\83\93\83h\82Å\82 \82ê\82Î\83L\83\83\83b\83V\83\85\82ð\83N\83\8a\83A\82·\82é\93à\95\94\8eè\91±\82«
 164
 165 procedure TBRegExp.CheckCommand(const Command: string);
 166 var p,q: PChar;
 167 begin
 168     if pBRegExp=nil then Exit;
 169     p:= pBRegExp.parap - 1;
 170     q:= PChar(@Command[1]) - 1;
 171     repeat
 172         Inc(p);
 173         Inc(q);
 174         if p^<>q^ then begin
 175             BRegFree(pBRegExp);
 176             pBRegExp:= nil;
 177             Break;
 178         end;
 179     until p^=#0;
 180 end;
 181
 182 //=====================================================================
 183
 184 function TBRegExp.Match(const Command, TargetString: string): Boolean;
 185 var ErrorString: string;
 186     i: Integer;
 187 begin
 188     CheckCommand(Command);
 189     SetLength(ErrorString, BREGEXP_ERROR_MAX);
 190     Mode:=brxNone;
 191     if TargetString='' then begin // \83G\83\89\81[\89ñ\94ð
 192         i:=0;
 193         Result:=BMatch(
 194             PChar(Command),
 195             PChar(@i),
 196             PChar(@i)+1,
 197             pBRegExp,
 198             PChar(ErrorString));
 199     end else begin
 200         Result:=BMatch(
 201             PChar(Command),
 202             PChar(TargetString),
 203             PChar(TargetString)+Length(TargetString),
 204             pBRegExp,
 205             PChar(ErrorString));
 206     end;
 207     SetLength(ErrorString, StrLen(PChar(ErrorString)));
 208     if ErrorString<>'' then
 209         raise EBRegExpError.Create(ErrorString);
 210     if Result then Mode:= brxMatch;
 211     pTargetString:= PChar(TargetString);
 212 end;
 213
 214 //=====================================================================
 215
 216 function TBRegExp.Subst(const Command: string;
 217                         var TargetString: string): Boolean;
 218 const TextBuffer: string='';
 219 var ErrorString: string;
 220     ep,sp: PPChar;
 221     i: Integer;
 222 begin
 223     CheckCommand(Command);
 224     Result:=False;
 225     if TargetString='' then Exit;
 226     TextBuffer:= TargetString;  // ( ) \82ð\90³\82µ\82\95Ô\82·\82½\82ß\82É\83e\83L\83X\83g\82ð\95Û\91¶\82·\82é
 227     UniqueString(TextBuffer);
 228     SetLength(ErrorString, BREGEXP_ERROR_MAX);
 229     Mode:=brxNone;
 230     Result:=BSubst(
 231         PChar(Command),
 232         PChar(TargetString),
 233         PChar(TargetString)+Length(TargetString),
 234         pBRegExp,
 235         PChar(ErrorString));
 236     SetLength(ErrorString,StrLen(PChar(ErrorString)));
 237     if ErrorString<>'' then
 238         raise EBRegExpError.Create(ErrorString);
 239
 240     if Result then begin // ( ) \82Ì\8c\8b\89Ê\82ð\90³\82µ\82\95Ô\82·\82½\82ß
 241         sp:=pBRegExp^.startp;
 242         ep:=pBRegExp^.endp;
 243         for i:=0 to GetMatchCount-1 do begin
 244             Inc(ep^, Integer(TextBuffer)-Integer(TargetString));
 245             Inc(sp^, Integer(TextBuffer)-Integer(TargetString));
 246             Inc(sp);
 247             Inc(ep);
 248         end;
 249         TargetString:= pBRegExp^.outp;
 250         Mode:=brxMatch;
 251     end;
 252 end;
 253
 254 //=====================================================================
 255
 256 function TBRegExp.Trans(const Command: string;
 257                         var TargetString: string): Boolean;
 258 var ErrorString: string;
 259 begin
 260     CheckCommand(Command);
 261     Mode:=brxNone;
 262     if TargetString='' then // \83G\83\89\81[\89ñ\94ð
 263         TargetString:= #0;
 264     SetLength(ErrorString, BREGEXP_ERROR_MAX);
 265     Result:=BTrans(
 266         PChar(Command),
 267         PChar(TargetString),
 268         PChar(TargetString)+Length(TargetString),
 269         pBRegExp,
 270         PChar(ErrorString));
 271     SetLength(ErrorString,StrLen(PChar(ErrorString)));
 272     if ErrorString<>'' then
 273         raise EBRegExpError.Create(ErrorString);
 274     if Result then TargetString:=pBRegExp^.outp;
 275 end;
 276
 277 //=====================================================================
 278
 279 function TBRegExp.Split(const Command, TargetString: string;
 280                         Limit: Integer): Boolean;
 281 var ErrorString: string;
 282     t: string;
 283 begin
 284     CheckCommand(Command);
 285     SetLength(ErrorString, BREGEXP_ERROR_MAX);
 286     Mode:=brxNone;
 287     if TargetString='' then begin // \83G\83\89\81[\89ñ\94ð
 288         t:= #0;
 289         Result:=BSplit(
 290             PChar(Command),
 291             PChar(t),
 292             PChar(t)+1,
 293             Limit,
 294             pBRegExp,
 295             PChar(ErrorString));
 296     end else begin
 297         Result:=BSplit(
 298             PChar(Command),
 299             PChar(TargetString),
 300             PChar(TargetString)+Length(TargetString),
 301             Limit,
 302             pBRegExp,
 303             PChar(ErrorString));
 304     end;
 305     SetLength(ErrorString,StrLen(PChar(ErrorString)));
 306     if ErrorString<>'' then
 307         raise EBRegExpError.Create(ErrorString);
 308     Mode:=brxSplit;
 309 end;
 310
 311 //=====================================================================
 312
 313 function TBRegExp.GetMatchPos: Integer;
 314 begin
 315     if Mode<>brxMatch then
 316         raise EBRegExpError.Create('no match pos');
 317     Result:=Integer(pBRegExp.startp^)-Integer(pTargetString)+1;
 318 end;
 319
 320 //=====================================================================
 321
 322 function TBRegExp.GetMatchLength: Integer;
 323 begin
 324     if Mode<>brxMatch then
 325         raise EBRegExpError.Create('no match length');
 326     Result:=Integer(pBRegExp.endp^)-Integer(pBRegExp.startp^);
 327 end;
 328
 329 //=====================================================================
 330
 331 function TBRegExp.GetCount: Integer;
 332 begin
 333     Result:=0;
 334     case Mode of
 335     brxNone:
 336         raise EBRegExpError.Create('no count now');
 337     brxMatch:
 338         Result:=GetMatchCount;
 339     brxSplit:
 340         Result:=GetSplitCount;
 341     end;
 342 end;
 343
 344 //=====================================================================
 345
 346 function TBRegExp.GetMatchCount: Integer;
 347 begin
 348     Result:= pBRegExp^.nparens+1;
 349 end;
 350
 351 //=====================================================================
 352
 353 function TBRegExp.GetSplitCount: Integer;
 354 begin
 355     Result:=pBRegExp^.splitctr;
 356 end;
 357
 358 //=====================================================================
 359
 360 function TBRegExp.GetStrings(index: Integer): string;
 361 begin
 362     Result:='';
 363     case Mode of
 364     brxNone:
 365         raise EBRegExpError.Create('no strings now');
 366     brxMatch:
 367         Result:=GetMatchStrings(index);
 368     brxSplit:
 369         Result:=GetSplitStrings(index);
 370     end;
 371 end;
 372
 373 //=====================================================================
 374
 375 function TBRegExp.GetMatchStrings(index:Integer):string;
 376 var sp,ep: PPChar;
 377 begin
 378     Result:='';
 379     if (index<0) or (index>=GetMatchCount) then
 380         raise EBRegExpError.Create('index out of range');
 381     sp:=pBRegExp^.startp; Inc(sp, index);
 382     ep:=pBRegExp^.endp;   Inc(ep, index);
 383     SetLength(Result,Integer(ep^)-Integer(sp^));
 384     Move(sp^^,PChar(Result)^,Integer(ep^)-Integer(sp^));
 385 end;
 386
 387 //=====================================================================
 388
 389 function TBRegExp.GetSplitStrings(index:Integer): string;
 390 var p: PPChar;
 391     sp,ep: PChar;
 392 begin
 393     if (index<0) or (index>=GetSplitCount) then
 394         raise EBRegExpError.Create('index out of range');
 395     p:=pBRegExp^.splitp;
 396     Inc(p,index*2); sp:=p^;
 397     Inc(p);         ep:=p^;
 398     SetLength(Result,Integer(ep)-Integer(sp));
 399     Move(sp^,PChar(Result)^,Integer(ep)-Integer(sp));
 400 end;
 401
 402 //=====================================================================
 403
 404 initialization
 405 finalization
 406     fbrx.Free;
 407 end.
 408