⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dmfrm.pas

📁 基于Interbase的图书管理系统
💻 PAS
📖 第 1 页 / 共 3 页
字号:
unit dmfrm;

interface

uses
  SysUtils, Classes, DB, DBTables,Forms,Controls,Dialogs,DateUtils;

type
   //根据不同的权限,分为四种用户:查询用户、普通用户、借书用户、管理员用户
   TRightUser=(ruFind,ruComm,ruBorrow,ruSystem);
   TDMbook = class(TDataModule)
    Dbasebook: TDatabase;
    QryLogin: TQuery;
    DSLogin: TDataSource;
    Qrybigtype: TQuery;
    Qrysmalltype: TQuery;
    Qrybook: TQuery;
    DSbigtyp: TDataSource;
    DSsmalltype: TDataSource;
    DSbook: TDataSource;
    SPbook: TStoredProc;
    SPreader: TStoredProc;
    Qryreader: TQuery;
    DSreader: TDataSource;
    QrybookBOOK_ID: TStringField;
    QrybookBOOK_NAME: TStringField;
    QrybookBOOK_PENSTER: TStringField;
    QrybookBOOK_PRICE: TFloatField;
    QrybookBOOK_NUMBER: TIntegerField;
    QrybookBOOK_DATE: TDateTimeField;
    QrybookBOOK_REMARK: TMemoField;
    QrybookBOOK_PUBLISH: TStringField;
    QrybookBOOK_RESIDE: TIntegerField;
    QrybookBook_borrowed: TIntegerField;
    SPborrow: TStoredProc;
    SPborrowitems: TStoredProc;
    SPborrowhistory: TStoredProc;
    Qryborrow: TQuery;
    SPrenewal: TStoredProc;
    QryRenewal: TQuery;
    SPreturn: TStoredProc;
    SPgoid: TStoredProc;
    QrybookBOOK_PUBDATE: TDateTimeField;
    SPbigtype: TStoredProc;
    SPsmalltype: TStoredProc;
    Qryborrowitems: TQuery;
    QryborrowHistory: TQuery;
    QryReturnHistory: TQuery;
    Qryclosetime: TQuery;
    QryclosetimeBOOK_ID: TStringField;
    QryclosetimeREADER_ID: TStringField;
    QryclosetimeBORROW_TIME: TIntegerField;
    QryclosetimeRENEWAL_TIME: TIntegerField;
    QryclosetimeBORROW_DATE: TDateTimeField;
    QryclosetimeBORROW_DAY: TIntegerField;
    QryclosetimeRENEWAL_DATE: TDateTimeField;
    QryclosetimeRENEWAL_DAY: TIntegerField;
    QryclosetimeRETURN_DATE: TDateTimeField;
    QryclosetimeTIMECLOSE_ID: TIntegerField;
    Qryclosetimepasscount: TIntegerField;
    Qrybooklose: TQuery;
    Qryclear: TQuery;
    Qrymaster: TQuery;
    QrymasterREADER_ID: TStringField;
    QrymasterBORROW_NUMBER: TIntegerField;
    QrymasterBOOK_ID: TStringField;
    QrymasterBOOK_NAME: TStringField;
    QrymasterBORROW_DATE: TDateTimeField;
    QrymasterBORROW_DAY: TIntegerField;
    QrymasterRENEWAL_DATE: TDateTimeField;
    QrymasterRENEWAL_DAY: TIntegerField;
    Qrytypemaster: TQuery;
    QrytypemasterBOOK_BIGTYPE: TStringField;
    QrytypemasterBOOK_BIGNAME: TStringField;
    QrytypemasterBOOK_TYPE: TStringField;
    QrytypemasterBOOK_SMALLNAME: TStringField;
    QryReaderQuit: TQuery;
    QryReaderQuitREADER_NO: TStringField;
    QryReaderQuitREADER_ID: TStringField;
    QryReaderQuitREADER_NAME: TStringField;
    QryReaderQuitREADER_DEPT: TStringField;
    QryReaderQuitREADER_QUITDATE: TDateTimeField;
    QryReaderQuitREADER_DODATE: TDateTimeField;
    USQLbook: TUpdateSQL;
    QryreaderREADER_ID: TStringField;
    QryreaderREADER_NO: TStringField;
    QryreaderREADER_DEPT: TStringField;
    QryreaderREADER_DODATE: TDateTimeField;
    QryreaderREADER_PHOTO: TBlobField;
    QryreaderREADER_NAME: TStringField;
    USQLreader: TUpdateSQL;
    QryStatisticBook: TQuery;
    QryStatisticReader: TQuery;
    QryStatisticBorrow: TQuery;
    dsStatisticBook: TDataSource;
    dsStatisticReader: TDataSource;
    dsStatisticBorrow: TDataSource;
    procedure DbasebookLogin(Database: TDatabase; LoginParams: TStrings);
    procedure QrybookCalcFields(DataSet: TDataSet);
    procedure QryclosetimeCalcFields(DataSet: TDataSet);
  private
    { Private declarations }
  public
      { Public declarations }
    glbBigTypeCount,glbSmallTypeCount,glbBookCount:Integer;
    //login database method
    procedure LocalRemoteParam(LocalRemote:string;var list:tstringlist);
    procedure createAliasName(AaliasName,LocalRemote,Adatatype:string);
    function connectdbase:boolean;
    procedure disconnectdbase;
    function login:boolean;
    procedure logout;
    //right method
    function getUserRight(user:string):TRightUser;
    function getUserRightIndex(Ausername:string):integer;
    function adduser(Ausername:string):boolean;
    function editpassword(Ausername,Auserword:string):boolean;
    function deleteuser(Ausername:string):boolean;
    function setUserRight(Ausername:string;Aindex:integer):boolean;
    //booktype method
    procedure bigtypefirst;
    procedure smalltypefirst;
    procedure openbooktypedb;
    procedure closebooktypedb;
    function getBigtypeList:string;
    function getSmalltypelist(Abigtype:string):string;
    function addbigtype(Abigtype,Abigtypename:string):boolean;
    function addsmalltype(Abigtype,Abooktype,Asmallname:string):boolean;
    function deletebigtype(Abigtype:string):boolean;
    function deletesmalltype(Asmalltype:string):boolean;
    //book mothed
    procedure openbook;
    procedure closebook;
    procedure bookfirst;
    procedure booknext;
    procedure bookprior;
    procedure bookinsert;
    procedure bookedit;
    procedure bookdelete;
    procedure booklast;
    function bookfind(Abook_id:string):boolean;
    procedure bookcancel;
    procedure bookaccept;
    procedure bookpost;
    procedure booksave(Abookid,Abookname,Apenster,Aprice,Aremark,Apublish:string;
Anumber:integer;Adate,Apubdate:Tdatetime);
    procedure bookReside(Abookid:string;Acount:integer);
    function bookISexists(Abook_id:string):boolean;
    //reader mothed;
    procedure openreader;
    procedure closereader;
    procedure readerfirst;
    procedure readernext;
    procedure readerprior;
    procedure readerinsert;
    procedure readeredit;
    procedure readerdelete;
    procedure readerlast;
    function readerfind(Adatefield,Astring:string):boolean;
    procedure readercancel;
    procedure readeraccept;
    procedure readerpost;
    procedure InsertReader(Areaderid,Areaderno,Areadername,Areaderdept,Areaderphoto:string;
    Areaderdodate:Tdatetime);
    function getborrowedreader(Abookid:string):string;
    function ReaderISexists(Areaderid,Areaderno:string):Boolean;
    //borrow mothed;
    procedure openborrow;
    procedure closeborrow;
    procedure borrowfirst;
    function getborrowedbook(Areaderid:string):string;
    function insertborrow(Areaderid:string;Aborrownumber:integer):integer;
    //borrowitems mothed;
   procedure insertborrowitems(Aborrowid,Aborrowday:integer;Abookid,Abookname:string;Aborrowdate:Tdatetime);
