atlib.prg

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

for step_cx=1 to 13
	ls_spma=spma
	ls_yytxm=yytxm
	ls_spmc=spmc
	ls_lsj=str(lingshouj,10,2)
	ls_gg=gg
	@ 16,18 say ls_spma color n/w
	@ 16,35 say ls_spmc color n/w
	@ step_cx+1,1 say ls_spma color n/w
	@ step_cx+1,8 say ls_yytxm color n/w
	@ step_cx+1,22 say ls_spmc color n/w
	@ step_cx+1,36 say ls_gg color n/w
	@ step_cx+1,46 say ls_lsj color n/w
	if .not.eof()
		skip
	else
		exit
	endif
endfor

ln_jldw_to=1
ln_jldw_bo=step_cx-1
do while .t.
	key_cx=inkey(0)
	do case
		case key_cx=27
			select cx_temp
			use
			erase cx_temp.dbf
			=relewind('cxjl')
			close databases
			exit
		case key_cx=key_up
			if ln_cxjl<13 .and. .not.bof()
				skip -1
				ls_spma=spma
				ls_spmc=spmc
				@ 16,18 say ls_spma color n/w
				@ 16,35 say ls_spmc color n/w
				loop
			endif
			do cxjp_up
		case key_cx=key_down
			if ln_cxjl<13 .and. .not.eof()
				skip
				ls_spma=spma
				ls_spmc=spmc
				@ 16,18 say ls_spma color n/w
				@ 16,35 say ls_spmc color n/w
				loop
			endif
			do cxjp_dn
		case key_cx=13
			gs_nost=ls_spma
			gn_num=gn_num+1
			select cx_temp
			use
			erase cx_temp.dbf
			=relewind('cxjl')
			do srplu
			do hjxs
			exit
	endcase
enddo
close databases
erase cx_temp.dbf
return

*===============================
*查询上卷屏
*===============================
procedure cxjp_up
if ln_jldw_to=1
	return
endif
select cx_temp
goto ln_jldw_to
skip -1
if .not.bof()
	ln_jldw_to=ln_jldw_to-1
	ln_jldw_bo=ln_jldw_bo-1
else
	return
endif
scroll 2,1,14,56,-1
ls_spma=spma
ls_yytxm=yytxm
ls_spmc=spmc
ls_lsj=str(lingshouj,10,2)
ls_gg=gg
@ 16,18 say ls_spma color n/w
@ 16,35 say ls_spmc color n/w
@ 2,1 say ls_spma color n/w
@ 2,8 say ls_yytxm color n/w
@ 2,22 say ls_spmc color n/w
@ 2,36 say ls_gg color n/w
@ 2,46 say ls_lsj color n/w
return

*===============================
*查询下卷屏
*===============================
procedure cxjp_dn
if ln_jldw_bo=reccount()
	return
endif
select cx_temp
goto ln_jldw_bo
skip
if .not.eof()
	ln_jldw_to=ln_jldw_to+1
	ln_jldw_bo=ln_jldw_bo+1
else
	return
endif
scroll 2,1,14,56,1
ls_spma=spma
ls_yytxm=yytxm
ls_spmc=ls_spmc
ls_lsj=str(lingshouj,10,2)
ls_gg=gg
@ 16,18 say ls_spma color n/w
@ 16,35 say ls_spmc color n/w
@ 14,1 say ls_spma color n/w
@ 14,8 say ls_yytxm color n/w
@ 14,22 say ls_spmc color n/w
@ 14,36 say ls_gg color n/w
@ 14,46 say ls_lsj color n/w
return
	
*===============================
*权限判断
*===============================		
procedure qxyz
=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('qxyz',8,20,17,60,"colo &p_color titl '使用特权'")
=actiwind('qxyz')
=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,7 say '特权工号:' color n/w
@ 4,7 say '特权密码:' color n/w
=dnrect(c2x(20)-2,r2y(2)-2,c2x(24)+2,r2y(3))
=dnrect(c2x(20)-2,r2y(4)-2,c2x(26)+2,r2y(5))
set cursor on
set color to w+/b,b/w
ls_gonghao=space(4)
@ 2,20 get ls_gonghao color n/w
read
if .not.used('yuangzd')
	use in 0 dat\yuangzd
