dxgeneralmsgobject.pas

Well known and usefull component for delphi 7

unit DXGeneralMsgObject;

interface

///////////////////////////////////////////////////////////////////////////////
//    Component: TDXGeneralMsgObject
//       Author: G.E. Ozz Nixon Jr. ([e-mail])
// ========================================================================
// Source Owner: DX, Inc. 1995-2002
//    Copyright: All code is the property of DX, Inc. Licensed for
//               resell by Brain Patchwork DX (tm) and part of the
//               DX (r) product lines, which are (c) 1999-2002
//               DX, Inc. Source may not be distributed without
//               written permission from both Brain Patchwork DX,
//               and DX, Inc.
//      License: (Reminder), None of this code can be added to other
//               developer products without permission. This includes
//               but not limited to DCU's, DCP's, DLL's, OCX's, or
//               any other form of merging our technologies. All of
//               your products released to a public consumer be it
//               shareware, freeware, commercial, etc. must contain a
//               license notification somewhere visible in the
//               application.
//               Example is Internet Explorer - Help->About screen
//               shows the licensed code contained in the application.
// Code Version: (3rd Generation Code)
// ========================================================================
//  Description:
// ========================================================================
// This is the ancestor to all of our message components. The message can be
// loaded from a file or a stream. The concept of this component is when a
// inbound message is received from a socket it comes line by line, you should
// "collect" that in either a stringstream or something like that. Past the
// stream to this component, and then use this component to drop it to disk.
// This component only works with HEADERS, so if you send it a header/body
// collection form the internet as a Stream it tries internally to drop the
// body. We do this so you can develop a body object that does virus or content
// filtering.
//
// This piece uses our modified version of PosInStrArray found in the Winshoes
// library.
///////////////////////////////////////////////////////////////////////////////

uses
   Classes;

{$I DXAddons.def}

type
   PDXMsgObjectRecord=^TDXMsgObjectRecord;
   TDXMsgObjectRecord=record
      esTO:string;
      esFROM:string;
      esRETURNPATH:string;
      esPATH:string;
      esRECEIVED:string;
      esDATE:string;
      esSENDER:string;
      esCC:string;
      esBCC:string;
      esREPLYTO:string;
      esMESSAGEID:string;
      esINREPLYTO:string;
      esREFERENCES:string;
      esKEYWORDS:string;
      esENCRYPTED:string;
      esRESENTREPLYTO:string;
      esRESENTFROM:string;
      esRESENTSENDER:string;
      esRESENTDATE:string;
      esRESENTTO:string;
      esRESENTCC:string;
      esRESENTBCC:string;
      esRESENTMESSAGEID:string;
      esMIMEVERSION:string;
      esCONTENTTYPE:string;
      esCONTENTTRANSFERENCODING:string;
      esLINES:string;
      esNEWSGROUPS:string;
      esDISTRIBUTION:string;
      esORGANIZATION:string;
      esRELAYVERSION:string;
      esNNTPPOSTINGHOST:string;
      esEXPIRES:string;
      esFOLLOWUPTO:string;
      esCONTROL:string;
      esAPPROVED:string;
      esSUBJECT:TStringList;
      esCOMMENTS:TStringList;
      esUnknown:TStringList;
   end;

type
   {$IFDEF OBJECTS_ONLY}
   TDXGeneralMsgObject=class
      {$ELSE}
   TDXGeneralMsgObject=class(TComponent)
      {$ENDIF}
   private
      // Private declarations
   protected
      // Protected declarations
      DXMsgObject_Record:PDXMsgObjectRecord;
      procedure HeaderInitialize;
      procedure HeaderDestroy;
   public
      // Public declarations
      {$IFDEF OBJECTS_ONLY}
      constructor Create;
      {$ELSE}
      constructor Create(AOwner:TComponent); override;
      {$ENDIF}
      destructor Destroy; override;
      procedure LoadFromStream(Stream:TStream);
      procedure LoadFromFile(const Filename:string);
      procedure SaveToStream(Stream:TStream);
      procedure SaveToFile(const Filename:string);
      procedure DeleteFile(const Filename:string);
      procedure HeaderProcess(header:tstringlist);
      procedure HeaderClear;
      procedure SaveHeaderToList(var header:tstringlist);
      function ActualHeader:PDXMsgObjectRecord;
   published
      // Published declarations
   end;

implementation

uses
   DXString,
   SysUtils;

const
   // DO NOT CHANGE THE ORDER, OR YOU WILL BREAK THE CODE!
   KnownCommands:array[1..39] of string=
      (
      'TO', 'FROM', 'RETURN-PATH', 'RECEIVED', 'DATE', 'SENDER', 'CC', 'BCC',
      'REPLY-TO', 'MESSAGE-ID', 'IN-REPLY-TO', 'REFERENCES', 'KEYWORDS',
      'ENCRYPTED', 'SUBJECT', 'COMMENTS', 'RESENT-REPLY-TO', 'RESENT-FROM',
      'RESENT-SENDER', 'RESENT-DATE', 'RESENT-TO', 'RESENT-CC', 'RESENT-BCC',
      'RESENT-MESSAGE-ID', 'SENT', 'MIME-VERSION', 'CONTENT-TYPE',
      'CONTENT-TRANSFER-ENCODING', 'PATH', 'LINES', 'NEWSGROUPS',
      'DISTRIBUTION', 'ORGANIZATION', 'RELAY-VERSION', 'NNTP-POSTING-HOST',
      'EXPIRES', 'FOLLOWUP-TO', 'CONTROL', 'APPROVED'
      );

   {$IFDEF OBJECTS_ONLY}

