unitdatamodule.pas

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

unit UnitDataModule;

interface

uses
  SysUtils, Classes, DB, DBClient, MConnect,dialogs, SConnect;

type
  TUnitDataModule1 = class(TDataModule)
    DCOMConnection1: TDCOMConnection;
    Cli_User: TClientDataSet;
    DS_User: TDataSource;
    Cli_Domain: TClientDataSet;
    DS_Domain: TDataSource;
    Cli_Clean: TClientDataSet;
    DS_Clean: TDataSource;
    Cli_Pass: TClientDataSet;
    DS_Pass: TDataSource;
    Cli_RUMail: TClientDataSet;
    DS_RUMail: TDataSource;
    Cli_Receive: TClientDataSet;
    DS_Receive: TDataSource;
    Cli_trash: TClientDataSet;
    DS_trash: TDataSource;
    Cli_Userdetail: TClientDataSet;
    DS_Userdetail: TDataSource;
    Cli_externalUser: TClientDataSet;
    DS_externalUser: TDataSource;
  private
    { Private declarations }
  public
    { Public declarations }
    function ChechkReg:Boolean;    
    {-------------USER------------}
    function  GetUserInfoInDomain(ADomain:string):string;
    function  GetDomain:string;
    function  GetDomainID(ADomainName:string):string;
    function  CheckIsExistsUserID(AUserName,ADOMAINNAME:string):boolean;
    function  CheckIsExistsExternalUserID(UserID:string):boolean;

    function  AddNewUserID(USERIDNAME,APASSWORD,ADOMAINID,AACTIVE,ANAME,AIDCARD,ADEPARTMENT,ATEL,
                              AQUESTION,AANSWER,AMEMO:string):boolean;
    function  AddExternalNewUserID(USERID,DOMAINID,DISPLAY_NAME,
                  POP3_SERVER,SMTP_SERVER,EMAIL_ADDR, EMAIL_PASS, DEFAULT_VAL:string):boolean;
             
    function  GetOneUserInfo(AUserID:string):string;
    function  GetOneExternalUserInfo(USERID:string):string;
    function  ModifyUserInfo(AUSERID,APASSWORD,AACTIVE,ANAME,AIDCARD,ADEPARTMENT,ATEL,
                              AQUESTION,AANSWER,AMEMO:string):boolean;

    function ModifyExternalUserInfo(USERID,DISPLAY_NAME,
                 POP3_SERVER,SMTP_SERVER,EMAIL_ADDR, EMAIL_PASS, DEFAULT_VAL:string):boolean;

    function  DeleteUserID(AUserID:string):boolean;
    function  ReplaceCrlf(AStr,ARepStr:string):string;
    {------------清理系统--------------}
    procedure CleanDeletedMailRecord;
    procedure CleanRelyedMailRecord;
    procedure CleanFailedMailRecord;
    {------------登录----------------}
    function  NowLogin(AStr:string):boolean;
    function  CheckPass(APass:string):boolean;
    function  SetPassword(AStr:string):boolean;
    {-------------查看用户邮件------}
    function  GetUserListInOneDomain(ADomain:string):string;
    procedure GetMailInBOX(AUserID,ARelyState,AMailBox:string);
    function GetMailCountInBOX(AUserID,ARelyState,AMailBox:string):string;
    function GetMailTotalSizeInBOX(AUserID,ARelyState,AMailBox:string):string;
    {-------------显示查询的邮件--}
    function  GetMCountOrSize(ASql:string):string;
    procedure ShowReceiveList(ASql:string);
    function  GetUserIDMailName(AUserID:string):String;
    {-------------显示垃圾邮件--}
    function  GetTrashMailTotalCount:string;
    procedure ShowTrashMail;
    function  InsertTrashMail(AStr:string):boolean;
    procedure ClearAllTrashMail;
    procedure DelOneTrashMail;
    {----------用户详细信息-----}
    function GetOneuserInfoInBox(AUserID,ARelyState,AMailBox:string):string;
    function GetUserIDAndNameInDomain(ADomain:string):string;
    function GetUsersTetailInfoInDomain(ADomainName:string):string;
  end;

