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
  14 procedure ExtractHttpFields(
  15         const chrSep : TSysCharSet;
  16         const chrWhite : TSysCharSet;
  17         const strValue : string;
  18         var strResult : TStringList;
  19         unknownFlag : boolean = false
  20 );
  21
  22 function HtmlEncode(
  23         const strValue : string
  24 ) : string;
  25
  26 function HtmlDecode(
  27         const strValue : string
  28 ) : string;
  29
  30 function HttpEncode(
  31         const strValue : string
  32 ) : string;
  33
  34 function HttpDecode(
  35         const strValue : string
  36 ) : string;
  37
  38 function MatchesMask(
  39         const filename, mask : string
  40 ) : boolean;
  41
  42 // \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·
  43 function RegExpEncode(
  44         const text : string
  45 ) : string;
  46
  47 //==================================================
  48 const
  49 //==================================================
  50         kYofKanji : TSysCharSet = [#$80..#$A0, #$E0..#$ff];
  51
  52 //==================================================
  53 implementation
  54 //==================================================
  55
  56 // \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
  57 procedure ExtractHttpFields(
  58         const chrSep : TSysCharSet;
  59         const chrWhite : TSysCharSet;
  60         const strValue : string;
  61         var strResult : TStringList;
  62         unknownFlag : boolean = false
  63 );
  64 var
  65         last, p, strLen : Integer;
  66 begin
  67
  68         strLen := Length( strValue );
  69         p := 1;
  70         last := 1;
  71
  72         while p <= strLen do
  73         begin
  74
  75                 if strValue[ p ] in chrSep then
  76                 begin
  77                         strResult.Add( Copy( strValue, last, p - last ) );
  78                         last := p + 1;
  79                 end;
  80
  81                 p := p + 1;
  82
  83         end;
  84
  85         if last <> p then
  86                 strResult.Add( Copy( strValue, last, strLen - last + 1 ) );
  87
  88 end;
  89
  90 function HtmlEncode(
  91         const strValue : string
  92 ) : string;
  93 var
  94         i : Integer;
  95         strLen : Integer;
  96         strResult : string;
  97 begin
  98
  99         strLen := Length( strValue );
 100         i := 1;
 101
 102         while i <= strLen do
 103         begin
 104
 105                 case strValue[ i ] of
 106                 '&':
 107                         begin
 108                                 strResult := strResult + '&amp;';
 109                         end;
 110                 '<':
 111                         begin
 112                                 strResult := strResult + '&lt;';
 113                         end;
 114                 '>':
 115                         begin
 116                                 strResult := strResult + '&gt;';
 117                         end;
 118                 '"':
 119                         begin
 120                                 strResult := strResult + '&quot;';
 121                         end;
 122                 else
 123                         begin
 124                                 if strValue[ i ] in kYofKanji then
 125                                 begin
 126                                         strResult := strResult + strValue[ i ];
 127                                         Inc( i );
 128                                 end;
 129                                 strResult := strResult + strValue[ i ];
 130                         end;
 131                 end;
 132
 133                 i := i + 1;
 134
 135         end;
 136
 137         Result := strResult;
 138
 139 end;
 140
 141 function HtmlDecode(
 142         const strValue : string
 143 ) : string;
 144 var
 145         strResult : string;
 146 begin
 147
 148         strResult := StringReplace( strValue, '&lt;', '<', [rfReplaceAll] );
 149         strResult := StringReplace( strResult, '&gt;', '>', [rfReplaceAll] );
 150         strResult := StringReplace( strResult, '&quot;', '"', [rfReplaceAll] );
 151         strResult := StringReplace( strResult, '&amp;', '&', [rfReplaceAll] );
 152
 153         Result := strResult;
 154
 155 end;
 156
 157 function HttpEncode(
 158         const strValue : string
 159         ) : string;
 160 var
 161         i : Integer;
 162         strLen : Integer;
 163         strResult : string;
 164         b : Integer;
 165 const
 166         kHexCode : array [0..15] of char = (
 167                                 '0', '1', '2', '3', '4', '5', '6', '7',
 168                                 '8', '9', 'A', 'B', 'C', 'D', 'E', 'F' );
 169 begin
 170
 171         strLen := Length( strValue );
 172         i := 1;
 173
 174         while i <= strLen do
 175         begin
 176
 177                 case strValue[ i ] of
 178                 '0' .. '9', 'a' .. 'z', 'A' .. 'Z', '*', '-', '.', '@', '_':
 179                         begin
 180                                 strResult := strResult + strValue[ i ];
 181                         end;
 182                 else
 183                         begin
 184                                 b := Integer( strValue[ i ] );
 185                                 strResult := strResult + '%'
 186                                                                 + kHexCode[ b div $10 ]
 187                                                                 + kHexCode[ b mod $10 ];
 188                         end;
 189                 end;
 190
 191                 i := i + 1;
 192
 193         end;
 194
 195         Result := strResult;
 196
 197 end;
 198
 199 function        toupper(
 200         ch : Longword
 201 ) : Byte; Register;
 202 asm
 203         mov     ecx, eax                // ecx = (ch - 'a')
 204         sub     cl, 'a'
 205         cmp     ecx, 26                 // edx = ecx < 26 (\8f¬\95¶\8e\9a\82È\82ç\83t\83\8b\83r\83b\83g)
 206         sbb     edx, edx
 207         and     edx, $20                // edx &= 0x20 (\8f¬\95¶\8e\9a\82È\82ç 0x20)
 208         xor     eax, edx                // eax ^= edx
 209 end;
 210
 211 function HttpDecode(
 212         const strValue : string
 213 ) : string;
 214 var
 215         i : Integer;
 216         strLen : Integer;
 217         strResult : string;
 218         b : Integer;
 219 begin
 220
 221         strLen := Length( strValue );
 222         i := 1;
 223
 224         while i <= strLen do
 225         begin
 226
 227                 if '%' = strValue[ i ] then begin
 228                         Inc( i );
 229                         if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
 230                                 b := (toupper( Longword( strValue[ i ] ) ) - 55) shl 4
 231                         else
 232                                 b := (Byte( strValue[ i ] ) - Byte( '0' )) shl 4;
 233                         Inc( i );
 234                         if strValue[ i ] in ['a' .. 'z', 'A' .. 'Z'] then
 235                                 b := b or (toupper( Longword( strValue[ i ] ) ) - 55)
 236                         else
 237                                 b := b or (Byte( strValue[ i ] ) - Byte( '0' ));
 238
 239                         strResult := strResult + Char( Byte( b ) );
 240                 end else begin
 241                         strResult := strResult + strValue[ i ];
 242                 end;
 243
 244                 Inc( i );
 245
 246         end;
 247
 248         Result := strResult;
 249
 250 end;
 251
 252 // \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
 253 function MatchesMask(
 254         const filename, mask : string
 255         ) : boolean;
 256 var
 257         pName, pMask : Integer;
 258         ptrName, ptrMask : PChar;
 259         nameLen, maskLen : Integer;
 260         chrUpMask : char;
 261         delimiterPos : Integer;
 262 begin
 263
 264         nameLen := Length( filename );
 265         maskLen := Length( mask );
 266         ptrName := PChar( filename );
 267         ptrMask := PChar( mask );
 268         pName := 0;
 269         pMask := 0;
 270         delimiterPos := Pos( '\', string( ptrName + pName ) );
 271         while delimiterPos > 0 do
 272         begin
 273                 pName := pName + delimiterPos;
 274                 delimiterPos := Pos( '\', string( ptrName + pName ) );
 275         end;
 276
 277         while (pMask < maskLen) and (pName < nameLen) do
 278         begin
 279
 280                 case ptrMask[ pMask ] of
 281                 '?':
 282                         begin
 283                                 // \82±\82Ì 1 \8e\9a\82Í\89½\82à\82µ\82È\82¢
 284                         end;
 285                 '*':
 286                         begin
 287                                 pMask := pMask + 1;
 288                                 // mask \82ð\91\96\8d¸\82µ\90Ø\82Á\82½\82ç\8fI\97¹
 289                                 if pMask >= maskLen then
 290                                 begin
 291                                         Result := true;
 292                                         exit;
 293                                 end;
 294
 295                                 // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\97\88\82é\82Ü\82Å\94ò\82Î\82·
 296                                 chrUpMask := upcase( ptrMask[ pMask ] );
 297                                 while chrUpMask <> UpCase( ptrName[ pName ] ) do
 298                                 begin
 299                                         pName := pName + 1;
 300                                         if pName >= nameLen then
 301                                         begin
 302                                                 Result := true;
 303                                                 exit;
 304                                         end;
 305                                 end;
 306
 307                                 // * \82Ì\8e\9f\82Ì\95¶\8e\9a\82ª\8c©\82Â\82©\82ç\82È\82©\82Á\82½\82ç\8fI\97¹
 308                                 if chrUpMask <> UpCase( ptrName[ pName ] ) then
 309                                 begin
 310                                         Result := false;
 311                                         exit;
 312                                 end;
 313
 314                                 pName := pName + 1;
 315                                 pMask := pMask + 1;
 316                         end;
 317                 else
 318                         begin
 319                                 // \82±\82Ì 1 \95¶\8e\9a\82ª\88á\82Á\82½\82ç\8fI\97¹
 320                                 if UpCase( ptrMask[ pMask ] ) <> UpCase( ptrName[ pName ] ) then
 321                                 begin
 322                                         Result := false;
 323                                         exit;
 324                                 end;
 325
 326                         end;
 327                 end;
 328
 329                 // \8e\9f\82Ì\95¶\8e\9a\82Ö
 330                 pName := pName + 1;
 331                 pMask := pMask + 1;
 332
 333         end;
 334
 335         if (pMask >= maskLen) and (pName >= nameLen) then
 336                 Result := true
 337         else
 338                 Result := false;
 339
 340 end;
 341
 342
 343 // \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·
 344 function RegExpEncode(
 345         const text : string
 346 ) : string;
 347 var
 348         strResult : string;
 349 begin
 350
 351         strResult := StringReplace( text, '\', '\\', [rfReplaceAll] );
 352         strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
 353         strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
 354         strResult := StringReplace( strResult, '(', '\(', [rfReplaceAll] );
 355         strResult := StringReplace( strResult, ')', '\)', [rfReplaceAll] );
 356         strResult := StringReplace( strResult, '[', '\[', [rfReplaceAll] );
 357         strResult := StringReplace( strResult, ']', '\]', [rfReplaceAll] );
 358         strResult := StringReplace( strResult, '*', '\*', [rfReplaceAll] );
 359         strResult := StringReplace( strResult, '?', '\?', [rfReplaceAll] );
 360         strResult := StringReplace( strResult, '.', '\.', [rfReplaceAll] );
 361         strResult := StringReplace( strResult, '+', '\+', [rfReplaceAll] );
 362         strResult := StringReplace( strResult, '|', '\|', [rfReplaceAll] );
 363         strResult := StringReplace( strResult, '^', '\^', [rfReplaceAll] );
 364         strResult := StringReplace( strResult, '$', '\$', [rfReplaceAll] );
 365
 366         Result := strResult;
 367
 368 end;
 369
 370 end.