dbmain.pas

详细说明:毕业论文中关于小型宾馆管理系统的详细设计毕 业论文中关于小型宾馆...一个酒店管理系统VB+Access [学生学籍管理系统(VB+Acess).zip] - !这个是刚刚编的毕业设计,可能

unit DBmain;

interface

uses
 ActiveX, MtsObj, Mtx, ComObj, AxCtrls, Classes, StdVcl,
  Sysutils,registry,
  dialogs,Prefs,
  Forms,Windows, Messages,  Graphics, Controls,
  StdCtrls, ExtCtrls, Buttons,  ComCtrls, DbTables, CheckLst,
  inifiles,ADODB,db,utils,dbinfo,dbfuncs,log,vafuncs,wpfuncs;

type
  Tsup = class(TDataModule)
private
    { Private declarations }



  public
    procedure Initialize;
    function connectDB:boolean;
    function LoginCheck(username,password:string):boolean;
    procedure WriteReg(key,value:string);
    function RetErr(err_codeval:integer;err_msgval:string):integer;
    function CheckVar(const row:variant):variant;
    procedure valtoval(const flag,table,infield,outfield:string;
         instrval:string;inintval:integer; out outstrval:string;out outintval:integer);
    //
    function PS_Login(const username, password: WideString): WordBool;
      safecall;
    function PS_Logout: WordBool; safecall;
    function PS_LastError: WideString; safecall;

    function PS_Is_Admin: WordBool; safecall;
    function PS_Get_Groups(const groupname: WideString): OleVariant; safecall;
    function PS_NewKey(max_length: Integer): WideString; safecall;
    function PS_Ins_Groups(const groupname, groupdes: WideString): Integer;
      safecall;
    function PS_Del_Groups(const groupname: WideString): Integer; safecall;
    function PS_Mod_Groups(const groupname, groupdes,
      oldgroupname: WideString): Integer; safecall;
    function PS_Ins_Logs(const c_type, c_source,
      c_description: WideString): Integer; safecall;
    function PS_Get_Logs(const c_type, c_source: WideString): OleVariant;
      safecall;
    function PS_Del_Logs(const condit: WideString): Integer; safecall;
    function PS_Get_Users(const username: WideString): OleVariant; safecall;
    function PS_Ins_Users(const username, description, password,
      email: WideString; pwdday: Integer; const rights,
      status: WideString): Integer; safecall;
    function PS_valStrToStr(const table, infield, outfield,
      invalue: WideString): WideString; safecall;
    function PS_valStrToInt(const table, infield, outfield,
      invalue: WideString): Integer; safecall;
    function PS_valInttoint(const table, infield, outfield: WideString;
      invalue: Integer): Integer; safecall;
    function PS_strInToOut(const table, infield, outfield,
      invalue: WideString): OleVariant; safecall;
    function PS_intIntoOut(const table, infield, outfield: WideString;
      invalue: Integer): OleVariant; safecall;
    function PS_Del_User(const username: WideString): Integer; safecall;
    function PS_valIntTostr(const table, infield, outfield: WideString;
      invalue: Integer): WideString; safecall;
    function PS_ChangePwd(const username, oldPassword,
      password: WideString): Integer; safecall;
    function PS_Mod_Users(ole: OleVariant): Integer; safecall;
    function PS_CheckUser(const username: WideString;
      out flag: WideString): Integer; safecall;
    function PS_Ins_UserGrp(const username, groupname: WideString): Integer;
      safecall;
    function PS_Get_UserGrp(const username, groupname: WideString): OleVariant;
      safecall;
    function PS_Del_UserGrp(const username, groupname: WideString): Integer;
      safecall;
    function PS_MaxVal(const tablename, intfield: WideString): Widestring;
      safecall;
    function PS_CheckExistStrVar(const table, field,
      val: WideString): WordBool; safecall;
    function PS_Username: WideString; safecall;
    function PS_UserAccGroup(const username, groupname: WideString): WordBool;
             safecall;
    procedure PS_LastErrorSet(Errorcode: Integer; const ErrMsg: WideString);
      safecall;
    function PS_Ins_UserPolicy(const username, policy: WideString): Integer;
      safecall;
    function PS_Del_UserPolicy(const username, policy: WideString): Integer;
      safecall;
    function PS_Get_UserPolicy(const username, policy: WideString): OleVariant;
      safecall;
    function PS_Get_Policy(const policy: WideString): OleVariant; safecall;
    function PS_CheckUserRights(const username, policy: WideString): WordBool;
      safecall;
    function PS_CheckExists2Val(const table, field1, field2, field3, val1,
      val2, val3: WideString): WordBool; safecall;
    function PS_ErrCode: WideString; safecall;
    function PB_Ins_Roles(const role_name, role_des:STRING): Integer; safecall;
    function PB_Get_Roles(const role_name:string): OleVariant;
      safecall;
    function PB_Del_Roles(const role_name: WideString): Integer; safecall;
    function PB_Mod_Roles(ole: OleVariant): Integer; safecall;
    procedure PB_StartTrans; safecall;
    procedure PB_Commit; safecall;
    procedure PB_Rollback; safecall;
    function PB_GetValFromTab(const table, outfield,
      sql_where: WideString): WideString; safecall;
    function PB_Execsql(SQL:string): BOOLEAN;
    function PS_WillExpire: WordBool;
    function PS_Get_HW(sqlwhere: WideString): OleVariant;
    function PS_Del_HW(id: WideString;hw:boolean): Integer;
    //function PS_Ins_HW(id,pm,gg:widestring;sl,je:widestring): Integer;
    function PS_ins_hw(ole:olevariant;count:integer):integer;
    function PS_Mod_HW(c_hw_id,pm,gg:widestring;sl,je:widestring): Integer;
    function CheckUser(username,password:string):string;
    function PS_Ins_rp(ole:olevariant):integer;
    function PS_Del_rp(id:string):integer;
    function PS_mod_rp(ole:olevariant):integer;
    function PS_Get_rp(sqlwhere:widestring):Olevariant;
    function PS_SP_RP(flag:integer;id,username,mem:widestring):integer;
    function PS_Get_Je(id:widestring):widestring;
    function PB_GetColRecordsA(oleArray: OleVariant; col: Integer): OleVariant;
    function PB_GetRowRecordsA(olearray: OleVariant;
                    row: Integer): OleVariant;
    function PS_Ins_Rphw(ole,ole2:olevariant;count:integer):integer;
    function PB_EmptyHis: WordBool;

    function PS_Ins_Mes(const c_from, c_to,
      c_mes: WideString): Integer; safecall;
    function PS_Get_Mes(const sql: WideString): OleVariant;
      safecall;
    function PS_Del_Mes(const condit: WideString): Integer; safecall;
    function PS_Get_Mes_ext(const sql:widestring;var from:widestring;var id:widestring): WideString;
    function PS_Mod_Mes(const id:Widestring):integer;safecall;



  protected
    //
  end;
