nmsmtp.pas

DELPHI里面一些常用的控件

      if not FAbort then
        ReplyMess := Transaction(Cons_Date);
      if ReplyNumber > 399 then
        raise Exception.Create(ReplyMess);
      Write(FFinalHeader.Text + CRLF);
      SendStream(FSendFile);
      ReplyMess := Transaction(CRLF + '.');
      if ReplyNumber > 399 then
      begin
        if Assigned(FOnFailure) then
          FOnFailure(self);
        raise Exception.Create(ReplyMess);
      end
      else
        Done := TRUE;
      if FAbort then
        ReplyMess := Transaction(CRLF + Cons_Rset);
      if FClearParams then
        ClearParameters;
    finally
      FTransactionInProgress := FALSE;
      if Done then
        if Assigned(FOnSuccess) then
          FOnSuccess(self);
    end;
  end;
end;

procedure TNMSMTP.AssembleMail;
var
  i: integer;
  Tstr: string;
begin
  FFinalHeader.clear;
  FFinalHeader.add(Cons_Head_from + FPostMessage.FFromName + '<' + FPostMessage.FFrom + '>');
  for i := 1 to FPostMessage.FTo.count do
  begin

    if (i = 1) then
      Tstr := Cons_Head_To + StripCRLF(FPostMessage.FTo.strings[0])
    else
      Tstr := Tstr + ',' + StripCRLF(FPostMessage.FTo.strings[i - 1]);
    if (i = FPostMessage.FTo.count) then
      FFinalHeader.add(Tstr);
  end;
  for i := 1 to FPostMessage.FCC.count do
  begin
    if (i = 1) then
      Tstr := Cons_Head_CC + StripCRLF(FPostMessage.FCC.strings[0])
    else
      Tstr := Tstr + ',' + StripCRLF(FPostMessage.FCC.strings[i - 1]);
    if (i = FPostMessage.FCC.count) then
      FFinalHeader.add(Tstr);
  end;
  FFinalHeader.values[Cons_Head_subj] := FPostMessage.FSubject;
  FFinalHeader.values[Cons_Head_mail] := FPostMessage.FLocalProgram;
  if (FPostMessage.FReplyTo <> '') then
    FFinalHeader.values[Cons_Head_ReplyTo] := FPostMessage.FReplyTo;
  if (FPostMessage.FDate <> '') then
    FFinalHeader.values[Cons_Head_Date] := FPostMessage.FDate;
  FFinalHeader.add(Cons_Head_mime);
  if (FPostMessage.FAttachments.count = 0) then
  begin
    case FSubType of
      mtEnriched: FFinalHeader.add(Cons_Head_Enriched + FCharset);
      mtSgml: FFinalHeader.add(Cons_Head_Sgml + FCharset);
      mtTabSeperated: FFinalHeader.add(Cons_Head_TabSeperated + FCharset);
      mtHtml: FFinalHeader.add(Cons_Head_mtHtml + FCharset);
    else
      FFinalHeader.add(Cons_Head_text + FCharset);
    end;
      {FFinalHeader.add(Cons_Head_7Bit);    }
  end
  else
  begin
    FBoundary := '====================54535' + TimeToStr(mailcount) + '====';
    inc(mailcount);
    FFinalHeader.add(Cons_Head_mult + FBoundary + '"');
  end;
  (*  {$IfDef NMF3}
       FSendFile.Flushbuffer;
   {$ELSE}    *)
  FSendFile.clear;
  // {$ENDIF}
  try
    if (FPostMessage.FAttachments.count = 0) then
      for i := 1 to FPostMessage.FBody.count do
      begin
        Tstr := FPostMessage.FBody[i - 1] + CRLF;
        if Tstr[1] = '.' then
          Tstr := '.' + Tstr;
        FSendFile.Write(Tstr[1], Length(Tstr));
      end
    else
    begin
      Tstr := '--' + FBoundary + CRLF + Cons_Head_text + FCharset + CRLF + CRLF;
      FSendFile.Write(Tstr[1], Length(Tstr));
      for i := 1 to FPostMessage.FBody.count do
      begin
        Tstr := FPostMessage.FBody[i - 1] + CRLF;
        if Tstr[1] = '.' then
          Tstr := '.' + Tstr;
        FSendFile.Write(Tstr[1], Length(Tstr));
      end;

      for i := 1 to FPostMessage.FAttachments.count do
        SendAttachments(i);
      Tstr := '--' + FBoundary + '--' + CRLF;
      FSendFile.Write(Tstr[1], Length(Tstr));
    end;
    FSendFile.Position := 0;
  finally
    {FSendFile.free; }
  end;
