Delphi 2 - Developers' Solutions/Delphi 2 Developers' Solutions.iso/dds/chap11/howto06/delphi10/cciccpop.pas

Pascal/Delphi Source File | 1996-06-12 | 107.2 KB | 3,010 lines

unit Cciccpop;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, StdCtrls, Buttons, Menus, FileCtrl, CCWSock, CCICCInf,
  CCICCPrf, IniFiles, Gauges , CCUUCode, CCiccfrm, CCFTP;

const
    The_Alphabet : array[ 0 .. 63 ] of char  =
     'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
type
  TMIMEErrorEvent = procedure( ErrorCode : Integer; ErrorMessage : String )
   of object;
  TMIMEUpdateEvent = procedure( BytesCompleted , TotalBytes : LongInt )
   of object;
  TMIMECodingObject = class( TWinControl )
  private
    FOnMIMEErrorOccurred  : TMIMEErrorEvent;
    FOnMIMEUpdateOccurred : TMIMEUpdateEvent;
  public
    OutputString       : String;
    The_Accumulator    : LongInt;
    Total_Bits_Shifted : SmallInt;
    BytesDone ,
    BytesToGet        : Longint;
    ErrorResult       : Integer;
    ErrorMessage      : String;
    Base64Found       : Boolean;
    TheEncodingHeader : TStringList;
    TheBoundaryString : String;
    TheInputFileName : String;
    TheOutputFileName : String;
    TheInputTextFile : TextFile;
    TheOutputTextFile : TextFile;
    TheInputBinaryFile : File of Byte;
    TheOutputBinaryFile : File of Byte;
    constructor Create( AOwner : TComponent ); override;
    function IsBoundaryToken( TheLine : String ) : String;
    function IsDecodeName( TheLine : String ) : String;
    function IsBase64( TheLine : String ) : Boolean;
    function IsBoundary( TheLine : String ) : Boolean;
    function DecodeMIMEFile : Boolean;
    function EncodeMIMEFile : Boolean;
    function OpenDecodeInputFile : Boolean;
    function OpenDecodeOutputFile : Boolean;
    function CloseDecodeFiles : Boolean;
    function OpenEncodeFiles : Boolean;
    function CloseEncodeFiles : Boolean;
    procedure MIMEError( ECode : Integer; EMsg : String );
    procedure MIMEUpdate( BSF , BT : LongInt );
    function GetQuotedString( TheInputString : String ) : String;
    function ConvertBase64Character( Current_Character : Char ) : SmallInt;
    procedure InitializeMIMEDecode;
    procedure InitializeMIMEEncode;
    function WriteMIMEHeader : Boolean;
    function WriteFinalMIMEEncoding : Boolean;
    function GetTextFileSize( TheName : String ) : Longint;
    function MIMEDecode( TheString : String ) : Boolean;
    procedure CreateDefaultHeader( var TheEncodingHeader : TStringList );
    function AddBinaryValueToStream( BinaryValue : SmallInt ) : Boolean;
    function EncodeMIMEOutputByte( TheInputByte : Byte;
                                   LastChar     : Boolean  )  : Boolean;
    property OnMIMEErrorOccurred : TMIMEErrorEvent read FOnMIMEErrorOccurred
     write FOnMIMEErrorOccurred;
    property OnMIMEUpdateOccurred : TMIMEUpdateEvent read FOnMIMEUpdateOccurred
     write FOnMIMEUpdateOccurred;
  end;
  { Component To Hold POP3/SMTP handling capabilities }
  TPOP3SMTPComponent = class( TWinControl )
  public
    POP3CommandInProgress ,
    SMTPCommandInProgress ,
    Connection_Established : Boolean;
    Socket1 : TCCSocket;
    constructor Create( AOwner : TComponent ); override;
    destructor Destroy; override;
    function EstablishPOP3Connection( PCRPointer : PConnectionsRecord ) : Boolean;
    function EstablishSMTPConnection( PCRPointer : PConnectionsRecord ) : Boolean;
    function POP3Disconnect : Boolean;
    function SMTPDisconnect : Boolean;
    function DoCStyleFormat(       TheText      : string;
                             const TheArguments : array of const ) : String;
    procedure UpdateGauge( BytesFinished , TotalToHandle : longint );
    procedure AddProgressText( WhatText : String );
    procedure ShowProgressText( WhatText : String );
    procedure ShowProgressErrorText( WhatText : String );
    function GetPOP3ServerResponse( var ResponseString : String ) : integer;
    function GetSMTPServerResponse( var ResponseString : String ) : integer;
    procedure SetRecipient( WhichMemo : TMemo; WhatName : String );
    procedure SetCarbonCopy( WhichMemo : TMemo; WhatName : String );
    procedure POP3SMTPSocketsErrorOccurred( Sender     : TObject;
                                     ErrorCode  : Integer;
                                     TheMessage : String   );
    function PerformPOP3Command(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function PerformSMTPCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function PerformPOP3ExtendedCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function PerformSMTPExtendedCommand(
                    TheCommand   : string;
              const TheArguments : array of const ) : Integer;
    function GetPOP3ServerExtendedResponse( ResponseString : PChar ) : integer;
    function GetSMTPServerExtendedResponse( ResponseString : PChar ) : integer;
    function GetNextSDItem(     WorkingString : String;
                            var TheIndex      : Integer ) : String;
    procedure PurgeTrashedMessageListings( TheEMBRecord : PEMailMailBoxRecord );
    procedure TrashMessage( TheEMMRecord : PEMailMessageRecord );
    procedure TrashAllMarkedMessages( TheLB       : TListBox;
                                      TheMBRecord : PEMailMailboxRecord );
    procedure ParseMailListing(     TheListing : String;
                                var TotalMessages : Longint;
                                var MessageBytes : Longint);
    function CheckAllNewMail( var TotalBytes : Longint ) : Integer;
    procedure SetMailHeaders( TheMemo      : TMemo;
                             TheEMCRecord : PConnectionsRecord );
    procedure InsertMIMETextHeader( TheMemo : TMemo );
    procedure AddMIMEAttachment( TheMemo      : TMemo; TheFileToAdd : String );
    procedure NewMIMEMessage( TheMemo      : TMemo; TheNewFile : String;
                               TheEMCRecord : PConnectionsRecord );
    procedure SetReplyMailHeaders( TheMemo         : TMemo ;
                                  TheEMCRecord    : PConnectionsRecord;
                                  TheEMBRecord    : PEmailMailBoxRecord;
                                  MessageNumber   : Integer );
    function GetMessageHeader( TheReturnList : TStringList ) : Longint;
    function DownloadMessageListing( TheNumber   : Integer;
                                     TheFileName : String;
                                     TheHeaderSL : TStringList ) : Longint;
    function DownloadAllMessageListings( TheEMBRecord : PEMailMailBoxRecord ) : Boolean;
    function UploadMessageListing( TheEMMRecord : PEmailMessageRecord ) : Boolean;
    function UploadAllMessageListings( PCRPointer : PConnectionsRecord;
                                       TheEMBRecord : PEMailMailBoxRecord ) : Boolean;
    function GetHeaderSubject( HList : TStringList ) : String;
    function GetHeaderSender( HList : TStringList ) : String;
    function GetHeaderRecipient( HList : TStringList ) : String;
    function GetHeaderCarbons( HList : TStringList ) : String;
    function GetHeaderBlindCarbons( HList : TStringList ) : String;
    function GetRCPTHeaderRecipient( HList : TStringList ) : String;
    function GetRCPTHeaderCarbons( HList : TStringList ) : String;
    function GetRCPTHeaderBlindCarbons( HList : TStringList ) : String;
    function GetHeaderDateTime( HList : TStringList ) : String;
    procedure TransferMessage( SourceEMBRecord , TargetEMBRecord : PEMailMailBoxRecord;
                              MessageNumber : Integer );
    procedure ExtractHeaderInfoFromMemo( TheMemo      : TMemo;
                                         TheEMMRecord : PEMailMessageRecord );
    function LoginUser( PCRPointer : PConnectionsRecord ) : Boolean;
    function SendPassword( PCRPointer : PConnectionsRecord ) : Boolean;
    function SendHelo( PCRPointer : PConnectionsRecord ) : Boolean;
    function SendMail( PCRPointer : PConnectionsRecord ) : Boolean;
    function DeleteMailItem( TheNumber : Longint ) : Boolean;
  end;

var
  ThePOP3SMTPComponent  : TPOP3SMTPComponent; { Gee, which one is this? :) }
  TheMIMEObject : TMIMECodingObject;

implementation

{ Create constructor; sets update and error methods }
constructor TMIMECodingObject.Create( AOwner : TComponent );
begin
  { Call inherited }
  Inherited Create( AOwner );
  { Setup two methods; can be overridden }
  OnMIMEErrorOccurred := MIMEError;
  OnMIMEUpdateOccurred := MIMEUpdate;
end;

{ This procedure resets the two decoding variables }
procedure TMIMECodingObject.InitializeMIMEDecode;
begin
  The_Accumulator := 0;
  Total_Bits_Shifted := 0;
  BytesDone := 0;
end;

{ This procedure resets the two decoding variables }
procedure TMIMECodingObject.InitializeMIMEEncode;
begin
  The_Accumulator := 0;
  Total_Bits_Shifted := 0;
  OutputString := '';
  BytesDone := 0;
end;

{ This is the generic error handler }
procedure TMIMECodingObject.MIMEError( ECode : Integer; EMsg : String );
begin
  { Do generic MessageBox }
  MessageDlg( 'A MIME error code ' + IntToStr( ECode ) +
   ' has happend with Message ' + EMsg , mtError , [mbOK] , 0 );
end;

{ This is the generic update procedure }
procedure TMIMECodingObject.MIMEUpdate( BSF , BT : LongInt );
begin
  CCInetCCForm.UpdateMIMEGauge( BSF , BT );
end;

