atlib.prg

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

******************************************************
&& 版本号: VER1.0
&& 逐条打印,电子秤条形码,店内条形码,顾客屏,error.txt处理库,营业员报表,收款员柜组报表,
&& 逐条打印标准版 V2.3
&& 覆盖xslsnet.txt前先用fopen()函数访问
&& 操作日志  czrz
&& 前台盘点  qtpd
&& 打折会员卡    hyj_xs
&& 前台查询      qtcx
******************************************************
*===============================
*ucdos5 sdk for foxpro
*===============================
procedure loadsdk
private foxver
foxver=version()
do case 
	case '2.5'$foxver
		if '(x)'$foxver
			set library to fp25x.plb
		else
			set library to fp25.plb
		endif
	case '2.6'$foxver
		if '(x)'$foxver
			set library to fp26x.plb
		else
			set library to fp26.plb
		endif
	otherwise
		? SDK不支持当前的FOXPRO版本!
		WAIT
endcase
return

*===============================
*初始化全局变量
*===============================
PROCEDURE initdata
public gs_skn    &&收款员编号
public gs_yyn    &&营业员编号
public gs_chc    &&功能码
public gs_skm    &&收款员姓名
public gs_skydj  &&收款员等级
public gs_scmc   &&商场名称
public gs_scdh   &&商场电话
public gn_hj     &&合计
public gn_hjyh   &&合计优惠
public gn_thbz   &&退货标志
public gs_skjh   &&收款机号
public gs_pass   &&密码
public gs_nost   &&输入字符
public gn_no     &&输入数值
public gn_num    &&输入行计数
public aa(22)      &&数据处理数组
public gs_flagnet  &&网络连通标志
public gn_qtpdbz   &&前台盘点标志
public gn_x        &&输入框X坐标
public gn_y        &&输入框Y坐标
public gs_pospath  &&POS机后台映射路径
public gn_fk       &&付款数
public gn_sfg      &&是否已合计标志
public gs_prttype  &&打印类型
public gn_scrollfg &&翻屏计数
public gs_qx       &&权限
public gs_fbbh     &&分店编号
public gs_fbmc     &&分店名称
public gs_ckrxm    &&持卡人姓名
public gs_nokh     &&系列卡号
public gs_kh       &&卡号
public gn_yhbz     &&优惠标志
public gs_gzbz     &&挂账标志
public gs_prtstatus  &&是否打印标志 

gn_x=7
gn_y=18
gs_flagnet=space(5)
gs_skm=space(8)
gs_skn=space(4)
gs_skydj=space(2)
gs_scmc=space(14)
gs_chc=space(2)
gs_scdh=space(14)
gs_hj=0.00
gs_hjyh=0.00
gn_thbz=1
gn_qtpdbz=0
gn_no=0
gs_nost=space(4)
gn_num=0
gs_skjh=space(4)
gs_pass=space(6)
aa='00'
gn_sfg=0
gn_scrollfg=0
gs_qx='n'
gs_ckrxm=''
gs_fbbh=''
gs_fbmc=''
gs_nokh=''
gs_kh=''
gn_yhbz=0
gs_gzbz='0'
gs_yyn=space(4)
gs_prtstatus='0'

if .not.used('posfzk')
	use in 0 dat\posfzk
endif
select posfzk
gs_skjh=alltrim(jihao)
gs_scmc=alltrim(scmg)
gs_scdh=alltrim(dhhm)
gs_pospath='f:\pos'+right(alltrim(jihao),2)
gs_prttype=alltrim(prt_style)
use
return

*===============================
*脱机登录
*===============================
function tjdl
if .not.file('f:\hpos\posnet.txt')
	p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,w/b,n/w,w+/w'
	=defiwind('tjdl',8,20,17,60,"colo &p_color titl '脱机登录窗'")
	=actiwind('tjdl')
	@ 4,7 say '输入单机密码' color n/w
	=dnrect(c2x(22)-2,r2y(4)-2,c2x(30)+2,r2y(5))
	for i=1 to 3
		set cursor off
		set color to w+/b,b/w
		gs_pass=space(6)
		@ 4,24 get gs_pass when passw(6,4,24)
		read
		rq=dtoc(date())
		if alltrim(gs_pass)=alltrim(str(val(left(rq,4))+val(substr(rq,6,2))+val(right(rq,2)),4))
			exit
		endif
		=showico(c2x(3)+5,r2y(5)+10,'face04.ico')
		if i<3
			@ 6,9 say '脱机密码错,请重新输入! ' color n/w
		else
			@ 6,9 say '脱机密码错,退出!       ' color n/w
			=relewind('tjdl')
			return ''
		endif
	endfor
	=showico(c2x(3)+5,r2y(5)+10,'face03.ico')
	@ 6,9 say '脱机登录成功!          ' color n/w
	do delay1						  
	=relewind('tjdl')
endif
return		
	
*===============================
*延时
*===============================
procedure delay1
oldtime=second()
do while .t.
	curtime=second()
	if curtime-oldtime>0.2 .or.curtime<oldtime		
		exit
	endif