end;

{
function TNMSMTP.CreateTemporaryFileName: string;
var
  nBufferLength: DWord;
  lpPathName, lpTempFileName: PChar;
begin
  Result := '';
  lpPathName := nil;
  lpTempFileName := nil;

  // first get the length of the tempory path
  nBufferLength := GetTempPath( 0, lpPathName );
  Win32Check( BOOL( nBufferLength ) );
  // Allocate a buffer of the specified length + 1
  lpPathName := AllocMem( nBufferLength );
  try
    // Get the tempory path
    Win32Check( BOOL( GetTempPath( nBufferLength, lpPathName ) ) );
    // Increase the tempory path to hold the file name also.
    lpTempFileName := AllocMem( 256 );
    try
      // Get the temporary file name
      Win32Check( BOOL( GetTempFileName( lpPathName, PChar( 'Buf' ), 0, lpTempFileName ) ) );
      // return the file name and path
      SetString( Result, lpTempFileName, StrLen( lpTempFileName ) );
      // Lastly free the buffers.
    finally
      FreeMem( lpPathName );
    end;
  finally
    FreeMem( lpTempFileName );
  end;
  if Result = '' then
    raise Exception.Create( 'Can''t create a temporary file' );
end;
}

{*******************************************************************************************
SendAttachments - Sends attachched file to server.
********************************************************************************************}

procedure TNMSMTP.SendAttachments;
var
  UUPROC: TNMUUProcessor;
  Tstr: string;
  //  SFileS: TFileStream;
  SfileF: TFileStream;
begin
  Tstr := '--' + FBoundary + CRLF;
  Tstr := Tstr + Cons_Head_appl + ExtractFileName(FPostMessage.FAttachments[i - 1]) + '"' + CRLF;
  Tstr := Tstr + Cons_Head_ba64 + CRLF;
  Tstr := Tstr + Cons_Head_disp + ExtractFileName(FPostMessage.FAttachments[i - 1]) + '"';
  Tstr := Tstr + CRLF + CRLF;
  FSendFile.Write(Tstr[1], Length(Tstr));
  //SfileS := nil;
  UUPROC := nil;
  try
    UUPROC := TNMUUProcessor.Create(self);
    //    Tstr := CreateTemporaryFileName;
    //    SFileS := TFileStream.create(Tstr, fmCreate);
    UUPROC.method := EncodeType;
    SfileF := TFileStream.Create(FPostMessage.FAttachments[i - 1], fmOpenRead);
    UUPROC.InPutStream := SfileF;
    UUPROC.OutPutStream := FSendFile;
    //    uuproc.OutPutStream := SFileS;
    if Assigned(OnEncodeStart) then
      OnEncodeStart(FPostMessage.FAttachments[i - 1]);
    try
      UUPROC.encode;
    except
      on E: EFOpenError do
      begin
        if Assigned(OnAttachmentNotFound) then
          OnAttachmentNotFound(FPostMessage.FAttachments[i - 1]);
        raise;
      end;
    end;

    if Assigned(OnEncodeEnd) then
      OnEncodeEnd(FPostMessage.FAttachments[i - 1]);
    try
      //SFileS.position := 0;
      //FSendFile.CopyFrom(SFileS, SFileS.size);
    finally
      //SFileA.Free;
      SfileF.free;
    end;
  finally
    //SysUtils.DeleteFile( Tstr );
    FSendFile.Position := FSendFile.Size;
    Tstr := CRLF;
    FSendFile.Write(Tstr[1], Length(Tstr));
    //SfileS.Free;
    UUPROC.free
  end;