endif
select yuangzd
goto top
locate for gonghao=ls_gonghao
if .not.found()
	select yuangzd
	use
	@ 6,7 say '无此工号!!!' color n/w
	do alarm
	do alarm
	do delay1
	=relewind('qxyz')
	gs_qx='n'
	return
endif
if gzbh<>'01'
	@ 6,7 say '此工号无此权限!!!' color n/w
	select yuangzd
	use
	do alarm
	do alarm
	do delay1
	=relewind('qxyz')
	gs_qx='n'
	return
endif
ls_xm=xingmin
ls_mm=kouling
select yuangzd
use
=tishil('请输入密码......')
set cursor off
gs_pass=space(6)
@ 4,20 get gs_pass when passw(6,4,20)
read cycle
gs_pass=alltrim(gs_pass)
if gs_pass=ls_mm
	gs_qx='y'
	@ 6,7 say '特权使用人为:'+ls_xm color n/w
else
	gs_qx='n'
	@ 6,7 say '密码错!!!' color n/w
endif
select yuangzd
use
@ 7,7 say '按任意键继续......' color n/w
=inkey(0)
=relewind('qxyz')
return

*===============================
*减操作日志
*===============================
procedure czrz
if .not.used('temp')
	use in 0 temp
endif
select temp
rq=substr(aa(12),3,6)
file_rz='rz\rz'+rq+'.dbf'
if .not.file(file_rz)
	copy to &file_rz stru
endif
if len(alltrim(jysj))=0
	replace jysj with time() all
endif
if .not.used(file_rz)
	use in 0 &file_rz
endif
select substr(file_rz,4,8)
append from temp
use
if gs_flagnet='ok' .and. file(file_rz)
	copy file &file_rz to &gs_pospath\&file_rz
endif
return

*===============================
*清除销售商品信息显示区
*===============================
procedure clswin
set color to w/w
@ 4,1 clear to 16,78
@ 18,31 say space(10) color n/w
@ 20,31 say space(10) color n/w
@ 22,31 say space(10) color n/w
@ 22,55 say space(10) color n/w
gn_num=0
if gn_thbz=-1
	gn_thbz=1
	do jhbz
endif
gn_yhbz=0
return

*===============================
*顾客付款
*===============================
procedure gkfk
if gn_num=0
	=tishiw('无商品交易!',0)
	return
endif
if gn_no>9999999.99
	=tishiw('合计超出范围!',0)
	return
endif
if .not.used('temp')
	use in 0 temp
endif
gn_fk=0.00
if gn_no=0
	gn_fk=gn_hj-gn_hjyh
else
	gn_fk=gn_no
endif
@ 20,31 say str(gn_thbz*gn_fk,10,2) color n/w
if gn_fk<gn_hj-gn_hjyh
	=tishiw('付款不足,请付清款额!',0)
	return
endif
@ 22,31 say str(gn_fk-gn_hj+gn_hjyh,10,2) color n/w
str1=left('PAID    '+str(gn_thbz*gn_fk,10,2)+space(20),20)
str2=left('付款  '+str(gn_thbz*gn_fk,10,2)+space(20),20)
str3='CHANGE  '+str(gn_fk-gn_hj+gn_hjyh,10,2)
str4='找零    '+str(gn_fk-gn_hj+gn_hjyh,10,2)
do dispgu with str1,str2,str3,str4
do draw
select temp
goto bottom
if sl>0
	if gs_gzbz='0'
		do prt_cnt
	endif
endif
strr=replicate('=',37)
do prt with strr

if .not.used('error')
	use in 0 error
endif
select error
copy to error.txt type delimited with tab
use

