mailpas.pas

base64邮箱加密解密源码

unit mailpas;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ExtCtrls, OleCtrls, isp3, Buttons;

type
  TForm1 = class(TForm)
    MailStatusBar: TStatusBar;
    ContentToSend: TRichEdit;
    Label3: TLabel;
    Panel1: TPanel;
    Label2: TLabel;
    Label1: TLabel;
    SendToEdit: TEdit;
    SendEdit: TEdit;
    SendButton: TBitBtn;
    SMTP1: TSMTP;
    Label4: TLabel;
    SubjectEdit: TEdit;
    InputFileName: TEdit;
    Input: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure SMTP1DocInput(Sender: TObject; const DocInput: DocInput);
    procedure SMTP1Error(Sender: TObject; Number: Smallint;
      var Description: WideString; Scode: Integer; const Source,
      HelpFile: WideString; HelpContext: Integer;
      var CancelDisplay: WordBool);
    procedure SMTP1StateChanged(Sender: TObject; State: Smallint);
    procedure SMTP1Verify(Sender: TObject);
    procedure SendButtonClick(Sender: TObject);
  private
    { Private declarations }
//    MailSendOK,
    RecvVerified,
    SMTPError : boolean;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function NoParam: Variant;
begin
  TVarData(Result).VType := varError;
  TVarData(Result).VError := DISP_E_PARAMNOTFOUND;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SMTP1.RemoteHost := '202.38.64.11';
  if SMTP1.State = prcConnected then
    SMTP1.Quit
  else
  if SMTP1.State = prcDisconnected then
    begin
      SMTPError := False;
      SMTP1.Connect(NoParam, NoParam);
   end;
end;

procedure TForm1.SMTP1DocInput(Sender: TObject; const DocInput: DocInput);
begin
  case DocInput.State of
    icDocBegin:
      MailStatusBar.SimpleText := 'Initiating document transfer';
    icDocHeaders:
      MailStatusBar.SimpleText := 'Sending headers';
    icDocData:
      if DocInput.BytesTotal > 0 then
        MailStatusBar.SimpleText := Format('Sending data: %d of %d bytes (%d%%)',
          [Trunc(DocInput.BytesTransferred), Trunc(DocInput.BytesTotal),
           Trunc(DocInput.BytesTransferred/DocInput.BytesTotal*100)])
      else
        MailStatusBar.SimpleText := 'Sending...';
    icDocEnd:
      if SMTPError then
        MailStatusBar.SimpleText := 'Transfer aborted'
      else
        MailStatusBar.SimpleText := Format('Mail sent to %s (%d bytes data)', ['[e-mail]',
          Trunc(DocInput.BytesTransferred)]);
  end;
end;

procedure TForm1.SMTP1Error(Sender: TObject; Number: Smallint;
  var Description: WideString; Scode: Integer; const Source,
  HelpFile: WideString; HelpContext: Integer; var CancelDisplay: WordBool);
var
  I: Integer;
  ErrorStr: string;
begin
  {Get extended error information}
  for I := 1 to SMTP1.Errors.Count do
    ErrorStr := Format(#13'(%s)', [SMTP1.Errors.Item(I).Description]);
  {Display error code, short and long error description}
  MessageDlg(Format('%d - %s%s', [Number, Description, Trim(ErrorStr)]), mtError, [mbOK], 0);
  SMTPError := true;
end;

procedure TForm1.SMTP1StateChanged(Sender: TObject; State: Smallint);
begin
  case State of
    prcConnecting:
      MailStatusBar.SimpleText := 'Connecting to SMTP server: '+SMTP1.RemoteHost+'...';
    prcResolvingHost:
      MailStatusBar.SimpleText := 'Resolving Host';
    prcHostResolved:
      MailStatusBar.SimpleText := 'Host Resolved';
    prcConnected:
      begin
        MailStatusBar.SimpleText := 'Connected to SMTP server: '+SMTP1.RemoteHost;
      end;
    prcDisconnecting:
      MailStatusBar.SimpleText := 'Disconnecting from SMTP server: '+SMTP1.RemoteHost+'...';
    prcDisconnected:
      begin
        MailStatusBar.SimpleText := 'Disconnected from SMTP server: '+SMTP1.RemoteHost;
      end;
   end;
end;

procedure TForm1.SMTP1Verify(Sender: TObject);
begin
  with SMTP1 do
  begin
    DocInput.Headers.Clear;
    DocInput.Headers.Add('To', SendToEdit.Text);
    DocInput.Headers.Add('From', SendEdit.Text);
    DocInput.Headers.Add('CC', ' ');
    DocInput.Headers.Add('Subject', SubjectEdit.Text);
    DocInput.Headers.Add('Message-Id', Format('%s_%s_%s', [Application.Title,
      DateTimeToStr(Now), SendEdit.Text]));
    DocInput.Headers.Add('MIME-Version', '1.0');
    DocInput.Headers.Add('Content-Type', 'audio/wav');
//    DocInput.Headers.Add('Content-Type', 'IMAGE/BMP');
    DocInput.Headers.Add('Content-Transfer-Encoding', 'BASE64');
//    SendDoc(NoParam, DocInput.Headers, SendStr[0], '', '');
    SendDoc(NoParam, DocInput.Headers, ContentToSend.Text, '', '');
    RecvVerified := True;
    end;
end;


procedure TForm1.SendButtonClick(Sender: TObject);
begin
    ContentToSend.Lines.LoadFromFile(PChar(InputFileName.Text));
//    ContentToSend.Lines.LoadFromFile('e:\cxh\mail\rec_ding.wav');
    if(SMTP1.State = prcConnected)and(not(SMTP1.Busy)) then
    begin
    SMTP1.Verify('[e-mail]');
    end;
end;

end.
{
     tmpFileName := 'c:\jxsyscfg.txt';
     if not(FileExists(tmpFileName)) then Close;
     AssignFile(tmpF,tmpFileName);
     Reset(tmpF);
     Readln(tmpF,tmppath);
     Readln(tmpF,tmppath);
     CloseFile(tmpF);

  FileHandle : Integer;
  F: TextFile;
  tmpFileName : string;

  tmpFileName := '$broad2.bat';
  if FileExists(tmpFileName) then
    DeleteFile(tmpFileName);
  FileHandle := FileCreate(tmpFileName);
  FileClose(FileHandle);
  AssignFile(F,tmpFileName);
  Rewrite(F);
  Writeln(F,'at ' + Trim(ComputerLst.Items[i]) + ' ' + Edit_Time.Text +' /interactive ' + tmpexefilename );
  CloseFile(F);
}