enddo
return

*===============================
*密码输入函数
*===============================
function passw
parameter mmcd,mmx,mmy
str_tmp=space(mmcd)
count=0
do while count<mmcd
	count=count+1
	key=inkey(0)
	if key=13
		exit
	endif
	if key=127
		count=0
		str_tmp=space(mmcd)
		gs_pass=space(mmcd)
		@ mmx,mmy say space(mmcd) color n/w
		loop
	endif
	gs_pass=alltrim(gs_pass+chr(abs(key)))
	str_tmp=stuff(str_tmp,count,1,'*')
	@ mmx,mmy say str_tmp color n/w
enddo
clear read
return

*===============================
*收款员登录
*===============================
procedure srsky
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,b/w,w/w,w+/w'
=defiwind('skydl',8,20,17,60,"colo &p_color titl '收款员登录窗口'")
=actiwind('skydl')
=dnrect(c2x(2),r2y(1)-5,c2x(36),r2y(8)+2)
=uprect(c2x(2),r2y(1)-4,c2x(36)-1,r2y(8)+1)
=showico(c2x(34)-5,r2y(7)-3,'note.ico')
@ 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))
if .not.used('yuangzd')
	use in 0 dat\yuangzd
endif
for i=1 to 3
	set cursor on
	set color to w+/b,b/w
	gs_skn=space(4)
	@ 2,20 get gs_skn size 1,4 picture '9999'
	read
	set cursor off
	gs_pass=space(6)
	@ 4,20 get gs_pass when passw(6,4,20)
	read
	select yuangzd
	locate for gonghao=gs_skn
	if found()
		if alltrim(leixin)='收' .and. alltrim(kouling)=alltrim(gs_pass) 
			gs_skm=alltrim(xingmin)
			gs_skydj=gzbh
			exit
		endif
	else
		*是否是系统管理员
		if gs_skn='9999' and alltrim(gs_pass)='9999'
			gs_skm='系统管理员'
			gs_skydj='01'
                                    exit
	endif
	=showico(c2x(3)+5,r2y(5)+10,'face04.ico')
	if i<3 
		@ 6,9 say '登录不对,请重新输入!' color n/w
	else
		@ 6,9 say '登录不对,退出!' color n/w
		do delay1
		=relewind('skydl')
		return ''
	endif
	@ 4,20 say space(6) color n/w
	do delay1
	set color to w/w
	@ 6,9 clear to 6,33
	=setfillsty(1,7)
	=drawbar(c2x(3),r2Y(5),c2x(7)+5,r2y(7)+5)
endfor
=showico(c2x(3)+5,r2y(5)+10,'face03.ico')
@ 6,9 say '收款员登录成功!' color n/w
do delay1
=relewind('skydl')
do prt_head
return

*===============================
*打印
*===============================
procedure prt
parameter strr
if gs_prtstatus='0'
	return
endif
if strr=''
	return
endif
if strr='feed paper'
	strr=''
endif
if .not.used('prn_conf')
	use in 0 dat\prn_conf
endif
select prn_conf
locate for status='1'
if found()
	prtsort="'"+alltrim(prn_socket)+"'"
	set printer to &prtsort
endif
if .not.printstatus() 
	do error_prt
endif
set printer on
set device to printer
@ prow(),0 say strr+chr(10)
set printer off
set device to screen
select prn_conf
use
return

*===============================
*打印机错误
*===============================
procedure error_prt
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,16,60,"colo &p_color titl '打印机出错'")
=actiwind('error')
=showico(c2x(34)-5,r2y(5)-3,'whello.ico')
do while .not.printstatus()
	@ 3,4 say '请检查打印机电源或是否连线......' color n/w
	@ 4,4 say '按任意键继续!' color n/w
enddo
=relewind('error')
return

*===============================
*打印小票头
*===============================	
procedure prt_head
if gs_prtstatus='0'
	return
endif
for i=1 to 3
	strr='feed paper'
	do prt with strr
endfor
strr=space(round((40-len(gs_scmc+'欢迎光临'))/2,0))+'欢迎光临'+gs_scmc
do prt with strr
strr=space(3)+dtoc(date())+space(9)+' TEL:'+gs_scdh
do prt with strr
strr=space(3)+'REG '+gs_skn+space(12)+'POS NO.'+GS_SKJH
do prt with strr
return 

*===============================
*数据备份
*===============================
procedure sjkbf
private rq,rq1,fileaaa,fileaa
if .not.used('posfzk')
	use in 0 dat\posfzk
endif
rq=dtoc(date())
rq1=alltrim(left(rq,4)+substr(rq,6,2)+right(rq,2))
rq=right(rq1,6)
fileaa='bak\xb'+rq+'.dbf'
if .not.file(fileaa)
	if .not.used('spxb')
		use in 0 tradedat\spxb
	endif
	select spxb
	copy stru to &fileaa
	select posfzk
	replace piaohao with 0
