H
huazf
Unregistered / Unconfirmed
GUEST, unregistred user!
library HOTELV1;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
DateUtils,
mwic_32;
type TYGuest=record
cardsno:array[0..3] of byte;
cardty:byte;
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
roomno:array[0..3,0..1] of byte;
end;
//cardty=0x0 客人卡
// =0x4 客人卡
// =0x8 通道卡
type TYWaiter=record
cardsno:array[0..3] of byte;
cardty:byte;
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
startime,stoptime:array[0..1] of byte;
roomno:array[0..1] of byte;
opercnt:byte;
end;
//cardty=0xc 清洁
//cardty=0xd 服务
//cardty=0xe 经理
//cardty=0xf 经理
//cardty=0x10 经理
type TYtime=record
cardsno:array[0..3] of byte;
cardty:byte; // 0x20
hotelid:array[0..2] of byte;
stardate:array[0..5] of byte;
end;
type TYaddr=record
cardsno:array[0..3] of byte;
cardty:byte; //0x21
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
roomno:array[0..1] of byte;
end;
type TYdis=record
cardsno:array[0..3] of byte;
cardty:byte; //0x22
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
disty1:byte;
disty2:byte;
end;
// byte0.7 =0 写入限制时间, 1=禁止/解除
// byte0.6 =0 解除, 1 禁止
// byte0.5=1 and byte0.6=1 禁止 byte1 所指示的开门卡类型
// byte1
// bit7..bit0 =1 禁止相应的开门卡
type TYdata=record
cardsno:array[0..3] of byte;
cardty:byte; //0x23
datasno: byte;
locktime: array[0..5] of byte;
hotelid:array[0..2] of byte;
roomno:array[0..1] of byte;
roomsta:byte;
recordall:array[0..1] of byte;
end;
TYpe TYrec=record
date:array[0..5] of byte; // bcd
cardsno:array[0..3] of byte;
end;
type TYOper=record
date:array[0..5] of byte;
roomno:array[0..1] of byte;
roomsta:byte;
end;
Function Getcrc(bufchar;le:longint;crcval:longint=$38):longint;stdcall;forward;
Function GetcrcW(bufchar;le:longint;crcval:longint=$4766):longint;stdcall;forward;
procedure sethotelid(h1,h2,h3:longint);stdcall;forward;
function getcardinfo(mycardchar;rdlen:longint)ointer;stdcall;forward;
function chkpass_42(commhandle:longint;cardsnochar):longint;stdcall;forward;
function wrguest_42(commhandle:longint;var Guestcard:TYGUEST):longint;stdcall;forward;
function wrwaiter_42(commhandle:longint;var waitercard:tywaiter):longint;stdcall;forward;
function wrtime_42(commhandle:longint;var timecard:tytime):longint;stdcall;forward;
function wraddr_42(commhandle:longint;var adrcard:tyaddr):longint;stdcall;forward;
function wrdis_42(commhandle:longint;var discard:tydis):longint;stdcall;forward;
function wrdata_42(commhandle:longint;var datacard:tydata):longint;stdcall;forward;
function rdcard_42(commhandle:longint;var cardty:longint):longint;stdcall;forward;
function clr_42(commhandle:longint):longint;stdcall;forward;
function clroper_42(commhandle:longint):longint;stdcall;forward;
function rdoper_42(commhandle:longint;bufchar;recsno:longint;var reclen:longint):longint;stdcall;forward;
function rdrec_42(commhandle:longint;bufchar;var reclen,recsno:longint):longint;stdcall;forward;
function wrdata_c64(commhandle:longint;var datacard:tydata):longint;stdcall;forward;
function rdcard_c64(Commhandle:longint;var keyty:longint):longint;stdcall;forward;
function clr_c64(commhandle:longint):longint;stdcall;forward;
Function clroper_c64(commhandle:longint):longint;stdcall;forward;
function rdoper_c64(commhandle:longint;bufchar;recsno:longint;var reclen,opencnt:longint):longint;stdcall;forward;
function rdrec_c64(commhandle:longint;bufchar;var reclen,recsno:longint):longint;stdcall;forward;
var
cardbuf:array[0..63] of byte;
conhotel:array[0..2] of byte;
procedure sethotelid(h1,h2,h3:longint);
begin
conhotel[0]:=h1;
conhotel[1]:=h2;
conhotel[2]:=h3;
end;
procedure dedate(sourCHAR;targetCHAR);
var
ctmp,byear,byear1:integer;
begin
byear:=YearOf(Date) mod 100;
byear1:=byear mod 10;
byear:=byear div 10;
ctmp:=ord(sour[0]) div $10;
if abs(ctmp-byear1)>5 then begin
if ctmp>byear1 then begin
if byear>0 then
dec(byear)
else
byear:=9;
end
else begin
if byear=9 then
byear:=0
else
inc(byear);
end;
end;
target[0]:=char(byear*$10+ctmp);
ctmp:=ord(sour[0]) and $f;
if ctmp>9 then ctmp:=ctmp+6;
target[1]:=char(ctmp);
target[2]:=sour[1];
target[3]:=sour[2];
target[4]:=sour[3];
target[5]:=CHAR(0);
end;
function getcardinfo(mycardchar;rdlen:longint)ointer;
begin
if mycard<>nil then
move(cardbuf,mycard,rdlen);
result:=@cardbuf;
end;
Function Getcrc(bufchar;le:longint;crcval:longint=$38):longint;
var cloop,bitloop:longint;
ctmp:byte;
ctmp1:byte;
begin
for cloop:=0 to le-1 do begin
ctmp:=ord(buf[cloop]);
for bitloop:=0 to 7 do begin
ctmp1:=(ctmp xor crcval) and 1;
ctmp:=ctmp div 2;
crcval:=crcval div 2;
if (ctmp1)>0 then
crcval:=crcval xor $8c;
end;
end;
result:=crcval;
end;
Function GetcrcW(bufchar;le:longint;crcval:longint=$4766):longint;
var
cloop,bitloop:longint;
ctmp,ctmp1:byte;
begin
for cloop:=0 to le-1 do begin
ctmp:=ord(buf[cloop]);
for bitloop:=0 to 7 do begin
ctmp1:=(ctmp xor crcval) and 1;
ctmp:=ctmp div 2;
crcval:=crcval div 2;
if (ctmp1)>0 then
crcval:=crcval xor $8408;
end;
end;
result:=crcval;
end;
function chkpass_42(commhandle:longint;cardsnochar):longint;
var
buf:array [0..$10] of byte;
oldpass:array[0..4] of byte;
oldsno:longword;
crcb,crcw:longint;
begin
result:=srd_4442(commhandle,$1c,4,pchar(@buf));
if result<0 then begin
exit;
end;
move(buf,oldsno,4);
if (oldsno>0) and (oldsno<$ffffffff) then begin
crcb:=getcrc(pchar(@buf),4);
crcw:=getcrcw(pchar(@buf),4);
oldpass[0]:=(crcb and $ff);
oldpass[1]:=(crcw and $ff);
oldpass[2]:=((crcw div $100)and $ff);
result:=csc_4442(commhandle,3,pchar(@oldpass));
if result>=0 then begin
move(buf,cardsno[0],4);
result:=0;
end;
end
else begin
result:=-1;
end;
end;
function wrguest_42(commhandle:longint;var Guestcard:TYGUEST):longint;
var
wrbuf:array[0..$80] of char;
rdcnt:byte;
begin
Guestcard.hotelid[0]:=conhotel[0];
Guestcard.hotelid[1]:=conhotel[1];
Guestcard.hotelid[2]:=conhotel[2];
move(Guestcard.cardty,wrbuf[0],sizeof(tyguest)-4);
rdcnt:=0;
repeat
inc(rdcnt);
until ((Guestcard.roomno[rdcnt,0]=0) or (rdcnt=3));
if (Guestcard.roomno[rdcnt,0]=0) then
dec(rdcnt);
wrbuf[0]:=chr(ord(wrbuf[0]) or rdcnt);
result:=chkpass_42(commhandle,pchar(@guestcard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tyguest)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrwaiter_42(commhandle:longint;var waitercard:tywaiter):longint;
var
wrbuf:array[0..$80] of char;
begin
waitercard.hotelid[0]:=conhotel[0];
waitercard.hotelid[1]:=conhotel[1];
waitercard.hotelid[2]:=conhotel[2];
waitercard.opercnt:=0;
move(waitercard.cardty,wrbuf,sizeof(tywaiter)-4);
result:=chkpass_42(commhandle,pchar(@waitercard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(waitercard)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrtime_42(commhandle:longint;var timecard:tytime):longint;
var
wrbuf:array[0..$80] of char;
begin
timecard.cardty:=$20;
timecard.hotelid[0]:=conhotel[0];
timecard.hotelid[1]:=conhotel[1];
timecard.hotelid[2]:=conhotel[2];
move(timecard.cardty,wrbuf,sizeof(tytime)-4);
result:=chkpass_42(commhandle,pchar(@timecard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tytime)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wraddr_42(commhandle:longint;var adrcard:tyaddr):longint;
var
wrbuf:array[0..$80] of char;
begin
adrcard.cardty:=$21;
adrcard.hotelid[0]:=conhotel[0];
adrcard.hotelid[1]:=conhotel[1];
adrcard.hotelid[2]:=conhotel[2];
move(adrcard.cardty,wrbuf,sizeof(tyaddr)-4);
result:=chkpass_42(commhandle,pchar(@adrcard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tyaddr)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrdis_42(commhandle:longint;var discard:tydis):longint;
var
wrbuf:array[0..$80] of char;
begin
discard.cardty:=$22;
discard.hotelid[0]:=conhotel[0];
discard.hotelid[1]:=conhotel[1];
discard.hotelid[2]:=conhotel[2];
move(discard.cardty,wrbuf,sizeof(discard)-4);
result:=chkpass_42(commhandle,pchar(@discard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(discard)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrdata_42(commhandle:longint;var datacard:tydata):longint;
var
wrbuf:array[0..$80] of char;
begin
datacard.cardty:=$23;
wrbuf[0]:=char($23);
wrbuf[1]:=char(datacard.datasno);
move(datacard.cardty,wrbuf,sizeof(datacard));
result:=chkPass_42(commhandle,pchar(@datacard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,2,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function rdcard_42(commhandle:longint;var cardty:longint):longint;
var
rdbuf:array[0..$40] of byte;
begin
result:=chkpass_42(commhandle,pchar(@rdbuf));
if result<>0 then
exit;
result:=srd_4442(commhandle,$20,$28,pchar(@rdbuf[4]));
if result>=0 then begin
move(rdbuf,cardbuf,32);
if ((cardbuf[4]=$23) and (cardbuf[5]=0)) then begin
move(cardbuf[$c],cardbuf[$6],14);
end;
result:=0;
end;
cardty:=cardbuf[4];
end;
function clr_42(commhandle:longint):longint;
var
wrbuf:array[0..$10] of char;
cardsno:array[0..4]of byte;
begin
FillChar(wrbuf,$10,$ff);
result:=chkpass_42(commhandle,pchar(@cardsno));
if result>=0 then begin
result:=swr_4442(commhandle,$20,8,wrbuf);
end;
if result>0 then
result:=0;
end;
function clroper_42(commhandle:longint):longint;
var
rdbuf:array[0..$8] of byte;
cardsno:array[0..4]of byte;
begin
result:=chkpass_42(commhandle,pchar(@cardsno));
if result<>0 then exit;
result:=srd_4442(commhandle,$20,4,pchar(@rdbuf));
if result<0 then exit;
if ((rdbuf[0]<$c) or (rdbuf[0]>$10)) then begin
result:=-1;
exit;
end;
rdbuf[0]:=0;
result:=swr_4442(commhandle,$20+20,1,pchar(@rdbuf));
if result>=0 then begin
result:=0;
end;
end;
function rdoper_42(commhandle:longint;bufchar;recsno:longint;var reclen:longint):longint;
var
rdbuf:array [0..$32] of byte;
sip:integer;
maxrec:longint;
mycard:^tywaiter;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_4442(commhandle,$1c,32,pchar(@rdbuf));
if result<0 then exit;
move(rdbuf[0],cardbuf[0],32);
mycard:=@cardbuf;
if (mycard.cardty <$0c) or (mycard.cardty >$10) then begin
result:=-1;
exit;
end;
sip:=mycard^.opercnt;
sip:=sip-recsno;
while (sip>0) and (maxrec>0) do begin
dec(sip);
result:=srd_4442(commhandle,sip*8+$20+21,8,PCHAR(@rdbuf));
if result<0 then exit;
move(rdbuf[4],buf[reclen*10+6],4);
dedate(PCHAR(@rdbuf[0]),PCHAR(@buf[reclen*10]));
inc(reclen);
dec(maxrec);
end;
end;
function rdrec_42(commhandle:longint;bufchar;var reclen,recsno:longint):longint;
// 3,31
// 0..7 keyty,cardsno,datasno,crc,data1
// 1 4 1 2 108
var
rdbuf:array [0..$20] of byte;
maxrec:longint;
recipad:longint;
sip,tip:longint;
begin
maxrec:=reclen;
reclen:=0;
result:=chkpass_42(commhandle,pchar(@cardbuf));
if result<>0 then exit;
result:=srd_4442(commhandle,$20,24,pchar(@rdbuf));
if result<>0 then exit;
if rdbuf[0]<>$23 then begin
result:=$32;
exit;
end;
cardbuf[4]:=rdbuf[0];
cardbuf[5]:=rdbuf[1];
sip:=rdbuf[1];
if sip=0 then begin
move(rdbuf[8],cardbuf[6],14);
tip:=25;
recipad:=$20+24;
end
else begin
sip:=sip*27-2;
tip:=27;
recipad:=$20+8;
end;
if (recsno<=sip) then begin
recsno:=sip;
end;
if (recsno>=sip+tip) then begin
exit;
end;
recipad:=(recsno-sip)*8+recipad;
tip:=0;
while (recipad<$ff) and (maxrec>0) do begin
if recipad<$20+16 then
move(rdbuf[0],rdbuf[8],8)
else if recipad<$20+24 then
move(rdbuf[0],rdbuf[16],8)
else
result:=srd_4442(commhandle,recipad,8,pchar(@rdbuf));
if result<>0 then exit;
dedate(pchar(@rdbuf[0]),pchar(@buf[tip]));
inc(tip,6);
move(rdbuf[4],buf[tip],4);
inc(tip,4);
inc(reclen);
dec(maxrec);
inc(recipad,8)
end;
end;
//*****************************************
//
//*****************************************
function wrdata_c64(commhandle:longint;var datacard:tydata):longint;
var
wrbuf:array[0..$80] of char;
begin
datacard.cardty:=$23;
wrbuf[0]:=char($23);
wrbuf[1]:=char(datacard.datasno);
// result:=chkpass_c64(commhandle,$1c,$4,pchar(@datacard.cardsno));
// if result<>0 then exit;
result:=swr_24c64(commhandle,$20,2,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function rdcard_c64(Commhandle:longint;var keyty:longint):longint;
var rdbuf:array[0..$40] of byte;
begin
// result:=chkpass_c64(commhandle,pchar(@cardbuf));
// if result<>0 then exit;
result:=srd_24c64(commhandle,$20,$28,pchar(@rdbuf[4]));
if result>=0 then begin
move(rdbuf[0],cardbuf[0],32);
if ((cardbuf[4]=$23) and (cardbuf[5]=0)) then begin
move(cardbuf[6],cardbuf[$c],14);
end;
result:=0;
end;
keyty:=cardbuf[4];
end;
function clr_c64(commhandle:longint):longint;
var
wrbuf:string;
begin
wrbuf:=stringofchar(chr($ff),16);
result:=swr_24c64(commhandle,$20,8,pchar(wrbuf));
end;
Function clroper_c64(commhandle:longint):longint;
var
rdbuf:array[0..$10] of byte;
begin
// result:=chkpass_c64(commhandle,pchar(@rdbuf));
// if result<>0 then exit;
result:=srd_24c64(commhandle,$20,4,pchar(@rdbuf));
if result<0 then exit;
if ((rdbuf[0]<$c) or (rdbuf[0]>$10)) then begin
result:=-1;
exit;
end;
rdbuf[0]:=0;
result:=swr_24c64(commhandle,$20+20,1,pchar(@rdbuf));
if result>=0 then begin
result:=0;
end;
end;
function rdoper_c64(commhandle:longint;bufchar;recsno:longint;var reclen,opencnt:longint):longint;
var
rdbuf:array [0..$32] of byte;
sip:integer;
maxrec:longint;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_24c64(commhandle,$20,32,pchar(@rdbuf));
if result<0 then exit;
if (rdbuf[0]<$0c) or (rdbuf[0]>$10) then begin
result:=-1;
exit;
end;
sip:=rdbuf[20];
sip:=sip-recsno;
while (sip>0) and (maxrec>0) do begin
dec(sip);
result:=srd_24c64(commhandle,sip*8+$21,8,PCHAR(@rdbuf));
if result<0 then exit;
move(rdbuf[4],buf[reclen*10+6],4);
dedate(PCHAR(@rdbuf[0]),PCHAR(@buf[reclen*10]));
inc(reclen);
dec(maxrec);
end;
end;
function rdrec_c64(commhandle:longint;bufchar;var reclen,recsno:longint):longint;
// 3,31
// 0..7 keyty,cardsno,datasno,crc, data1[locktime,roomno,roomsta,recall]
// 1 4 1 2 108 6 2 1 2
var
rdbuf:array [0..$20] of byte;
maxrec:longint;
recipad:longint;
sip,tip:longint;
mydata:^tydata;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_24c64(commhandle,$20,24,pchar(@rdbuf));
if result<>0 then exit;
if rdbuf[0]<>$23 then begin
result:=$32;
exit;
end;
cardbuf[4]:=rdbuf[0];
cardbuf[5]:=rdbuf[1];
sip:=rdbuf[1];
move(cardbuf[6],rdbuf[8],14);
mydata:=@cardbuf;
tip:=mydata.recordall[0]+mydata.recordall[0]*$100;
if tip=$ffff then begin
tip:=0;
end;
recipad:=$20+8;
if (recsno<=sip) then begin
recsno:=sip;
end;
if (recsno>=sip+tip) then begin
exit;
end;
recipad:=(recsno-sip)*8+recipad;
result:=0;
tip:=0;
while (recipad<$1fff) and (maxrec>0) do begin
if recipad<$20+16 then
move(rdbuf[8],rdbuf[0],8)
else if recipad<$20+24 then
move(rdbuf[16],rdbuf[0],8)
else
result:=srd_24c64(commhandle,recipad,8,pchar(@rdbuf));
if result<>0 then exit;
dedate(pchar(@rdbuf[0]),pchar(@buf[tip]));
inc(tip,6);
move(rdbuf[4],buf[tip],4);
inc(tip,4);
inc(reclen);
dec(maxrec);
inc(recipad,8)
end;
end;
exports
getcardinfo,
chkpass_42,
wrguest_42,
wrwaiter_42,
wrtime_42,
wraddr_42,
wrdis_42,
wrdata_42,
rdcard_42,
clr_42,
clroper_42,
rdoper_42,
rdrec_42,
wrdata_c64,
rdcard_c64,
clr_c64,
clroper_c64,
rdoper_c64,
rdrec_c64,
sethotelid;
begin
end.
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
SysUtils,
Classes,
DateUtils,
mwic_32;
type TYGuest=record
cardsno:array[0..3] of byte;
cardty:byte;
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
roomno:array[0..3,0..1] of byte;
end;
//cardty=0x0 客人卡
// =0x4 客人卡
// =0x8 通道卡
type TYWaiter=record
cardsno:array[0..3] of byte;
cardty:byte;
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
startime,stoptime:array[0..1] of byte;
roomno:array[0..1] of byte;
opercnt:byte;
end;
//cardty=0xc 清洁
//cardty=0xd 服务
//cardty=0xe 经理
//cardty=0xf 经理
//cardty=0x10 经理
type TYtime=record
cardsno:array[0..3] of byte;
cardty:byte; // 0x20
hotelid:array[0..2] of byte;
stardate:array[0..5] of byte;
end;
type TYaddr=record
cardsno:array[0..3] of byte;
cardty:byte; //0x21
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
roomno:array[0..1] of byte;
end;
type TYdis=record
cardsno:array[0..3] of byte;
cardty:byte; //0x22
hotelid:array[0..2] of byte;
stardate,stopdate:array[0..4] of byte;
disty1:byte;
disty2:byte;
end;
// byte0.7 =0 写入限制时间, 1=禁止/解除
// byte0.6 =0 解除, 1 禁止
// byte0.5=1 and byte0.6=1 禁止 byte1 所指示的开门卡类型
// byte1
// bit7..bit0 =1 禁止相应的开门卡
type TYdata=record
cardsno:array[0..3] of byte;
cardty:byte; //0x23
datasno: byte;
locktime: array[0..5] of byte;
hotelid:array[0..2] of byte;
roomno:array[0..1] of byte;
roomsta:byte;
recordall:array[0..1] of byte;
end;
TYpe TYrec=record
date:array[0..5] of byte; // bcd
cardsno:array[0..3] of byte;
end;
type TYOper=record
date:array[0..5] of byte;
roomno:array[0..1] of byte;
roomsta:byte;
end;
Function Getcrc(bufchar;le:longint;crcval:longint=$38):longint;stdcall;forward;
Function GetcrcW(bufchar;le:longint;crcval:longint=$4766):longint;stdcall;forward;
procedure sethotelid(h1,h2,h3:longint);stdcall;forward;
function getcardinfo(mycardchar;rdlen:longint)ointer;stdcall;forward;
function chkpass_42(commhandle:longint;cardsnochar):longint;stdcall;forward;
function wrguest_42(commhandle:longint;var Guestcard:TYGUEST):longint;stdcall;forward;
function wrwaiter_42(commhandle:longint;var waitercard:tywaiter):longint;stdcall;forward;
function wrtime_42(commhandle:longint;var timecard:tytime):longint;stdcall;forward;
function wraddr_42(commhandle:longint;var adrcard:tyaddr):longint;stdcall;forward;
function wrdis_42(commhandle:longint;var discard:tydis):longint;stdcall;forward;
function wrdata_42(commhandle:longint;var datacard:tydata):longint;stdcall;forward;
function rdcard_42(commhandle:longint;var cardty:longint):longint;stdcall;forward;
function clr_42(commhandle:longint):longint;stdcall;forward;
function clroper_42(commhandle:longint):longint;stdcall;forward;
function rdoper_42(commhandle:longint;bufchar;recsno:longint;var reclen:longint):longint;stdcall;forward;
function rdrec_42(commhandle:longint;bufchar;var reclen,recsno:longint):longint;stdcall;forward;
function wrdata_c64(commhandle:longint;var datacard:tydata):longint;stdcall;forward;
function rdcard_c64(Commhandle:longint;var keyty:longint):longint;stdcall;forward;
function clr_c64(commhandle:longint):longint;stdcall;forward;
Function clroper_c64(commhandle:longint):longint;stdcall;forward;
function rdoper_c64(commhandle:longint;bufchar;recsno:longint;var reclen,opencnt:longint):longint;stdcall;forward;
function rdrec_c64(commhandle:longint;bufchar;var reclen,recsno:longint):longint;stdcall;forward;
var
cardbuf:array[0..63] of byte;
conhotel:array[0..2] of byte;
procedure sethotelid(h1,h2,h3:longint);
begin
conhotel[0]:=h1;
conhotel[1]:=h2;
conhotel[2]:=h3;
end;
procedure dedate(sourCHAR;targetCHAR);
var
ctmp,byear,byear1:integer;
begin
byear:=YearOf(Date) mod 100;
byear1:=byear mod 10;
byear:=byear div 10;
ctmp:=ord(sour[0]) div $10;
if abs(ctmp-byear1)>5 then begin
if ctmp>byear1 then begin
if byear>0 then
dec(byear)
else
byear:=9;
end
else begin
if byear=9 then
byear:=0
else
inc(byear);
end;
end;
target[0]:=char(byear*$10+ctmp);
ctmp:=ord(sour[0]) and $f;
if ctmp>9 then ctmp:=ctmp+6;
target[1]:=char(ctmp);
target[2]:=sour[1];
target[3]:=sour[2];
target[4]:=sour[3];
target[5]:=CHAR(0);
end;
function getcardinfo(mycardchar;rdlen:longint)ointer;
begin
if mycard<>nil then
move(cardbuf,mycard,rdlen);
result:=@cardbuf;
end;
Function Getcrc(bufchar;le:longint;crcval:longint=$38):longint;
var cloop,bitloop:longint;
ctmp:byte;
ctmp1:byte;
begin
for cloop:=0 to le-1 do begin
ctmp:=ord(buf[cloop]);
for bitloop:=0 to 7 do begin
ctmp1:=(ctmp xor crcval) and 1;
ctmp:=ctmp div 2;
crcval:=crcval div 2;
if (ctmp1)>0 then
crcval:=crcval xor $8c;
end;
end;
result:=crcval;
end;
Function GetcrcW(bufchar;le:longint;crcval:longint=$4766):longint;
var
cloop,bitloop:longint;
ctmp,ctmp1:byte;
begin
for cloop:=0 to le-1 do begin
ctmp:=ord(buf[cloop]);
for bitloop:=0 to 7 do begin
ctmp1:=(ctmp xor crcval) and 1;
ctmp:=ctmp div 2;
crcval:=crcval div 2;
if (ctmp1)>0 then
crcval:=crcval xor $8408;
end;
end;
result:=crcval;
end;
function chkpass_42(commhandle:longint;cardsnochar):longint;
var
buf:array [0..$10] of byte;
oldpass:array[0..4] of byte;
oldsno:longword;
crcb,crcw:longint;
begin
result:=srd_4442(commhandle,$1c,4,pchar(@buf));
if result<0 then begin
exit;
end;
move(buf,oldsno,4);
if (oldsno>0) and (oldsno<$ffffffff) then begin
crcb:=getcrc(pchar(@buf),4);
crcw:=getcrcw(pchar(@buf),4);
oldpass[0]:=(crcb and $ff);
oldpass[1]:=(crcw and $ff);
oldpass[2]:=((crcw div $100)and $ff);
result:=csc_4442(commhandle,3,pchar(@oldpass));
if result>=0 then begin
move(buf,cardsno[0],4);
result:=0;
end;
end
else begin
result:=-1;
end;
end;
function wrguest_42(commhandle:longint;var Guestcard:TYGUEST):longint;
var
wrbuf:array[0..$80] of char;
rdcnt:byte;
begin
Guestcard.hotelid[0]:=conhotel[0];
Guestcard.hotelid[1]:=conhotel[1];
Guestcard.hotelid[2]:=conhotel[2];
move(Guestcard.cardty,wrbuf[0],sizeof(tyguest)-4);
rdcnt:=0;
repeat
inc(rdcnt);
until ((Guestcard.roomno[rdcnt,0]=0) or (rdcnt=3));
if (Guestcard.roomno[rdcnt,0]=0) then
dec(rdcnt);
wrbuf[0]:=chr(ord(wrbuf[0]) or rdcnt);
result:=chkpass_42(commhandle,pchar(@guestcard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tyguest)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrwaiter_42(commhandle:longint;var waitercard:tywaiter):longint;
var
wrbuf:array[0..$80] of char;
begin
waitercard.hotelid[0]:=conhotel[0];
waitercard.hotelid[1]:=conhotel[1];
waitercard.hotelid[2]:=conhotel[2];
waitercard.opercnt:=0;
move(waitercard.cardty,wrbuf,sizeof(tywaiter)-4);
result:=chkpass_42(commhandle,pchar(@waitercard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(waitercard)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrtime_42(commhandle:longint;var timecard:tytime):longint;
var
wrbuf:array[0..$80] of char;
begin
timecard.cardty:=$20;
timecard.hotelid[0]:=conhotel[0];
timecard.hotelid[1]:=conhotel[1];
timecard.hotelid[2]:=conhotel[2];
move(timecard.cardty,wrbuf,sizeof(tytime)-4);
result:=chkpass_42(commhandle,pchar(@timecard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tytime)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wraddr_42(commhandle:longint;var adrcard:tyaddr):longint;
var
wrbuf:array[0..$80] of char;
begin
adrcard.cardty:=$21;
adrcard.hotelid[0]:=conhotel[0];
adrcard.hotelid[1]:=conhotel[1];
adrcard.hotelid[2]:=conhotel[2];
move(adrcard.cardty,wrbuf,sizeof(tyaddr)-4);
result:=chkpass_42(commhandle,pchar(@adrcard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(tyaddr)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrdis_42(commhandle:longint;var discard:tydis):longint;
var
wrbuf:array[0..$80] of char;
begin
discard.cardty:=$22;
discard.hotelid[0]:=conhotel[0];
discard.hotelid[1]:=conhotel[1];
discard.hotelid[2]:=conhotel[2];
move(discard.cardty,wrbuf,sizeof(discard)-4);
result:=chkpass_42(commhandle,pchar(@discard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,sizeof(discard)-4,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function wrdata_42(commhandle:longint;var datacard:tydata):longint;
var
wrbuf:array[0..$80] of char;
begin
datacard.cardty:=$23;
wrbuf[0]:=char($23);
wrbuf[1]:=char(datacard.datasno);
move(datacard.cardty,wrbuf,sizeof(datacard));
result:=chkPass_42(commhandle,pchar(@datacard.cardsno));
if result<>0 then
exit;
result:=swr_4442(commhandle,$20,2,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function rdcard_42(commhandle:longint;var cardty:longint):longint;
var
rdbuf:array[0..$40] of byte;
begin
result:=chkpass_42(commhandle,pchar(@rdbuf));
if result<>0 then
exit;
result:=srd_4442(commhandle,$20,$28,pchar(@rdbuf[4]));
if result>=0 then begin
move(rdbuf,cardbuf,32);
if ((cardbuf[4]=$23) and (cardbuf[5]=0)) then begin
move(cardbuf[$c],cardbuf[$6],14);
end;
result:=0;
end;
cardty:=cardbuf[4];
end;
function clr_42(commhandle:longint):longint;
var
wrbuf:array[0..$10] of char;
cardsno:array[0..4]of byte;
begin
FillChar(wrbuf,$10,$ff);
result:=chkpass_42(commhandle,pchar(@cardsno));
if result>=0 then begin
result:=swr_4442(commhandle,$20,8,wrbuf);
end;
if result>0 then
result:=0;
end;
function clroper_42(commhandle:longint):longint;
var
rdbuf:array[0..$8] of byte;
cardsno:array[0..4]of byte;
begin
result:=chkpass_42(commhandle,pchar(@cardsno));
if result<>0 then exit;
result:=srd_4442(commhandle,$20,4,pchar(@rdbuf));
if result<0 then exit;
if ((rdbuf[0]<$c) or (rdbuf[0]>$10)) then begin
result:=-1;
exit;
end;
rdbuf[0]:=0;
result:=swr_4442(commhandle,$20+20,1,pchar(@rdbuf));
if result>=0 then begin
result:=0;
end;
end;
function rdoper_42(commhandle:longint;bufchar;recsno:longint;var reclen:longint):longint;
var
rdbuf:array [0..$32] of byte;
sip:integer;
maxrec:longint;
mycard:^tywaiter;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_4442(commhandle,$1c,32,pchar(@rdbuf));
if result<0 then exit;
move(rdbuf[0],cardbuf[0],32);
mycard:=@cardbuf;
if (mycard.cardty <$0c) or (mycard.cardty >$10) then begin
result:=-1;
exit;
end;
sip:=mycard^.opercnt;
sip:=sip-recsno;
while (sip>0) and (maxrec>0) do begin
dec(sip);
result:=srd_4442(commhandle,sip*8+$20+21,8,PCHAR(@rdbuf));
if result<0 then exit;
move(rdbuf[4],buf[reclen*10+6],4);
dedate(PCHAR(@rdbuf[0]),PCHAR(@buf[reclen*10]));
inc(reclen);
dec(maxrec);
end;
end;
function rdrec_42(commhandle:longint;bufchar;var reclen,recsno:longint):longint;
// 3,31
// 0..7 keyty,cardsno,datasno,crc,data1
// 1 4 1 2 108
var
rdbuf:array [0..$20] of byte;
maxrec:longint;
recipad:longint;
sip,tip:longint;
begin
maxrec:=reclen;
reclen:=0;
result:=chkpass_42(commhandle,pchar(@cardbuf));
if result<>0 then exit;
result:=srd_4442(commhandle,$20,24,pchar(@rdbuf));
if result<>0 then exit;
if rdbuf[0]<>$23 then begin
result:=$32;
exit;
end;
cardbuf[4]:=rdbuf[0];
cardbuf[5]:=rdbuf[1];
sip:=rdbuf[1];
if sip=0 then begin
move(rdbuf[8],cardbuf[6],14);
tip:=25;
recipad:=$20+24;
end
else begin
sip:=sip*27-2;
tip:=27;
recipad:=$20+8;
end;
if (recsno<=sip) then begin
recsno:=sip;
end;
if (recsno>=sip+tip) then begin
exit;
end;
recipad:=(recsno-sip)*8+recipad;
tip:=0;
while (recipad<$ff) and (maxrec>0) do begin
if recipad<$20+16 then
move(rdbuf[0],rdbuf[8],8)
else if recipad<$20+24 then
move(rdbuf[0],rdbuf[16],8)
else
result:=srd_4442(commhandle,recipad,8,pchar(@rdbuf));
if result<>0 then exit;
dedate(pchar(@rdbuf[0]),pchar(@buf[tip]));
inc(tip,6);
move(rdbuf[4],buf[tip],4);
inc(tip,4);
inc(reclen);
dec(maxrec);
inc(recipad,8)
end;
end;
//*****************************************
//
//*****************************************
function wrdata_c64(commhandle:longint;var datacard:tydata):longint;
var
wrbuf:array[0..$80] of char;
begin
datacard.cardty:=$23;
wrbuf[0]:=char($23);
wrbuf[1]:=char(datacard.datasno);
// result:=chkpass_c64(commhandle,$1c,$4,pchar(@datacard.cardsno));
// if result<>0 then exit;
result:=swr_24c64(commhandle,$20,2,wrbuf);
if result>=0 then begin
result:=0;
end;
end;
function rdcard_c64(Commhandle:longint;var keyty:longint):longint;
var rdbuf:array[0..$40] of byte;
begin
// result:=chkpass_c64(commhandle,pchar(@cardbuf));
// if result<>0 then exit;
result:=srd_24c64(commhandle,$20,$28,pchar(@rdbuf[4]));
if result>=0 then begin
move(rdbuf[0],cardbuf[0],32);
if ((cardbuf[4]=$23) and (cardbuf[5]=0)) then begin
move(cardbuf[6],cardbuf[$c],14);
end;
result:=0;
end;
keyty:=cardbuf[4];
end;
function clr_c64(commhandle:longint):longint;
var
wrbuf:string;
begin
wrbuf:=stringofchar(chr($ff),16);
result:=swr_24c64(commhandle,$20,8,pchar(wrbuf));
end;
Function clroper_c64(commhandle:longint):longint;
var
rdbuf:array[0..$10] of byte;
begin
// result:=chkpass_c64(commhandle,pchar(@rdbuf));
// if result<>0 then exit;
result:=srd_24c64(commhandle,$20,4,pchar(@rdbuf));
if result<0 then exit;
if ((rdbuf[0]<$c) or (rdbuf[0]>$10)) then begin
result:=-1;
exit;
end;
rdbuf[0]:=0;
result:=swr_24c64(commhandle,$20+20,1,pchar(@rdbuf));
if result>=0 then begin
result:=0;
end;
end;
function rdoper_c64(commhandle:longint;bufchar;recsno:longint;var reclen,opencnt:longint):longint;
var
rdbuf:array [0..$32] of byte;
sip:integer;
maxrec:longint;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_24c64(commhandle,$20,32,pchar(@rdbuf));
if result<0 then exit;
if (rdbuf[0]<$0c) or (rdbuf[0]>$10) then begin
result:=-1;
exit;
end;
sip:=rdbuf[20];
sip:=sip-recsno;
while (sip>0) and (maxrec>0) do begin
dec(sip);
result:=srd_24c64(commhandle,sip*8+$21,8,PCHAR(@rdbuf));
if result<0 then exit;
move(rdbuf[4],buf[reclen*10+6],4);
dedate(PCHAR(@rdbuf[0]),PCHAR(@buf[reclen*10]));
inc(reclen);
dec(maxrec);
end;
end;
function rdrec_c64(commhandle:longint;bufchar;var reclen,recsno:longint):longint;
// 3,31
// 0..7 keyty,cardsno,datasno,crc, data1[locktime,roomno,roomsta,recall]
// 1 4 1 2 108 6 2 1 2
var
rdbuf:array [0..$20] of byte;
maxrec:longint;
recipad:longint;
sip,tip:longint;
mydata:^tydata;
begin
maxrec:=reclen;
reclen:=0;
result:=srd_24c64(commhandle,$20,24,pchar(@rdbuf));
if result<>0 then exit;
if rdbuf[0]<>$23 then begin
result:=$32;
exit;
end;
cardbuf[4]:=rdbuf[0];
cardbuf[5]:=rdbuf[1];
sip:=rdbuf[1];
move(cardbuf[6],rdbuf[8],14);
mydata:=@cardbuf;
tip:=mydata.recordall[0]+mydata.recordall[0]*$100;
if tip=$ffff then begin
tip:=0;
end;
recipad:=$20+8;
if (recsno<=sip) then begin
recsno:=sip;
end;
if (recsno>=sip+tip) then begin
exit;
end;
recipad:=(recsno-sip)*8+recipad;
result:=0;
tip:=0;
while (recipad<$1fff) and (maxrec>0) do begin
if recipad<$20+16 then
move(rdbuf[8],rdbuf[0],8)
else if recipad<$20+24 then
move(rdbuf[16],rdbuf[0],8)
else
result:=srd_24c64(commhandle,recipad,8,pchar(@rdbuf));
if result<>0 then exit;
dedate(pchar(@rdbuf[0]),pchar(@buf[tip]));
inc(tip,6);
move(rdbuf[4],buf[tip],4);
inc(tip,4);
inc(reclen);
dec(maxrec);
inc(recipad,8)
end;
end;
exports
getcardinfo,
chkpass_42,
wrguest_42,
wrwaiter_42,
wrtime_42,
wraddr_42,
wrdis_42,
wrdata_42,
rdcard_42,
clr_42,
clroper_42,
rdoper_42,
rdrec_42,
wrdata_c64,
rdcard_c64,
clr_c64,
clroper_c64,
rdoper_c64,
rdrec_c64,
sethotelid;
begin
end.