YofUtils.pas

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