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