var
  UnitDataModule1: TUnitDataModule1;

implementation

uses UnitConst;

{$R *.dfm}

{-------------------------------------------------------------------------------
+                      start       用户                                        +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}

//注册版本
function TUnitDataModule1.ChechkReg:Boolean;
var
  SQL:string;
  I,maxuser:Integer;
begin
  Result :=True;
  try
    with  Cli_User do
    begin
      Close;
      CommandText:='select * from MAILUSER';
      Open;
    end;
    I :=0 ; maxuser :=1;

    DS_User.DataSet.First;
    while  not DS_User.DataSet.Eof do
    begin
      if i>=maxuser then
        begin
         DS_User.DataSet.Delete ;
         Result :=False;
        end;
       inc(i);
     DS_User.DataSet.Next;
    end;
   DS_User.DataSet.Close;
  finally

  end;
end;


//获取域名
function TUnitDataModule1.GetDomain:string;
var
  MyStr:string;
begin
  try
    result:='';
    with  Cli_Domain do
    begin
      Close;
      CommandText:='select * from MAILDOMAIN';
      Open;
    end;
    with DS_Domain.DataSet do
    begin
      while  Eof=false do
      begin
        if Fields[2].asstring='1' then
        begin
          MyStr:=Fields[1].asstring+#13#10+MyStr;
        end
        else begin
          MyStr:=MyStr+Fields[1].asstring+#13#10;
        end;
        Next;
      end;
    end;
    result:=MyStr;
  finally
  end;
end;

