poslib.prg

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

	do prtproce with strr
*  =fputs(handle,strr)
	strr=[            此日无销售 ]
	do prtproce with strr
*  =fput(handle,strr)
else
*       handle=fcreat('prtcch.dat')
	strr=[        ]+allt(scmc)+[收款员部门报表 ]
	do prtproce with strr
*       =fput(handle,strr)
	if len(nost)=5
		strr=space(9)+'报表日期:'+substr(rq,3,2)+'/'+substr(rq,5,2)+'/'+substr(rq,7,2)
		do prtproce with strr
*               =fput(handle,strr)
	endif
	strr=space(7)+dtoc(date())+space(10)+'POS No.'+'('+skjh+')'
	do prtproce with strr
	strr=[  部门号]+space(23)+[金 额]
	do prtproce with strr
*       =fput(handle,strr)
	strr=repl([-],36)
	do prtproce with strr
*       =fput(handle,strr)
	sele yyy_gz
	go top
	for ss=1 to k
		L_bbhj=L_bbhj+ssje
		strr=space(4)+yyym+space(18)+str(ssje,10,2)
		do prtproce with strr
*               =fput(handle,strr)
		skip
	endfor
	use in yyy_gz
	erase yyy_gz.dbf
	use in sky_gz
	erase sky_gz.dbf
endif
strr=repl([-],36)
do prtproce with strr
*=fput(handle,strr)
strr='  合计 '+space(16)+str(L_bbhj,10,2)
do prtproce with strr
*=fput(handle,strr)
strr=[    REG ]+allt(sk_n)+space(18)+time()
do prtproce with strr
*=fput(handle,strr)
strr=[]
do prtproce with strr
*=fput(handle,strr)
use dat\posfzk in 10
select posfzk
strr='  '
do prtproce with strr
do prtproce with strr
*=fputs(handle,strr)
*=fputs(handle,strr)
strr=space(12)+scmg
do prtproce with strr
*=fputs(handle,strr)
strr=space(4)+'诚 实 持 重'+space(6)+'便 民 利 众'
do prtproce with strr
*=fputs(handle,strr)
strr=space(3)+dtoc(date())+space(9)+'Tel:'+scdh
do prtproce with strr
*=fputs(handle,strr)
*do prtproce with '   '
strr=space(3)+' REG '+sk_n+'           '+'POS No.'+'('+skjh+')  '
do prtproce with strr
*=fputs(handle,strr)
do tmcut
*=fclose(handle)
use in posfzk
return


*=================================================
*营业员报表
*=================================================
procedure yyybb
private rq,k,ss,fph,strr,je,filiedbf,L_bbhj

L_bbhj=0
if len(nost)=5
	rq=left(dtoc(date()),4)+left(nost,4)
	filedbf='bak\xbbk'+left(nost,4)+'.dbf'
	if !file(filedbf)
		=tishil('日期错!')
		do alarm
		return
	endif
	filedbf='bak\xbbk'+left(nost,4)
else
	rq=left(dtoc(date()),4)+substr(dtoc(date()),6,2)+right(dtoc(date()),2)
	filedbf='tradedat\spxb'
endif
sele ssje,yyym,sksjph from &filedbf into dbf aaa;
where len(allt(tzm))=1.and.allt(tzm)#[5].and.allt(tzm)#[6].and.allt(jyrq)==allt(rq)
sele -ssje as ssje,yyym,sksjph from &filedbf into dbf bbb;
where (allt(tzm)==[5].or.allt(tzm)==[6]).and.allt(jyrq)==allt(rq)
sele ssje,jsbz,yyym,sksjph from &filedbf into dbf ccc;
where len(allt(tzm))=3.and.allt(jyrq)==allt(rq)
sele dist sksjph from &filedbf into dbf ddd;
where (allt(tzm)==[15].or.allt(tzm)==[16]).and.allt(jyrq)==allt(rq)
if len(nost)=5
	filedbf='xbbk'+left(nost,4)
	select &filedbf
	use
else
	use in spxb