constructor TDXGeneralMsgObject.Create;
{$ELSE}

constructor TDXGeneralMsgObject.Create(AOwner:TComponent);
{$ENDIF}
begin
   {$IFDEF OBJECTS_ONLY}
   inherited Create;
   {$ELSE}
   inherited Create(AOwner);
   {$ENDIF}
   DXMsgObject_Record:=nil;
   HeaderInitialize;
end;

destructor TDXGeneralMsgObject.Destroy;
begin
   HeaderDestroy;
   inherited Destroy;
end;

procedure TDXGeneralMsgObject.HeaderInitialize;
begin
   HeaderDestroy;
   {$IFNDEF OBJECTS_ONLY}
   if not(csDesigning in ComponentState) then begin
      {$ENDIF}
      New(DXMsgObject_Record);
      FillChar2(DXMsgObject_Record^, sizeof(DxMSGObject_Record^), #0);
      DXMsgObject_Record^.esSubject:=TStringList.Create;
      DXMsgObject_Record^.esComments:=TStringList.Create;
      DXMsgObject_Record^.esUnknown:=TStringList.Create;
      {$IFNDEF OBJECTS_ONLY}
   end;
   {$ENDIF}
end;

procedure TDXGeneralMsgObject.HeaderDestroy;

   procedure ClearStringList(sl:TStringList);
   var
      cnt:integer;
   begin
      if assigned(sl) then begin
         sl.BeginUpdate;
         try
            cnt:=sl.Count;
            while cnt>0 do begin
               sl.Delete(0);
               cnt:=sl.count;
            end;
         finally
            sl.Clear;
            sl.endupdate;
         end;
      end;
   end;

begin
   try
      if Assigned(DXMsgObject_Record) then begin
         if Assigned(DxMsgObject_Record^.esSUBJECT) then begin
            ClearStringList(DxMsgObject_Record^.esSUBJECT);
            DxMsgObject_Record^.esSubject.Free;
            DxMsgObject_Record^.esSubject:=nil;
         end;
         if Assigned(DxMsgObject_Record^.esComments) then begin
            ClearStringList(DxMsgObject_Record^.esComments);
            DxMsgObject_Record^.esComments.Free;
            DxMsgObject_Record^.esComments:=nil;
         end;
         if Assigned(DxMsgObject_Record^.esUnknown) then begin
            ClearStringList(DxMsgObject_Record^.esUnknown);
            DxMsgObject_Record^.esUnknown.Free;
            DxMsgObject_Record^.esUnknown:=nil;
         end;
         FillChar2(DXMsgObject_Record^, sizeof(DxMSGObject_Record^), #0);
         Dispose(DxMsgObject_Record);
      end;
   finally
      DxMsgObject_Record:=nil;
   end;
end;

procedure TDXGeneralMsgObject.HeaderProcess(header:tstringlist);
var
   CurrentParseCode:string;
   UseCurrentParseCode:Boolean;
   WorkString:string;
   cnt:integer;
begin
   CurrentParseCode:='';
   header.BeginUpdate;
   try
      cnt:=header.count;
      while cnt>0 do begin
         WorkString:=Header[0]+#32;
         if WorkString=#32 then Exit;
         UseCurrentParseCode:=WorkString[1]in [#32, #9];
         WorkString:=Trim(WorkString);
         if not UseCurrentParseCode then begin
            CurrentParseCode:=Uppercase(Copy(WorkString, 1, Pos(':',
               WorkString)-1));
            Trim(CurrentParseCode);
            Delete(WorkString, 1, pos(':', WorkString));
            WorkString:=Trim(WorkString);
         end
         else
            WorkString:=#32+WorkString;
         case InStrArray(CurrentParseCode, KnownCommands)+1 of
            1:// 'TO'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esTO:=DXMsgObject_Record.esTO+WorkString
               else
                  DXMsgObject_Record.esTO:=WorkString;
            2:// 'FROM'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esFROM:=DXMsgObject_Record.esFROM+WorkString
               else
                  DXMsgObject_Record.esFROM:=WorkString;
            3:// 'RETURN-PATH'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esRETURNPATH:=DXMsgObject_Record.esRETURNPATH+WorkString
               else
                  DXMsgObject_Record.esRETURNPATH:=WorkString;
            4:// 'RECEIVED'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esRECEIVED:=DXMsgObject_Record.esRECEIVED+WorkString
               else
                  DXMsgObject_Record.esRECEIVED:=WorkString;
            5, 25:// 'DATE','SENT'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esDATE:=DXMsgObject_Record.esDATE+WorkString
               else
                  DXMsgObject_Record.esDATE:=WorkString;
            6:// 'SENDER'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esSENDER:=DXMsgObject_Record.esSENDER+WorkString
               else
                  DXMsgObject_Record.esSENDER:=WorkString;
            7:// 'CC'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esCC:=DXMsgObject_Record.esCC+WorkString
               else
                  DXMsgObject_Record.esCC:=WorkString;
            8:// 'BCC'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esBCC:=DXMsgObject_Record.esBCC+WorkString
               else
                  DXMsgObject_Record.esBCC:=WorkString;
            9:// 'REPLY-TO'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esREPLYTO:=DXMsgObject_Record.esREPLYTO+WorkString
               else
                  DXMsgObject_Record.esREPLYTO:=WorkString;
            10:// 'MESSAGE-ID'
               if UseCurrentParseCode then
                  DXMsgObject_Record.esMESSAGEID:=DXMsgObject_Record.esMESSAGEID+WorkString
               else
                  DXMsgObject_Record.esMESSAGEID:=WorkString;
            11:// 'IN-REPLY-TO'