📄 dmfrm.pas
字号:
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 + -