frmbroadcast.pas

Mailserver Source code - Delphi. Simple Mail server source code. SMTP and POP3 protocols.

{******************************************************************************)
                             发布消息单元
     程序编写:  钱解锋
     时间: 2002-2-10   ->

     描述:
          1.给每个用户发送邮件



(******************************************************************************}

unit FrmBroadcast;

interface

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

type
  TFrmBroadcast1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Label4: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Edit1: TEdit;
    ListView1: TListView;
    Label1: TLabel;
    memo1: TRichEdit;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    function  CheckTrue:boolean;
    function  GetCheckedDomain:string;
    function  DomainIsChecked:boolean;
    procedure SendBroadCast;
  public
    { Public declarations }
    procedure IniShow;
  end;

var
  FrmBroadcast1: TFrmBroadcast1;

implementation

uses UnitConst, UnitDataModule;

{$R *.dfm}

procedure TFrmBroadcast1.IniShow;
var
  i:integer;
  MyList:TStringList;
  MyItem:TlistItem;
begin
  MyList:=TStringList.Create;
  try
    MyList.Text:=UnitDataModule1.GetDomain;
    listview1.Clear;
    for i:=0 to MyList.Count-1 do
    begin
      MyItem:=listview1.Items.Add;
      MyItem.Checked:=true;
      MyItem.SubItems.Add(MyList.Strings[i]);
    end;
  finally
    MyList.Free;
  end;
end;

//检查错误----------------------------------------------------------------------
function TFrmBroadcast1.CheckTrue:boolean;
begin
  result:=false;
  if DomainIsChecked=false then
  begin
    application.MessageBox('请至少选择一个域名','提示信息',MB_ok or MB_ICONINFORMATION);
    Label1.Font.Color:=clred;
    exit;
  end;
  Label1.Font.Color:=clWindowText;

  if (pos('@',edit1.Text)=0) or (pos('@',edit1.Text)=1) or (pos('@',edit1.Text)=length(edit1.Text)) then
  begin
    application.MessageBox('请输入正确的email','提示信息',MB_ok or MB_ICONINFORMATION);
    Label2.Font.Color:=clred;
    exit;
  end;
  Label2.Font.Color:=clWindowText;

  if trim(edit2.Text)='' then
  begin
    application.MessageBox('请输入标题','提示信息',MB_ok or MB_ICONINFORMATION);
    Label3.Font.Color:=clred;
    exit;
  end;
  Label3.Font.Color:=clWindowText;

  if trim(memo1.Text)='' then
  begin
    application.MessageBox('请输入内容','提示信息',MB_ok or MB_ICONINFORMATION);
    Label4.Font.Color:=clred;
    exit;
  end;
  Label4.Font.Color:=clWindowText;

  result:=true;
end;
//------------------------------------------------------------------------------

//发送广播
procedure TFrmBroadcast1.SendBroadCast;
begin
  if CheckTrue=true then
  begin
    UnitDataModule1.DCOMConnection1.AppServer.BroadCastEmail(GetCheckedDomain,edit1.Text,edit2.Text,memo1.Text);
    application.MessageBox('发送完成。','提示信息',MB_ok or MB_ICONINFORMATION);
  end;
end;

//是否选择了域名
function TFrmBroadcast1.DomainIsChecked:boolean;
var
  i:integer;
begin
  result:=false;
  for i:=0 to listview1.Items.Count-1 do
  begin
    if listview1.Items[i].Checked=true then
      result:=true;
  end;
end;

//获得选择的域名
function TFrmBroadcast1.GetCheckedDomain:string;
var
  MyList:TstringList;
  i:integer;
begin
  MyList:=TstringList.Create;
  try
    for i:=0 to listview1.Items.Count-1 do
    begin
      if listview1.Items[i].Checked=true then
      begin
        MyList.Add(listview1.Items[i].SubItems[0])
      end;
    end;
    result:=MyList.Text;
  finally
    MyList.Free;
  end;
end;

procedure TFrmBroadcast1.SpeedButton2Click(Sender: TObject);
begin
  Edit1.Text:='';
  Edit2.Text:='';
  memo1.Text:='';
end;

procedure TFrmBroadcast1.SpeedButton1Click(Sender: TObject);
begin
  SendBroadCast;
end;

end.