{ This function takes an input string and returns any "" delimited text in it }
function TMIMECodingObject.GetQuotedString( TheInputString : String ) : String;
var HoldingString : String;  { Interim results holder }
    PositionIndex : Integer; { " position holder      }
begin
  { Look for initial positon of double quote }
  PositionIndex := Pos( '"' , TheInputString );
  { If not found, then no quoted text; return empty string }
  if PositionIndex = 0 then
  begin
    Result := '';
    exit;
  end;
  { Otherwise get from just beyond " to end of string, allowing for unlimited }
  { string sizes now in Delphi 2.0                                            }
  HoldingString := Copy( TheInputString , PositionIndex + 1 ,
   ( Length( TheInputString ) - PositionIndex ));
  { Find ending " if any }
  PositionIndex := Pos( '"' , HoldingString );
  { If no ending " then assume all from first quote is result }
  if PositionIndex = 0 then
  begin
    Result := HoldingString;
    exit;
  end;
  { Otherwise get down to 1 before closing " }
  HoldingString := Copy( HoldingString , 1 , PositionIndex - 1 );
  { and return the ""-stripped string as desired }
  Result := HoldingString;
end;

{ This function scans a line of text for the keyword 'boundary=' }
function TMIMECodingObject.IsBoundaryToken( TheLine : String ) : String;
begin
  { Find out if it's a boundary token symbol }
  if Pos( 'boundary=' , lowercase( TheLine )) <> 0 then
  begin
    { And grab the value }
    Result := GetQuotedString( TheLine );
  end
  else
  begin
    { Else return empty string }
    Result := '';
  end;
end;

{ This function determines if the "name=" token is on a line and if so }
{ Returns the quoted file name as its result; otherwise it returns ''  }
function TMIMECodingObject.IsDecodeName( TheLine : String ) : String;
var PositionIndex : Integer; { Holds possible position of name= token }
    HoldingString : String;  { Holds working string once token found  }
    ResultString  : String;  { Holds name once stripped out of ""     }
begin
  { Find out if name= token in line }
  PositionIndex := Pos( 'name=' , lowercase( TheLine ));
  { If not reutrn the empty string }
  if PositionIndex = 0 then
  begin
    Result := '';
  end
  else
  begin
    { Otherwise strip out stuff before token }
    HoldingString := Copy( TheLine , PositionIndex + 1 ,
     ( Length( TheLine ) - PositionIndex ));
    { And send rest through stripquotes to get filename }
    ResultString := GetQuotedString( HoldingString );
    { Send it back; if malformed will be '' }
    Result := ResultString;
  end;
end;

{ This function returns true if the Base64 token is found, otherwise false }
function TMIMECodingObject.IsBase64( TheLine : String ) : Boolean;
begin
  { if substring found assume valid token and return true else return false }
  if Pos( 'base64' , lowercase( TheLine )) > 0 then Result := true
   else Result := false;
end;

{ This funcion assumes the boundary string has been found; once it's known }
{ this function tells whether a line contains it.                          }
function TMIMECodingObject.IsBoundary( TheLine : String ) : Boolean;
begin
  { A valid substring hit means true otherwise false }
  if Pos( TheBoundaryString , TheLine ) <> 0 then Result := true else
   Result := false;
end;

{ This is a clever function to get the total bytes of a text file }
function TMIMECodingObject.GetTextFileSize( TheName : String ) : Longint;
var TheSR : TSearchRec; { Used for trick }
begin
  { This allows getting the data }
  FindFirst( TheName , faAnyFile , TheSR );
  { And this is the info }
  Result := TheSR.Size;
  { Needed for win32 }
  {FindClose( TheSR )};
end;

{ This function uses Try..Except loops to check for valid file openings }
function TMIMECodingObject.OpenDecodeInputFile : Boolean;
begin
  { Use a try..except loop to catch IOErrors }
  try
    { assign the text input file to the input filename }
    AssignFile( TheInputTextFile , TheInputFileName );
    { do a reset }
    Reset( TheInputTextFile );
    { Get total bytes of a text file! }
    BytesToGet := GetTextFileSize( TheInputFileName );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to open Input File ' + TheInputFileName +
       ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { Return true on no error }
  Result := true;
end;

{ This function uses Try..Except loops to check for valid file openings }
function TMIMECodingObject.OpenDecodeOutputFile : Boolean;
begin
  { Use a try..except loop to catch IOErrors }
  try
    { assign the binary output file to the parsed output filename }
    AssignFile( TheOutputBinaryFile , TheOutputFileName );
    { do a rewrite }
    ReWrite( TheOutputBinaryFile );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to open Output File ' + TheOutputFileName +
       ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { Return true on no error }
  Result := true;
end;

{ This closes both files and signals any error }
function TMIMECodingObject.CloseDecodeFiles : Boolean;
begin
  { Use try..except to catch errors }
  try
    { Do both closefiles }
    CloseFile( TheInputTextFile );
    CloseFile( TheOutputBinaryFile );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to close file(s) ' + ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { No error sends true }
  Result := true;
end;

{ This function opens all the encoding files at once and sends false if errors }
function TMIMECodingObject.OpenEncodeFiles : Boolean;
begin
  { Use try..except to catch any IO Errors }
  try
    { For Encoding, can assume prior knowledge of both the input and output }
    { file names; can do both at once.                                      }
    AssignFile( TheInputBinaryFile , TheInputFileName );
    Reset( TheInputBinaryFile );
    { Get update information }
    BytesToGet := FileSize( TheInputBinaryFile );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to open Input File ' + TheInputFileName +
       ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { Do the output file }
  try
    AssignFile( TheOutputTextFile , TheOutputFileName );
    ReWrite( TheOutputTextFile );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to open Output File ' + TheOutputFileName +
       ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { Signal true if no errors }
  Result := true;
end;

{ This function returns true if no errors closing encode files or false if not }
function TMIMECodingObject.CloseEncodeFiles : Boolean;
begin
  { Use a try..except to catch errors }
  try
    { do both closefiles }
    CloseFile( TheInputBinaryFile );
    CloseFile( TheOutputTextFile );
  except
    { Set error information on an input/output failure }
    On E:EInOutError do
    begin
      { Get error message from exception object }
      ErrorResult := -E.ErrorCode;
      { Get filename and error message from exception object }
      ErrorMessage := 'Unable to close file(s) ' + ' Due to ' + E.Message;
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { return false on an error }
      Result := false;
      exit;
    end;
  end;
  { Return true if no errors }
  Result := true;
end;

{ This function assumes the input filename is set but it does the rest }
function TMIMECodingObject.DecodeMIMEFile : Boolean;
var Finished      : Boolean; { Loop control variable }
    Completed     : Boolean; { Loop control variable }
    WorkingString : String;  { Input holder          }
begin
  { clear boundary marker }
  TheBoundaryString := '';
  { Set failure default return value; specific error handling }
  { will be done be individual functions via ErrorResult and  }
  { HandleMIMEError.                                          }
  Result := false;
  { Try to open the input text file }
  if not OpenDecodeInputFile then exit;
  { Clear loop variable }
  Finished := false;
  { Run till either end of file or signal done }
  while (( not Finished ) and ( not EOF( TheInputTextFile ))) do
  begin
    { Get a line }
    Readln( TheInputTextFile , WorkingString );
    { Do the process count }
    BytesDone := BytesDone + Length( WorkingString );
    { Find out if the boundary token }
    TheBoundaryString := IsBoundaryToken( WorkingString );
    { If found then set exit variable }
    if TheBoundaryString <> '' then Finished := true;
  end;
  { if no boundary marker found then go bye bye }
  if TheBoundaryString = '' then
  begin
    { Set error message }
    ErrorResult := -101;
    { Get filename and error message from exception object }
    ErrorMessage := 'No Boundary Token Found!';
    { if assigned error event then call it with info }
    if Assigned( FOnMIMEErrorOccurred ) then
     OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
    exit;
  end;
  { Clear control variables }
  Finished := false;
  Base64Found := false;
  TheOutputFileName := '';
  { run loop to get name and confirm base64 encoding }
  while (( not Finished ) and ( not EOF( TheInputTextFile ))) do
  begin
    { This outer loop grabs lines of text; does multiple boundaries }
    Readln( TheInputTextFile , WorkingString );
    { Do the process count }
    BytesDone := BytesDone + Length( WorkingString );
    { if hit a boundary then look for the base64 stuff }
    if IsBoundary( WorkingString ) then
    begin
      { Set loop control }
      Completed := false;
      { run until run out of file or hit blank line }
      while (( not Completed ) and ( not EOF( TheInputTextfile ))) do
      begin
        { Get line }
        Readln( TheInputTextFile , WorkingString );
        { Do the process count }
        BytesDone := BytesDone + Length( WorkingString );
        { if a blank then go bye bye }
        if WorkingString = '' then
        begin
          Completed := true;
        end
        else
        begin
          { Get both possible output name and base64 OK }
          if TheOutputFileName = '' then
           TheOutputFileName := IsDecodeName( WorkingString );
          if not Base64Found then
           Base64Found := IsBase64( WorkingString );
        end;
      end;
      { if found a blank line then check for valid base64 file }
      if Completed then
      begin
        { If got an output filename and found b64 then set finished }
        if (( TheOutputFileName <> '' ) and Base64Found ) then
         Finished := true;
      end;
    end;
  end;
  { If never completed or output data not found then exit }
  if not Finished then
  begin
    if TheOutputFileName = '' then
    begin
      { Set error message }
      ErrorResult := -102;
      { Get filename and error message from exception object }
      ErrorMessage := 'No output filename found!';
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
    end
    else
    begin
      { Set error message }
      ErrorResult := -103;
      { Get filename and error message from exception object }
      ErrorMessage := 'Not Base64 encoding!';
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
    end;
    exit;
  end;
  { Try to open the decode output file }
  if not OpenDecodeOutputFile then exit;
  { Set loop control variable }
  Finished := false;
  { Set up the decode variables }
  InitializeMIMEDecode;
  { run loop to get binary data }
  while (( not Finished ) and ( not EOF( TheInputTextFile ))) do
  begin
    { Get an input line }
    Readln( TheInputTextFile , WorkingString );
    { Do the process count }
    BytesDone := BytesDone + Length( WorkingString );
    { If it's a boundary then don't process it otherwise do decode }
    if not IsBoundary( WorkingString ) then
    begin
      { If decodes ok keep going else abort }
      if not MIMEDecode( WorkingString ) then exit;
      { Update status indicator }
      if Assigned( FOnMIMEUpdateOccurred ) then
       OnMIMEUpdateOccurred( BytesDone , BytesToGet );
    end
    { End processing if a boundary found }
    else Finished := true;
  end;
  { Clear status indicator }
  if Assigned( FOnMIMEUpdateOccurred ) then
   OnMIMEUpdateOccurred( BytesToGet , BytesToGet );
  { Close the files }
  if not CloseDecodeFiles then exit;
  { Return success }
  Result := true;
end;

{ This function returns a binary number based on the ascii of the input char }
function TMIMECodingObject.ConvertBase64Character( Current_Character : Char ) :
 SmallInt;
begin
   { Decode ordinals of uppercase characters 0 - 25 }
   if (( Current_Character >= 'A' ) and
       ( Current_Character <= 'Z' )) then
   begin
     result :=
      SmallInt( Ord( Current_Character ) - Ord( 'A' ));
     exit;
   end;
   { Decode ordinals of lowercase characters 26 - 51 }
   if (( Current_Character >= 'a') and
       ( Current_Character <= 'z')) then
   begin
     result := 26 +
       SmallInt( Ord( Current_Character ) - Ord( 'a' ));
     exit;
   end;
   { Decode ordinals of numbers 52 - 61 }
   if (( Current_Character >= '0') and
       ( Current_Character <= '9' )) then
   begin
     result := 52 +
       SmallInt( Ord( Current_Character ) - Ord( '0' ));
     exit;
   end;
   { Decode + as 62 }
   if ( Current_Character = '+' ) then
   begin
     result := 62;
     exit;
   end;
   { Decode / as 63 }
   if ( Current_Character = '/' ) then
   begin
     result := 63;
     exit;
   end;
   { Signal padding character = by -2 }
   if ( Current_Character = '=' ) then
   begin
     result := -2;
     exit;
   end;
   { Signal invalid character by -1 }
   result := -1;
end;

{ This function does bit magic on the current data state and when appropriate }
{ writes a byte to the output file.                                           }
function TMIMECodingObject.AddBinaryValueToStream( BinaryValue : SmallInt ) :
 Boolean;
var WorkingValue : SmallInt; { Used to store bit conversion }
    OutputValue  : Byte;     { Used to store output byte    }
begin
  { Assume success; only error will be file write failure }
  Result := true;
  { Shift over six bits of the accumulator }
  The_Accumulator := The_Accumulator SHL 6;
  { Add the shift to the counter }
  Total_Bits_Shifted := Total_Bits_Shifted + 6;
  { OR in the acquired bits }
  { first char =  6 bits }
  { 2nd   char = 12 bits; moved back to 4 }
  { 3rd   char = 10 bits; moved back to 2 }
  { 4th   char =  8 bits; moved back to 0 }
  The_Accumulator := ( The_Accumulator or BinaryValue );
  { If have at least one valid output byte }
  if  Total_Bits_Shifted >= 8 then
  begin
    { Reduce remaining bits by 8 }
    Total_Bits_Shifted := Total_Bits_Shifted - 8;
    { Grab last full 8 bits in the accumulator }
    { note that continual shifting clears it   }
    WorkingValue := The_Accumulator SHR Total_Bits_Shifted;
    { Mask off the high byte of the smallint }
    OutputValue := byte( WorkingValue and $00FF );
    { Use try..except to write out the byte }
    try
      { Do a seek for safety }
      Seek( TheOutputBinaryFile , FileSize( TheOutputBinaryFile ));
      { write the data byte }
      Write( TheOutputBinaryFile , OutputValue );
    except
      { Set error information on an input/output failure }
      On E:EInOutError do
      begin
        { Get error message from exception object }
        ErrorResult := -E.ErrorCode;
        { Get filename and error message from exception object }
        ErrorMessage := 'Unable to Write output byte Due to ' + E.Message;
        { if assigned error event then call it with info }
        if Assigned( FOnMIMEErrorOccurred ) then
         OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
        { return false on an error }
        Result := false;
        exit;
      end;
    end;
  end;
end;

{ This function does the dirty work of doing the MIME decoding }
function TMIMECodingObject.MIMEDecode( TheString : String ) : Boolean;
var Counter_1         : Integer;   { Loop counter }
    Current_Character : Char;      { Decode char  }
    Binary_Value      : SmallInt;  { Output value }
begin
  { Assume success }
  Result := true;
  { Ignore blank lines }
  if TheString = '' then exit;
  { Run along string }
  for Counter_1 := 1 to Length( TheString ) do
  begin
    { get char to decode }
    Current_Character := TheString[ Counter_1 ];
    { convert char to binary via lookup function }
    Binary_Value := ConvertBase64Character( Current_Character );
    { if -2 hit = padding char; abort }
    if Binary_Value = -2 then exit;
    { if invalid char signal error }
    if Binary_Value = -1 then
    begin
      { Set error message }
      ErrorResult := -104;
      { Get filename and error message from exception object }
      ErrorMessage := 'Invalid Input Character!';
      { if assigned error event then call it with info }
      if Assigned( FOnMIMEErrorOccurred ) then
       OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
      { signal error and exit }
      Result := false;
      exit;
    end;
    { try to send the binary value through the byte cruncher }
    if not AddBinaryValueToStream( Binary_Value ) then
    begin
      { If failed return error since had disk write error }
      Result := false;
      exit;
    end;
  end;
end;

{ This method will attempt to create the default stringlist of a MIME header }
{ It will include the file name without path.                                }
procedure TMIMECodingObject.CreateDefaultHeader( var TheEncodingHeader : TStringList );
begin
  { Put in a lot of weird text }
  TheBoundaryString := '=====================_CIUPKC158==_';
  TheEncodingHeader := TStringList.Create;
  with TheEncodingHeader do
  begin
    Add( 'Content-Type: multipart/mixed; boundary="' + TheBoundaryString + '"' );
    Add( 'X-Attachments: ' + TheInputFileName );
    Add( '--' + TheBoundaryString );
    Add( 'Content-Type: octet-stream; name="' +
     ExtractFileName( TheInputFileName ) + '"' );
    Add( 'Content-Transfer-Encoding: base64' );
    Add( 'Content-Disposition: attachment; filename="' +
     ExtractFileName( TheInputFilename ) + '"' );
    Add( '' );
  end;
end;

{ This function does the actual encoding of an output byte into the four byte }
{ character quads and sends the characters out as needed.                     }
function TMIMECodingObject.EncodeMIMEOutputByte( TheInputByte : Byte;
          LastChar : Boolean ) : Boolean;
var WorkingValue  : Cardinal; { This is 16 bits in win16 and 32 bits in win95 }
    WorkingCharacter : Char;  { Holds output char value                       }
    WorkingString : String;   { Holder for single-character addition string   }
begin
  { Default is good processing }
  Result := true;
  { Set up workingString for one character }
  WorkingString := ' ';
  { Promote the input byte }
  WorkingValue := Cardinal( TheInputByte );
  { Scoot current bit list oer 8 }
  The_Accumulator := The_Accumulator SHL 8;
  { Increment bitshift count }
  Total_Bits_Shifted := Total_Bits_Shifted + 8;
  { OR in the new bits }
  The_Accumulator := ( The_Accumulator or WorkingValue );
  { Except on last output, run chars into string until below 6 bits }
  while ( Total_Bits_Shifted >= 6 ) do
  begin
    { Reduce total bitshift }
    Total_Bits_Shifted := Total_Bits_Shifted - 6;
    { Do bit magic on accumulator to get char value  masked to 1 byte}
    WorkingValue := (( The_Accumulator SHR Total_Bits_Shifted ) and  $0000003F );
    { get array index character from preset constant }
    WorkingCharacter := The_Alphabet[ Byte( WorkingValue ) ];
    { shove it into the working string }
    WorkingString[ 1 ] := WorkingCharacter;
    { And add it to the output string }
    OutputString := OutputString + WorkingString;
    { If hit 80 chars do output to file }
    if ( Length( OutputString ) = 80 ) then
    begin
      { Usual try..except block }
      try
        Writeln( TheOutputTextFile , OutputString );
        { Update status indicator }
        if Assigned( FOnMIMEUpdateOccurred ) then
         OnMIMEUpdateOccurred( BytesDone , BytesToGet );
      except
        { Set error information on an input/output failure }
        On E:EInOutError do
        begin
          { Get error message from exception object }
          ErrorResult := -E.ErrorCode;
          { Get filename and error message from exception object }
          ErrorMessage := 'Unable to Write output line Due to ' + E.Message;
          { if assigned error event then call it with info }
          if Assigned( FOnMIMEErrorOccurred ) then
           OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
          { return false on an error }
          Result := false;
          exit;
        end;
      end;
      { Reset the output string }
      OutputString := '';
    end;
    { Don't loop on last dummy character to flush bit buffer }
    if LastChar then exit;
  end;
end;

{ This function writes out the preloaded stringlist with what }
{ is assumed to be a valid MIME header.                       }
{ If one is not found the default header is written.          }
function TMIMECodingObject.WriteMIMEHeader : Boolean;
var Counter_1 : Integer; { Loop counter }
begin
  { if the encoding header is not assigned then create a default }
  if not Assigned( TheEncodingHeader ) then
    CreateDefaultHeader( TheEncodingHeader );
  { run along the string list and write its contents out to the file }
  for Counter_1 := 0 to TheEncodingHeader.Count - 1 do
  begin
    { do try..except to catch errors }
    try
      Writeln( TheOutputTextFile , TheEncodingHeader.Strings[ Counter_1 ] );
    except
      { Set error information on an input/output failure }
      On E:EInOutError do
      begin
        { Get error message from exception object }
        ErrorResult := -E.ErrorCode;
        { Get filename and error message from exception object }
        ErrorMessage := 'Unable to Write output line Due to ' + E.Message;
        { if assigned error event then call it with info }
        if Assigned( FOnMIMEErrorOccurred ) then
         OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
        { return false on an error }
        Result := false;
        exit;
      end;
    end;
  end;
  { Signal success }
  Result := true;
end;

{ This function writes out any last bytes to the encoded file and flushes the }
{ output string if needed.                                                    }
function TMIMECodingObject.WriteFinalMIMEEncoding : Boolean;
begin
  if Total_Bits_Shifted = 0 then
  begin
    if OutputString = '' then
    begin
      { Usual try..except block }
      try
        Writeln( TheOutputTextFile , '--' + TheBoundaryString );
      except
        { Set error information on an input/output failure }
        On E:EInOutError do
        begin
          { Get error message from exception object }
          ErrorResult := -E.ErrorCode;
          { Get filename and error message from exception object }
          ErrorMessage := 'Unable to Write output line Due to ' + E.Message;
          { if assigned error event then call it with info }
          if Assigned( FOnMIMEErrorOccurred ) then
           OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
          { return false on an error }
          Result := false;
          exit;
        end;
      end;
      Result := true;
      exit;
    end;
    { Usual try..except block }
    try
      Writeln( TheOutputTextFile , OutputString );
      Writeln( TheOutputTextFile , '--' + TheBoundaryString );
    except
      { Set error information on an input/output failure }
      On E:EInOutError do
      begin
        { Get error message from exception object }
        ErrorResult := -E.ErrorCode;
        { Get filename and error message from exception object }
        ErrorMessage := 'Unable to Write output line Due to ' + E.Message;
        { if assigned error event then call it with info }
        if Assigned( FOnMIMEErrorOccurred ) then
         OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
        { return false on an error }
        Result := false;
        exit;
      end;
    end;
    Result := true;
  end
  else
  begin
    if Total_Bits_Shifted = 4 then OutputString := OutputString + '=' else
     OutputString := OutputString + '==';
    { Usual try..except block }
    try
      Writeln( TheOutputTextFile , OutputString );
      Writeln( TheOutputTextFile , '--' + TheBoundaryString );
    except
      { Set error information on an input/output failure }
      On E:EInOutError do
      begin
        { Get error message from exception object }
        ErrorResult := -E.ErrorCode;
        { Get filename and error message from exception object }
        ErrorMessage := 'Unable to Write output line Due to ' + E.Message;
        { if assigned error event then call it with info }
        if Assigned( FOnMIMEErrorOccurred ) then
         OnMIMEErrorOccurred( ErrorResult , ErrorMessage );
        { return false on an error }
        Result := false;
        exit;
      end;
    end;
    Result := true;
  end;
end;

{ This function does a MIME encode; reading in a binary file     }
{ and outputting MIME characters to a text file; it assumes      }
{ valid filenames and a valid MIME Header/boundary are in place. }
function TMIMECodingObject.EncodeMIMEFile : Boolean;
var InputCounter : Integer; { Counter for file seeking  }
    Finished     : Boolean; { Loop controller           }
    TheInputByte : Byte;    { Byte to hold read in data }
begin
  { Assume failure }
  Result := false;
  BytesDone := 1;
  { Try to open the encode files and exit if fail }
  if not OpenEncodeFiles then exit;
  { Try to write the MIME header and exit if fail }
  if not WriteMIMEHeader then exit;
  { Clear loop variables }
  InputCounter := 0;
  Finished := false;
  { Set up baseline for encoding }
  InitializeMIMEEncode;
  { Loop till abort or run out of input file }
  while not Finished do
  begin
    { Seek along the binary input file }
    Seek( TheInputBinaryFile , InputCounter );
    { Get a byte of input data }
    Read( TheInputBinaryFile , TheInputByte );
    { Update progress counter }
    Inc( BytesDone );
    { Move up the counter }
    Inc( InputCounter );
    { If greater than or equal to size of file then done }
    if InputCounter >= FileSize( TheInputBinaryFile ) then Finished := true;
    { Try to encode and write data and abort if fail }
    if not EncodeMIMEOutputByte( TheInputByte , false ) then exit;
  end;
  { Clear status indicator }
  if Assigned( FOnMIMEUpdateOccurred ) then
   OnMIMEUpdateOccurred( BytesToGet , BytesToGet );
  { Handle leftovers }
  if Total_Bits_Shifted > 0 then EncodeMIMEOutputByte( 0  , true );
  { Write out left over ='s and final section boundary }
  if not WriteFinalMIMEEncoding then exit;
  { Try and close the files }
  if not CloseEncodeFiles then exit;
  { Only return true if everything went right }
  Result := true;
end;

procedure TPOP3SMTPComponent.TrashMessage( TheEMMRecord : PEMailMessageRecord );
begin
  TheEMMRecord^.MRMessageSender := 'DELETE ME';
end;

procedure TPOP3SMTPComponent.TrashAllMarkedMessages( TheLB       : TListBox;
                                                     TheMBRecord : PEMailMailboxRecord );
var Counter_1 : Integer;
    WorkingList : TList;
begin
  WorkingList := TList( TheMBRecord^.MBLTag );
  for Counter_1 := 0 to TheLB.Items.Count - 1 do
  begin
    if TheLB.Selected[ Counter_1 ] then
    begin
      TrashMessage( PEMailMessageRecord( WorkingList.Items[ Counter_1 ] ));
    end;
  end;
end;

procedure TPOP3SMTPComponent.SetRecipient( WhichMemo : TMemo; WhatName : String );
var Finished : Boolean;
    Counter_1 ,
    FoundLine   : Integer;
begin
  Finished := false;
  Counter_1 := 0;
  FoundLine := -1;
  while not Finished do
  begin
    if Pos( 'TO:' , Uppercase( WhichMemo.Lines[ Counter_1 ] )) <> 0 then
    begin
      FoundLine := Counter_1;
      Finished := true;
    end
    else Inc( Counter_1 );
    if Counter_1 > WhichMemo.Lines.Count then Finished := true;
  end;
  if FoundLine = -1 then exit;
  WhichMemo.Lines[ FoundLine ] := 'TO: ' + WhatName;
end;

procedure TPOP3SMTPComponent.SetCarbonCopy( WhichMemo : TMemo; WhatName : String );
var Finished : Boolean;
    Counter_1 ,
    FoundLine   : Integer;
begin
  Finished := false;
  Counter_1 := 0;
  FoundLine := -1;
  while not Finished do
  begin
    if Pos( 'CC:' , Uppercase( WhichMemo.Lines[ Counter_1 ] )) <> 0 then
    begin
      FoundLine := Counter_1;
      Finished := true;
    end
    else Inc( Counter_1 );
    if Counter_1 > WhichMemo.Lines.Count then Finished := true;
  end;
  if FoundLine = -1 then exit;
  WhichMemo.Lines[ FoundLine ] := 'CC: ' + WhatName;
end;

{ This function calls an extended response POP3SMTP command routine }
function TPOP3SMTPComponent.PerformPOP3ExtendedCommand(
               TheCommand   : string;
         const TheArguments : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if POP3CommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  POP3CommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function calls an extended response POP3SMTP command routine }
function TPOP3SMTPComponent.PerformSMTPExtendedCommand(
               TheCommand   : string;
         const TheArguments : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if SMTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  SMTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function gets an extended period-ended multiline response from the server }
function TPOP3SMTPComponent.GetPOP3ServerExtendedResponse( ResponseString : PChar ) : integer;
var
  { Assume ResponseString already allocated as 0..513 }
  { Pointer to the response string }
  TheBuffer ,
  BufferPointer : array[0..255] of char;
  HolderBuffer : array[0..513] of char;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
  BufferString : String;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  StrCopy( HolderBuffer , '' );
  repeat
    { Do a peek }
    BufferString := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , BufferString );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , BufferString );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , BufferString );
        if TheIndex = 0 then
        begin
          TheIndex := Length( BufferString );
          LeftoversInPan := True;
          StrPCopy( TheBuffer , BufferString );
          StrCat( HolderBuffer , TheBuffer );
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 0 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ TheLength ] := Chr( 0 );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        StrCopy( ResponseString , HolderBuffer );
        StrCat( ResponseString , BufferPointer );
      end
      else
      begin
        if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end
      else
      begin
        ResponseChar := ResponseString[ 0 ];
        if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
        begin
          ResponseString[ 0 ] := ' ';
          Finished := true;
          Result := TCPIP_STATUS_COMPLETED;
        end
        else
        begin
          if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
          Finished := true;
          Result := TCPIP_STATUS_PRELIMINARY;
        end;
      end;
    end;
  until ( Finished and ( not LeftoversOnTable ));
  StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
end;

{ This function gets an extended period-ended multiline response from the server }
function TPOP3SMTPComponent.GetSMTPServerExtendedResponse( ResponseString : PChar ) : integer;
var
  { Assume ResponseString already allocated as 0..513 }
  { Pointer to the response string }
  TheBuffer ,
  BufferPointer : array[0..255] of char;
  HolderBuffer : array[0..513] of char;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
  BufferString : String;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  StrCopy( HolderBuffer , '' );
  repeat
    { Do a peek }
    BufferString := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , BufferString );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , BufferString );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , BufferString );
        if TheIndex = 0 then
        begin
          TheIndex := Length( BufferString );
          LeftoversInPan := True;
          StrPCopy( TheBuffer , BufferString );
          StrCat( HolderBuffer , TheBuffer );
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 0 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ TheLength ] := Chr( 0 );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        StrCopy( ResponseString , HolderBuffer );
        StrCat( ResponseString , BufferPointer );
      end
      else
      begin
        if not LeftoversInPan then StrCopy( ResponseString , BufferPointer );
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end
      else
      begin
        ResponseChar := ResponseString[ 0 ];
        if (( ResponseChar = '.' ) and ( StrLen( ResponseString ) <= 3 )) then
        begin
          ResponseString [ 0 ] := ' ';
          Finished := true;
          Result := TCPIP_STATUS_COMPLETED;
        end
        else
        begin
          if ResponseChar = '.' then ResponseString[ 0 ] := ' ';
          Finished := true;
          Result := TCPIP_STATUS_PRELIMINARY;
        end;
      end;
    end;
  until ( Finished and ( not LeftoversOnTable ));
  StrLCopy( ResponseString , ResponseString , StrLen( ResponseString ) - 2 );
end;

{ This function moves along a string from an index, getting the next }
{ string delimited item or last one on string.                       }
function TPOP3SMTPComponent.GetNextSDItem(     WorkingString : String;
                                       var TheIndex      : Integer ) : String;
var HoldingString : String;
begin
  HoldingString := Copy( WorkingString , TheIndex + 1 , 255 );
  TheIndex := Pos( ' ' , HoldingString );
  if TheIndex = 0 then
  begin
    Result := HoldingString;
  end
  else
  begin
    HoldingString := Copy( HoldingString , 1 , TheIndex - 1 );
    Result := HoldingString;
  end;
end;

{ This function Inserts a MIME header into a memo for EMail usage }
procedure TPOP3SMTPComponent.InsertMIMETextHeader( TheMemo : TMemo );
var Counter_1 : Integer;
    Finished  : Boolean;
begin
  Counter_1 := 0;
  Finished := false;
  while not Finished do
  begin
    if TheMemo.Lines[ Counter_1 ] = '' then
    begin
      Finished := true;
    end
    else
    begin
      Inc( Counter_1 );
      if Counter_1 = TheMemo.Lines.Count then exit;
    end;
  end;
  TheMemo.Lines.Insert( Counter_1 - 1 , 'Mime-Version: 1.0' );
  TheMemo.Lines.Insert( Counter_1 , 'Content-Type: multipart/mixed; boundary="' +
   TheMIMEObject.TheBoundaryString + '"' );
  TheMemo.Lines.Insert( Counter_1 + 1 , '' );
  TheMemo.Lines.Insert( Counter_1 + 2 , '--' + TheMIMEObject.TheBoundaryString );
  TheMemo.Lines.Insert( Counter_1 + 3 , 'Content-Type: text/plain; charset="us-ascii"' );
end;

{ this method adds a MIME file as an attachment to a message }
procedure TPOP3SMTPComponent.AddMIMEAttachment( TheMemo : TMemo;
 TheFileToAdd : String );
var TempMemo  : TMemo;
    Counter_1 : Integer;
begin
  InsertMIMETextHeader( TheMemo );
  TempMemo := TMemo.Create( self );
  TempMemo.parent := self;
  Tempmemo.Visible := false;
  TempMemo.Width := TheMemo.Width;
  TempMemo.Height := TheMemo.Height;
  TempMemo.Lines.LoadFromFile( TheFileToAdd );
  TheMemo.Lines.Add( '' );
  for Counter_1 := 0 to TempMemo.Lines.Count - 1 do
   TheMemo.Lines.Add( TempMemo.Lines[ Counter_1 ] );
  TempMemo.Free;
  TheMemo.Lines.Add( '--' + TheMIMEObject.TheBoundarystring );
end;

{ This method creates a new message with a MIME attachment  }
procedure TPOP3SMTPComponent.NewMIMEMessage( TheMemo : TMemo;
 TheNewFile : String; TheEMCRecord : PConnectionsRecord  );
begin
  SetMailHeaders( TheMemo , TheEMCRecord );
  AddMimeAttachment( TheMemo , TheNewFile );
end;

{ This method puts all the headers into the memo, getting the group name from gn }
procedure TPOP3SMTPComponent.SetMailHeaders( TheMemo      : TMemo;
                                            TheEMCRecord : PConnectionsRecord );
var DateString , TimeString : String;
    DateData , TimeData : Word;
    D1,D2,D3,D4 : Word;
begin
  DecodeTime( Time , D1 , D2 , D3 , D4 );
  TimeData := D1 + D2 + D3 + D4;
  DecodeDate( Date , D1 , D2 , D3 );
  DateData := D1 + D2 + D3;
  with TheEMCRecord^ do
  begin
    TheMemo.Clear;
    TheMemo.Lines.Add( 'To:');
    TheMemo.Lines.Add( 'From: ' + CStartDir );
    TheMemo.Lines.Add( 'CC:' );
    TheMemo.Lines.Add( 'BCC:' );
    TheMemo.Lines.Add( 'Subject:');
    TheMemo.Lines.Add( 'Message-ID: <' + IntToStr( DateData ) + IntToStr( TimeData ) +
     '@' + CIPAddress + '>' );
    TheMemo.Lines.Add( 'X-Mailer: CC Internet Command Center' );
    DateString := FormatDateTime( '"Date: "  ddd ' + '" " dd mmm yy', Date );
    TimeString := FormatDateTime( '" " hh:nn:ss' ,Time );
    TheMemo.Lines.Add( DateString  + TimeString + ' MDT' );
    TheMemo.Lines.Add( '' );
  end;
end;

{ This function adds the text of an article to the current memo with > }
procedure TPOP3SMTPComponent.SetReplyMailHeaders(
          TheMemo         : TMemo ;
          TheEMCRecord    : PConnectionsRecord;
          TheEMBRecord    : PEmailMailBoxRecord;
          MessageNumber   : Integer );
var WorkingList     : TList;
    TheEMMRecord    : PEmailMessageRecord;
    Counter_1       : Integer;
    WorkingFileName : String;
    DateString ,
    TimeString      : String;
    DateData , TimeData : Word;
    D1,D2,D3,D4 : Word;
begin
  DecodeTime( Time , D1 , D2 , D3 , D4 );
  TimeData := D1 + D2 + D3 + D4;
  DecodeDate( Date , D1 , D2 , D3 );
  DateData := D1 + D2 + D3;
  WorkingList := TList( TheEMBRecord^.MBLTag );
  TheEMMRecord := PEmailMessageRecord( WorkingList.Items[ MessageNumber ] );
  WorkingFileName := TheEMMRecord^.MRFileName;
  WorkingFileName := MailPath + '\' + WorkingFileName;
  try
    TheMemo.Lines.LoadFromFile( WorkingFileName );
  except
    MessageDlg('Message File Too Big for Memo!',mtError,[mbOK],0);
  end;
  for Counter_1 := 0 to TheMemo.Lines.Count - 1 do
   TheMemo.Lines[ Counter_1 ] := '>' + TheMemo.Lines[ Counter_1 ];
  TheMemo.Lines.Insert( 0 , 'To:' + TheEMMRecord^.MRMessageSender );
  TheMemo.Lines.Insert( 1 , 'From:' + TheEMCRecord^.CStartDir );
  TheMemo.Lines.Insert( 2 , 'CC:' );
  TheMemo.Lines.Insert( 3 , 'BCC:' );
  TheMemo.Lines.Insert( 4 , 'Subject: Re: ' + TheEMMRecord^.MRMessageSubject );
  TheMemo.Lines.Insert( 5 , 'Message-ID: <' + IntToStr( DateData ) + IntToStr( TimeData ) +
   '@' + TheEMCRecord^.CIPAddress + '>' );
  TheMemo.Lines.Insert( 6 , 'X-Mailer: CC Internet Command Center' );
  DateString := FormatDateTime( '"Date: " ddd ' + '" "  dd mmm yy ', Date );
  TimeString := FormatDateTime( '" " hh:nn:ss' ,Time );
  TheMemo.Lines.Insert( 7 , DateString  + TimeString + ' MDT' );
  TheMemo.Lines.Insert( 8 , '' );
end;

{ This method assumes logged into server; gets data via STAT command }
{ returns total bytes in var'd param and total messages as result    }
function TPOP3SMTPComponent.CheckAllNewMail( var TotalBytes : Longint ) : Integer;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    TheLResult      : Longint;
begin
  TheReturnString :=
   DoCStyleFormat( 'STAT' , [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformPOP3Command( 'STAT', [ nil ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    POP3CommandInProgress := false;
    Result := -1;
    exit;
  end;
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Mail Not Available!' , [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := -1;
    { leave }
    exit;
  end;
  ParseMailListing( TheReturnString , TheLResult , TotalBytes );
  Result := TheLResult;
end;

function TPOP3SMTPComponent.DeleteMailItem( TheNumber : Longint ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'DELE %d' , [ TheNumber ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformPOP3Command( 'DELE %d', [ TheNumber ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    POP3CommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Mail Not Available!' , [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := false;
    { leave }
    exit;
  end;
  Result := True;
end;

{ This method splits up a listing and pulls out its component data }
procedure TPOP3SMTPComponent.ParseMailListing(     TheListing : String;
                                               var TotalMessages : Longint;
                                               var MessageBytes : Longint);
var HoldingString ,
    HoldingString2 : String;
    WorkingIndex  : Integer;
begin
  WorkingIndex := Pos( ' ' , TheListing );
  HoldingString := Copy( TheListing , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos(  ' ' , HoldingString );
  HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  TotalMessages := StrToInt( HoldingString2 );
  HoldingString := Copy( HoldingString , WorkingIndex + 1 , 255 );
  WorkingIndex := Pos(  ' ' , HoldingString );
  if WorkingIndex = 0 then WorkingIndex := 256;
  HoldingString2 := Copy( HoldingString , 1 , WorkingIndex - 1 );
  MessageBytes := StrToInt( HoldingString2 );
end;

{ This method accumulates all the strings until '' as a messge header }
function TPOP3SMTPComponent.GetMessageHeader( TheReturnList : TStringList ) : Longint;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    TheReturnPChar ,
    TheHoldingPChar : PChar;
    TotalGotten : Longint;
begin
  GetMem( TheReturnPChar , 514 );
  TheReturnList.Clear;
  TotalGotten := 0;
  repeat
    TheResult := GetPOP3ServerExtendedResponse( TheReturnPChar );
    if StrLen( TheReturnPChar ) < 3 then
    begin
     TheResult := TCPIP_STATUS_COMPLETED;
    end;
    TotalGotten := TotalGotten + StrLen( TheReturnPChar ) + 2;
    if StrLen( TheReturnPChar ) > 255 then
    begin
      Getmem( TheHoldingPChar , 255 );
      while StrLen( TheReturnPChar ) > 255 do
      begin
        StrCopy( TheHoldingPChar , '' );
        StrMove( TheHoldingPChar , TheReturnPChar , 255 );
        TheReturnPChar := TheReturnPChar + 256;
        TheReturnString := StrPas( TheHoldingPChar );
        TheReturnList.Add( TheReturnString );
      end;
      StrCopy( TheHoldingPChar , '' );
      StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
      TheReturnString := StrPas( TheHoldingPChar );
      TheReturnString := '\' + TheReturnString;
      TheReturnList.Add( TheReturnString );
      FreeMem( TheHoldingPChar , 255 );
    end
    else
    begin
      TheReturnString := StrPas( TheReturnPChar );
      TheReturnList.Add( TheReturnString );
    end;
  until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  FreeMem( TheReturnPChar , 514 );
  Result := TotalGotten;
end;

{ This method parses a header stringlist and obtains the subject line }
function TPOP3SMTPComponent.GetHeaderSubject( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '[No Subject]';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'SUBJECT:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 9 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method parses a header stringlist and obtains the sender's ID }
function TPOP3SMTPComponent.GetHeaderSender( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'FROM:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 7 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the TO: field of a mail message header }
function TPOP3SMTPComponent.GetHeaderRecipient( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'TO:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 5 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the TO: field of a mail message header }
function TPOP3SMTPComponent.GetRCPTHeaderRecipient( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'TO:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := 'TO:<' + Copy( HList.Strings[ Counter_1 ] , 5 , 255 ) + '>';
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the CC: field of a mail message header }
function TPOP3SMTPComponent.GetHeaderCarbons( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'CC:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 5 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the CC: field of a mail message header }
function TPOP3SMTPComponent.GetRCPTHeaderCarbons( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'CC:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := 'CC:<' + Copy( HList.Strings[ Counter_1 ] , 5 , 255 ) + '>';
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the BCC: field of a mail message header }
function TPOP3SMTPComponent.GetHeaderBlindCarbons( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'BCC:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 6 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the BCC: field of a mail message header }
function TPOP3SMTPComponent.GetRCPTHeaderBlindCarbons( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'BCC:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := 'BCC:<' + Copy( HList.Strings[ Counter_1 ] , 6 , 255 ) + '>';
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method strips out the DATE: field of a mail message header }
function TPOP3SMTPComponent.GetHeaderDateTime( HList : TStringList ) : String;
var Counter_1     : Integer;
    Finished      : Boolean;
    WorkingIndex  : Integer;
    WorkingString : String;
begin
  Counter_1 := 0;
  Finished := false;
  WorkingString := '';
  while (( not Finished ) and ( Counter_1 <= HList.Count - 1 )) do
  begin
    WorkingIndex := Pos( 'DATE:' , Uppercase( HList.Strings[ Counter_1 ] ));
    if WorkingIndex > 0 then
    begin
      WorkingString := Copy( HList.Strings[ Counter_1 ] , 7 , 255 );
      Finished := true;
    end
    else Inc( Counter_1 );
  end;
  Result := WorkingString;
end;

{ This method transfers a message from one mailbox to another }
procedure TPOP3SMTPComponent.TransferMessage( SourceEMBRecord ,
                                              TargetEMBRecord : PEMailMailBoxRecord;
                                              MessageNumber : Integer );
var  WorkingList1 , WorkingList2 : TList;
     TheEMMRecord : PEMailMessageRecord;
begin
  WorkingList1 := TList( SourceEMBRecord^.MBLTag );
  WorkingList2 := TList( TargetEMBRecord^.MBLTag );
  TheEMMRecord := PEMailMessageRecord( WorkingList1.Items[ MessageNumber ] );
  WorkingList2.Add( TheEMMRecord );
  SourceEMBRecord^.MBLTag := Longint( WorkingList1 );
  TargetEMBRecord^.MBLTag := Longint( WorkingList2 );
end;

{ This function deletes all read/sent articles and associated files }
procedure TPOP3SMTPComponent.PurgeTrashedMessageListings( TheEMBRecord : PEMailMailBoxRecord );
var TheEMMRecord   : PEMailMessageRecord;
    Counter_1      : Integer;
    WorkingList    : TList;
    Finished       : Boolean;
begin
  { Do this for ease of coding }
  with TheEMBRecord^ do
  begin
    { Get the current TList of article headers }
    WorkingList := TList( MBLTag );
    { Run up to total new articles }
    for Counter_1 := 0 to WorkingList.Count - 1 do
    begin
      TheEMMRecord := PEMailMessageRecord( WorkingList.Items[ Counter_1 ] );
      if ( TheEMMRecord^.MRMessageSender = 'DELETE ME' ) then
      begin
        Dec( MBTotal );
        if not TheEMMRecord^.MRRead then if MBUnReadTotal > 0 then Dec( MBUnReadTotal );
        if not TheEMMRecord^.MRSent then if MBUnSentTotal > 0 then Dec( MBUnSentTotal );
        if FileExists( MailPath + '\' + TheEMMRecord^.MRFilename ) then
         {DeleteFile( MailPath + '\' + TheEMMRecord^.MRFileName )};
      end;
    end;
    Counter_1 := 0;
    Finished := False;
    if WorkingList.Count = 0 then Finished := true;
    while Not Finished do
    begin
      TheEMMRecord := PEMailMessageRecord( WorkingList.Items[ Counter_1 ] );
      if ( TheEMMRecord^.MRMessageSender = 'DELETE ME' ) then
      begin
        WorkingList.Delete( Counter_1 );
      end
      else Counter_1 := Counter_1 + 1;
      if Counter_1 > WorkingList.Count - 1 then Finished := true;
    end;
  end;
end;

{ This method uses the ARTICLE command to obtain an article and put it in a  }
{ preset/supplied file. It is designed to work by itself or inside DAALs     }
function TPOP3SMTPComponent.DownloadMessageListing( TheNumber   : Integer;
                                                    TheFileName : String;
                                                    TheHeaderSL : TStringList   ) : Longint;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
    TheReturnPChar ,
    TheHoldingPChar : PChar;
    TheMessageFile       : TextFile;
    Counter_1   : Integer;
    TotalGotten : Longint;
begin
  TheReturnString :=
   DoCStyleFormat( 'RETR %d' ,
    [ TheNumber ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformPOP3Command( 'RETR %d', [ TheNumber ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    POP3CommandInProgress := false;
    Result := 0;
    exit;
  end;
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'Retrieve Message %d Failed!' ,
      [ TheNumber ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := 0;
    { leave }
    exit;
  end;
  GetMem( TheReturnPChar , 514 );
  try
    AssignFile( TheMessageFile , TheFileName );
    Rewrite( TheMessageFile );
  except
    MessageDlg( 'Unable to open Mail Message file ' + TheFileName + '!' ,
     mtError , [mbok],0 );
    Socket1.OutOfBand := 'ABOR'+#13#10;
    repeat
      TheResult := GetPOP3ServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString  + #13#10 );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    result := 0;
    exit;
  end;
  TotalGotten := GetMessageHeader( TheHeaderSL );
  for Counter_1 := 0 to TheHeaderSL.Count - 1 do
   Writeln( TheMessageFile , TheHeaderSL.Strings[ Counter_1 ] );
  repeat
    TheResult := GetPOP3ServerExtendedResponse( TheReturnPChar );
    TotalGotten := TotalGotten + StrLen( TheReturnPChar ) + 2;
    if StrLen( TheReturnPChar ) > 255 then
    begin
      Getmem( TheHoldingPChar , 255 );
      while StrLen( TheReturnPChar ) > 255 do
      begin
        StrCopy( TheHoldingPChar , '' );
        StrMove( TheHoldingPChar , TheReturnPChar , 255 );
        TheReturnPChar := TheReturnPChar + 256;
        TheReturnString := StrPas( TheHoldingPChar );
        Writeln( TheMessageFile , TheReturnString );
      end;
      StrCopy( TheHoldingPChar , '' );
      StrMove( TheHoldingPChar , TheReturnPChar , StrLen( TheReturnPChar ));
      TheReturnString := StrPas( TheHoldingPChar );
      TheReturnString := '\' + TheReturnString;
      Writeln( TheMessageFile , TheReturnString );
      FreeMem( TheHoldingPChar , 255 );
    end
    else
    begin
      TheReturnString := StrPas( TheReturnPChar );
      Writeln( TheMessageFile , TheReturnString );
    end;
  until (( GlobalAbortedFlag ) or ( TheResult = TCPIP_STATUS_COMPLETED ));
  FreeMem( TheReturnPChar , 514 );
  CloseFile( TheMessageFile );
  Result := TotalGotten;
end;

{ This method Gets all the Article Listings for a newsgroup which have not been  }
{ Downloaded and gets them into text files. It displays Article count, # & bytes }
{ in the status line during the process.                                         }
function TPOP3SMTPComponent.DownloadAllMessageListings(
  TheEMBRecord : PEMailMailBoxRecord ) : Boolean;
var WorkingList   : TList;
    TheEMMRecord  : PEMailMessageRecord;
    Counter_1 : Integer;
    WorkingID ,
    WorkingNumber : Integer;
    WorkingFileName : String;
    BytesToGet : Longint;
    TotalMessages : Integer;
    WorkingSL : TStringList;
    BytesGotten : Longint;
begin
  Result := true;
  TotalMessages := CheckAllNewMail( BytesToGet );
  if TotalMessages < 0 then exit;
  if TotalMessages = 0 then
  begin
    MessageDlg( 'No New Mail!' , mtInformation, [mbOK],0);
    exit;
  end;
  with TheEMBRecord^ do
  begin
    WorkingID := MBIDNumber;
    WorkingNumber := MBMaxMsgNumber;
    WorkingList := TList( MBLTag );
    WorkingSL := TStringList.Create;
    for Counter_1 := 1 to TotalMessages do
    begin
      New( TheEMMRecord );
      WorkingNumber := WorkingNumber + 1;
      with TheEMMRecord^ do
      begin
        WorkingFileName := 'EM' + IntToStr( WorkingNumber );
        if Length( WorkingFileName ) > 8 then WorkingFileName :=
         Copy( WorkingFileName , 1 , 8 );
        WorkingFileName := WorkingFileName + '.' +
         IntToStr( WorkingID );
        MRFileName := WorkingFileName;
        WorkingFileName := MailPath + '\' + WorkingFileName;
        BytesGotten := DownloadMessageListing( Counter_1 , WorkingFileName , WorkingSL );
        if EMRemoteDeletionVector = 2 then DeleteMailItem( Counter_1 );
        UpdateGauge( BytesGotten , BytesToGet );
        MRMailBoxName      := MBName;
        MRMessageSubject   := GetHeaderSubject( WorkingSL );
        MRMessageRecipient := GetHeaderRecipient( WorkingSL );
        MRMessageSender    := GetHeaderSender( WorkingSL );
        MRCarbonCopy       := GetHeaderCarbons( WorkingSL );
        MRBlindCarbonCopy  := GetHeaderBlindCarbons( WorkingSL );
        MRDateTime         := GetHeaderDateTime( WorkingSL );
        MRRead             := false;
        MRSent             := false;
        MRFileName         := ExtractFileName( WorkingFileName );
        WorkingList.Add( TheEMMRecord );
      end;
    end;
    UpdateGauge( BytesToGet , BytesToGet );
    MBLTag := Longint( WorkingList );
    MBMaxMsgNumber := WorkingNumber;
    MBTotal       := MBTotal + TotalMessages;
    MBUnReadTotal := MBUnReadTotal + TotalMessages;
    Result := true;
  end;
end;

{ This method sends a message via RCPT and DATA commands (assumes HELO and }
{ and MAIL already sent via EstablishSMTPConnection.)                      }
function TPOP3SMTPComponent.UploadMessageListing(
          TheEMMRecord : PEmailMessageRecord ): Boolean;
var WorkingString   : String;
    WorkingFile     : TextFile;
    TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  with TheEMMRecord^ do
  begin
    MRSent := true;
    MRRead := true;
    WorkingString := MailPath + '\' + MRFileName;
    try
      AssignFile( WorkingFile , WorkingString );
      Reset( WorkingFile );
    except
      MessageDlg( 'Unable to Send due to open error on '
       + Workingstring + '!' , mtError , [mbok],0 );
      Result := false;
      exit;
    end;
    if MRMessageRecipient <> '' then
    begin
      TheReturnString :=
       DoCStyleFormat( 'RCPT %s' ,
        [ MRMessageRecipient ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
      SMTPCommandInProgress := false;
      { Begin login sequence with user name }
      TheResult := PerformSMTPCommand( 'RCPT %s', [ MRMessageRecipient ] );
      if TheResult <> TCPIP_STATUS_PRELIMINARY then
      begin
        SMTPCommandInProgress := false;
        Result := false;
        exit;
      end;
      repeat
        TheResult := GetSMTPServerResponse( TheReturnString );
        { Put result in progress and status line }
        AddProgressText( TheReturnString );
        ShowProgressText( TheReturnString + #13#10 );
      until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    end;
    if MRCarbonCopy <> 'CC:<>' then
    begin
      TheReturnString :=
       DoCStyleFormat( 'RCPT %s' ,
        [ MRCarbonCopy ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
      { Begin login sequence with user name }
      SMTPCommandInProgress := false;
      TheResult := PerformSMTPCommand( 'RCPT %s', [ MRCarbonCopy ] );
      if TheResult <> TCPIP_STATUS_PRELIMINARY then
      begin
        SMTPCommandInProgress := false;
        Result := false;
        exit;
      end;
      repeat
        TheResult := GetSMTPServerResponse( TheReturnString );
        { Put result in progress and status line }
        AddProgressText( TheReturnString );
        ShowProgressText( TheReturnString + #13#10 );
      until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    end;
    if MRBlindCarbonCopy <> 'BCC:<>' then
    begin
      TheReturnString :=
       DoCStyleFormat( 'RCPT %s' ,
        [ MRBlindCarbonCopy ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
      { Begin login sequence with user name }
      SMTPCommandInProgress := false;
      TheResult := PerformSMTPCommand( 'RCPT %s' , [ MRBlindCarbonCopy ] );
      if TheResult <> TCPIP_STATUS_PRELIMINARY then
      begin
        SMTPCommandInProgress := false;
        Result := false;
        exit;
      end;
      repeat
        TheResult := GetSMTPServerResponse( TheReturnString );
        { Put result in progress and status line }
        AddProgressText( TheReturnString );
        ShowProgressText( TheReturnString + #13#10 );
      until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    end;
    TheReturnString :=
     DoCStyleFormat( 'DATA' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString );
    { Begin login sequence with user name }
    SMTPCommandInProgress := false;
    TheResult := PerformSMTPCommand( 'DATA' , [ nil ] );
    if TheResult <> TCPIP_STATUS_PRELIMINARY then
    begin
      SMTPCommandInProgress := false;
      Result := false;
      exit;
    end;
    repeat
      TheResult := GetSMTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString + #13#10 );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    repeat
      SMTPCommandInProgress := false;
      ReadLn( WorkingFile , WorkingString );
      if WorkingString[ 1 ] = '.' then WorkingString := '.' + WorkingString;
      TheResult := PerformSMTPCommand( WorkingString , [ nil ] );
      if TheResult <> TCPIP_STATUS_PRELIMINARY then
      begin
        SMTPCommandInProgress := false;
        Result := false;
        exit;
      end;
    until EOF( WorkingFile );
    CloseFile( WorkingFile );
    SMTPCommandInProgress := false;
    TheResult := PerformSMTPCommand( '.' , [ nil ] );
    if TheResult <> TCPIP_STATUS_PRELIMINARY then
    begin
      SMTPCommandInProgress := false;
      Result := false;
      exit;
    end;
    repeat
      TheResult := GetSMTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString  + #13#10 );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    Result := true;
  end;
end;

procedure TPOP3SMTPComponent.ExtractHeaderInfoFromMemo(
           TheMemo : TMemo; TheEMMRecord : PEMailMessageRecord );
var Counter_1    : Integer;
    Finished     : Boolean;
    TheWorkingSL : TStringList;
begin
  Counter_1 := 0;
  Finished := false;
  TheWorkingSL := TStringList.Create;
  while not Finished do
  begin
    if TheMemo.Lines[ Counter_1 ] = '' then
    begin
      Finished := true;
    end
    else
    begin
      TheWorkingSL.Add( TheMemo.Lines[ Counter_1 ] );
      Inc( Counter_1 );
    end;
  end;
  with TheEMMRecord^ do
  begin
    MRMessageSubject   := GetHeaderSubject( TheWorkingSL );
    MRMessageRecipient := GetRCPTHeaderRecipient( TheWorkingSL );
    MRMessageSender    := 'CIUPKC158';
    MRCarbonCopy       := GetRCPTHeaderCarbons( TheWorkingSL );
    MRBlindCarbonCopy  := GetRCPTHeaderBlindCarbons( TheWorkingSL );
    MRDateTime         := GetHeaderDateTime( TheWorkingSL );
  end;
  TheWorkingSL.Free;
end;

{ This method takes an entire Newsgroup and scans for SENDER = CIUPKC158 and }
{ if that article has not been posted posts it. (Used by queue system.)      }
function TPOP3SMTPComponent.UploadAllMessageListings( PCRPointer : PConnectionsRecord;
          TheEMBRecord : PEMailMailBoxRecord ) : Boolean;
var WorkingList : TList;
    Counter_1   : Integer;
    WorkingEMMRecord : PEMailMessageRecord;
    TheReturnString  : String;
begin
  Result := true;
  with TheEMBRecord^ do
  begin
    WorkingList := TList( MBLTag );
    for Counter_1 := 0 to WorkingList.Count - 1 do
    begin
      WorkingEMMRecord :=
       PEMailMessageRecord( WorkingList.Items[ Counter_1 ] );
      with WorkingEMMRecord^ do
      begin
        if MRMessageSender = 'CIUPKC158' then
        begin
          if not MRSent then
          begin
            SMTPCommandInProgress := false;
            SendMail( PCRPointer );
            UploadMessageListing( WorkingEMMRecord );
            Dec( MBUnSentTotal );
          end;
        end;
      end;
    end;
    MBLTag := Longint( WorkingList );
  end;
  TheReturnString := 'Message(s) Uploaded!';
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString + #13#10 );
end;

{ This sends FTP progress text to the Inet form }
procedure TPOP3SMTPComponent.ShowProgressErrorText( WhatText : String );
begin
 CCInetCCForm.ShowProgressErrorText( WhatText );
end;

{ This is a core function! It performs an FTP command and if no timeout }
{ return a preliminary ok.                                              }
function TPOP3SMTPComponent.PerformPOP3Command(
                 TheCommand        : string;
           const TheArguments      : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if POP3CommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  POP3CommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This is a core function! It performs an FTP command and if no timeout }
{ return a preliminary ok.                                              }
function TPOP3SMTPComponent.PerformSMTPCommand(
                 TheCommand        : string;
           const TheArguments      : array of const ) : Integer;
var TheBuffer : string; { Text buffer }
begin
  { If command in progress send back -1 error }
  if SMTPCommandInProgress then
  begin
    Result := -1;
    exit;
  end;
  { Set status variable }
  SMTPCommandInProgress := True;
  { Set global error code }
  GlobalErrorCode := 0;
  { Format output string }
  TheBuffer := Format( TheCommand , TheArguments );
  { Preset failure code }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { If invalid socket or no connection abort }
  if ( Socket1.TheSocket = INVALID_SOCKET ) or not Connection_Established then
   exit;
  { Send the buffer plus EOL chars }
  Socket1.StringData := TheBuffer + #13#10;
  { if abort due to timeout or other error exit }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
  { Otherwise return preliminary code }
  Result := TCPIP_STATUS_PRELIMINARY;
end;

{ This function gets up to 255 chars of data plus a return code from FTP serv }
function TPOP3SMTPComponent.GetPOP3ServerResponse(
          var ResponseString : String ) : integer;
var
  { Buffer string for response line }
  TheBuffer     : string;
  { Pointer to the response string }
  BufferPointer : array[0..255] of char absolute TheBuffer;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  repeat
    { Do a peek }
    TheBuffer := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , TheBuffer );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , TheBuffer );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , TheBuffer );
        if TheIndex = 0 then
        begin
          TheIndex := Length( TheBuffer );
          LeftoversInPan := True;
          LeftoverText := LeftoverText + TheBuffer;
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 1 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ 0 ] := Chr( TheLength );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        ResponseString := LeftoverText + TheBuffer;
        TheBuffer := ResponseString;
        LeftoverText := '';
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end;
      { Get first number character }
      ResponseChar := TheBuffer[ 1 ];
      { Get the value of the number from 1 to 5 }
      if (( ResponseChar = '+' ) or ( ResponseChar = '-' )) then
      begin
        Finished := true;
        if ResponseChar = '+' then Result := TCPIP_STATUS_COMPLETED
         else Result := TCPIP_STATUS_FATAL_ERROR;
      end;
    end
    else
    begin
    end;
  until ( Finished and ( not LeftoversOnTable ));
  { Return buffer as response string }
  ResponseString := TheBuffer;
  ResponseString := Copy( ResponseString , 1, Length( ResponseString ) - 2 );
end;

{ This function gets up to 255 chars of data plus a return code from FTP serv }
function TPOP3SMTPComponent.GetSMTPServerResponse(
          var ResponseString : String ) : integer;
var
  { Buffer string for response line }
  TheBuffer     : string;
  { Pointer to the response string }
  BufferPointer : array[0..255] of char absolute TheBuffer;
  { Character to check for response code }
  ResponseChar   : char;
  { Pointers into returned string }
  TheIndex ,
  TheLength     : integer;
  { Control variable }
  LeftoversInPan ,
  Finished      : Boolean;
begin
  { Preset fatal error }
  Result := TCPIP_STATUS_FATAL_ERROR;
  { Start loop control }
  LeftoversInPan := false;
  Finished := false;
  repeat
    { Do a peek }
    TheBuffer := Socket1.PeekData;
    { If timeout or other error exit }
    if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
    { Find end of line character }
    TheIndex := Pos( #10 , TheBuffer );
    if TheIndex = 0 then
    begin
      TheIndex := Pos( #13 , TheBuffer );
      if TheIndex = 0 then
      begin
        TheIndex := Pos( #0 , TheBuffer );
        if TheIndex = 0 then
        begin
          TheIndex := Length( TheBuffer );
          LeftoversInPan := True;
          LeftoverText := LeftoverText + TheBuffer;
          LeftoversOnTable := false;
        end;
      end;
    end;
    { If an end of line then process the line }
    if TheIndex > 0 then
    begin
      { Get length of string }
      TheLength := TheIndex;
      { Receive actual data }
      Socket1.CCSockReceive( Socket1.TheSocket   ,
                             @BufferPointer[ 1 ] ,
                             TheLength              );
      { Abort if timeout or error }
      if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 )) then exit;
      { Put in the length byte }
      BufferPointer[ 0 ] := Chr( TheLength );
      if LeftOversOnTable then
      begin
        LeftOversOnTable := false;
        ResponseString := LeftoverText + TheBuffer;
        TheBuffer := ResponseString;
        LeftoverText := '';
      end;
      if LeftoversInPan then
      begin
        LeftoversInPan := false;
        LeftoversOnTable := true;
      end;
      { Get first number character }
      ResponseChar := TheBuffer[ 1 ];
      { Get the value of the number from 1 to 5 }
      if (( ResponseChar >= '1' ) and ( ResponseChar <= '5' )) then
      begin
        if TheBuffer[ 4 ] = '-' then
        begin
          Finished := true;
          Result := TCPIP_STATUS_PRELIMINARY;
        end
        else
        begin
          Finished := true;
          Result := Ord( ResponseChar ) - 48;
        end;
      end;
    end
    else
    begin
    end;
  until ( Finished and ( not LeftoversOnTable ));
  { Return buffer as response string }
  ResponseString := TheBuffer;
  ResponseString := Copy( ResponseString , 1, Length( ResponseString ) - 2 );
end;


{ Boilerplate error routine }
procedure TPOP3SMTPComponent.POP3SMTPSocketsErrorOccurred( Sender     : TObject;
                                                 ErrorCode  : Integer;
                                                 TheMessage : String   );
begin
  CCInetCCForm.SocketsErrorOccurred( Sender,ErrorCode,TheMessage );
end;

{ This is the POP3SMTP components POP3 initial connection routine }
function TPOP3SMTPComponent.EstablishPOP3Connection(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  { Set default FTP Port value }
  Socket1.PortName := '110';
  { Get the ip address from the record }
  Socket1.IPAddressName := PCRPointer^.CIPAddress;
  { Set blocking mode }
  Socket1.AsynchMode := False;
  { Clear condition variables }
  GlobalErrorCode := 0;
  GlobalAbortedFlag := false;
  { Actually attempt to connect }
  Socket1.CCSockConnect;
  { Check if connected }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
      ( Socket1.TheSocket = INVALID_SOCKET )) then
  begin { Didn't connect; signal error and abort }
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'POP3 Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else
  begin
    Connection_Established := true;
    { Signal successful connection }
    TheReturnString := DoCStyleFormat(
      'Connected on Local port: %s with IP: %s',
      [ Socket1.GetSocketPort( Socket1.TheSocket ),
        Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat(
     'Connected to Remote port: %s with IP: %s',
      [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
        Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
     [ Socket1.IPAddressName ]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    repeat
      TheResult := GetPOP3ServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'POP3 Host %s Connection Failed!' ,
        [ PCRPointer^.CIPAddress ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This is the POP3SMTP components SMTP initial connection routine }
function TPOP3SMTPComponent.EstablishSMTPConnection(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  { Set default FTP Port value }
  Socket1.PortName := '25';
  { Get the ip address from the record }
  Socket1.IPAddressName := PCRPointer^.CIPAddress;
  { Set blocking mode }
  Socket1.AsynchMode := False;
  { Clear condition variables }
  GlobalErrorCode := 0;
  GlobalAbortedFlag := false;
  { Actually attempt to connect }
  Socket1.CCSockConnect;
  { Check if connected }
  if (( GlobalAbortedFlag ) or ( GlobalErrorCode <> 0 ) or
      ( Socket1.TheSocket = INVALID_SOCKET )) then
  begin { Didn't connect; signal error and abort }
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'SMTP Host %s Connection Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else
  begin
    Connection_Established := true;
    { Signal successful connection }
    TheReturnString := DoCStyleFormat(
      'Connected on Local port: %s with IP: %s',
      [ Socket1.GetSocketPort( Socket1.TheSocket ),
        Socket1.GetSocketIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat(
     'Connected to Remote port: %s with IP: %s',
      [ Socket1.GetSocketPeerPort( Socket1.TheSocket ),
        Socket1.GetSocketPeerIPAddress( Socket1.TheSocket )]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    TheReturnString := DoCStyleFormat( 'Successfully connected to %s',
     [ Socket1.IPAddressName ]);
    { Put result in progress and status line }
    CCINetCCForm.AddProgressText( TheReturnString );
    CCINetCCForm.ShowProgressText( TheReturnString );
    repeat
      TheResult := GetSMTPServerResponse( TheReturnString );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressText( TheReturnString + #13#10 );
    until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
    if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
    begin
      { Do clever C formatting trick }
      TheReturnString :=
       DoCStyleFormat( 'SMTP Host %s Connection Failed!' ,
        [ PCRPointer^.CIPAddress ] );
      { Put result in progress and status line }
      AddProgressText( TheReturnString );
      ShowProgressErrorText( TheReturnString );
      { Signal error }
      Result := False;
      { leave }
      exit;
    end
    else Result := true; { Signal no problem }
  end;
end;

{ This sends FTP progress text to the Inet form }
procedure TPOP3SMTPComponent.AddProgressText( WhatText : String );
begin
  CCInetCCForm.AddProgressText( WhatText );
end;

{ This sends FTP progress text to the Inet form }
procedure TPOP3SMTPComponent.ShowProgressText( WhatText : String );
begin
  CCInetCCForm.ShowProgressText( WhatText );
end;

{ This is a clever c-style formatting trick }
function TPOP3SMTPComponent.DoCStyleFormat(
                TheText      : string;
          const TheArguments : array of const ) : String;
begin
  Result := Format( TheText , TheArguments ) + #13#10;
end;

{ This is the FTP components USER login routine }
function TPOP3SMTPComponent.LoginUser(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'USER %s' ,
    [ PCRPointer^.CUserName ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformPOP3Command( 'USER %s',
                                  [ PCRPointer^.CUserName ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    POP3CommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'POP3 Host %s Login Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components USER login routine }
function TPOP3SMTPComponent.SendHelo(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'HELO %s' ,
    [ Socket1.GetSocketIPAddress( Socket1.TheSocket ) ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformSMTPCommand( 'HELO %s',
                [ Socket1.GetSocketIPAddress( Socket1.TheSocket ) ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    POP3CommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetSMTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  SMTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'SMTP Host %s Login Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components USER login routine }
function TPOP3SMTPComponent.SendMail(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'MAIL FROM:<%s>' ,
    [ PCRPointer^.CStartDir ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  TheResult := PerformSMTPCommand( 'MAIL FROM:<%s>',
                                  [ PCRPointer^.CStartDir ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    SMTPCommandInProgress := false;
    Result := false;
    exit;
  end;
  repeat
    TheResult := GetSMTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  SMTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'SMTP Host %s Login Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP components PASSWORD routine }
function TPOP3SMTPComponent.SendPassword(
          PCRPointer : PConnectionsRecord ) : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString := 'PASS XXXXXX' + #13#10;
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Send Password sequence }
  TheResult := PerformPOP3Command( 'PASS %s',
                                  [ PCRPointer^.CPassword ] );
  if TheResult <> TCPIP_STATUS_PRELIMINARY then
  begin
    Result := false;
    POP3CommandInProgress := false;
    exit;
  end;
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'POP3 Host %s Login Failed!' ,
      [ PCRPointer^.CIPAddress ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the FTP component constructor; it creates 2 sockets }
constructor TPOP3SMTPComponent.Create( AOwner : TComponent );
begin
  { do inherited create }
  inherited Create( AOwner );
  { Create sockets, put in their parents, and error procs }
  Socket1 := TCCSocket.Create( Self );
  Socket1.Parent := Self;
  Socket1.OnErrorOccurred := POP3SMTPSocketsErrorOccurred;
  { Set up booleans }
  Connection_Established := false;
  POP3CommandInProgress := false;
  SMTPCommandInProgress := false;
end;

{ This is the FTP component destructor; it frees 2 sockets }
destructor TPOP3SMTPComponent.Destroy;
begin
  { Free the sockets }
  Socket1.Free;
  { and call inherited }
  inherited Destroy;
end;

{ This is the POP3 components QUIT routine }
function TPOP3SMTPComponent.POP3Disconnect : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'QUIT' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  PerformPOP3Command( 'QUIT', [ nil ] );
  repeat
    TheResult := GetPOP3ServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  POP3CommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'EMail Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

{ This is the POP3 components QUIT routine }
function TPOP3SMTPComponent.SMTPDisconnect : Boolean;
var TheReturnString : String;  { Internal string holder }
    TheResult       : Integer; { Internal int holder    }
begin
  TheReturnString :=
   DoCStyleFormat( 'QUIT' ,
    [ nil ] );
  { Put result in progress and status line }
  AddProgressText( TheReturnString );
  ShowProgressText( TheReturnString );
  { Begin login sequence with user name }
  PerformSMTPCommand( 'QUIT', [ nil ] );
  repeat
    TheResult := GetSMTPServerResponse( TheReturnString );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressText( TheReturnString + #13#10 );
  until (( GlobalAbortedFlag ) or ( TheResult <> TCPIP_STATUS_PRELIMINARY ));
  SMTPCommandInProgress := false;
  if ( GlobalAbortedFlag or ( TheResult <> TCPIP_STATUS_COMPLETED )) then
  begin
    { Do clever C formatting trick }
    TheReturnString :=
     DoCStyleFormat( 'EMail Host Connection Failed!' ,
      [ nil ] );
    { Put result in progress and status line }
    AddProgressText( TheReturnString );
    ShowProgressErrorText( TheReturnString );
    { Signal error }
    Result := False;
    { leave }
    exit;
  end
  else Result := true; { Signal no problem }
end;

procedure TPOP3SMTPComponent.UpdateGauge( BytesFinished , TotalToHandle : longint );
begin
  CCInetCCForm.UpdateMailGauge( BytesFinished , TotalToHandle );
end;

end.