unitdatamodule.pas

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

+                                                                              +
--------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
+                      start       用户  详细信息                              +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
+                      end       用户  详细信息                                +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}
//获得用户列表
function TUnitDataModule1.GetUserIDAndNameInDomain(ADomain:string):string;
var
  MyList:TstringList;
begin
  MyList:=TstringList.Create;
  try
    result:='';
    with  Cli_Userdetail do
    begin
      Close;
      CommandText:='select USERID,USERIDNAME from USERINFO_VIEW where DOMAINNAME='''+ADomain+'''';
      Open;
    end;
    with DS_Userdetail.DataSet do
    begin
      while  Eof=false do
      begin
        MyList.Add(Fields[0].asstring);
        MyList.Add(Fields[1].asstring);
        Next;
      end;
    end;
    result:=MyList.Text;
  finally
    MyList.free;
  end;
end;

function TUnitDataModule1.GetUsersTetailInfoInDomain(ADomainName:string):string;
var
  MyUserList,MyDetail:TStringList;
  i:integer;
  MyStr:string;
begin
  MyUserList:=TStringList.Create;
  MyDetail:=TStringList.Create;
  try
    MyUserList.Text:=GetUserIDAndNameInDomain(ADomainName);
    i:=0;
    while i<MyUserList.Count do
    begin
      MyStr:=MyUserList.Strings[i]+','+
             MyUserList.Strings[i+1]+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'0','1')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'0','3')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'0','4')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'0','5')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'1','1')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'1','2')+','+
             GetOneuserInfoInBox(MyUserList.Strings[i],'1','3');
      MyDetail.Add(MyStr);
      i:=i+2;
    end;
    result:=MyDetail.text;
  finally
    MyDetail.Free;
    MyUserList.Free;
  end;
end;

function TUnitDataModule1.GetOneuserInfoInBox(AUserID,ARelyState,AMailBox:string):string;
var
  MyStr,
  SizeStr,
  MySql:string;
begin
  try
    if ARelyState='0' then
    begin
      MyStr:='RECEIVEMAILPROPERTY';
    end
    else begin
      MyStr:='REPLYMAILPROPERTY';
    end;
    MySql:='select count(*),sum(MAILSIZE) from '+MyStr+' where USERID='''+AUserID+''' and  MAILBOX='''+AMailBox+''' group by MAILBOX ';
    with  Cli_Userdetail do
    begin
      Close;
      CommandText:=MySql;
      Open;
    end;
    with DS_Userdetail.DataSet do
    begin
      if  Eof=false then
      begin
        SizeStr:=fields[1].AsString;
        SizeStr:=floattostr(strtoint(SizeStr) / 1024) ;
        if pos('.',SizeStr)<>0 then
          SizeStr:=copy(SizeStr,1,pos('.',SizeStr)+3);
        result:=fields[0].AsString+'封/('+SizeStr+'kb)';
      end
      else begin
        result:='0封/(0kb)';
      end;
    end;
  finally
  end;
end;

{-------------------------------------------------------------------------------
+                      start      清理系统                                     +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}
procedure TUnitDataModule1.CleanDeletedMailRecord;
begin
  try
    with Cli_Clean do
    begin
      Close;
      CommandText:='delete from RECEIVEMAILPROPERTY where MAILBOX=''4''';
      Execute;
    end;
  finally
  end;
end;

procedure TUnitDataModule1.CleanRelyedMailRecord;
begin
  try
    with Cli_Clean do
    begin
      Close;
      CommandText:='delete from REPLYMAILPROPERTY where MAILBOX=''2''';
      Execute;
    end;
  finally
  end;
end;

procedure TUnitDataModule1.CleanFailedMailRecord;
begin
  try
    with Cli_Clean do
    begin
      Close;
      CommandText:='delete from REPLYMAILPROPERTY where MAILBOX=''3''';
      Execute;
    end;
  finally
  end;
end;
{-------------------------------------------------------------------------------
+                      end      清理系统                                       +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
+                      start 登录                                              +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}
//登录
function  TUnitDataModule1.NowLogin(AStr:string):boolean;
begin
  try
    with  DCOMConnection1 do
    begin
      Connected:=false;
      ComputerName:=AStr;
      Connected:=true;
    end;
    result:=true;
  except
    result:=false;
  end;
end;

//检查密码
function  TUnitDataModule1.CheckPass(APass:string):boolean;
begin
  result:=false;
  try
    with Cli_Pass do
    begin
      Close;
      CommandText:='select * from SYSMANAGER';
      Open;
    end;

    with DS_Pass.DataSet do
    begin
      if eof=false then
      begin
        if Fields[0].AsString=APass then
        begin
          result:=true;
        end;
      end;
    end;
  except
    on e:exception do showmessage(e.Message);
  end;
end;