endif

if gs_flagnet='ok'	
	if .not.file('f:\hpos\posnet.txt')
		gs_flagnet='false'
		close databases
		return
	endif
	rq=dtoc(date()-1)
	rq1=alltrim(substr(rq,3,2)+substr(rq,6,2)+right(rq,2))
	fileaa='bak\xb'+rq1+'.dbf'
	fileaaa=gs_pospath+'\bak\xb'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='rz\rz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\rz\rz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='gz\gz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\gz\gz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	rq=dtoc(date()-2)
	rq1=alltrim(substr(rq,3,2)+substr(rq,6,2)+right(rq,2))
	fileaa='bak\xb'+rq1+'.dbf'
	fileaaa=gs_pospath+'\bak\xb'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='rz\rz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\rz\rz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='gz\gz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\gz\gz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	
	rq=dtoc(date()-3)
	rq1=alltrim(substr(rq,3,2)+substr(rq,6,2)+right(rq,2))
	fileaa='bak\xb'+rq1+'.dbf'
	fileaaa=gs_pospath+'\bak\xb'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='rz\rz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\rz\rz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
	fileaa='gz\gz'+rq1+'.dbf'
	fileaaa=gs_pospath+'\gz\gz'+rq1+'.txt'
	if .not.file(fileaaa) .and. file(fileaa)
		select 25
		use &fileaa
		copy to &fileaaa type delimited with tab
		select 25
		use
	endif
endif
return

*===============================
*判断文件大小函数
*===============================
function uf_filesiz
parameter as_filenam
private pfilesiz,phandle
if parameters()=0 
	return -2
endif
if .not.file(as_filenam)
	return -1
endif
phandle=fopen(as_filenam)
pfilesiz=fseek(phandle,0,2)
=fclose(phandle)
return pfilesiz

*===============================
*提示消息窗口
*===============================	
procedure tishiw
parameter as_xinxi,an
=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('tishiw',9,20,15,60,"colo &p_color titl '提示信息'")
=actiwind('tishiw')
set cursor off
=tishil(as_xinxi)
=showico(c2x(2),r2y(2)-14,'warn.ico')
@ 2,8 say as_xinxi color n/w
if an=1
	ln=inkey(0)
else
	ln=inkey(1)
endif
=relewind('tishiw')
return ln

*===============================
*提示栏
*===============================
procedure tishil
parameter as_xixin
=setfillsty(1,1)
=drawbar(69,432,484,451)
=sethzcolor(15)
=sethzbkcol(1)
=showhz(75,434,as_xixin)
return

*===============================
*更新数据库
*===============================
procedure gxsjk
if gs_flagnet='ok'
	do sjgxw
	do fzk_pro
	do spmx_pro
	do fbk_pro
	do poskb_pro
	do ygk_pro
	=relewind('sjgxw')
endif
return

*===============================
*数据更新窗口
*===============================
procedure sjgxw
p_color='b/w,w+/b,w/w,w+/b,w/b,w+/b,gr/w,b/w,w/w,w+/w'
=defiwind('sjgxw',8,20,17,60,"colo &p_color titl '输据更新窗口'")
=actiwind('sjgxw')
=showico(c2x(34)-5,r2y(5)-3,'NOTE.ICO')
@ 2,4 say '正在进行数据库更新!' color n/w
@ 3,4 say '正在接收后台数据库信息!' color n/w
@ 4,8 say '请梢候...' color n/w
return

*===============================
*员工更新
*===============================
procedure ygk_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\ygk.txt') .or. uf_filesiz(gs_pospath+'\ygk.txt')<1 .or.file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if .not.used('yuangzd')
	use in 0 dat\yuangzd
endif
select yuangzd
zap
append from &gs_pospath\ygk.txt delimited with tab
use
erase &gs_pospath\pos.txt
erase &gs_pospath\ygk.txt
return

*===============================
*辅币库更新
*===============================
procedure fbk_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\hbk.txt') .or. uf_filesiz(gs_pospath+'\hbk.txt')<1 .or. file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if .not.used('posfbk')
	use in 0 dat\posfbk
endif
select posfbk
zap
append from &gs_pospath\hbk.txt delimited with tab
use
erase &gs_pospath\pos.txt
erase &gs_pospath\hbk.txt
return

*===============================
*参数库更新
*===============================
procedure fzk_pro
if gs_flagnet='false'
	return
endif
if .not.file('f:\hpos\posnet.txt') .or. .not.file(gs_pospath+'\fzk.txt') .or. uf_filesiz(gs_pospath+'\fzk.txt')<1 .or. file(gs_pospath+'\control.txt')
	return
endif
copy file yes.txt to &gs_pospath\pos.txt
if .not.used('posfzk')
	use in 0 dat\posfzk
endif
if .not.file('fzk')
	select posfzk
	copy to fzk stru
	use in 0 fzk
endif
select fzk
zap
append from &gs_pospath\fzk.txt delimited with tab
mc=scmg