procedure getborrowdateday(Areaderid,Abookid:string;var Aborrowdate,Aborrowday,Arenewaldate,Arenewalday:string);
 procedure openBorrowitems;
 procedure closeBorrowitems;
    //borrowhistory mothed;
procedure insertborrowhistory(Areaderid,Abookid,Abookname:string;Aborrowdate:Tdatetime;Aborrowday:integer);
    //renewal book mothed;
procedure renewalfirst;
procedure isrenewaled(Areaderid,Abookid:string;var Atempbool:boolean);
procedure renewalbook(Areaderid,Abookid:string;Arenewaldate:Tdatetime;Arenewalday:integer);
    //date mothed
function passdaymothed(Anow,Athen:Tdatetime;Aday:integer):integer;
function comparedatemothed(A,B:Tdatetime):integer;
procedure returnbook(Areaderid,Abookid:string;Aborrowday,Aborrowpassday,Arenewalday,Arenewalpassday:integer;
 Aborrowdate,Arenewaldate,Areturndate:Tdatetime);
procedure goreaderid(Areaderid: string;var Aresult:boolean);
   //borrowhistory mothed
   procedure openborrowhistory;
   procedure closeborrowhistory;
   //returnhistory mothed
   procedure openReturnHistory;
   procedure closeReturnHistory;
   //closetime mothed
   procedure openClosetime;
   procedure closeClosetime;
   //booklose mothed
   procedure openBooklose;
   procedure closeBooklose;
   //clear datebase mothed
   procedure clearBorrowHistory(Adate:Tdatetime);
   procedure clearReturnHistory(Adate:Tdatetime);
   procedure clearBookLose(Adate:Tdatetime);
   procedure clearReaderQuit(Adate:Tdatetime);
   procedure clearCloseTime(Adate:Tdatetime);
   //qrymaster mothed
   procedure closeQrymaster;
   procedure openQrymaster;
   //qrytypemaster mothed
   procedure closeQryTypemaster;
   procedure openQryTypemaster;
   //qryReaderQuit mothed
   procedure closeQryReaderQuit;
   procedure OpenQryReaderQuit;
   //book or reader mothed
   function IsFirst(Astate:string):boolean;
   function IsLast(Astate:string):boolean;
   procedure CountBookDataFromWhere(Atype,Awhere:string);
   procedure CountAllCount(AString:TStrings);
   procedure CountBigCount(Awhere:string;var AsmalltypeCount,AbigBookcount:string;Astring:TStrings);
   procedure closeCountData;
   procedure CountReaderDataFromWhere(Atype,Awhere:string);
   procedure CountBorrowDataFromWhere(Atype: string; Awhere: Tdatetime);
   procedure CounteachBorrowDataFromWhere(Atype: string; Awhere: string);
 end;
