synacode.pas

snmp设计增加相应SNMP的OID,是实时处理的.

{==============================================================================|
| Project : Ararat Synapse                                       | 002.001.003 |
|==============================================================================|
| Content: Coding and decoding support                                         |
|==============================================================================|
| Copyright (c)1999-2003, Lukas Gebauer                                        |
| All rights reserved.                                                         |
|                                                                              |
| Redistribution and use in source and binary forms, with or without           |
| modification, are permitted provided that the following conditions are met:  |
|                                                                              |
| Redistributions of source code must retain the above copyright notice, this  |
| list of conditions and the following disclaimer.                             |
|                                                                              |
| Redistributions in binary form must reproduce the above copyright notice,    |
| this list of conditions and the following disclaimer in the documentation    |
| and/or other materials provided with the distribution.                       |
|                                                                              |
| Neither the name of Lukas Gebauer nor the names of its contributors may      |
| be used to endorse or promote products derived from this software without    |
| specific prior written permission.                                           |
|                                                                              |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"  |
| AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE    |
| IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE   |
| ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR  |
| ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL       |
| DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR   |
| SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER   |
| CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT           |
| LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY    |
| OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH  |
| DAMAGE.                                                                      |
|==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2000-2003.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{:@abstract(Various encoding and decoding support)}
{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$Q-}
{$R-}
{$H+}

unit synacode;

interface

uses
  SysUtils;

type
  TSpecials = set of AnsiChar;

const

  SpecialChar: TSpecials =
  ['=', '(', ')', '[', ']', '<', '>', ':', ';', ',', '@', '/', '?', '\',
    '"', '_'];
  NonAsciiChar: TSpecials =
  [Char(0)..Char(31), Char(127)..Char(255)];
  URLFullSpecialChar: TSpecials =
  [';', '/', '?', ':', '@', '=', '&', '#'];
  URLSpecialChar: TSpecials =
  [#$00..#$20, '_', '<', '>', '"', '%', '{', '}', '|', '\', '^', '~', '[', ']',
    '`', #$7F..#$FF];
  TableBase64 =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
  TableBase64mod =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,=';
  TableUU =
    '`!"#$%&''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
  TableXX =
    '+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  ReTablebase64 =
    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
    +#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
    +#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
    +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
    +#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
  ReTableUU =
    #$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
    +#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
    +#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
    +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
    +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
    +#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
  ReTableXX =
    #$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
    +#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
    +#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
    +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
    +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
    +#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
    +#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
    +#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;

{:Decodes triplet encoding with a given character delimiter. It is used for
 decoding quoted-printable or URL encoding.}
function DecodeTriplet(const Value: AnsiString; Delimiter: AnsiChar): AnsiString;

{:Decodes a string from quoted printable form. (also decodes triplet sequences
 like '=7F')}
function DecodeQuotedPrintable(const Value: AnsiString): AnsiString;

{:Decodes a string of URL encoding. (also decodes triplet sequences like '%7F')}
function DecodeURL(const Value: AnsiString): AnsiString;

{:Performs triplet encoding with a given character delimiter. Used for encoding
 quoted-printable or URL encoding.}
function EncodeTriplet(const Value: AnsiString; Delimiter: AnsiChar;
  Specials: TSpecials): AnsiString;

{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar)
 are encoded.}
function EncodeQuotedPrintable(const Value: AnsiString): AnsiString;

{:Encodes a string to triplet quoted printable form. All @link(NonAsciiChar) and
 @link(SpecialChar) are encoded.}
function EncodeSafeQuotedPrintable(const Value: AnsiString): AnsiString;

{:Encodes a string to URL format. Used for encoding data from a form field in
 HTTP, etc. (Encodes all critical characters including characters used as URL
 delimiters ('/',':', etc.)}
function EncodeURLElement(const Value: AnsiString): AnsiString;

{:Encodes a string to URL format. Used to encode critical characters in all
 URLs.}
function EncodeURL(const Value: AnsiString): AnsiString;

{:Decode 4to3 encoding with given table. If some element is not found in table,
 first item from table is used. This is good for buggy coded items by Microsoft
 Outlook. This software sometimes using wrong table for UUcode, where is used
 ' ' instead '`'.}
function Decode4to3(const Value, Table: AnsiString): AnsiString;

{:Decode 4to3 encoding with given REVERSE table. Using this function with
reverse table is much faster then @link(Decode4to3). This function is used
internally for Base64, UU or XX decoding.}
function Decode4to3Ex(const Value, Table: AnsiString): AnsiString;

{:Encode by system 3to4 (used by Base64, UU coding, etc) by given table.}
function Encode3to4(const Value, Table: AnsiString): AnsiString;

{:Decode string from base64 format.}
function DecodeBase64(const Value: AnsiString): AnsiString;

{:Encodes a string to base64 format.}
function EncodeBase64(const Value: AnsiString): AnsiString;

{:Decode string from modified base64 format. (used in IMAP, for example.)}
function DecodeBase64mod(const Value: AnsiString): AnsiString;

{:Encodes a string to  modified base64 format. (used in IMAP, for example.)}
function EncodeBase64mod(const Value: AnsiString): AnsiString;

{:Decodes a string from UUcode format.}
function DecodeUU(const Value: AnsiString): AnsiString;

{:encode UUcode. it encode only datas, you must also add header and footer for
 proper encode.}
function EncodeUU(const Value: AnsiString): AnsiString;

{:Decodes a string from XXcode format.}
function DecodeXX(const Value: AnsiString): AnsiString;

{:decode line with Yenc code. This code is sometimes used in newsgroups.}
function DecodeYEnc(const Value: AnsiString): AnsiString;

{:Returns a new CRC32 value after adding a new byte of data.}
function UpdateCrc32(Value: Byte; Crc32: Integer): Integer;

{:return CRC32 from a value string.}
function Crc32(const Value: AnsiString): Integer;

{:Returns a new CRC16 value after adding a new byte of data.}
function UpdateCrc16(Value: Byte; Crc16: Word): Word;

{:return CRC16 from a value string.}
function Crc16(const Value: AnsiString): Word;

{:Returns a binary string with a RSA-MD5 hashing of "Value" string.}
function MD5(const Value: AnsiString): AnsiString;

{:Returns a binary string with HMAC-MD5 hash.}
function HMAC_MD5(Text, Key: AnsiString): AnsiString;

{:Returns a binary string with a RSA-MD5 hashing of string what is constructed
 by repeating "value" until length is "Len".}
function MD5LongHash(const Value: AnsiString; Len: integer): AnsiString;

{:Returns a binary string with a SHA-1 hashing of "Value" string.}
function SHA1(const Value: AnsiString): AnsiString;

{:Returns a binary string with HMAC-SHA1 hash.}
function HMAC_SHA1(Text, Key: AnsiString): AnsiString;

{:Returns a binary string with a SHA-1 hashing of string what is constructed
 by repeating "value" until length is "Len".}
function SHA1LongHash(const Value: AnsiString; Len: integer): AnsiString;

implementation

const

  Crc32Tab: array[0..255] of Integer = (
    Integer($00000000), Integer($77073096), Integer($EE0E612C), Integer($990951BA),
    Integer($076DC419), Integer($706AF48F), Integer($E963A535), Integer($9E6495A3),
    Integer($0EDB8832), Integer($79DCB8A4), Integer($E0D5E91E), Integer($97D2D988),
    Integer($09B64C2B), Integer($7EB17CBD), Integer($E7B82D07), Integer($90BF1D91),
    Integer($1DB71064), Integer($6AB020F2), Integer($F3B97148), Integer($84BE41DE),
    Integer($1ADAD47D), Integer($6DDDE4EB), Integer($F4D4B551), Integer($83D385C7),
    Integer($136C9856), Integer($646BA8C0), Integer($FD62F97A), Integer($8A65C9EC),
    Integer($14015C4F), Integer($63066CD9), Integer($FA0F3D63), Integer($8D080DF5),
    Integer($3B6E20C8), Integer($4C69105E), Integer($D56041E4), Integer($A2677172),
    Integer($3C03E4D1), Integer($4B04D447), Integer($D20D85FD), Integer($A50AB56B),
    Integer($35B5A8FA), Integer($42B2986C), Integer($DBBBC9D6), Integer($ACBCF940),
    Integer($32D86CE3), Integer($45DF5C75), Integer($DCD60DCF), Integer($ABD13D59),
    Integer($26D930AC), Integer($51DE003A), Integer($C8D75180), Integer($BFD06116),
    Integer($21B4F4B5), Integer($56B3C423), Integer($CFBA9599), Integer($B8BDA50F),
    Integer($2802B89E), Integer($5F058808), Integer($C60CD9B2), Integer($B10BE924),
    Integer($2F6F7C87), Integer($58684C11), Integer($C1611DAB), Integer($B6662D3D),
    Integer($76DC4190), Integer($01DB7106), Integer($98D220BC), Integer($EFD5102A),
    Integer($71B18589), Integer($06B6B51F), Integer($9FBFE4A5), Integer($E8B8D433),
    Integer($7807C9A2), Integer($0F00F934), Integer($9609A88E), Integer($E10E9818),
    Integer($7F6A0DBB), Integer($086D3D2D), Integer($91646C97), Integer($E6635C01),
    Integer($6B6B51F4), Integer($1C6C6162), Integer($856530D8), Integer($F262004E),
    Integer($6C0695ED), Integer($1B01A57B), Integer($8208F4C1), Integer($F50FC457),
    Integer($65B0D9C6), Integer($12B7E950), Integer($8BBEB8EA), Integer($FCB9887C),
    Integer($62DD1DDF), Integer($15DA2D49), Integer($8CD37CF3), Integer($FBD44C65),
    Integer($4DB26158), Integer($3AB551CE), Integer($A3BC0074), Integer($D4BB30E2),
    Integer($4ADFA541), Integer($3DD895D7), Integer($A4D1C46D), Integer($D3D6F4FB),
    Integer($4369E96A), Integer($346ED9FC), Integer($AD678846), Integer($DA60B8D0),
    Integer($44042D73), Integer($33031DE5), Integer($AA0A4C5F), Integer($DD0D7CC9),
    Integer($5005713C), Integer($270241AA), Integer($BE0B1010), Integer($C90C2086),
    Integer($5768B525), Integer($206F85B3), Integer($B966D409), Integer($CE61E49F),
    Integer($5EDEF90E), Integer($29D9C998), Integer($B0D09822), Integer($C7D7A8B4),
    Integer($59B33D17), Integer($2EB40D81), Integer($B7BD5C3B), Integer($C0BA6CAD),
    Integer($EDB88320), Integer($9ABFB3B6), Integer($03B6E20C), Integer($74B1D29A),
    Integer($EAD54739), Integer($9DD277AF), Integer($04DB2615), Integer($73DC1683),
    Integer($E3630B12), Integer($94643B84), Integer($0D6D6A3E), Integer($7A6A5AA8),
    Integer($E40ECF0B), Integer($9309FF9D), Integer($0A00AE27), Integer($7D079EB1),
    Integer($F00F9344), Integer($8708A3D2), Integer($1E01F268), Integer($6906C2FE),
    Integer($F762575D), Integer($806567CB), Integer($196C3671), Integer($6E6B06E7),
    Integer($FED41B76), Integer($89D32BE0), Integer($10DA7A5A), Integer($67DD4ACC),
    Integer($F9B9DF6F), Integer($8EBEEFF9), Integer($17B7BE43), Integer($60B08ED5),
    Integer($D6D6A3E8), Integer($A1D1937E), Integer($38D8C2C4), Integer($4FDFF252),
    Integer($D1BB67F1), Integer($A6BC5767), Integer($3FB506DD), Integer($48B2364B),
    Integer($D80D2BDA), Integer($AF0A1B4C), Integer($36034AF6), Integer($41047A60),
    Integer($DF60EFC3), Integer($A867DF55), Integer($316E8EEF), Integer($4669BE79),
    Integer($CB61B38C), Integer($BC66831A), Integer($256FD2A0), Integer($5268E236),
    Integer($CC0C7795), Integer($BB0B4703), Integer($220216B9), Integer($5505262F),
    Integer($C5BA3BBE), Integer($B2BD0B28), Integer($2BB45A92), Integer($5CB36A04),
    Integer($C2D7FFA7), Integer($B5D0CF31), Integer($2CD99E8B), Integer($5BDEAE1D),
    Integer($9B64C2B0), Integer($EC63F226), Integer($756AA39C), Integer($026D930A),
    Integer($9C0906A9), Integer($EB0E363F), Integer($72076785), Integer($05005713),
    Integer($95BF4A82), Integer($E2B87A14), Integer($7BB12BAE), Integer($0CB61B38),
    Integer($92D28E9B), Integer($E5D5BE0D), Integer($7CDCEFB7), Integer($0BDBDF21),
    Integer($86D3D2D4), Integer($F1D4E242), Integer($68DDB3F8), Integer($1FDA836E),
    Integer($81BE16CD), Integer($F6B9265B), Integer($6FB077E1), Integer($18B74777),
    Integer($88085AE6), Integer($FF0F6A70), Integer($66063BCA), Integer($11010B5C),
    Integer($8F659EFF), Integer($F862AE69), Integer($616BFFD3), Integer($166CCF45),
    Integer($A00AE278), Integer($D70DD2EE), Integer($4E048354), Integer($3903B3C2),
    Integer($A7672661), Integer($D06016F7), Integer($4969474D), Integer($3E6E77DB),
    Integer($AED16A4A), Integer($D9D65ADC), Integer($40DF0B66), Integer($37D83BF0),
    Integer($A9BCAE53), Integer($DEBB9EC5), Integer($47B2CF7F), Integer($30B5FFE9),
    Integer($BDBDF21C), Integer($CABAC28A), Integer($53B39330), Integer($24B4A3A6),
    Integer($BAD03605), Integer($CDD70693), Integer($54DE5729), Integer($23D967BF),
    Integer($B3667A2E), Integer($C4614AB8), Integer($5D681B02), Integer($2A6F2B94),
    Integer($B40BBE37), Integer($C30C8EA1), Integer($5A05DF1B), Integer($2D02EF8D)
    );

  Crc16Tab: array[0..255] of Word = (
    $0000, $1189, $2312, $329B, $4624, $57AD, $6536, $74BF,
    $8C48, $9DC1, $AF5A, $BED3, $CA6C, $DBE5, $E97E, $F8F7,
    $1081, $0108, $3393, $221A, $56A5, $472C, $75B7, $643E,
    $9CC9, $8D40, $BFDB, $AE52, $DAED, $CB64, $F9FF, $E876,
    $2102, $308B, $0210, $1399, $6726, $76AF, $4434, $55BD,
    $AD4A, $BCC3, $8E58, $9FD1, $EB6E, $FAE7, $C87C, $D9F5,
    $3183, $200A, $1291, $0318, $77A7, $662E, $54B5, $453C,
    $BDCB, $AC42, $9ED9, $8F50, $FBEF, $EA66, $D8FD, $C974,
    $4204, $538D, $6116, $709F, $0420, $15A9, $2732, $36BB,
    $CE4C, $DFC5, $ED5E, $FCD7, $8868, $99E1, $AB7A, $BAF3,
    $5285, $430C, $7197, $601E, $14A1, $0528, $37B3, $263A,
    $DECD, $CF44, $FDDF, $EC56, $98E9, $8960, $BBFB, $AA72,
    $6306, $728F, $4014, $519D, $2522, $34AB, $0630, $17B9,
    $EF4E, $FEC7, $CC5C, $DDD5, $A96A, $B8E3, $8A78, $9BF1,
    $7387, $620E, $5095, $411C, $35A3, $242A, $16B1, $0738,
    $FFCF, $EE46, $DCDD, $CD54, $B9EB, $A862, $9AF9, $8B70,
    $8408, $9581, $A71A, $B693, $C22C, $D3A5, $E13E, $F0B7,
    $0840, $19C9, $2B52, $3ADB, $4E64, $5FED, $6D76, $7CFF,
    $9489, $8500, $B79B, $A612, $D2AD, $C324, $F1BF, $E036,
    $18C1, $0948, $3BD3, $2A5A, $5EE5, $4F6C, $7DF7, $6C7E,
    $A50A, $B483, $8618, $9791, $E32E, $F2A7, $C03C, $D1B5,
    $2942, $38CB, $0A50, $1BD9, $6F66, $7EEF, $4C74, $5DFD,
    $B58B, $A402, $9699, $8710, $F3AF, $E226, $D0BD, $C134,
    $39C3, $284A, $1AD1, $0B58, $7FE7, $6E6E, $5CF5, $4D7C,
    $C60C, $D785, $E51E, $F497, $8028, $91A1, $A33A, $B2B3,
    $4A44, $5BCD, $6956, $78DF, $0C60, $1DE9, $2F72, $3EFB,
    $D68D, $C704, $F59F, $E416, $90A9, $8120, $B3BB, $A232,
    $5AC5, $4B4C, $79D7, $685E, $1CE1, $0D68, $3FF3, $2E7A,
    $E70E, $F687, $C41C, $D595, $A12A, $B0A3, $8238, $93B1,
    $6B46, $7ACF, $4854, $59DD, $2D62, $3CEB, $0E70, $1FF9,
    $F78F, $E606, $D49D, $C514, $B1AB, $A022, $92B9, $8330,
    $7BC7, $6A4E, $58D5, $495C, $3DE3, $2C6A, $1EF1, $0F78
    );

procedure ArrByteToLong(var ArByte: Array of byte; var ArLong: Array of Integer);
{$IFDEF CIL}
var
  n: integer;
{$ENDIF}
begin
  if (High(ArByte) + 1) > ((High(ArLong) + 1) * 4) then
    Exit;
  {$IFDEF CIL}
  for n := 0 to ((high(ArByte) + 1) div 4) - 1 do
    ArLong[n] := ArByte[n * 4 + 0]
      + (ArByte[n * 4 + 1] shl 8)
      + (ArByte[n * 4 + 2] shl 16)
      + (ArByte[n * 4 + 3] shl 24);
  {$ELSE}
  Move(ArByte[0], ArLong[0], High(ArByte) + 1);
  {$ENDIF}
end;

procedure ArrLongToByte(var ArLong: Array of Integer; var ArByte: Array of byte);
{$IFDEF CIL}
var
  n: integer;
{$ENDIF}