endif
sele ddd
k=recc()
if k#0
	go top
	for ss=1 to k
		fph=sksjph
		sele ccc
		locate for sksjph==fph
		do while .t.
			if found().and.!eof()
				repl ssje with -ssje
			else
				exit
			endif
			continue
		enddo
		sele ddd
		skip
	endfor
endif
sele aaa
append from bbb
append from ccc
use in bbb
use in ccc
use in ddd
erase bbb.dbf
erase ccc.dbf
erase ddd.dbf
sele yyym,sum(ssje) as ssje from aaa into dbf bbb group by 1 order by 1
use in aaa
erase aaa.dbf
use dat\yuangzd in 0
use dat\posfzk in 0
sele bbb
k=recc()
if k=0
*  handle=fcreat('prtcch.dat')
	strr=[          ]+allt(scmc)+[柜组报表 ]
	do prtproce with strr
*  =fput(handle,strr)
	if len(nost)=5
		strr=space(9)+'报表日期:'+substr(rq,3,2)+'/'+substr(rq,5,2)+'/'+substr(rq,7,2)
		do prtproce with strr
*       =fput(handle,strr)
	endif
	strr=space(7)+dtoc(date())+space(5)+'POS No.'+'('+skjh+')  '
	do prtproce with strr
*  =fputs(handle,strr)
	strr=[              此日无销售 ]
	do prtproce with strr
*  =fput(handle,strr)
else
*       handle=fcreat('prtcch.dat')
	strr=[          ]+allt(scmc)+[柜组报表 ]
	do prtproce with strr
*       =fput(handle,strr)
	if len(nost)=5
		strr=space(9)+'报表日期:'+substr(rq,3,2)+'/'+substr(rq,5,2)+'/'+substr(rq,7,2)
		do prtproce with strr
*               =fput(handle,strr)
	endif
	strr=space(7)+dtoc(date())+space(5)+'POS No.'+'('+skjh+')  '
	do prtproce with strr
	strr=[  柜组号]+space(20)+[金 额]
	do prtproce with strr
*       =fput(handle,strr)
	strr=repl([-],36)
	do prtproce with strr
*       =fput(handle,strr)
	sele bbb
	go top
	for ss=1 to k
		fph=yyym
		je=ssje
		L_bbhj=L_bbhj+ssje
		sele yuangzd
		locate for allt(gonghao)==allt(fph)
		if found()
			strr=space(4)+padr(allt(xingmin),8,[ ])+space(4)+right(space(30)+allt(str(je,10,2)),15)
			do prtproce with strr
*                   =fput(handle,strr)
		endif
		sele bbb
		skip
	endfor
endif
strr=repl([-],36)
do prtproce with strr
*=fput(handle,strr)
strr='  合计 '+space(18)+str(L_bbhj,10,2)
do prtproce with strr
*=fput(handle,strr)
strr=[    REG ]+allt(sk_n)+space(16)+time()
do prtproce with strr
*=fput(handle,strr)
strr=[]
do prtproce with strr
*=fput(handle,strr)
select posfzk
strr='  '
do prtproce with strr
do prtproce with strr
*=fputs(handle,strr)
*=fputs(handle,strr)
strr=space(12)+scmg
do prtproce with strr
*=fputs(handle,strr)
strr=space(4)+'诚 实 持 重'+space(6)+'便 民 利 众'
do prtproce with strr
*=fputs(handle,strr)
strr=space(3)+dtoc(date())+space(9)+'Tel:'+scdh
do prtproce with strr
*=fputs(handle,strr)
*do prtproce with '   '
strr=space(3)+' REG '+sk_n+'           '+'POS No.'+'('+skjh+')  '
do prtproce with strr
*=fputs(handle,strr)
*=fclose(handle)
use in bbb
erase bbb.dbf
use in yuangzd
use in posfzk
return


*=============================================
*更新数据库
*=============================================
procedure gxsjk
do ddjm
if flag_net = 'OK'
	do fzk_pro
	do spmx_pro
	do fbk_pro
	do poskb_pro