//设置密码
function  TUnitDataModule1.SetPassword(AStr:string):boolean;
begin
  result:=false;
  try
    with Cli_Pass do
    begin
      Close;
      CommandText:='update SYSMANAGER set PASSWORD='''+AStr+'''';
      Execute;
    end;
    result:=true;
  except
  end;
end;
{-------------------------------------------------------------------------------
+                      end   登录                                              +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}

{-------------------------------------------------------------------------------
+                      start   查看用户邮件                                    +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}
//获取用户列表
function  TUnitDataModule1.GetUserListInOneDomain(ADomain:string):string;
var
  MyList:TStringList;
begin
  MyList:=TStringList.Create;
  try
    result:='';
    with Cli_RUMail do
    begin
      Close;
      CommandText:='select USERID,USERIDNAME from USERINFO_VIEW where DOMAINNAME='''+ADomain+'''';
      open;
    end;
    with DS_RUMail.DataSet do
    begin
      while eof=false do
      begin
         MyList.Add(Fields[0].AsString);
         MyList.Add(Fields[1].AsString);
         next;
      end;
    end;
    Cli_RUMail.Close;
    result:=MyList.Text;
  finally
    MyList.Free;
  end;
end;


//获取邮件
procedure TUnitDataModule1.GetMailInBOX(AUserID,ARelyState,AMailBox:string);
var
  MySql:string;
begin
  try
    with Cli_RUMail do
    begin
      Close;
      if ARelyState='0' then
      begin
        MySql:='select MAILID ,MAILFROM,SUBJECT,MAILDATE,MAILSIZE from RECEIVEMAILPROPERTY where MAILBOX=';
      end
      else begin
        MySql:='select MAILID ,RCPTTO,SUBJECT,MAILDATE,MAILSIZE from REPLYMAILPROPERTY where MAILBOX=';
      end;
      MySql:=MySql+AMailBox+' and USERID='''+AUserID+'''';
      CommandText:=MySql;
      open;
    end;
  finally
  end;
end;

//获取邮件  数量
function TUnitDataModule1.GetMailCountInBOX(AUserID,ARelyState,AMailBox:string):string;
var
  MySql:string;
begin
  try
    with Cli_Domain do
    begin
      Close;
      if ARelyState='0' then
      begin
        MySql:='select count(*) from RECEIVEMAILPROPERTY where MAILBOX=';
      end
      else begin
        MySql:='select count(*) from REPLYMAILPROPERTY where MAILBOX=';
      end;
      MySql:=MySql+AMailBox+' and USERID='''+AUserID+'''';
      CommandText:=MySql;
      open;
    end;
    with DS_Domain.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].AsString;
      end;
    end;
  finally
  end;
end;

//获取邮件大小
function TUnitDataModule1.GetMailTotalSizeInBOX(AUserID,ARelyState,AMailBox:string):string;
var
  MySql:string;
begin
  try
    with Cli_Domain do
    begin
      Close;
      if ARelyState='0' then
      begin
        MySql:='select sum(MAILSIZE) from RECEIVEMAILPROPERTY where MAILBOX=';
      end
      else begin
        MySql:='select sum(MIALSIZE) from REPLYMAILPROPERTY where MAILBOX=';
      end;
      MySql:=MySql+AMailBox+' and USERID='''+AUserID+'''';
      CommandText:=MySql;
      open;
    end;
    with DS_Domain.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].AsString;
      end;
    end;
  finally
  end;
end;


//获得某个域名的用户列表
function TUnitDataModule1.GetUserIDMailName(AUserID:string):String;
begin

  try
    with Cli_Userdetail do
    begin
      Close;
      CommandText:='select USERIDNAME,DOMAINNAME from USERINFO_VIEW where USERID='''+AUserID+'''';
      Open;
    end;
    with DS_Userdetail.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].AsString+'@'+Fields[1].AsString;
      end;
    end;

  finally

  end;
end;

{-------------------------------------------------------------------------------
+                      end     查看用户邮件                                    +
+                                                                              +
+                                                                              +
--------------------------------------------------------------------------------}




procedure TUnitDataModule1.ShowReceiveList(ASql:string);
begin
  try
    with Cli_Receive do
    begin
      close;
      CommandText:=ASql;
      open;
    end;
  except
  end;
end;

function TUnitDataModule1.GetMCountOrSize(ASql:string):string;
begin
  try
    with Cli_Domain do
    begin
      Close;
      CommandText:=ASql;
      open;
    end;
    with DS_Domain.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].AsString;
      end;
    end;
  finally
  end;
end;

procedure TUnitDataModule1.ShowTrashMail;
begin
  try
    Cli_trash.close;
    Cli_trash.CommandText:='select * from TRASHMAIL';
    Cli_trash.Open;
  finally
  end;
end;

function TUnitDataModule1.GetTrashMailTotalCount:string;
var
  MySql:string;
begin
  try
    with Cli_Domain do
    begin
      Close;
      MySql:='select count(*) from TRASHMAIL';
      CommandText:=MySql;
      open;
    end;
    with DS_Domain.DataSet do
    begin
      if  Eof=false then
      begin
        result:=Fields[0].AsString;
      end;
    end;
  finally
  end;
end;


function TUnitDataModule1.InsertTrashMail(AStr:string):boolean;
begin
  try
    Cli_trash.close;
    Cli_trash.CommandText:='insert into TRASHMAIL (MAILADDRESS) values ('''+AStr+''')';
    Cli_trash.Execute;
    result:=true;
  finally
  end;
end;

procedure TUnitDataModule1.DelOneTrashMail;
begin
  try
    DS_trash.DataSet.Delete;
    Cli_trash.ApplyUpdates(0);
  finally
  end;
end;

procedure TUnitDataModule1.ClearAllTrashMail;
begin
  try
    Cli_trash.close;
    Cli_trash.CommandText:='delete from TRASHMAIL ';
    Cli_trash.Execute;
  finally
  end;
end;

end.