//获取域名
function TUnitDataModule1.GetDomainID(ADomainName:string):string;
begin
  try
    with  Cli_Domain do
    begin
      Close;
      CommandText:='select * from MAILDOMAIN where DOMAINNAME='''+ADomainName+'''';
      Open;
    end;
    with DS_Domain.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].asstring;
      end;
    end;
  finally
  end;
end;

//刷新用户数据
function TUnitDataModule1.GetUserInfoInDomain(ADomain:string):string;
var
  MyList:TstringList;
begin
  MyList:=TstringList.Create;
  try
    result:='';
    with  Cli_User do
    begin
      Close;
      CommandText:='select USERID,USERIDNAME,ACTIVE,NAME,DEPARTMENT,CREATETIME,LASTVISITTIME,MEMO from USERINFO_VIEW where DOMAINNAME='''+ADomain+'''';
      Open;
    end;
    with DS_User.DataSet do
    begin
      while  Eof=false do
      begin
        MyList.Add(Fields[0].asstring);
        MyList.Add(Fields[1].asstring);
        MyList.Add(Fields[2].asstring);
        MyList.Add(Fields[3].asstring);
        MyList.Add(Fields[4].asstring);
        MyList.Add(Fields[5].asstring);
        MyList.Add(Fields[6].asstring);
        MyList.Add(ReplaceCrlf(Fields[7].asstring,' '));
        Next;
      end;
    end;
    result:=MyList.Text;
  finally
    MyList.free;
  end;
end;

function TUnitDataModule1.ReplaceCrlf(AStr,ARepStr:string):string;
var
  MyList:TStringList;
  i:integer;
  MyStr:string;
begin
  MyList:=TStringList.Create;
  result:='';
  try
    MyList.Text:=AStr;
    for i:=0 to MyList.Count-1 do
    begin
      MyStr:=MyStr+MyList.Strings[i]+ARepStr;
    end;
    result:=MyStr;
  finally
    MyList.Free;
  end;
end;

//是否存在此用户
function TUnitDataModule1.CheckIsExistsUserID(AUserName,ADOMAINNAME:string):boolean;
begin
  result:=false;
  try
    with Cli_User do
    begin
      Close;
      CommandText:='select count(*) from USERINFO_VIEW where USERIDNAME='''+AUserName+''' and DOMAINNAME='''+ADOMAINNAME+'''';
      Open;
    end;
    if DS_User.DataSet.Fields[0].AsInteger=1 then
      result:=true;
  finally
  end;
end;

//增加用户
function TUnitDataModule1.AddNewUserID(USERIDNAME,APASSWORD,ADOMAINID,AACTIVE,ANAME,AIDCARD,ADEPARTMENT,ATEL,
                              AQUESTION,AANSWER,AMEMO:string):boolean;
var
  MySql:string;
begin
  try
    result:=false;
    Mysql:='insert into MAILUSER (USERIDNAME,PASSWORD,DOMAINID,ACTIVE,NAME,IDCARD,DEPARTMENT,TEL,QUESTION,ANSWER,CREATETIME,LASTVISITTIME,MEMO) values ('''+
           USERIDNAME+''','''+
           APASSWORD+''','''+
           ADOMAINID+''','''+
           AACTIVE+''','''+
           ANAME+''','''+
           AIDCARD+''','''+
           ADEPARTMENT+''','''+
           ATEL+''','''+
           AQUESTION+''','''+
           AANSWER+''',getdate(),getdate(),'''+
           AMEMO+''')';
      with Cli_User do
      begin
        Close;
        CommandText:=Mysql;
        Execute;
      end;
      result:=true;
  finally
  end;
end;

//修改用户数据
function TUnitDataModule1.ModifyUserInfo(AUSERID,APASSWORD,AACTIVE,ANAME,AIDCARD,ADEPARTMENT,ATEL,
                              AQUESTION,AANSWER,AMEMO:string):boolean;
var
  MySql:string;
begin
  result:=false;
  MySql:='update MAILUSER set '+
         'PASSWORD='''+APASSWORD+''','+
         'ACTIVE='''+AACTIVE+''','+
         'NAME='''+ANAME+''','+
         'IDCARD='''+AIDCARD+''','+
         'DEPARTMENT='''+ADEPARTMENT+''','+
         'TEL='''+ATEL+''','+
         'QUESTION='''+AQUESTION+''','+
         'ANSWER='''+AANSWER+''','+
         'MEMO='''+AMEMO+''' where USERID='''+AUSERID+'''' ;
  try
    with Cli_User do
    begin
      Close;
      CommandText:=Mysql;
      Execute;
    end;
    result:=true;
  except
  end;
end;

//获取某个用户的资料
function TUnitDataModule1.GetOneUserInfo(AUserID:string):string;
var
  MyList:TstringList;
begin
  MyList:=TstringList.Create;
  try
    result:='';
    with  Cli_User do
    begin
      Close;
      CommandText:='select USERIDNAME,PASSWORD,ACTIVE,NAME,IDCARD,DEPARTMENT,TEL,QUESTION,ANSWER,MEMO from MAILUSER where USERID='''+AUserID+'''';
      Open;
    end;
    with DS_User.DataSet do
    begin
      if   Eof=false  then
      begin
        MyList.Add(Fields[0].asstring);
        MyList.Add(Fields[1].asstring);
        MyList.Add(Fields[2].asstring);
        MyList.Add(Fields[3].asstring);
        MyList.Add(Fields[4].asstring);
        MyList.Add(Fields[5].asstring);
        MyList.Add(Fields[6].asstring);
        MyList.Add(Fields[7].asstring);
        MyList.Add(Fields[8].asstring);
        MyList.Add(ReplaceCrlf(Fields[9].asstring,'%+%'));
      end;
    end;
    result:=MyList.Text;
  finally
    MyList.free;
  end;
end;

function  TUnitDataModule1.GetOneExternalUserInfo(USERID:String):string;
var
  MyList:TstringList;
begin
  MyList:=TstringList.Create;
  try
    result:='';
    with  Cli_externalUser do
    begin
      Close;
      CommandText:='select DISPLAY_NAME, POP3_SERVER,	SMTP_SERVER,	EMAIL_ADDR,	EMAIL_PASS,	DEFAULT_VAL ' +
                   ' from EXTERNALMAILUSER where USERID='''+USERID+'''';
      Open;
    end;
    with DS_externalUser.DataSet do
    begin
      if  Eof=false  then
      begin
        MyList.Add(Fields[0].asstring);
        MyList.Add(Fields[1].asstring);
        MyList.Add(Fields[2].asstring);
        MyList.Add(Fields[3].asstring);
        MyList.Add(Fields[4].asstring);
        MyList.Add(Fields[5].asstring);
      end;
    end;
    result:=MyList.Text;
  finally
    MyList.free;
  end;
end;

Function TUnitDataModule1.DeleteUserID(AUserID:string):boolean;
begin
  try
    with Cli_User do
    begin
      close;
      CommandText:='delete from MAILUSER  where USERID='''+AUserID+'''';
      Execute;
    end;

    with Cli_externalUser do
    begin
      close;
      CommandText:='delete from EXTERNALMAILUSER  where USERID='''+AUserID+'''';
      Execute;
    end;
    
    result:=true;
  except
    result:=false;
  end;
end;

//是否存在此外部用户
function TUnitDataModule1.CheckIsExistsExternalUserID(UserID:String):boolean;
begin
  result:=false;
  try
    with Cli_externalUser do
    begin
      Close;
      CommandText:='select count(*) from EXTERNALMAILUSER where USERID='''+UserID+'''';
      Open;
    end;
    if DS_externalUser.DataSet.Fields[0].AsInteger>=1 then
      result:=true;
  finally
  end;
end;

//增加外部用户
function TUnitDataModule1.AddExternalNewUserID(USERID,DOMAINID,DISPLAY_NAME,
             POP3_SERVER,SMTP_SERVER,EMAIL_ADDR, EMAIL_PASS, DEFAULT_VAL:string):boolean;
var
  MySql:string;
begin
  try
    result:=false;
    Mysql:='insert into EXTERNALMAILUSER (USERID,DOMAINID,DISPLAY_NAME,'+
            ' POP3_SERVER,SMTP_SERVER,EMAIL_ADDR, EMAIL_PASS, DEFAULT_VAL) values ('''+
            USERID+''','''+
            DOMAINID+''','''+
            DISPLAY_NAME+''','''+
            POP3_SERVER+''','''+
            SMTP_SERVER+''','''+
            EMAIL_ADDR+''','''+
            EMAIL_PASS+''','''+
            DEFAULT_VAL+''')';

    with Cli_externalUser do
    begin
      Close;
      CommandText:=Mysql;
      Execute;
    end;
    result:=true;
  finally
  end;
end;

//修改外部用户数据
function TUnitDataModule1.ModifyExternalUserInfo(USERID,DISPLAY_NAME,
             POP3_SERVER,SMTP_SERVER,EMAIL_ADDR, EMAIL_PASS, DEFAULT_VAL:string):boolean;
var
  MySql:string;
begin
  result:=false;
  MySql:='update EXTERNALMAILUSER set '+
         'DISPLAY_NAME='''+DISPLAY_NAME+''','+
         'POP3_SERVER='''+POP3_SERVER+''','+
         'SMTP_SERVER='''+SMTP_SERVER+''','+
         'EMAIL_ADDR='''+EMAIL_ADDR+''','+
         'EMAIL_PASS='''+EMAIL_PASS+''','+
         'DEFAULT_VAL='''+DEFAULT_VAL+''''+
         ' where USERID='''+USERID+'''';

  try
    with Cli_externalUser do
    begin
      Close;
      CommandText:=Mysql;
      Execute;
    end;
    result:=true;
  except
  end;
end;


{-------------------------------------------------------------------------------
+                      end       用户                                          +
+                                                                              +