var
  DMbook: TDMbook;
  CurrentUsername:string;//当用户名变量
implementation
uses loginfrm;
{$R *.dfm}
procedure TDMbook.LocalRemoteParam(LocalRemote: string;
  var list: tstringlist);
begin
with list do
 begin
  // showmessage(LocalRemote);
   if LocalRemote='Local' then
      begin
         add('OPEN MODE=READ/WRITE');
         ADD('USER NAME=SYSDBA');
         if not fileexists(extractfilepath(application.ExeName)+'data\books.gdb') then
           begin
          list.Free;
          list:=nil;
          messagedlg('数据库'+extractfilepath(application.ExeName)+'data\books.gdb'+'不存在',mtError,[mbOK],0);
          halt(0);
           end;
         ADD('SERVER NAME='+extractfilepath(application.ExeName)+'data\books.gdb');
      end
   else begin
           //远程数据库设定
        end;
 end;
end;

procedure TDMbook.createAliasName(AaliasName,LocalRemote,Adatatype:string);
var
 list:tstringlist;
begin
  list:=tstringlist.Create;
   try
   Session.ConfigMode:=[cfmPersistent];
   Session.GetAliasNames(list);
   if list.IndexOf(AaliasName)=-1 then
     begin
       list.Clear;
       LocalRemoteParam(LocalRemote,list);
       Session.AddAlias(Aaliasname,Adatatype,list);
       session.SaveConfigFile;
      end;
  finally
   list.Free;
   list:=nil;
  end;
end;

