YofUtils.pas

   1 unit YofUtils;
   2
   3 {!
   4 \file           YofUtils.pas
   5 \brief  HttpApp \82Ì\83N\83\8d\81[\83\93\82â\82»\82Ì\91¼\8eG\97p\8aÖ\90\94
   6
   7 $Id: YofUtils.pas,v 1.10 2004/10/09 15:06:19 yoffy Exp $
   8 }
   9 interface
  10
  11 //==================================================
  12 uses
  13 //==================================================
  14
  15         Classes, SysUtils,
  16         Windows;
  17
  18 {!
  19 \brief          ExtractHttpFields \82Ì\83N\83\8d\81[\83\93
  20 \warning        \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å chrWhite \82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
  21 }
  22 procedure ExtractHttpFields(
  23         const chrSep : TSysCharSet;
  24         const chrWhite : TSysCharSet;
  25         const strValue : string;
  26         var strResult : TStringList;
  27         unknownFlag : boolean = false
  28 );
  29
  30 function HtmlEncode(
  31         const strValue : string
  32 ) : string;
  33
  34 function HtmlDecode(
  35         const strValue : string
  36 ) : string;
  37
  38 function HttpEncode(
  39         const strValue : string
  40 ) : string;
  41
  42 function HttpDecode(
  43         const strValue : string
  44 ) : string;
  45
  46 {!
  47 \brief          MachiesMask \82Ì\83N\83\8d\81[\83\93
  48 \warning        \82Æ\82è\82 \82¦\82¸\82Ì\91ã\97p\95i\82È\82Ì\82Å [] \82ð\8eg\82Á\82½\90³\8bK\95\\8c»\82ð\8dl\97¶\82µ\82Ä\82¢\82È\82¢\82±\82Æ\82É\92\8d\88Ó\81I\81I\81I
  49 }
  50 function MatchesMask(
  51         const filename, mask : string
  52 ) : boolean;
  53
  54 //! \83\81\83^\83L\83\83\83\89\83N\83^\82ð\90³\8bK\95\\8c»\88µ\82¢\82É\82È\82ç\82È\82¢\82æ\82¤\82É\92u\8a·
  55 function RegExpEncode(
  56         const text : string
  57 ) : string;
  58
  59 {!
  60 \brief          \95\\8e¦\83\81\83b\83Z\81[\83W\82Ì\90®\8c`
  61 \param          msg                             \95\\8e¦\82·\82é\83\81\83b\83Z\81[\83W
  62 \param          elements        \92u\8a·\92P\8cê
  63
  64 msg \82Ì\92\86\82Ì\92u\8a·\82³\82ê\82é\92P\8cê\82Í '^\94Ô\8d\86' \82Å\95\\82³\82ê\81A
  65 elements \82Í\89ü\8ds\82É\82æ\82Á\82Ä\92P\8cê\95ª\82¯\82³\82ê\82Ü\82·\81B<br>
  66
  67 <pre><code>
  68 elements := IntToStr( 10 ) + #10 + 'hoge';
  69 m := MessageStyle(
  70         '^0 \8cÂ\82Ì\81g^1\81h\82ð\92u\8a·\82µ\82Ü\82µ\82½\81B',
  71         elements );
  72 </code></pre>
  73
  74 \82Å\8fo\97Í\82³\82ê\82é m \82Í\81u10 \8cÂ\82Ì\81ghoge\81h\82ð\92u\8a·\82µ\82Ü\82µ\82½\81B\81v\82Æ\82È\82è\82Ü\82·\81B
  75 }
  76 function MessageStyle(
  77         const msg                               : string;
  78         const elements  : string
  79 ) : string; overload;
  80
  81 function MessageStyle(
  82         const msg                               : string;
  83         const elements  : TStringList
  84 ) : string; overload;
  85
  86 {!
  87 \brief  \89E\89ñ\93]\83V\83t\83g
  88 \param  v               \89ñ\93]\82·\82é\92l
  89 \param  n               \89ñ\93]\83r\83b\83g\90\94
  90 \return Longword( (v shl (32 - n)) or (v shr n) ) \82Ì\92l
  91 }
  92 function ror( v, n : Longword ) : Longword; register;
  93
  94 {!
  95 \brief          \95¶\8e\9a\97ñ\82Ì\83n\83b\83V\83\85\92l\82ð\8cv\8eZ
  96 \param          s               \95¶\8e\9a\97ñ
  97 \return         \83n\83b\83V\83\85\92l ( 4 byte )
  98 \warning  \91½\83o\83C\83g\82ð 4 byte \82É\8fk\82ß\82Ä\82¢\82é\82½\82ß\81A
  99                                         \93¯\82¶\92l\82ð\8fo\97Í\82·\82é\95¶\8e\9a\97ñ\82Í\96³\8cÀ\82É\91¶\8dÝ\82µ\82Ü\82·\81B
 100                                         \83R\83\93\83t\83\8a\83N\83g\82ª\8bN\82±\82ç\82È\82¢\8e\96\82ð\91O\92ñ\82É\82µ\82½\8bL\8fq\82Í\94ð\82¯\82Ä\82\82¾\82³\82¢\81B
 101
 102 \82±\82Ì\8aÖ\90\94\82Í\91½\83o\83C\83g\92·\82Ì\95¶\8e\9a\97ñ\82ð 4 byte \82É\8fk\82ß\82Ü\82·\81B<br>
 103 \82»\82Ì\89ß\92ö\82Å\81A'abcdefgh' \82Æ 'efghabcd' \82ª\93¯\82¶\92l\82É\82È\82ç\82È\82¢\82æ\82¤\82É\82·\82é\93\99\81A
 104 \91½\8f\95Î\82è\82ð\8fÈ\82\82æ\82¤\82É\8dl\97¶\82³\82ê\82Ü\82·\81B
 105 }
 106 function GetStringHash( const s : string ) : Longword;
 107
 108 type
 109         //! Mode \92l\82ª\82¨\82©\82µ\82¢
 110         EMappedFileModeError = class( Exception );
 111         //! \83}\83b\83s\83\93\83O\82É\8e¸\94s
 112         EMappedFileMappingError = class( Exception );
 113
 114         //! \83\81\83\82\83\8a\83}\83b\83v\83h\81E\83t\83@\83C\83\8b \83N\83\89\83X
 115         TMappedFile = class( TObject )
 116         private
 117                 FFileHandle                     : THandle;
 118                 FMappingHandle  : THandle;
 119                 FSize                                           : Int64;
 120                 FViewAddress            : Pointer;
 121         public
 122                 {!
 123                 \brief  \83\81\83\82\83\8a\83}\83b\83v\83h\83t\83@\83C\83\8b\82Ì\8dì\90¬
 124                 \param  filePath                \8aJ\82\83t\83@\83C\83\8b\82Ì\83p\83X
 125                 \param  mode                            fmOpenRead (\83f\83t\83H\83\8b\83g) \82Ü\82½\82Í fmOpenReadWrite
 126                 \param  maximumSize     \83y\81[\83W\83T\83C\83Y\82Ì\8fã\8cÀ (0 \82È\82ç\8c»\8dÝ\82Ì\83t\83@\83C\83\8b\83T\83C\83Y)
 127                 }
 128                 constructor Create(
 129                         const filePath  : string;
 130                         mode                                            : Longword = fmOpenRead;
 131                         maximumSize                     : Int64 = 0 );
 132                 destructor      Destroy; override;
 133
 134                 //! \83T\83C\83Y\82Ì\8eæ\93¾
 135                 property                Size            : Int64                 read FSize;
 136                 //! \83A\83h\83\8c\83X\82Ì\8eæ\93¾
 137                 property                Memory  : Pointer               read FViewAddress;
 138         end;
 139
 140 //==================================================
 141 const
 142 //==================================================
 143         kYofKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
 144
 145 //==================================================
 146 implementation
 147 //==================================================
 148
 149 uses MojuUtils;
 150
 151 procedure ExtractHttpFields(
 152         const chrSep : TSysCharSet;
 153         const chrWhite : TSysCharSet;
 154         const strValue : string;
 155         var strResult : TStringList;
 156         unknownFlag : boolean = false
 157 );
 158 var
 159         last, p, strLen : Integer;
 160 begin
 161
 162         strLen := Length( strValue );
 163         p := 1;
 164         last := 1;
 165
 166         while p <= strLen do
 167         begin
 168
 169                 if strValue[ p ] in chrSep then
 170                 begin
 171                         strResult.Add( Copy( strValue, last, p - last ) );
 172                         last := p + 1;
 173                 end;
 174
 175                 p := p + 1;
 176
 177         end;
 178
 179         if last <> p then
 180                 strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
 181
 182 end;
 183
 184 function HtmlEncode(
 185         const strValue : string
 186 ) : string;
 187 var
 188         i : Integer;
 189         strLen : Integer;
 190         strResult : string;
 191 begin
 192
 193         strLen := Length( strValue );
 194         i := 1;
 195
 196         while i <= strLen do
 197         begin
 198
 199                 case strValue[ i ] of
 200                 '&':
 201                         begin
 202                                 strResult := strResult + '&amp;';
 203                         end;
 204                 '<':
 205                         begin
 206                                 strResult := strResult + '&lt;';
 207                         end;
 208                 '>':
 209                         begin
 210                                 strResult := strResult + '&gt;';
 211                         end;
 212                 '"':
 213                         begin
 214                                 strResult := strResult + '&quot;';
 215                         end;
 216                 else
 217                         begin
 218                                 if strValue[ i ] in kYofKanji then
 219                                 begin
 220                                         strResult := strResult + strValue[ i ];
 221                                         Inc( i );
 222                                 end;
 223                                 strResult := strResult + strValue[ i ];
 224                         end;
 225                 end;
 226
 227                 i := i + 1;
 228
 229         end;
 230
 231         Result := strResult;
 232
 233 end;
 234
 235 function HtmlDecode(
 236         const strValue : string
 237 ) : string;
 238 var
 239         strResult : string;
 240 begin
 241
 242         strResult := StringReplace( strValue, '&lt;', '<', [rfReplaceAll] );
 243         strResult := StringReplace( strResult, '&gt;', '>', [rfReplaceAll] );
 244         strResult := StringReplace( strResult, '&quot;', '"', [rfReplaceAll] );
 245         strResult := StringReplace( strResult, '&amp;', '&', [rfReplaceAll] );
 246
 247         Result := strResult;
 248
 249 end;
 250
 251 function HttpEncode(
 252         const strValue : string
 253         ) : string;
 254 var
 255         i : Integer;
 256         strLen : Integer;
 257         strResult : string;
 258         b : Integer;
 259 const
 260         kHexCode : array [0..15] of char = (
 261                                 '0', '1', '2', '3', '4', '5', '6', '7',
 262                                 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
 263 begin
 264
 265         strLen := Length( strValue );
 266         i := 1;
 267
 268         while i <= strLen do
 269         begin
 270
 271                 case strValue[ i ] of
 272                 '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
 273                         begin
 274                                 strResult := strResult + strValue[ i ];
 275                         end;
 276                 else
 277                         begin
 278                                 b := Integer( strValue[ i ] );
 279                                 strResult := strResult + '%'
 280                                                                 + kHexCode[ b div $10 ]
 281                                                                 + kHexCode[ b mod $10 ];
 282                         end;
 283                 end;
 284
 285                 i := i + 1;
 286
 287         end;
 288
 289         Result := strResult;
 290
 291 end;
 292
 293 function        toupper(
 294         ch : Longword
 295 ) : Byte; Register;
 296 asm
 297         mov     ecx, eax                // ecx = (ch - 'a')
 298         sub     cl, 'a'
 299         cmp     ecx, 26                 // edx = ecx < 26 (\8f¬\95¶\8e\9a\82È\82ç\83t\83\8b\83r\83b\83g)
 300         sbb     edx, edx
 301         and     edx, $20                // edx &= 0x20 (\8f¬\95¶\8e\9a\82È\82ç 0x20)
 302         xor     eax, edx                // eax ^= edx
 303 end;
 304
 305 function HttpDecode(
 306         const strValue : string
 307 ) : string;
 308 var
 309         i : Integer;
 310         strLen : Integer;
 311         strResult : string;
 312         b : Integer;
 313 begin
 314
 315         strLen := Length( strValue );
 316         i := 1;
 317
 318         while i <= strLen do
 319         begin
 320
 321                 if '%' = strValue[ i ] then begin
 322                         Inc( i );
 323                         if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
 324                                 b := (toupper( Longword( strValue[ i ] ) ) - 55) shl 4
 325                         else
 326                                 b := (Byte( strValue[ i ] ) - Byte( '0' )) shl 4;
 327                         Inc( i );
 328                         if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
 329                                 b := b or (toupper( Longword( strValue[ i ] ) ) - 55)
 330                         else
 331                                 b := b or (Byte( strValue[ i ] ) - Byte( '0' ));
 332
 333                         strResult := strResult + Char( Byte( b ) );
 334                 end else begin
 335                         strResult := strResult + strValue[ i ];
 336                 end;
 337
 338                 Inc( i );
 339
 340         end;
 341
 342         Result := strResult;
 343
 344 end;
 345
 346 function MatchesMask(
 347         const filename, mask : string
 348         ) : boolean;
 349 var
 350         pName, pMask : Integer;
 351         ptrName, ptrMask : PChar;
 352         nameLen, maskLen : Integer;
 353         chrUpMask : char;
 354         delimiterPos : Integer;
 355 begin
 356
 357         nameLen := Length( filename );
 358         maskLen := Length( mask );
 359         ptrName := PChar( filename );
 360         ptrMask := PChar( mask );
 361         pName := 0;
 362         pMask := 0;
 363         delimiterPos := Pos( '\', string( ptrName + pName ) );
 364         while delimiterPos > 0 do
 365         begin
 366                 pName := pName + delimiterPos;
 367                 delimiterPos := Pos( '\', string( ptrName + pName ) );
 368         end;
 369
 370         while (pMask < maskLen) and (pName < nameLen) do
 371         begin
 372
 373                 case ptrMask[ pMask ] of
 374                 '?':
 375                         begin
 376                                 // \82±\82Ì 1 \8e\9a\82Í\89½\82à\82µ\82È\82¢
 377                         end;
 378                 '*':
 379                         begin
 380                                 pMask := pMask + 1;
 381                                 // mask \82ð\91\96\8d¸\82µ\90Ø\82Á\82½\82ç\8fI\97¹
 382                                 if pMask >= maskLen then
 383                                 begin
 384                                         Result := true;
 385                                         exit;
 386                                 end;
 387
 388                                 // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\97\88\82é\82Ü\82Å\94ò\82Î\82·
 389                                 chrUpMask := upcase( ptrMask[ pMask ] );
 390                                 while chrUpMask <> UpCase( ptrName[ pName ] ) do
 391                                 begin
 392                                         pName := pName + 1;
 393                                         if pName >= nameLen then
 394                                         begin
 395                                                 Result := true;
 396                                                 exit;
 397                                         end;
 398                                 end;
 399
 400                                 // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\8c©\82Â\82©\82ç\82È\82©\82Á\82½\82ç\8fI\97¹
 401                                 if chrUpMask <> UpCase( ptrName[ pName ] ) then
 402                                 begin
 403                                         Result := false;
 404                                         exit;
 405                                 end;
 406
 407                                 pName := pName + 1;
 408                                 pMask := pMask + 1;
 409                         end;
 410                 else
 411                         begin
 412                                 // \82±\82Ì 1 \95¶\8e\9a\82ª\88á\82Á\82½\82ç\8fI\97¹
 413                                 if UpCase( ptrMask[ pMask ] ) <> UpCase( ptrName[ pName ] ) then
 414                                 begin
 415                                         Result := false;
 416                                         exit;
 417                                 end;
 418
 419                         end;
 420                 end;
 421
 422                 // \8e\9f\82Ì\95¶\8e\9a\82Ö
 423                 pName := pName + 1;
 424                 pMask := pMask + 1;
 425
 426         end;
 427
 428         if (pMask >= maskLen) and (pName >= nameLen) then
 429                 Result := true
 430         else
 431                 Result := false;
 432
 433 end;
 434
 435 function RegExpEncode(
 436         const text : string
 437 ) : string;
 438 var
 439         strResult : string;
 440 begin
 441
 442         strResult := StringReplace( text, '\', '\\', [rfReplaceAll] );
 443         strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
 444         strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
 445         strResult := StringReplace( strResult, '(', '\(', [rfReplaceAll] );
 446         strResult := StringReplace( strResult, ')', '\)', [rfReplaceAll] );
 447         strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
 448         strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
 449         strResult := StringReplace( strResult, '*', '\*', [rfReplaceAll] );
 450         strResult := StringReplace( strResult, '?', '\?', [rfReplaceAll] );
 451         strResult := StringReplace( strResult, '.', '\.', [rfReplaceAll] );
 452         strResult := StringReplace( strResult, '+', '\+', [rfReplaceAll] );
 453         strResult := StringReplace( strResult, '|', '\|', [rfReplaceAll] );
 454         strResult := StringReplace( strResult, '^', '\^', [rfReplaceAll] );
 455         strResult := StringReplace( strResult, '$', '\$', [rfReplaceAll] );
 456
 457         Result := strResult;
 458
 459 end;
 460
 461 function MessageStyle(
 462         const msg                               : string;
 463         const elements  : string
 464 ) : string;
 465 var
 466         list                                            : TStringList;
 467 begin
 468
 469         list := TStringList.Create;
 470         try
 471                 list.Text := elements;
 472                 Result := MessageStyle( msg, list );
 473         finally
 474                 list.Free;
 475         end;
 476
 477 end;
 478
 479 function MessageStyle(
 480         const msg                               : string;
 481         const elements  : TStringList
 482 ) : string;
 483 var
 484         i                                                               : Integer;
 485 begin
 486
 487         Result := msg;
 488         for i := elements.Count - 1 downto 0 do
 489                 Result := CustomStringReplace( Result, '^' + IntToStr( i ), elements[ i ], false );
 490
 491 end;
 492
 493 //==============================
 494 // ror
 495 //==============================
 496 function ror( v, n : Longword ) : Longword; register;
 497 asm
 498         mov             cl, dl
 499         ror             eax, cl
 500 end;
 501
 502 //==============================
 503 // GetStringHash
 504 //==============================
 505 function GetStringHash( const s : string ) : Longword;
 506 var
 507         l                               : Integer;
 508         v                               : Longword;
 509         p, tail : PChar;
 510 begin
 511
 512         l                       := Length( s );
 513         p                       := PChar( s );
 514         v                       := $87654321;
 515         tail    := p + (l and $fffffffc);
 516         while p < tail do begin
 517                 v       := PDword( p )^ + (v shl 2) * ($10000 - v);
 518                 p := p + 4;
 519         end;
 520         tail    := PChar( s ) + l;
 521         while p < tail do begin
 522                 v := PByte( p )^ + (v shl 2) * ($10000 - v);
 523                 Inc( p );
 524         end;
 525
 526         Result := v xor ((v shl 2) * ($10000 - v));
 527
 528 end;
 529
 530 { TMappedFile }
 531
 532 constructor TMappedFile.Create(
 533         const filePath  : string;
 534         mode                                            : Longword = fmOpenRead;
 535         maximumSize                     : Int64 = 0 );
 536 var
 537         dwFileDesiredAccess     : DWORD;
 538         flProtect                                               : DWORD;
 539         dwViewDesiredAccess     : DWORD;
 540 begin
 541
 542         case mode of
 543         fmOpenRead:
 544                 begin
 545                         dwFileDesiredAccess     := GENERIC_READ;
 546                         flProtect                                               := PAGE_READONLY;
 547                         dwViewDesiredAccess     := FILE_MAP_READ;
 548                 end;
 549
 550         fmOpenReadWrite:
 551                 begin
 552                         dwFileDesiredAccess     := GENERIC_READ or GENERIC_WRITE;
 553                         flProtect                                               := PAGE_READWRITE;
 554                         dwViewDesiredAccess     := FILE_MAP_WRITE;
 555                 end;
 556
 557         else
 558                 raise EMappedFileModeError.Create( '\83t\83@\83C\83\8b\83I\81[\83v\83\93\82Ì\83\82\81[\83h\82ª\95s\90³\82Å\82·\81B' );
 559         end;
 560
 561         FFileHandle := CreateFile(
 562                 PChar( filePath ), dwFileDesiredAccess, 0, nil, OPEN_ALWAYS,
 563                 FILE_ATTRIBUTE_NORMAL, 0 );
 564         if FFileHandle = INVALID_HANDLE_VALUE then
 565 // for Delphi 7
 566 //              raise EFOpenError.Create( '\83t\83@\83C\83\8b\82Ì\83I\81[\83v\83\93\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B' );
 567                 raise EMappedFileMappingError.Create( '\83t\83@\83C\83\8b\82Ì\83I\81[\83v\83\93\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B' );
 568 /////////////
 569
 570         FSize := GetFileSize( FFileHandle, nil );
 571         if FSize < maximumSize then
 572                 FSize := maximumSize;
 573
 574         FMappingHandle := CreateFileMapping(
 575                 FFileHandle, nil, flProtect,
 576                 DWORD( (maximumSize shr 32) and $ffffffff ),
 577                 DWORD( maximumSize and $ffffffff ),
 578                 nil );
 579         if FFileHandle = INVALID_HANDLE_VALUE then
 580                 raise EMappedFileMappingError.Create( '\83t\83@\83C\83\8b\82Ì\83}\83b\83s\83\93\83O\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B' );
 581
 582         FViewAddress := MapViewOfFile( FMappingHandle, dwViewDesiredAccess, 0, 0, 0 );
 583         if FViewAddress = nil then
 584                 raise EMappedFileMappingError.Create( '\83t\83@\83C\83\8b\82Ì\83}\83b\83s\83\93\83O\82É\8e¸\94s\82µ\82Ü\82µ\82½\81B' );
 585
 586 end;
 587
 588 destructor      TMappedFile.Destroy;
 589 begin
 590
 591         UnmapViewOfFile( FViewAddress );
 592         CloseHandle( FMappingHandle );
 593         CloseHandle( FFileHandle );
 594
 595 end;
 596
 597 end.