mimepart.pas

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

{==============================================================================|
| Project : Ararat Synapse                                       | 002.006.003 |
|==============================================================================|
| Content: MIME support procedures and functions                               |
|==============================================================================|
| Copyright (c)1999-2004, 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-2004.                |
| All Rights Reserved.                                                         |
|==============================================================================|
| Contributor(s):                                                              |
|==============================================================================|
| History: see HISTORY.HTM from distribution package                           |
|          (Found at URL: http://www.ararat.cz/synapse/)                       |
|==============================================================================}

{:@abstract(MIME part handling)
Handling with MIME parts.

Used RFC: RFC-2045
}

{$IFDEF FPC}
  {$MODE DELPHI}
{$ENDIF}
{$H+}
{$Q-}
{$R-}

unit mimepart;

interface

uses
  SysUtils, Classes,
{$IFDEF LINUX}
  {$IFDEF FPC}
  synafpc,
  {$ENDIF}
{$ELSE}
  Windows,
{$ENDIF}
  synachar, synacode, synautil, mimeinln;

type

  TMimePart = class;

  {:@abstract(Procedural type for @link(TMimepart.Walkpart) hook). This hook is used for
   easy walking through MIME subparts.}
  THookWalkPart = procedure(const Sender: TMimePart) of object;

  {:The four types of MIME parts. (textual, multipart, message or any other
   binary data.)}
  TMimePrimary = (MP_TEXT, MP_MULTIPART, MP_MESSAGE, MP_BINARY);

  {:The various types of possible part encodings.}
  TMimeEncoding = (ME_7BIT, ME_8BIT, ME_QUOTED_PRINTABLE,
    ME_BASE64, ME_UU, ME_XX);

  {:@abstract(Object for working with parts of MIME e-mail.)
   Each TMimePart object can handle any number of nested subparts as new
   TMimepart objects. It can handle any tree hierarchy structure of nested MIME
   subparts itself.

   Basic tasks are:

   Decoding of MIME message:
   - store message into Lines property
   - call DecomposeParts. Now you have decomposed MIME parts in all nested levels!
   - now you can explore all properties and subparts. (You can use WalkPart method)
   - if you need decode part, call DecodePart.

   Encoding of MIME message:

   - if you need multipart message, you must create subpart by AddSubPart.
   - set all properties of all parts.
   - set content of part into DecodedLines stream
   - encode this stream by EncodePart.
   - compose full message by ComposeParts. (it build full MIME message from all subparts. Do not call this method for each subpart! It is needed on root part!)
   - encoded MIME message is stored in Lines property.
  }
  TMimePart = class(TObject)
  private
    FPrimary: string;
    FPrimaryCode: TMimePrimary;
    FSecondary: string;
    FEncoding: string;
    FEncodingCode: TMimeEncoding;
    FDefaultCharset: string;
    FCharset: string;
    FCharsetCode: TMimeChar;
    FTargetCharset: TMimeChar;
    FDescription: string;
    FDisposition: string;
    FContentID: string;
    FBoundary: string;
    FFileName: string;
    FLines: TStringList;
    FPartBody: TStringList;
    FHeaders: TStringList;
    FPrePart: TStringList;
    FPostPart: TStringList;
    FDecodedLines: TMemoryStream;
    FSubParts: TList;
    FOnWalkPart: THookWalkPart;
    FMaxLineLength: integer;
    FSubLevel: integer;
    FMaxSubLevel: integer;
    FAttachInside: boolean;
    procedure SetPrimary(Value: string);
    procedure SetEncoding(Value: string);
    procedure SetCharset(Value: string);
    function IsUUcode(Value: string): boolean;
  public
    constructor Create;
    destructor Destroy; override;

    {:Assign content of another object to this object. (Only this part,
     not subparts!)}
    procedure Assign(Value: TMimePart);

    {:Assign content of another object to this object. (With all subparts!)}
    procedure AssignSubParts(Value: TMimePart);

    {:Clear all data values to default values. It also call @link(ClearSubparts).}
    procedure Clear;

    {:Decode Mime part from @link(Lines) to @link(DecodedLines).}
    procedure DecodePart;

    {:Parse header lines from Headers property into another properties.}
    procedure DecodePartHeader;

    {:Encode mime part from @link(DecodedLines) to @link(Lines) and build mime
     headers.}
    procedure EncodePart;

    {:Build header lines in Headers property from another properties.}
    procedure EncodePartHeader;

    {:generate primary and secondary mime type from filename extension in value.
     If type not recognised, it return 'Application/octet-string' type.}
    procedure MimeTypeFromExt(Value: string);

    {:Return number of decomposed subparts. (On this level! Each of this
     subparts can hold any number of their own nested subparts!)}
    function GetSubPartCount: integer;

    {:Get nested subpart object as new TMimePart. For getting maximum possible
     index you can use @link(GetSubPartCount) method.}
    function GetSubPart(index: integer): TMimePart;

    {:delete subpart on given index.}
    procedure DeleteSubPart(index: integer);

    {:Clear and destroy all subpart TMimePart objects.}
    procedure ClearSubParts;

    {:Add and create new subpart.}
    function AddSubPart: TMimePart;

    {:E-mail message in @link(Lines) property is parsed into this object.
     E-mail headers are stored in @link(Headers) property and is parsed into
     another properties automaticly. Not need call @link(DecodePartHeader)!
     Content of message (part) is stored into @link(PartBody) property. This
     part is in undecoded form! If you need decode it, then you must call
     @link(DecodePart) method by your hands. Lot of another properties is filled
     also.

     Decoding of parts you must call separately due performance reasons. (Not
     needed to decode all parts in all reasons.)

     For each MIME subpart is created new TMimepart object (accessible via
     method @link(GetSubPart)).}
    procedure DecomposeParts;

    {:This part and all subparts is composed into one MIME message stored in
     @link(Lines) property.}
    procedure ComposeParts;

    {:By calling this method is called @link(OnWalkPart) event for each part
     and their subparts. It is very good for calling some code for each part in
     MIME message}
    procedure WalkPart;

    {:Return @true when is possible create next subpart. (@link(maxSublevel)
     is still not reached)}
    function CanSubPart: boolean;
  published
    {:Primary Mime type of part. (i.e. 'application') Writing to this property
     automaticly generate value of @link(PrimaryCode).}
    property Primary: string read FPrimary write SetPrimary;

    {:String representation of used Mime encoding in part. (i.e. 'base64')
     Writing to this property automaticly generate value of @link(EncodingCode).}
    property Encoding: string read FEncoding write SetEncoding;

    {:String representation of used Mime charset in part. (i.e. 'iso-8859-1')
     Writing to this property automaticly generate value of @link(CharsetCode).
     Charset is used only for text parts.}
    property Charset: string read FCharset write SetCharset;

    {:Define default charset for decoding text MIME parts without charset
     specification. Default value is 'ISO-8859-1' by RCF documents.
     But Microsoft Outlook use windows codings as default. This property allows
     properly decode textual parts from some broken versions of Microsoft
     Outlook. (this is bad software!)}
    property DefaultCharset: string read FDefaultCharset write FDefaultCharset;

    {:Decoded primary type. Possible values are: MP_TEXT, MP_MULTIPART,
     MP_MESSAGE and MP_BINARY. If type not recognised, result is MP_BINARY.}
    property PrimaryCode: TMimePrimary read FPrimaryCode Write FPrimaryCode;

    {:Decoded encoding type. Possible values are: ME_7BIT, ME_8BIT,
     ME_QUOTED_PRINTABLE and ME_BASE64. If type not recognised, result is
     ME_7BIT.}
    property EncodingCode: TMimeEncoding read FEncodingCode Write FEncodingCode;

    {:Decoded charset type. Possible values are defined in @link(SynaChar) unit.}
    property CharsetCode: TMimeChar read FCharsetCode Write FCharsetCode;

    {:System charset type. Default value is charset used by default in your
     operating system.}
    property TargetCharset: TMimeChar read FTargetCharset Write FTargetCharset;

    {:Secondary Mime type of part. (i.e. 'mixed')}
    property Secondary: string read FSecondary Write FSecondary;

    {:Description of Mime part.}
    property Description: string read FDescription Write FDescription;

    {:Value of content disposition field. (i.e. 'inline' or 'attachment')}
    property Disposition: string read FDisposition Write FDisposition;

    {:Content ID.}
    property ContentID: string read FContentID Write FContentID;

    {:Boundary delimiter of multipart Mime part. Used only in multipart part.}
    property Boundary: string read FBoundary Write FBoundary;

    {:Filename of file in binary part.}
    property FileName: string read FFileName Write FFileName;

    {:String list with lines contains mime part (It can be a full message).}
    property Lines: TStringList read FLines;

    {:Encoded form of MIME part data.}
    property PartBody: TStringList read FPartBody;

    {:All header lines of MIME part.}
    property Headers: TStringList read FHeaders;

    {:On multipart this contains part of message between first line of message
     and first boundary.}
    property PrePart: TStringList read FPrePart;

    {:On multipart this contains part of message between last boundary and end
     of message.}
    property PostPart: TStringList read FPostPart;

    {:Stream with decoded form of budy part.}
    property DecodedLines: TMemoryStream read FDecodedLines;

    {:Show nested level in subpart tree. Value 0 means root part. 1 means
     subpart from this root. etc.}
    property SubLevel: integer read FSubLevel write FSubLevel;

    {:Specify maximum sublevel value for decomposing.}
    property MaxSubLevel: integer read FMaxSubLevel write FMaxSubLevel;

    {:When is @true, then this part maybe(!) have included some uuencoded binary
    data.}
    property AttachInside: boolean read FAttachInside;

    {:Here you can assign hook procedure for walking through all part and their
     subparts.}
    property OnWalkPart: THookWalkPart read FOnWalkPart write FOnWalkPart;

    {:Here you can specify maximum line length for encoding of MIME part.
     If line is longer, then is splitted by standard of MIME. Correct MIME
     mailers can de-split this line into original length.}
    property MaxLineLength: integer read FMaxLineLength Write FMaxLineLength;
  end;

const
  MaxMimeType = 25;
  MimeType: array[0..MaxMimeType, 0..2] of string =
  (
    ('AU', 'audio', 'basic'),
    ('AVI', 'video', 'x-msvideo'),
    ('BMP', 'image', 'BMP'),
    ('DOC', 'application', 'MSWord'),
    ('EPS', 'application', 'Postscript'),
    ('GIF', 'image', 'GIF'),
    ('JPEG', 'image', 'JPEG'),
    ('JPG', 'image', 'JPEG'),
    ('MID', 'audio', 'midi'),
    ('MOV', 'video', 'quicktime'),
    ('MPEG', 'video', 'MPEG'),
    ('MPG', 'video', 'MPEG'),
    ('MP2', 'audio', 'mpeg'),
    ('MP3', 'audio', 'mpeg'),
    ('PDF', 'application', 'PDF'),
    ('PNG', 'image', 'PNG'),
    ('PS', 'application', 'Postscript'),
    ('QT', 'video', 'quicktime'),
    ('RA', 'audio', 'x-realaudio'),
    ('RTF', 'application', 'RTF'),
    ('SND', 'audio', 'basic'),
    ('TIF', 'image', 'TIFF'),
    ('TIFF', 'image', 'TIFF'),
    ('WAV', 'audio', 'x-wav'),
    ('WPD', 'application', 'Wordperfect5.1'),
    ('ZIP', 'application', 'ZIP')
    );

{:Read header from "Value" stringlist beginning at "Index" position. If header
 is Splitted into multiple lines, then this procedure de-split it into one line.}
function NormalizeHeader(Value: TStrings; var Index: Integer): string;

{:Generates a unique boundary string.}
function GenerateBoundary: string;

implementation

function NormalizeHeader(Value: TStrings; var Index: Integer): string;
var
  s, t: string;
  n: Integer;
begin
  s := Value[Index];
  Inc(Index);
  if s <> '' then
    while (Value.Count - 1) > Index do
    begin
      t := Value[Index];
      if t = '' then
        Break;
      for n := 1 to Length(t) do
        if t[n] = #9 then
          t[n] := ' ';
      if not(t[1] in [' ', '"', ':', '=']) then
        Break
      else
      begin