var
  sup: Tsup;
  bConnected:Boolean;
  sUsername,sPwd,sID:string;
  bAdmin:boolean;
  err_Msg:wideString;
  err_Code:integer;
  t_connection: TPodmsConnection;
  bExpire:boolean;
implementation

{$R *.DFM}
function Tsup.RetErr(err_codeval:integer;err_msgval:string):integer;
begin
  Err_code:=err_codeval;
  err_msg:=err_msgval;
  Result:=Err_code;
end;
// Check value
// =============================================================================
function Tsup.CheckVar(const row:variant):variant;
begin
    if not VarIsNull(row) then  result:=row
    else result:=NULL;
end;
procedure Tsup.WriteReg(key,value:string);
var
  Reg: TRegistry;
begin

  if key ='' then exit;
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.OpenKey(key, True) then begin
       Reg.WriteString(key,value);
    end;

  finally
    Reg.CloseKey;
    Reg.Free;
    //inherited;
  end;
end;
// Connect to Database
// =============================================================================
function Tsup.connectDB:boolean;
begin

     // Destroy any existing connections
     if t_connection<>nil then t_connection.Free;
     t_connection:=nil;

     // Create database connection
     try
               t_connection:=TPodmsConnection.CreateADO('','',
               g_Prefs.PREFS_DBUSERNAME, g_Prefs.PREFS_DBPASSWORD,
               g_Prefs.PREFS_DBSERVER, g_Prefs.PREFS_DBDBName,true);

     except on E:Exception do begin
            RetErr(ER_EXCEPT,'数据库连接错误: '+e.message);
            Result:=false;
            Exit;
        end;
     end;

     // Try and login to database
     try
        t_Connection.Open;
     except on E:Exception do begin
           RetErr(ER_EXCEPT,'数据库打开错误:'+e.message);
           Result:=false;
           Exit;
        end;
     end;

     // Success
     Result:=true;


end;
// login check
// =============================================================================
function Tsup.LoginCheck(username,password:string):boolean;
var
  use_password:Widestring;
  l_password,l_username:WideString;
  sRights,sStatus:string;
  dtTo,dtPwd:TDateTime;
  dtExpire:integer;
  q: TPodmsQuery;