do crsjk
do prt_end
gn_num=0
gn_yhbz=0
if gn_thbz=-1
	gn_thbz=1
	do jhbz
endif
if gs_gzbz='1'
	gs_gzbz='0'
endif
@ 22,73 say aa(16) color n/w
set color to w/w
@ 4,1 clear to 16,78
close databases
return 


*===============================
*开钱箱
*===============================
procedure draw
if gs_prtstatus='0'
	return
endif
if .not.used('drw_conf')
	use in 9 dat\drw_conf
endif
select drw_conf
goto top
locate for status='1'
if found()
	if alltrim(drw_socket)=''
		replace drw_socket with '5'
		ln_plus=10
	else
		ln_plus=val(alltrim(drw_socket))*2
	endif
endif
if gn_qtpdbz=1
	return
endif
set printer on
set device to printer
@ prow(),1 say chr(27)+'p'+chr(0)+chr(ln_plus)+chr(250)+chr(10)
@ prow(),0 say chr(27)+'+'
set device to screen
set printer off
select drw_conf
use
return

*===============================
*打印小标尾部信息
*===============================
procedure prt_end
if gs_prtstatus='0'
	return
endif
if .not.used('temp')
	use in 0 temp
endif
select temp
sum round(ssje,1) to ss_zj
sum round(yj*sl,1) to yj_zj
sum sl to ln_sl
strr=substr('原价合计'+space(22),1,19)+str(ln_sl,8,1)+'0'+str(gn_thbz*yj_zj,8,1)+'0'
do prt with strr
if yj_zj-ss_zj>0
	strr=substr('优惠'+space(28),1,28)+str(gn_thbz*(yj_zj-ss_zj),8,1)+'0'
	do prt with strr
endif
if gn_fk-gn_hj+gn_hjyh>0
	str3=str(gn_fk,10,2)
	str4=str(gn_fk-gn_hj+gn_hjyh,10,1)+'0'
	strr='付款  '+str3+space(6)+'找零'+str4
else
	strr=substr('现金'+space(28),1,28)+str(gn_thbz*ss_zj,8,1)+'0'
endif
do prt with strr
if gn_thbz=-1
	do prt with chr(27)+chr(14)
	strr=space(16)+'退货交易'
	do prt with strr
	do prt with chr(1)
endif
select temp
goto bottom
strr='交易时间:'+jysj+space(12)+'No.'+sksjph
do prt with strr
ln_handle=fopen('please.txt')
do while .not.feof(ln_handle)
	strr=fgets(ln_handle,80)
	strr=alltrim(strr)
	strr=space((40-len(strr))/2)+strr
	do prt with strr
	do delay1
enddo
=fclose(ln_handle)
do prt_head
return


*===============================
*插入数据库
*===============================
procedure crsjk
private filepc,filenet
do slhb
if .not.used('temp')
	use in 0 temp
endif
if .not.used('netxb')
	use in 0 tradedat\netxb
endif
if .not.used('lsbflast')
	use in 0 tradedat\lsbflast
endif
if .not.used('posfzk')
	use in 0 dat\posfzk
endif
if .not.used('tracks')
	use in 0 tracks
endif
select posfzk
if piaohao>9999999
	replace piaohao with 0
endif
aa(16)=padl(piaohao+1,5,'0')
replace piaohao with val(aa(16))
aa(13)=time()
select  tracks
replace sksjph with aa(16),tablename with 'posfzk'

select temp
replace jyrq with aa(12) all
replace jysj with aa(13) all
replace sksjph with aa(16) all
select tracks
replace sksjph with aa(16),tablename with 'temp'

select tzm,spma,sptxm,jyj,sl,ssje,jyrq,jysj,yyym,skym,sksjph,jsbz,gklx,jihao,mbk,yj from temp into dbf pcxs
select pcxs
replace mbk with '01' all
select tracks
replace sksjph with aa(16),tablename with 'pcxs'

