sl_server.pas

三層源碼,DELPHI寫的三層源碼,三層源碼,

unit sl_server;

interface

uses
  Windows, Messages, SysUtils, Classes, ComServ, ComObj, VCLCom,databkr,
  DBClient, slserver_TLB, StdVcl, Provider, Db, ADODB;

type
  Tslsvr = class(TRemoteDataModule, Islsvr)
    ado1: TADOConnection;
    Queryer: TADOQuery;
    sldata: TDataSetProvider;
    procedure RemoteDataModuleCreate(Sender: TObject);
    procedure RemoteDataModuleDestroy(Sender: TObject);
    function sldataDataRequest(Sender: TObject;
      Input: OleVariant): OleVariant;
  private
      lasterrormsger,
      authority,
      loginuser,
      md5_user: string;
      operationresult: boolean;
    {----------开启数据库-----------}
    procedure opendatabase;
    procedure openunknow;
    { Private declarations }
  protected
    class procedure UpdateRegistry(Register: Boolean; const ClassID, ProgID: string); override;
    function Get_getserverdate: TDateTime; safecall;
    function Get_getoperation: WordBool; safecall;
    function Get_lasterrormsg: WideString; safecall;
   //---------------------------------------------------------------------------
    procedure user_model(const funid, params: WideString); safecall;
    procedure dept_model(const funid, params: WideString); safecall;
    procedure Parchives_model(const funid, params: WideString); safecall;
    procedure dormitory_model(const funid, params: WideString); safecall;
    procedure event_model(const funid, params: WideString); safecall;
    procedure sysother_model(const funid, params: WideString); safecall;
    procedure cess_model(const funid, params: WideString); safecall;
    procedure medicare_model(const funid, params: WideString); safecall;
    procedure insurance_model(const funid, params: WideString); safecall;
    procedure incometax_model(const funid, params: WideString); safecall;
  public
    { Public declarations }
  end;

implementation

uses shareunit,userfun,deptfun,Parchives,dormitory,
     event,cess,medicare,sysother,insurance,incometax;

{$R *.DFM}

class procedure Tslsvr.UpdateRegistry(Register: Boolean; const ClassID, ProgID: string);
begin
  if Register then
  begin
    inherited UpdateRegistry(Register, ClassID, ProgID);
    EnableSocketTransport(ClassID);
    EnableWebTransport(ClassID);
  end else
  begin
    DisableSocketTransport(ClassID);
    DisableWebTransport(ClassID);
    inherited UpdateRegistry(Register, ClassID, ProgID);
  end;
end;

// 开启数据库连接...

procedure Tslsvr.opendatabase;
var DBConnectionString: string;
begin
////  connection to ACCESS
  DBConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;'
    + 'Password="";Data Source=%s;'
    + 'Persist Security Info=True';
  ado1.ConnectionString := Format(DBConnectionString,
    [datapath + 'salary.mdb']);  

//// connection to MY Sql
/// DBConnectionString:='Provider=MSDASQL.1;Persist Security Info=False;Data Source=salary';
//  ado1.ConnectionString :=DBConnectionString;
  try
    ado1.LoginPrompt := false;
    ado1.connected := true;
  finally
    ado1.connected := false;
  end;

end;

procedure Tslsvr.openunknow;
begin
queryer.Close;
queryer.SQL.clear;
queryer.Parameters.Clear;
queryer.SQL.add('select 1 as 没有权限查看该列表 from system where 1<>1');
queryer.open;
end;

//******************************************************************************
//客户端查询数据处理过程
//******************************************************************************
function Tslsvr.sldataDataRequest(Sender: TObject;
  Input: OleVariant): OleVariant;
var params:widestring;
    comid,funid:string;
begin
try
openunknow;
params:=input;
funid:=getparamitem(params,'funid');
comid:=getparamitem(params,'operid');
case strtointdef(comid,Query_unknow) of

    Query_user:   //帐号管理
      begin
      if check_authority_user(funid,authority) then
         Query_userinfo(params,queryer);
      end;

    Query_dept:  //部门工种管理
      begin
      if check_authority_dept(funid,authority) then
         Query_deptinfo(params,queryer);
      end;

    Query_Parchives:   //员工管理
      begin
      if check_authority_Parchives(funid,authority) then
         Query_Parchivesinfo(params,queryer);
      end;

    Query_dormitory: //宿舍管理
      begin
      if check_authority_dormitory(funid,authority) then
         Query_dormitoryinfo(md5_user,params,queryer);
      end;

    Query_event:  //事件提醒
      begin
      if check_authority_event(funid,authority) then
         Query_eventinfo(params,queryer);
      end;

    Query_cess:  //税率表
      begin
      if check_authority_cess(funid,authority) then
         Query_cessinfo(params,queryer);
      end;

    Query_medicare: //医疗保险
      begin
      if check_authority_medicare(funid,authority) then
         Query_medicareinfo(params,queryer);
      end;

    Query_insurance:  //养老保险
      begin
      if check_authority_insurance(funid,authority) then
         Query_insuranceinfo(params,queryer);
      end;

    Query_incometax:  //个人所得税
      begin
      if check_authority_incometax(funid,authority) then
         Query_incometaxinfo(params,queryer);
      end;

    Query_sysother:
      begin
         Query_sysotherinfo(params,queryer);
      end;

    Query_unknow:logmemo.Add('错误的消息格式...');
  else logmemo.add('未知的消息ID');
end;

finally
result:=sldata.data;
queryer.Close;
end;
end;

//******************************************************************************
//系统相关
//******************************************************************************

procedure Tslsvr.RemoteDataModuleCreate(Sender: TObject);
begin
  operationresult := false;
  lasterrormsger := '错误:未知的错误';
  clientsum := clientsum + 1;
  opendatabase;
end;

procedure Tslsvr.RemoteDataModuleDestroy(Sender: TObject);
begin
clientsum := clientsum - 1;
logmemo.add('用户:' + loginuser + '已经断开连接.');
if clientsum = 0 then
    begin
    deltempdata(ado1);
    CompactAndRepair;
    end;
end;
//******************************************************************************
//系统相关
//******************************************************************************
function Tslsvr.Get_getserverdate: TDateTime;
begin
  result := date;
end;

function Tslsvr.Get_getoperation: WordBool;
begin
  result := operationresult;
end;

function Tslsvr.Get_lasterrormsg: WideString;
begin
  logmemo.add(timetostr(time) + '操作日志>' + lasterrormsger);
  result := lasterrormsger;
  lasterrormsger := '错误:未知的错误';
end;

//******************************************************************************