function TDMbook.adduser(Ausername: string): boolean;
begin
 Result:=true;
 Qrylogin.Close;
 Qrylogin.SQL.Clear;
 try
 Qrylogin.SQL.Add('insert into loginright(username,userword) values(:Aname,:Aword);');
 Qrylogin.ParamByName('Aname').AsString:=Ausername;
 Qrylogin.ParamByName('Aword').AsString:=''''+'()*+,-.'; {password:12345678}
 Qrylogin.Prepare;
 Qrylogin.ExecSQL;
 except
  Result:=false;
 end;
end;

function TDMbook.connectdbase: boolean;
begin
Result:=false;
try
 Dbasebook.LoginPrompt:=true;
 Dbasebook.Connected:=true;
 QryLogin.Close;
 QryLogin.SQL.Clear;
 QryLogin.SQL.Add('select * from loginright');
 QryLogin.Active:=true;
 if not assigned(loginform) then
 loginform:=Tloginform.Create(application);
 try
   while not qrylogin.Eof do
         begin
           loginform.cbuser.Items.Add(qrylogin['username']);
           qrylogin.Next;
         end;
   if qrylogin.Locate('username','system',[]) then
    if qrylogin['userword']<>'........' then
        loginform.lbhint.visible:=false
        else loginform.lbhint.visible:=true;
   if loginform.ShowModal=mrOk then
       Result:=true
       else application.Terminate;
  finally
    loginform.Free;
    loginform:=nil;
  end;
except
Messagedlg('数据库未连接上,或者数据服务器未运行!'+#13
+'请运InterBase Server服务器或服务。',mtError,[mbok],0);
  dbasebook.Connected:=false;
  Result:=false;
end;
end;

procedure TDMbook.DbasebookLogin(Database: TDatabase;
  LoginParams: TStrings);
begin
loginparams.Values['USER NAME']:='SYSDBA';
loginparams.Values['PASSWORD']:='masterkey';
end;

function TDMbook.deleteuser(Ausername: string): boolean;
begin
  Result:=true;
 Qrylogin.Close;
 Qrylogin.SQL.Clear;
 try
 Qrylogin.SQL.Add('delete from loginright where username=:Aname');
 Qrylogin.ParamByName('Aname').AsString:=Ausername;
 Qrylogin.Prepare;
 Qrylogin.ExecSQL;
 except
  Result:=false;
 end;
end;

procedure TDMbook.disconnectdbase;
begin
 Dbasebook.Connected:=false;
end;

function TDMbook.editpassword(Ausername,Auserword: string): boolean;
begin
 Result:=true;
 Qrylogin.Close;
 Qrylogin.SQL.Clear;
 try
Qrylogin.SQL.Add('update loginright set userword=:Aword where username=:Aname');
 Qrylogin.ParamByName('Aword').AsString:=Auserword;
 Qrylogin.ParamByName('Aname').AsString:=Ausername;
 Qrylogin.Prepare;
 Qrylogin.ExecSQL;
 except
  Result:=false;
 end;
end;

function TDMbook.setUserRight(Ausername: string;Aindex:integer): boolean;
begin
 Result:=true;
 Qrylogin.Close;
 Qrylogin.SQL.Clear;
try
  if Aindex=0 then
   begin
 Qrylogin.SQL.Add('update loginright set right_a=upper("T"),');
 Qrylogin.SQL.Add('right_b=upper("F"),right_c=upper("F"),right_d=upper("F")');
 Qrylogin.SQL.Add('where username=:Aname');
   end;
 if Aindex=1 then
   begin
 Qrylogin.SQL.Add('update loginright set right_a=upper("F"),');
 Qrylogin.SQL.Add('right_b=upper("T"),right_c=upper("F"),right_d=upper("F")');
 Qrylogin.SQL.Add('where username=:Aname');
   end;
 if Aindex=2 then
      begin
 Qrylogin.SQL.Add('update loginright set right_a=upper("F"),');
 Qrylogin.SQL.Add('right_b=upper("F"),right_c=upper("T"),right_d=upper("F")');
 Qrylogin.SQL.Add('where username=:Aname');
       end;
 if Aindex=3 then
         begin
 Qrylogin.SQL.Add('update loginright set right_a=upper("F"),');
 Qrylogin.SQL.Add('right_b=upper("F"),right_c=upper("F"),right_d=upper("T")');
 Qrylogin.SQL.Add('where username=:Aname');
         end;
 Qrylogin.ParamByName('Aname').AsString:=Ausername;
 Qrylogin.Prepare;
 Qrylogin.ExecSQL;
except
  Result:=false;
 end;
end;

function TDMbook.getUserRight(user: string): TRightUser;
begin
Result:=ruFind;
if user<>'' then qrylogin.Locate('username',user,[]);
if qrylogin['right_a']='T' then Result:=ruFind;
if qrylogin['right_b']='T' then Result:=ruComm;
if qrylogin['right_c']='T' then Result:=ruBorrow;
if qrylogin['right_d']='T' then Result:=ruSystem;
end;

function TDMbook.login: boolean;
begin
  Result:=connectdbase;
end;

procedure TDMbook.logout;
begin
 disconnectdbase;
end;

function TDMbook.getUserRightIndex(Ausername: string): integer;
begin
 Result:=0;
 Qrylogin.Close;
 Qrylogin.SQL.Clear;
try
 Qrylogin.SQL.Add('select * from loginright where username=:Aname');
 Qrylogin.ParamByName('Aname').AsString:=Ausername;
 Qrylogin.Prepare;
 Qrylogin.Open;
 if qrylogin['right_a']='T' then Result:=0;
 if qrylogin['right_b']='T' then Result:=1;
 if qrylogin['right_c']='T' then Result:=2;
 if qrylogin['right_d']='T' then Result:=3;
except
  showmessage('得到用户权限失败!');
end;
end;

procedure TDMbook.openbooktypedb;
begin
  if Qrybigtype.Active=true then Qrybigtype.Close;
  if Qrysmalltype.Active=true then Qrysmalltype.close;
  Qrybigtype.Open;
  glbBigTypeCount:=QryBigType.RecordCount;
  Qrysmalltype.Open;
  glbSmallTypeCount:=QrySmallType.RecordCount; 
end;

procedure TDMbook.closebooktypedb;
begin
 if Qrysmalltype.Active=true then Qrysmalltype.Close;
 if Qrybigtype.Active=true then Qrybigtype.Close;
 qrysmalltype.Filter:=emptystr;
 qrysmalltype.Filtered:=false;
 qrybigtype.Filter:=emptystr;
 qrybigtype.Filtered:=false;  
end;

function TDMbook.getBigtypeList: string;
begin
  Result:=Emptystr;
  openbooktypedb;
  with Qrybigtype do
  begin
  First;
   while not eof do
     begin
     Result:=Result+Qrybigtype['book_bigtype']+'-'+Qrybigtype['book_bigname']+#13#10;
     next;
     end;
  end;
end;

function TDMbook.getSmalltypelist(Abigtype:string): string;
begin
 Result:=Emptystr;
 openbooktypedb;
 with Qrysmalltype do
  begin
   first;
   while not eof do
    begin
     if Qrysmalltype['book_bigtype']=Abigtype then
  Result:=Result+Qrysmalltype['book_type']+'-'+Qrysmalltype['book_smallname']+#13#10;
     next;
    end;
  end;
end;

function TDMbook.addbigtype(Abigtype, Abigtypename: string): boolean;
begin
Result:=true;
 Dbasebook.StartTransaction;
try
  if SPbigtype.Active then SPbigtype.Active:=false;
        SPbigtype.StoredProcName:='INSERT_BOOKBIGTYPE';
        SPbigtype.Prepare;
        SPbigtype.Params[0].AsString:=Abigtype;
        SPbigtype.Params[1].AsString:=Abigtypename;
        SPbigtype.ExecProc;
  Dbasebook.Commit;
except
  Dbasebook.Rollback;
  Result:=false;
end;
end;

function TDMbook.addsmalltype(Abigtype, Abooktype,
  Asmallname: string): boolean;
begin
  Result:=true;
 dbasebook.StartTransaction;
try

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -