atlib.prg

超市收银系统,所需系统dos6.22,ucdos,foxpro另外加上一些外设的驱动程序.

procedure goodbye
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/b'
=defiwind('tcxt',9,20,16,60,"colo &p_color titl '退出系统'")
=actiwind('tcxt')
@ 2,4 say '按"1"键  返回' color n/w
@ 3,4 say '按"2"键  重新登录' color n/w
@ 4,4 say '按"3"键  退出' color n/w
do while .t.
	key_tc=inkey(0)
	if key_tc=49 .or. key_tc=50 .or. key_tc=51
		exit
	endif
enddo
=relewind('tcxt')
if key_tc=49
	return 1
endif
if key_tc=50
	if empty(srsky())
		return 3
	else
		do clsnum
		do clswin
		do cssj
		@ 20,9 say alltrim(gs_skm) color n/w
		return 1
	endif
endif
if gn_num<>0
	do czrz
	strr=replicate('=',37)
	do prt with strr
	strr='       此小票作废!'
	do prt with strr
	do prt_head
endif
if .not.used('posfzk')
	use in 0 dat\posfzk
endif
select posfzk
goto 1
replace keystate with '1'
do data_up
set clock off
set color to
=sys(2009)
set cursor off
=showbmpin(0,0,639,449,'_marble.bmp')
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('bye',9,20,16,60,"colo &p_color titl '谢谢使用'")
=actiwind('bye')
=showico(c2x(34)-5,r2y(5)-3,'whello.ico')
@ 2,4 say '谢谢使用安立公司产品!' color n/w
@ 3,4 say space(22) color n/w
do alarm
ot=seconds()
do while .t.
	ct=seconds()
	if ct-ot>1 .or. ct<ot
		exit
	endif
enddo

if .not.used('netxb')
	use in 0 tradedat\netxb
endif
select netxb
if reccount()>0
	@ 1,4 say '由于网络故障,销售明细未完全回收!' color n/w
	@ 2,4 say '    请通知电脑系统管理员!!!' color n/w
	@ 5,4 say '按任意键退出......' color n/w
	=inkey(0)
	do alarm
	do alarm
endif
ot=seconds()
do while .t.
	ct=seconds()
	if ct-ot>1 .or. ct<ot
		exit
	endif
enddo
release all
close all
clear all
run cls
return 3

*===============================
*报表打印
*===============================
procedure bbdy
if .not.used('tradedat\netxb')
	use in 0 tradedat\netxb
endif
select netxb
if reccount()>0
	strr='POS机销售数据未完全回收!!!'
	do prt with strr
endif 
select netxb
use
do skybbl_mx
return

*===============================
*收款员报表
*===============================
procedure skybbl_mx
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('mxbb',8,20,14,60,"colo &p_color titl '收款员明细日报表'")
=actiwind('mxbb')
@ 2,7 say '请输入查询日期:' color n/w
=dnrect(c2x(23)-2,r2y(2)-2,c2x(31)+2,r2y(3))
set cursor on
set color to w+/b,b/w
rq=left(dtoc(date()),4)+substr(dtoc(date()),6,2)+right(dtoc(date()),2)
ls_rq=rq
=tishiL('请输入查询日期(YYYYMMDD')
@ 2,23 get ls_rq color n/w
read
=relewind('mxbb')
ln_bbhj=0
filepc='bak\xb'+right(ls_rq,6)+'.dbf'
if .not.file(filepc)
	=tishil('日期错!!')
	do alarm
	return
endif
select skym,ssje from &filepc where alltrim(tzm)=[2] .or. alltrim(tzm)=[1] into dbf bb1
select skym,ssje from &filepc where alltrim(tzm)=[5] .or. alltrim(tzm)=[6] into dbf bb2
select skym,sum(ssje) as ssje from bb1 group by 1 order by 1 into dbf bb3
use in bb1
erase bb1.dbf
select skym,sum(ssje) as ssje from bb2 group by 1 order by 1 into dbf bb4
use in bb2
erase bb2.dbf
select bb4
ln2=reccount()
goto top
for step=1 to ln2
	m_skym=skym
	select bb3
	goto top
	locate for skym=m_skym
	if .not.found()
		insert into bb3(skym,ssje) value (m_skym,0)
	endif
	select bb4
	skip
endfor
select bb3
ln1=reccount()
strr=space(5)+'收款员明细报表'
do prt with strr
do delay1
strr='报表日期'+substr(ls_Rq,1,4)+'/'+substr(ls_rq,5,2)+'/'+right(ls_Rq,2)
do prt with strr
do delay1
if ln1=0 .and. ln2=0
	strr=replicate('-',30)
	do prt with strr
	strr='此日无销售!'
	do prt with strr
else
	strr=replicate('-',30)
	do prt with strr
	do delay1
	ln_bbhj=0
	ssje_xs=0
	ssje_th=0
	select bb3
	for li=1 to reccount()
		m_skym=skym
		ssje_xs=ssje
		if .not.used('yuangzd')
			use in 0 dat\yuangzd
    	endif
    	select yuangzd
    	goto top
    	locate for alltrim(gonghao)=alltrim(m_skym)
    	if found()
    		strr=space(1)+'姓名'+space(10)+padr(alltrim(xingmin),8,' ')
    	else		
    		strr=space(1)+'姓名'+space(10)+m_skym)
    	endif
    	do prt with strr
    	strr=space(1)+'销售额'+space(7)+str(ssje_xs,10,2)
    	do prt with strr
    	do delay1
    	select bb4
    	ssje_th=0
    	ln_th=reccount()
    	if ln_th>0
    		goto top
    		locate for alltrim(skym)=alltrim(m_skym)
    		if found()
    			ssje_th=ssje
    			strr=space(1)+'退货额'+space(7)+str(ssje_th,10,2)
    			do prt with strr
    		endif
    	endif
    	ln_bbhj=ln_bbhj+ssje_xs-ssje_th
    	strr=space(1)+'实收金额'+space(5)+str(ssje_xs-ssje_th,10,2)
    	do prt with strr
    	strr=replicate('-',30)
    	do prt with strr
    	do delay1
    	select bb3
	    skip
	endfor    	
	select yuangzd
	use
endif
use in bb3
erase bb3.dbf
use in bb4
erase bb4.dbf
strr=space(1)+'合计'+space(10)+str(ln_bbhj,10,2)
do prt with strr
do prt_head
return

*===============================
*会员卡销售
*===============================
procedure hyk
=autosize(.t.)
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('readcard',8,20,13,60,"colo &p_color titl [请刷卡]")
=tishil('请刷卡')
=actiwind('readcard')
@ 2,3 say '卡号为:' color n/w
=dnrect(c2x(11)-2,r2y(2)-2,c2x(31)+9,r2y(3))
set cursor off
set color to w+/b,b/w
gs_pass=space(24)
@ 2,11 get gs_pass when passw(24,2,11)
read
=inkey(0)
str1=alltrim(gs_pass)
=relewind('readcard')
if len(str1)<>24
	p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
	=defiwind('readcard',8,20,17,60,"colo &p_color titl '请刷卡'")
	=tishil('请刷卡')
	=actiwind('readcard')
	@ 2,3 say '卡号为:' color n/w
	=dnrect(c2x(11)-2,r2y(2)-2,c2x(31)+9,r2y(3))
	gs_pass=space(24)
	@ 2,11 get gs_pass when passw(24,2,11)
	read
	=inkey(0)
	str1=alltrim(gs_pass)
endif
if len(str1)<>24
	=tishiw('卡号输入错误,按任意键返回!',1)
	return
endif
gs_fbbh=substr(str1,7,2)
if .not.used('posfbk')
	use in 0 dat\posfbk
endif
select posfbk
locate for alltrim(bzbh)=gs_fbbh
if .not.found()
	=tishiw('无此结算方式!',0)
	return
else
	gs_fbmc=alltrim(bzmc)
	gs_nokh=substr(str1,9,15)
	ls_s1=left(gs_nokh,6)
	ls_s2=right(gs_nokh,9)
	ls_s3=''
	ln_n=0
	ln_i=1
	do while ln_i<7
		ls_s4=substr(ls_s1,ln_i,1)
		ln_n=10-val(ls_s4)
		ls_s3=ls_s3+substr(ls_s2,ln_n,1)
		ln_i=ln_i+1
	enddo
	gs_kh=ls_s3
	do hyj_xs
endif
if used('posfbk')
	select posfbk
	use
endif
return

*===============================
*刷卡提交
*===============================
procedure commit_card
parameter ac1,ac2,ac3,an1
private ps_r
if .not.used('hyk_dn')
	use in 0 dat\hyk_dn
endif
select hyk_dn
zap
if .not.used('hyk')
	use in 0 dat\hyk
endif
if .not.used('temp')
	use in 0 temp
endif
select hyk
delete for kxfbs='001'
delete for kxfbs='002'
pack
select temp
sum yj*sl to yj_hj
use
select hyk
INSERT INTO hyk ( KXFBS, POSNO, XFRQ, XFSJ, KXFJE, CARDNO, KAHAO, SKYM, YYYM, HBXH, HJBZ, KAMC, SKSJPH, KYE, HYKMM, BZC, BZN ) VALUE ( AC1, gs_SKJH, AA(12), TIME(), AN1, AC2, AC3, gs_SKN, gs_YYN, GS_FBBH, '0', GS_FBMC, '     ', 0.00, '', '', YJ_HJ-AN1 )
=autosize(.t.)
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('dsxx',8,20,17,60,"colo &p_color titl '提示信息'")
=actiwind('dsxx')
set cursor off
=tishil(gs_fbmc+'正在申请中,请等待!')
@ 4,4 say gs_fbmc+'正在申请中,请等待!' color n/w
if file('f:\hpos\posnet.txt')
	if file(gs_pospath+'\error.txt')
		do cwcl
	endif
	if .not.file(gs_pospath+'\hyk_up.txt')
		copy file yes.txt to &gs_pospath\pos.txt
		select hyk
		copy to &gs_pospath\hyk_up.txt type delimited with tab
		erase &gs_pospath\pos.txt
	endif
	ot=seconds()
	ct=seconds()
	do while ct-ot<5
		if file(gs_pospath+'\hyk_dn.txt')
			exit
		endif
		ct=seconds()
	enddo
	if file(gs_pospath+'\hyk_dn.txt')
		copy file yes.txt to &gs_pospath\pos.txt
		copy file &gs_pospath\hyk_dn.txt to hyk_dn.txt
		erase &gs_pospath\pos.txt
		erase &gs_pospath\hyk_dn.txt
		if .not.used('hyk_dn')
			use in 0 dat\hyk_dn
		endif
		select hyk_dn
		zap
		append from hyk_dn delimited with tab
		gs_ckrxm=alltrim(bzc)
		use
		erase hyk_dn.txt
		ps_R='1'
	else
		if file(gs_pospath+'\hyk_up.txt')
			erase &gs_pospath\hyk_up.txt
		endif
		ps_r='-1'
	endif
else
	ps_r='0'
endif
=relewind('dsxx')
return ps_r

*===============================
*会员价销售
*===============================
procedure hyj_xs
private ps_sqbz
ls_r=commit_card('001',gs_nokh,gs_kh,0)
do case
	case ls_r='0' .or. ls_r='-1'
		ps_sqbz='0'
	case ls_r='1'
		if .not. used('hyk_dn')
		 	use in 0 dat\hyk_dn
		endif
		select hyk_dn
		goto top
		do case
			case kxfbs='100'
				ps_sqbz='1'
			case kxfbs='101'
				ps_sqbz='-1'
				=tishiw('此卡已进入黑名单,申请失败!',1)
			case kxfbs='102'
				ps_sqbz='-1'
				=tishiw('此卡已挂失,申请失败!',1)
			case kxfbs='103'
				ps_sqbz='-1'
				=tishiw('此卡已作废,申请失败!',1)
			case kxfbs='104'
				ps_sqbz='-1'
				=tishiw('此卡未发行,申请失败!',1)
			otherwise
				ps_sqbz='-1'
				=tishiw(kxfbs+'不知道卡标识含义,申请失败!',1)
		endcase
endcase
if ps_sqbz='-1'
	return
endif
if .not.used('temp')
	use in 0 temp
endif
if .not.used('spmx')
	use in 0 dat\spmx
endif
select temp
sum ssje to yj_hj
goto top
do while .not.eof()
	ls_spma=spma
	ln_jyj=jyj
	select spmx
	set order to spma
	seek ls_spma
	if ln_jyj>pifaj .and. pifaj>0
		ln_jyj=pifaj
		select temp
		replace jyj with ln_jyj 
		replace ssje with jyj*sl
		if alltrim(tzm)='1' 
			replace tzm with '2'
		endif
		if alltrim(tzm)='5'
			replace tzm with '6'
		endif
	endif
	select temp
	skip
enddo
sum ssje to hj
if ps_sqbz='1'
	ls_r=commit_card('002',gs_nokh,gs_kh,hj)