begin

      // Init
      bAdmin:=false;

     if username='' then begin
       Result:=false;
       Exit;
     end;

     q:=nil;
     // Create query object
     q:=TPodmsQuery.Create(t_connection);
     if q=nil then begin
        // Error creating query object
        Result:=false;
        Exit;
     end;

     // Construct SQL statement
     try

        q.SQLAdd('Select * From '+CSI_SECU_USER);
        q.SQLAdd(' where C_USER_LOGID=:vname');
        q.ParamString('vname',username);
        q.Open;
        if Q.RecordCount=0 then begin
             RetErr(-3,'没有记录.');
             result:=False;
             Exit;
        end;

        // Get results
        if not q.EOF then begin

           l_username   := q.StringFieldByName('C_USER_NAME');
           l_Password   := q.StringFieldByName('C_USER_PWD');
           sRights      := q.StringFieldByName('C_RIGHTS');
           sStatus      := q.StringFieldByName('C_USER_STATUS');
           dtPwd        := q.DateTimeFieldByName('D_PASSWORD_DATE');
           dtExpire     := q.IntegerFieldByName('D_EXPIRED_DATE');

           // Check User status and rights
           // C_USER_STATUS D-DISABLED A-ACTIVE C-CREATED P-PEDING*/
           // RIGTHS A-ADMIN M-MANAGE N-NULL B -BOTH*/
           if sStatus <>'A' then begin
                    if sStatus = 'D' then begin
                       RetErr(ER_SECU_USER_DISABLED,'这个用户已被禁止.');
                       Result:=false;
                       Exit;
                    end;
                    if sStatus = 'P' then begin
                       RetErr(ER_SECU_USER_PENDING,'这个用户被暂时停止使用.');
                       Result:=false;
                       Exit;
                    end;

            end;

            // Check Expired

            if dtExpire<>0 then begin
            // Password will be expired?
               dtTo:=dtPwd+dtExpire-1;
               if dtTo < now then begin
                  bExpire:=true;
               end;

               dtTo:=dtPwd+dtExpire;
               if dtTo < now then begin
                    RetErr(ER_SECU_USER_EXPIRE,'用户密码已过期,请联系系统管理员.');
                    Result:=false;
                    Exit;
               end;
            end;

             // Check rights
             if sRights='A' then bAdmin:=True else
                bADMIN:=FALSE;



                   use_password := Utils.Decrypt(l_password);
                    // Cehck password
                   if l_password='' then begin
                        if l_password<>password then begin

                                RetErr(ER_SECU_USER_BADPASSWORD,'密码不合适.');
                                Result := false;
                                //tbUsers.Close;
                                Exit;
                        end;
                   end else if use_password <> password   then begin
                       RetErr(ER_SECU_USER_BADPASSWORD,'密码不合适.');
                       Result := false;
                       //tbUsers.Close;
                       Exit;
               end;



        end;
     except on E:Exception do begin
           // Exception raised on SQL statement
           RetErr(-3,'检查登陆错误.');
           Result:=false;
           Exit;
        end;
     end;

     sUsername:=l_username;
     // Close query and exit
     try
       CloseNewQuery(q);
    
     except
       err_Code:=-3;
       err_Msg:='关闭查询错误.';
     end;
     Result:=true;


end;
function Tsup.CheckUser(username,password:string):string;
var
  q: TPodmsQuery;
  l_username,l_password:string;
use_password:string;
begin

     if username='' then begin
       Result:='';
       Exit;
     end;

     q:=nil;
     // Create query object
     q:=TPodmsQuery.Create(t_connection);
     if q=nil then begin
        // Error creating query object
        Result:='';
        Exit;
     end;

     // Construct SQL statement
     try

        q.SQLAdd('Select * From '+CSI_SECU_USER);
        q.SQLAdd(' where C_USER_LOGID=:vname');
        q.ParamString('vname',username);
        q.Open;
        if Q.RecordCount=0 then begin
             result:='';
             Exit;
        end;

        // Get results
        if not q.EOF then begin

           l_username   := q.StringFieldByName('C_USER_NAME');
           l_Password   := q.StringFieldByName('C_USER_PWD');

           use_password := Utils.Decrypt(l_password);
           // Cehck password
            if l_password='' then begin
                   if l_password<>password then begin
                                Result := '';
                                Exit;
                        end;
           end else if use_password <> password   then begin
                       Result := '';
                       Exit;
           end;
        end;
     except on E:Exception do begin
           // Exception raised on SQL statement