endif
=relewind('sky')
return
*=============================================
*对fzk.txt进行转换
*=============================================
procedure fzk_pro
private fileaaa,mc,zhf,ruj,tuh,zoq,zhk,bij,zhr,jic,jicz,gud
fileaaa='\fzk.txt'
if !file(pospath+fileaaa)
	return
endif
if not used("posfzk")
	use dat\posfzk in 0
endif
sele posfzk
copy stru to fzk
use fzk in 0
sele fzk
append from &pospath\fzk.txt delimited with tab
mc=scmg
disp1=cdisp1
disp2=cdisp2
zhf=zf
ruj=rj
tuh=th
zoq=zq
zhk=zk
bij=bj
zhr=zr
jic=bbdy
jicz=jcz
gud=fixdisc
l_w=lw
dh_num=dhhm
ls_prtsheet = prtsheet
ls_prtmode = prtmode
prt_mode = prtmode
prt_sheet = prtsheet
scmc=scmg
scdh=allt(dhhm)
sele posfzk
repl scmg with mc,zf with zhf,rj with ruj, th with tuh, zq with zoq,;
zk with zhk, bj with bij, zr with zhr, bbdy with jic, jcz with jicz,;
fixdisc with gud,lw with l_w,dhhm with dh_num ,prtsheet with ls_prtsheet,prtmode with ls_prtmode
use
sele fzk
use
erase fzk.dbf
erase &pospath\fzk.txt
return
*=============================================
*对spmx.txt进行转换
*=============================================
procedure spmx_pro
private strr,st,k,fileaaa
fileaaa='\spmx.txt '
if !file(pospath+fileaaa)
	return
endif
if not used("spmx")
	use dat\spmx in 0
endif
sele spmx
copy stru to mx
use mx in 0
*永康前台spmx回收出现Line to long错误,程序调整如下   JiangYu 2001-3-13
*sele mx
*append from &pospath\spmx.txt;
*fields spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc;
*delimited with tab
*将数据文件copy到本地回收
if file('bdspmx.txt')
	erase bdspmx.txt
endif
copy file &pospath\spmx.txt to bdspmx.txt
sele mx
append from bdspmx.txt;
fields spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc;
delimited with tab
if recco()=0
	use
	erase mx.dbf
	sele spmx
	use
	return
endif
sele spmx
zap
append from bdspmx.txt;
fields spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc;
delimited with tab

sele spmx
index on spma tag spma
index on yytxm tag yytxm

fileaaa=pospath+'\spit.txt'
if file(fileaaa)
	erase &fileaaa
endif
fileaaa=pospath+'\spmx.txt'
erase &fileaaa

if file('bdspmx.txt')
	erase bdspmx.txt
endif

return

*=============================================
*对fbk.txt进行转换
*=============================================
procedure fbk_pro
private strr,st,k,fileaaa

fileaaa='\hbk.txt'
if !file(pospath+fileaaa)
	return
endif
if not used("posfbk")
	use dat\posfbk in 0
endif
sele posfbk
zap
fileaaa=pospath+fileaaa
append from &fileaaa delimited with tab
erase &fileaaa
select posfbk
use
return
*=============================================
*对poskb.txt进行转换
*=============================================
procedure poskb_pro
private strr,st,k,fileaaa
fileaaa='\poskb.txt'
if !file(pospath+fileaaa)
	return
endif
if not used("poskb")
	use dat\poskb in 0
endif
sele poskb
zap
fileaaa=pospath+fileaaa
append from &fileaaa delimited with tab
erase &fileaaa
select poskb
use
return
*=============================================
*对ygk.txt进行转换
*=============================================
procedure ygk_pro
private strr,st,k,fileaaa
fileaaa='\ygk.txt'
if !file(pospath+fileaaa)
	return
endif
if not used("yuangzd")
	use dat\yuangzd in 0
endif
sele yuangzd
zap
append from &pospath\ygk.txt delimited with tab
use
erase &pospath\ygk.txt

*=============================================
*对spit.txt进行转换
*=============================================
procedure spit_pro
private strr,st,k,fileaaa,fileaa,lgk,lgl
fileaaa='\spit.txt'
fileaa='\control.txt'
if flag_net='FLASE'
	return