select netxb
append from pcxs
select tracks
replace sksjph with aa(16),tablename with 'netxb'

rq=right(aa(12),6)
filepc='bak\xb'+rq+'.dbf'
if .not.used(substr(filepc,5,8))
	select 25
	use &filepc
endif
append from pcxs
select 25
use
select tracks
replace sksjph with aa(16),tablename with 'xbbak'

erase error.txt
select pcxs
use
erase pcxs.dbf

if gs_flagnet='ok' .and. .not.file(gs_pospath+'\tradedat\xslsnet.txt')
	if .not.file('f:\hpos\posnet.txt') .or. file(gs_pospath+'\control.txt')
		return
	endif
	copy file yes.txt to &gs_pospath\pos.txt
	if file(gs_pospath+'\error.txt')
		do cwcl
	else
		select lsbflast
		zap
		append from tradedat\netxb
		count to rowcount
		goto top
		mspma=spma
		insert into lsbflast (tzm,spma,sl) value ('000',mspma,rowcount)
		filenet=gs_pospath+'\tradedat\xslsnet.txt'
		filepc='tradedat\xslsnet.txt'
		copy to &filepc type delimited with tab
		ln_i=0
		do while uf_filesiz(filenet)<>uf_filesiz(filepc)
			ln_i=ln_i+1
			if ln_i>3
				=tishiw('网络上传错误,请检查错误!',1)
				exit
			endif
			if file('f:\hpos\posnet.txt')
				copy file &filepc to &filenet
			endif
		enddo
		if file(filenet)
			select netxb
			zap
		endif
		filenet=gs_pospath+'\pos.txt'
		erase &filenet
		erase &filepc
	endif
endif
=tishil('交易数据已成功存盘!')
return 

*===============================
*交换(销售和退货)标志
*===============================
procedure jhbz
if gn_thbz=-1
	@ 18,56 say '○ 销售 ● 退货' color n/w
	aa(5)='5'
else
	@ 18,56 say '● 销售  ○退货' color n/w
	aa(5)='1'
endif
return

*===============================
*发送前台数据
*===============================
procedure data_up
if gs_flagnet='false'
	return
endif
if .not.used('netxb')
	use in 0 tradedat\netxb
endif
if .not.used('lsbflast')
	use in 0 tradedat\lsbflast
endif
select netxb
if reccount()=0
	close database
	return
endif

if gs_flagnet='ok' .and. file('f:\hpos\posnet.txt') .and. .not.file(gs_pospath+'\control.txt')
	if file(gs_pospath+'\error.txt')
		do cwcl
	else
		filepc='tradedat\xslsnet.txt'
		filenet=gs_pospath+'\tradedat\xslsnet.txt'
		copy file yes.txt to &gs_pospath\pos.txt
		select lsbflast
		zap
		if file(gs_pospath+'\tradedat\xslsnet.txt')
			ln_i=0
			do while uf_filesiz(filepc)<>uf_filesiz(filenet)
				ln_i=ln_i+1
				if ln_i>3
					=tishiw('网络错误,请检查网络!',1)
					exit
				endif
				copy file &filenet to &filepc
			enddo
			append from &filepc delimited with tab
			delete for tzm='000'
			pack
		endif
		append from tradedat\netxb
		count to rowcount
		goto top
		mspma=spma
		insert into lsbflast (tzm,spma,sl) value ('000',mspma,rowcount)
		copy to &filepc delimited with tab
		use
		ln_i=0
		do while uf_filesiz(filepc)<>uf_filesiz(filenet)
			ln_i=ln_i+1
			if ln_i>3
				=tishiw('网络错误,请检查网络!',1)
				exit
			endif
			copy file &filepc to &filenet
		enddo
        if file(filenet)
			select netxb
			zap
		endif
		filenet=gs_pospath+'\pos.txt'
		erase &filepc
		erase &filenet
	endif
endif
close databases
return

*===============================
*退出收银系统
*===============================