endif
=autosize(.t.)
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('card',8,20,17,60,"colo &p_color titl gs_fbmc+[信息]")
=actiwind('card')
=dnrect(c2x(2),r2y(1)-5,c2x(36),r2y(8)+2)
=uprect(c2x(2)+1,r2y(1)-4,c2x(36)-1,r2y(8)+1)
@ 2,5 say '卡名:'+gs_fbmc color n/w
@ 3,5 say '卡号:'+gs_kh color n/w
@ 4,5 say '持卡人:'+gs_ckrxm color n/w
@ 5,5 say '合计:'+str(hj,8,2)+'元 优惠:'+str(yj_hj-hj,6,2)+'元' color n/w
=inkey(0)
set cursor on
=relewind('card')
return

*===============================
*错误处理,后台最后一次未回收成功的数据再发送一遍
*===============================
procedure cwcl
if .not.used('lsbflast')
	use in 0 tradedat\lsbflast
endif
copy file yes.txt to &gs_pospath\pos.txt
filenet=gs_pospath+'\tradedat\xslsnet.txt'
select lsbflast
copy to &gs_pospath delimited with tab
if file(filenet)
	erase &gs_pospath\pos.txt
	erase &gs_pospath\error.txt
endif
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('error',9,20,17,60,"colo &p_color titl '错误处理'")
=actiwind('error')
=showico(c2x(34)-5,r2y(5)-3,'whello.ico')
do while file(gs_pospath+'\error.txt')
	@ 2,4 say '不能删除文件,错误号001' color n/w
	@ 3,4 say '请立即通知系统管理员,按任意键继续!' color n/w
	=inkey(0)
enddo
=relewind('error')
select lsbflast
use
return
		
*===============================
*挂帐
*===============================
procedure gzgc
if .not.used('temp')
	use in 0 temp
endif
rq1=dtoc(date())
rq=substr(rq1,3,2)+substr(rq1,6,2)+right(rq1,2)
filepc='gz\gz'+rq+'.dbf'																																					
select temp
if .not.file('gz\gz'+rq+'.dbf')
	copy to 'gz\gz'+rq stru
endif
=autosize(.t.)
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,w/w,w+/w'
=defiwind('gzgc',8,20,17,60,"colo &p_color titl '交易挂起'")
=actiwind('gzgc')
=dnrect(c2x(2),r2y(1)-5,c2x(36),r2y(8)+2)
=uprect(c2x(2)+1,r2y(1)-4,c2x(36)-1,r2y(8)+1)
=showico(c2x(34)-5,r2y(7)-3,'note.ico')
@ 2,7 say '请输入挂帐号:' color n/w
=dnrect(c2x(10)-2,r2y(4)-2,c2x(30)+2,r2y(5))
ls_jyh=space(6)
ls_time=time()
if gn_num>0
	ls_jyh=left(ls_time,2)+substr(ls_time,4,2)+right(ls_time,2)
	@ 4,10 say ls_jyh color n/w
	@ 6,10 say '按任意键继续...' color n/w
	=inkey(0)
else
	@ 4,10 get ls_jyh picture '999999' color n/w
	read
	ls_jyh=alltrim(ls_jyh)
	if len(ls_jyh)<>6
		=relewind('gzgc')
		select temp
		use
		return
	endif
endif

if .not.used(substr(filepc,4,8))
	use in 0 &filepc
endif
select substr(filepc,4,8)
goto top
if left(ls_jyh,2)='00'
	locate for right(alltrim(jysj),4)=right(ls_jyh,4)
else
	locate for alltrim(jysj)=ls_jyh
endif

if .not.found() .and. gn_num=0
	@ 2,7 say '无交易!!!    ' color n/w
	do alarm  
	do delay1
	=relewind('gzgc')
	select temp
	use
	select substr(filepc,4,8)
	use
	return
endif

if .not.found() .and. gn_num>0
	if gs_gzbz='0'
		select temp
		go bottom
		if sl>0
			do prt_cnt
		else
			delete for sl=0
			pack
		endif
	else
		gs_gzbz='0'
	endif
	select temp
	replace jysj with ls_jyh all
	select substr(filepc,4,8)
	append from temp
	strr=replicate('=',37)
	do prt with strr
	strr=space(2)+'挂帐号为:'+space(2)+ls_jyh
	do prt with strr
	strr=space(2)+'挂帐时间:'+space(2)+time()
	do prt with strr
	strr=space(2)+'请注意:此单不能作为销售凭证!!!'
	do prt with strr
	do prt_head
	=relewind('gzgc')
	select substr(filepc,4,8)
	use
	do czgz
	do cssj
	do clswin
	select temp
	zap
	use
	return
endif

if found() .and. gn_num=0
	select temp
	if left(ls_jyh,2)='00'
		append from 'gz\gz'+rq for right(a