endif
if !file(pospath+fileaaa)
	return
endif
if file(pospath+fileaa)
	return
endif
copy file yes.txt to &pospath\pos.txt
=tishil([正在进行商品库数据更新!请稍候])
if not used("spmx")
	use dat\spmx in 0
endif
if !file('mx.dbf')
	select spmx
	copy stru to mx
endif
if not used("mx")
	use mx in 0
endif
sele mx
zap
copy file &pospath\spit.txt to spit.txt
append from spit.txt fields spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc delimited with tab
erase spit.txt
st=recc()
if st=0
	sele spmx
	use
	sele mx
	use
	erase mx.dbf
	erase &pospath\pos.txt
	return
endif

sele spmx
set order to spma
select mx
go top
for k=1 to st
	spma1=spma
	yytxm1=yytxm
	dntxm1=dntxm
	spmc1=spmc
	spjldw1=spjldw
	spguige1=spguige
	pifaj1=pifaj
	lingshoj1=lingshoj
	glfs1=glfs
	bum1=bum
	ban1=ban
	zu1=zu
	spqc1=spqc
	select spmx
	loca for spma=spma1
	if found() .and. (lingshoj<>lingshoj1 .or. pifaj<>pifaj1)
		repl all spmc with spmc1;
		spjldw with spjldw1;
		spguige with spguige1;
		pifaj with pifaj1;
		lingshoj with lingshoj1;
		glfs with glfs1;
		bum with bum1;
		ban with ban1;
		zu with zu1;
		spqc with spqc1 for spma=spma1
	else
		insert into spmx (spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc);
		values (spma1,yytxm1,dntxm1,spmc1,spjldw1,spguige1,pifaj1,lingshoj1,glfs1,bum1,ban1,zu1,spqc1)
	endif
	select mx
	skip
endfor

sele spmx
use
sele mx
use
erase mx.dbf
erase &pospath\spit.txt
erase &pospath\pos.txt
return

*============================================================
*= 从软盘更新新增调价商品(spit.txt)
*============================================================
procedure spit_pro_a
private strr,st,k,fileaaa,fileaa,lgk,lgl


if num > 0
	return
endif

fileaaa='a:\spit.txt'

if !file(fileaaa)
	return
endif

=tishil([正在进行商品库数据更新!请稍候])

if !file('mx.dbf')
	select spmx
	copy stru to mx
endif
use mx in 0
sele mx
zap
copy file &fileaaa  to spit.txt
append from spit.txt fields spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc delimited with tab
!del spit.txt
st=recc()
if st=0
	use in mx
	erase mx.dbf
	return
endif
sele spmx
set order to spma
select mx
go top
for k=1 to st
	spma1=spma
	yytxm1=yytxm
	dntxm1=dntxm
	spmc1=spmc
	spjldw1=spjldw
	spguige1=spguige
	pifaj1=pifaj
	lingshoj1=lingshoj
	glfs1=glfs
	bum1=bum
	ban1=ban
	zu1=zu
	spqc1=spqc
	select spmx
	loca for spma=spma1
	if found() .and. (lingshoj<>lingshoj1 .or. pifaj<>pifaj1)
		repl all spmc with spmc1;
		spjldw with spjldw1;
		spguige with spguige1;
		pifaj with pifaj1;
		lingshoj with lingshoj1;
		glfs with glfs1;
		bum with bum1;
		ban with ban1;
		zu with zu1;
		spqc with spqc1 for spma=spma1
	else
		insert into spmx (spma,yytxm,dntxm,spmc,spjldw,spguige,pifaj,lingshoj,glfs,bum,ban,zu,spqc);
		values (spma1,yytxm1,dntxm1,spmc1,spjldw1,spguige1,pifaj1,lingshoj1,glfs1,bum1,ban1,zu1,spqc1)
	endif
	select mx
	skip
endfor
sele spmx
use
sele mx
use
erase mx.dbf
return

*==============================================