unewmail.pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit uNewMail;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd,
  CompProd, PagItems, SiteProd, WebAdapt, WebComp, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
  MidItems, WebForm;

type
  TNewMail = class(TWebPageModule)
    AdapterPageProducer: TAdapterPageProducer;
    EmailMessage: TAdapter;
    adfFrom: TAdapterField;
    adfTo: TAdapterField;
    adfSubject: TAdapterField;
    adfBody: TAdapterField;
    adaOK: TAdapterAction;
    SMTPEmail: TIdSMTP;
    AdapterForm1: TAdapterForm;
    AdapterFieldGroup1: TAdapterFieldGroup;
    AdapterCommandGroup1: TAdapterCommandGroup;
    CmdadaOK: TAdapterActionButton;
    FldadfFrom: TAdapterDisplayField;
    FldadfTo: TAdapterDisplayField;
    FldadfSubject: TAdapterDisplayField;
    FldadfBody: TAdapterDisplayField;
    procedure adaOKExecute(Sender: TObject; Params: TStrings);
    procedure adfFromGetValue(Sender: TObject; var Value: Variant);
    procedure adfFromGetDisplayText(Sender: TObject; var Value: String);
    procedure adfToGetDisplayText(Sender: TObject; var Value: String);
    procedure adfToGetValue(Sender: TObject; var Value: Variant);
    procedure adfSubjectGetDisplayText(Sender: TObject; var Value: String);
    procedure adfSubjectGetValue(Sender: TObject; var Value: Variant);
    procedure adfBodyGetValue(Sender: TObject; var Value: Variant);
    procedure adfBodyGetDisplayText(Sender: TObject; var Value: String);
  private
    FMSubject: string;
    FMBody: string;
  public
    { Public declarations }
  end;

  function NewMail: TNewMail;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants,uViewMail, home;

function NewMail: TNewMail;
begin
  Result := TNewMail(WebContext.FindModuleClass(TNewMail));
end;

procedure TNewMail.adaOKExecute(Sender: TObject; Params: TStrings);
begin
  FMSubject:=adfSubject.ActionValue.Values[0];
  Session.Values['EmailFrom']:=adfFrom.ActionValue.Values[0];
  hrhome.Session.Values['EmailTo']:=adfTo.ActionValue.Values[0];
  FMBody:=adfBody.ActionValue.Values[0];
  if SMTPEmail.Connected then
    try
      SMTPEmail.Disconnect;
    except
    end;

  SMTPEmail.UserId := hrhome.Session.Values['EmailID'];
  SMTPEmail.Password := hrhome.Session.Values['EmailPassword'];
  SMTPEmail.host :=hrhome.Session.Values['EmailHost'] ;
  try
    SMTPEmail.Connect;
    SMTPEmail.QuickSend('26.29.240.3',FMSubject,
      hrhome.Session.Values['EmailTo'], hrhome.Session.Values['EmailFrom'],FMBody);
  finally
    try
      SMTPEmail.Disconnect;
    except
    end;
  end;
end;

procedure TNewMail.adfFromGetValue(Sender: TObject; var Value: Variant);
begin
  value:=hrhome.Session.Values['EmailFrom'];
end;

procedure TNewMail.adfFromGetDisplayText(Sender: TObject;
  var Value: String);
begin
  value:=hrhome.Session.Values['EmailFrom'];
end;

procedure TNewMail.adfToGetDisplayText(Sender: TObject;
  var Value: String);
begin
  value:=hrhome.Session.Values['EmailTo'];
end;

procedure TNewMail.adfToGetValue(Sender: TObject; var Value: Variant);
begin
  value:=hrhome.Session.Values['EmailTo'];
end;

procedure TNewMail.adfSubjectGetDisplayText(Sender: TObject;
  var Value: String);
begin
  value:=FMSubject;
end;

procedure TNewMail.adfSubjectGetValue(Sender: TObject; var Value: Variant);
begin
  value:=FMSubject;
end;

procedure TNewMail.adfBodyGetValue(Sender: TObject; var Value: Variant);
begin
  value:=FMBody;
end;

procedure TNewMail.adfBodyGetDisplayText(Sender: TObject;
  var Value: String);
begin
  value:=FMBody;
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(TNewMail, TWebPageInfo.Create([wpPublished,wpLoginRequired], '.html', '', '发送邮件'), crOnDemand, caCache));

end.