end;

{*******************************************************************************************
Process Extra Lines in Transaction
********************************************************************************************}

procedure TNMSMTP.ReadExtraLines;
begin
  while (ReplyMess[1] = ' ') or (ReplyMess[4] = '-') do {If extra Lines}
    ReplyMess := Readln;
end;

{*******************************************************************************************
Verify
********************************************************************************************}

function TNMSMTP.Verify(UserName: string): boolean;
var
  ReplyMess: string;
begin
  CertifyConnect;
  ReplyMess := Transaction(Cons_Vrfy + UserName);
  if ReplyNumber > 251 then Result := FALSE else Result := TRUE;
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TNMSMTP.Abort;
begin
  inherited Abort;
  (*if (not BeenCanceled) and Connected then
  begin
     if FTransactionInProgress then
     begin
        Cancel;
     end
     else
     begin
        inherited Disconnect;
        TMemoryStream(FIstream).clear;
     end;
  end;    *)
end;

procedure TNMSMTP.AbortResume(Sender: TObject);
begin
  inherited Disconnect;
  ClearInput;
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

function TNMSMTP.ExpandList(MailList: string): boolean;
var
  ReplyMess: string;
begin
  Result := FALSE;
  if not FTransactionInProgress then
  begin
    FTransactionInProgress := TRUE;
    try
      CertifyConnect;
      ReplyMess := Transaction(Cons_Expn + MailList);
      if ReplyNumber > 399 then
        Result := FALSE
      else
      begin
        Result := TRUE;
        if Assigned(OnMailListReturn) then
          OnMailListReturn(ReplyMess);
        ReadExtraLines(ReplyMess);
      end;
    finally
      FTransactionInProgress := TRUE;
    end;
  end;
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

function TNMSMTP.ExtractAddress(TotalAddress: string): string;
begin
  if Pos('<', TotalAddress) > 0 then
    Result := NthWord(NthWord(TotalAddress, '<', 2), '>', 1)
  else if Pos(':', TotalAddress) > 0 then
    Result := NthWord(TotalAddress, ':', 2)
  else
    Result := TotalAddress;
end;

procedure TNMSMTP.SetFinalHeader(Value: TExStringList);
begin
  FFinalHeader.assign(Value);
end;

{*******************************************************************************************
Constructor - Create String Lists to hold body, attachment list and distribution lists.
Sets Default port and clears Transaction in Progress flag.
********************************************************************************************}

constructor TPostMessage.Create;
begin
  inherited Create;
  FTo := TStringList.Create;
  FCC := TStringList.Create;
  FBCC := TStringList.Create;
  FBody := TStringList.Create;
  FAttachments := TStringList.Create;

end;

{*******************************************************************************************
Constructor - Destroys String Lists holding body, attachment list and distribution lists.
********************************************************************************************}

destructor TPostMessage.Destroy;
begin
  FTo.free;
  FCC.free;
  FBCC.free;
  FAttachments.free;
  FBody.free;
  inherited Destroy;
end;

{*******************************************************************************************
ClearParameters - Clears distribution lists and Attachments.
********************************************************************************************}

procedure TNMSMTP.ClearParameters;
begin
  FPostMessage.FTo.clear;
  FPostMessage.FCC.clear;
  FPostMessage.FBCC.clear;
  FPostMessage.FAttachments.clear;
end;
{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TPostMessage.SetLinesTo(Value: TStringList);
begin
  FTo.assign(Value);
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TPostMessage.SetLinesCC(Value: TStringList);
begin
  FCC.assign(Value);
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TPostMessage.SetLinesBCC(Value: TStringList);
begin
  FBCC.assign(Value);
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TPostMessage.SetLinesBody(Value: TStringList);
begin
  FBody.assign(Value);
end;

{*******************************************************************************************
Aborts a transaction
********************************************************************************************}

procedure TPostMessage.SetLinesAttachments(Value: TStringList);
begin
  FAttachments.assign(Value);
end;

end.