编程工具.prg

通用题库组卷系统 1.本来是一个学生的本科毕业课题

********************************金额大写
FUNCTION H_金额大写不带单位
PARA JE
JEDX=''
JEDX=allt(STR(JE,18,2))
JEDX=STRTRAN(JEDX,'.','点')
JEDX=STRTRAN(JEDX,' ','0')
JEDX=STRTRAN(JEDX,'0','零')
JEDX=STRTRAN(JEDX,'1','壹')
JEDX=STRTRAN(JEDX,'2','贰')
JEDX=STRTRAN(JEDX,'3','叁')
JEDX=STRTRAN(JEDX,'4','肆')
JEDX=STRTRAN(JEDX,'5','伍')
JEDX=STRTRAN(JEDX,'6','陆')
JEDX=STRTRAN(JEDX,'7','柒')
JEDX=STRTRAN(JEDX,'8','捌')
JEDX=STRTRAN(JEDX,'9','玖')
*jedxl=left(jedx,35)
*jedxr=right(jedx,28)
*JEDX=JEDXL+' '+JEDXR
RETU jedx

FUNCTION H_金额大写带单位(mrmbze)	
LOCAL s_1,s_2,s_3,s_4	
s_1="零壹贰叁肆伍陆柒捌玖"	
s_2="仟佰拾万仟佰拾元角分"	
s_3=88888888.88	
s_4=STR(mrmbze*100,10)	
i=1	
mm=" "	
DO WHILE i<=10
  s_5=SUBSTR(s_4,i,1)
  IF s_5<>" "
    s_6=SUBSTR(s_1,VAL(s_5)*2+1,2)
    s_7=SUBSTR(s_2,i*2-1,2)
    IF s_5="0".AND.i<>4.AND.i<>8
      s_7=""
    ENDIF
    IF (SUBSTR(s_4,i,2)="00").OR.(s_5="0".AND.(i=4.OR.i=8.OR.i=10))		  
       s_6=""	
    ENDIF			
    mm=mm+s_6+s_7			
    IF SUBSTR(s_4,i,1)="0".AND.SUBSTR(s_4,i+1,1)<>"0".AND.(i=4.OR.i=8)	
      mm=mm+"零"
    ENDIF		
  ENDIF		
  i=i+1	
ENDDO	
IF s_5="0"		
  mm=mm+"整"	
ENDIF
mm=allt(mm)	
RETURN(mm)
ENDFUNC




* ok日记号=H_最大序号("日记号")
proc h_最大序号  &&假设是基本有序的         &&&&&&&&&&&&&&&&&&&要改
para c字段名
&&该函数求最大可用交易序号，要改，作法是设一个系统区存储最大交易号
nok=sele()
******************
l_system_ka=.f.
if .not. used("system")
  sele 0
  use system.sys
  l_system_ka=.t.
endif
sele system
=h_记录锁定()
cmax=allt(c字段名)
nmax=system.&cmax.
nmax=nmax+1
do case
case c字段名="存折号"
  nmax=iif(nmax<1000000001,1000000001,nmax)
case c字段名="存折序号"
  nmax=iif(nmax<1121010121,1121010121,nmax)
case c字段名="卡号"
  nmax=iif(nmax<5000000001,5000000001,nmax)
case c字段名="卡序号"
  nmax=iif(nmax<5123456789,5123456789,nmax)
endcase
repl system.&cmax. with nmax
if l_system_ka=.t.
  sele system
  use
endif
cok=allt(str(nok,18,0))
sele &cok.
return nmax

*if  H_表锁定()
*    ok存折号=iif(ok存折号<1000000000,1000000000,ok存折号)   &&存号从这个数开始
*    ok存折序号=iif(ok存折序号<1121010121,1121010121,ok存折序号)
*  ok卡序号=iif(ok卡序号<=5123456789,5123456789,ok卡序号)
      *ok卡号=iif(ok卡号<=5000000000,5000000000,ok卡号)   &&卡号从这个数开始



*鼠标右键菜单 的复制板
***********************引用方式do H_mouseright
proc H_mouseright
DEFINE POPUP popRight SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR _med_undo OF popRight PROMPT "撤消(\<U)" 
DEFINE BAR 2 OF popRight PROMPT "\-"
DEFINE BAR _med_cut OF popRight PROMPT "剪切(\<T)"
DEFINE BAR _med_copy OF popRight PROMPT "复制(\<C)"
DEFINE BAR _med_paste OF popRight PROMPT "粘贴(\<P)" 
DEFINE BAR _med_clear OF popRight PROMPT "删除(\<D)" 
DEFINE BAR 7 OF popRight PROMPT "\-" 
DEFINE BAR _med_slcta OF popRight PROMPT "全选(\<S)" 
ACTIVATE POPUP popRight  


***********************************

proc H_软驱检查
parameter driver
local y
y=fcreate("&driver.:\测试软盘.txt")
=fclose(y)
if .not. file("&driver.:\测试软盘.txt")
  return .f.
else
  erase &driver.:\测试软盘.txt
endif
return .t.
*=messagebox("&driver.盘是否没有插入或者&driver.盘正被写保护!",0,"提示")
  



****************************************************************************
* 主要功能:显示等待牌  使用旧定义窗口             林宇洪
****************************************************************************
*proc H_设立等待
*para _ots
*if empty(_ots)
*  _ots='程序正在进行复杂的数据整理，请您稍候......'
*endif
*_owa=(SROW())/2
*_owb=(SCOLS()-LEN(_ots)-6)/2
*defi windows W_等待 at _owa,_owb size 3,len(_ots)+6 in desktop;
*     none nofloat nogrow noclose color rgb(255,0,0,188,222,188);
*     title "信息提示窗" ;
*     font '宋体',12 style 'T'  
*activate windows W_等待
*@ 1,3 say _ots
*return 

************************
**主要功能　　增加动画稍候
proc H_设立等待_动画
para _ots
do form 等待_动画 with _ots

proc H_消除等待_动画
rele windows 程序_等待

*以下程序为景林老师的南平林政资源系统所用的辅助程序块
*由及是以下和网络处理有关通用模块程序块,是通过大量测试编写的,
*在调用程序要考虑周全，当我们这些函数返回.f.值时，应当退出当前表单，否则肯定要出错了
*编程日期 1999.01.28 -- 1999.01.31

************ novell 网上数据库锁定的程序段
proc H_表锁定           &&弹出一个介面告知正在锁定当前数据库
reprold=set("repr")     &&如果返回.f.则说明锁定失败则在调用程序要考虑到如何结束当前工作
set repr to 1   && 设置自动加锁检测为１次
if .not. flock()      
  =H_设立等待("正在锁定表，请您等待....[ESC]放弃")
  do while .not. flock()
    kkey=inkey(0.2,"hM")
    if kkey=27 
      if MESSAGEBOX("放弃锁定操作将放弃本次"+;
              "存盘工作，是否真的放弃？",48+256+4,"")=6      
        exit
      else  
        loop
      endif
    endif      
  enddo   
  =H_消除等待()
  if .not. flock()
    =MESSAGEBOX("加锁数据库失败，放弃存盘退出！",48+0+0,"警告")
    set repr to reprold
    return .f.      &&表示锁定失败了
  endif
endif
set repr to reprold
return .t.

************ novell 网上数据库锁定的程序段
proc H_表试探锁定 &&弹出一个介面正在试图锁定当前数据库，或指定数据库
                   &&试探性的操作，如果失败一声不吭的返回一个.f.  
reprold=set("repr")     &&如果返回.f.则说明锁定失败则在调用程序要考虑到如何结束当前工作
set repr to 1   && 设置自动加锁检测为１次
if .not. flock()
  =H_设立等待("网络上有操作员正在工作中！")
  set repr to reprold
  return .f.      &&表示锁定失败了
endif
set repr to reprold
return .T.      &&表示锁定成功


************ novell 网上记录锁定的程序段
proc H_记录锁定  &&弹出一个介面告知正在锁定当前数据库
if eof()
  return .t.
endif
reprold=set("repr")
set repr to 1   && 设置自动加锁检测为１次
if .not. rlock()      
  =H_设立等待("正在锁定记录，请您等待....[ESC]放弃")
  do while .not. rlock()
    kkey=inkey(0.2,"hM")
    if kkey=27
      if MESSAGEBOX("放弃锁定操作将放弃本次"+;
              "存盘工作，是否真的放弃？",48+256+4,"")=6      
         exit
      else  
          loop
      endif
    endif      
  enddo   
  =H_消除等待()
  if .not. rlock()
    =MESSAGEBOX("加锁数据库失败，放弃存盘退出！",48+0+0,"")
    set repr to reprold
    return .f.      &&表示锁定失败了
  endif
endif
set repr to reprold
return .t.

******************  novell 独占测试
proc H_表独占  &&弹出一个介面正在试图独占当前数据库，或指定数据库
para dbfname,alianame,norde    &&第一参数为数据库名,第二参数为别名,第三参数为工作区
ocsgs=para()    && 如果什么参数都没有加则在当前工作区处理当前数据库
do case         && 如果加了一个参数则在一新的工作区内打开指定文件名的数据库
case ocsgs=0   && 说明未带参数,则默认锁定当前数据库
  dbfname=dbf()
case ocsgs=3
  sele norde
other
  sele 0
endcase
olderr=on("ERROR")
nerr=0
on error nerr=error()
if type("alianame")="C"   &&有别名参数
  aliatrue="alia &alianame"
else
  aliatrue=""
endif  
use &dbfname excl &aliatrue
if nerr=1705    && 该文件打不开
  =H_设立等待("正在独占文件，请您稍候....[ESC]放弃")
  do while .t.
     use &dbfname excl  &aliatrue
     if flock()=.t.   && 没有独占成功的话flock文件将失灵
        exit
     endif
     kkey=inkey(0.2,"hM")
     if kkey=27
       if MESSAGEBOX("放弃此操作将放弃本次"+;
          "工作，是否真的放弃？",48+256+4,"")=6      
        exit
      else  
        loop
      endif
    endif      
  enddo   
  =H_消除等待()
  if .not. flock()
    =MESSAGEBOX("独占数据库失败，退出此次操作！",48+0+0,"")
    on error &olderr.
    return .f.      &&表示锁定失败了
  endif
endif
on error &olderr.
return .t.

******************  novell 独占测试
proc H_表试探独占  &&弹出一个介面正在试图独占当前数据库，或指定数据库
                   &&试探性的独占，如果失败一声不吭的返回一个.f.  
para dbfname,alianame,norde    &&第一参数为数据库名,第二参数为别名,第三参数为工作区
ocsgs=para()    && 如果什么参数都没有加则在当前工作区处理当前数据库
do case         && 如果加了一个参数则在一新的工作区内打开指定文件名的数据库
case ocsgs=0   && 说明未带参数,则默认锁定当前数据库
  dbfname=dbf()
case ocsgs=3
  sele norde
other
  sele 0
endcase
olderr=on("ERROR")
nerr=0
on error nerr=error()
if type("alianame")="C"   &&有别名参数
  aliatrue="alia &alianame"
else
  aliatrue=""
endif  
use &dbfname excl &aliatrue
if nerr=1705    && 该文件打不开
  use &dbfname excl  &aliatrue
  if flock()=.t.   && 没有独占成功的话flock文件将失灵
    exit
  endif
  if .not. flock()
    =H_设立等待("网络上有人正在使用本系统！")
    on error &olderr.
    return .f.      &&表示锁定失败了
  endif
endif
on error &olderr.
return .t.


******************
proc H_表测试  &&测试表结构是否完整
para dbfname   &&转到一个零空间　　打开所指定的数据库
olderr=on("ERROR")
nerr=0
on error nerr=error()
sele 0
use &dbfname shar
use
if nerr=1705    && 该文件打不开
  if flock()=.t.   && 没有独占成功的话flock文件将失灵
    exit
  endif
  if .not. flock()
*    =H_设立等待("网络上有人正在使用本系统！")
    on error &olderr.
*    return .f.      &&表示锁定失败了
  endif
endif

if nerr=15    && 该文件表结构损坏
  on error &olderr.
  return .f.      &&表示表结构损坏
endif

on error &olderr.
return .t.


************************通用错误 陷井
proc H_通用错误    && 本模块拦载网络工享造成的错误并可让用户参与选择
nerr=error()
if nerr=108 .or.nerr=109 
      && 108 109 1.别人正在共享锁定使用数据库，而当前工作站又企图操作brow或repl
      &&   108 为文件被他人使用   109 为当前记录被他人占用
     if MESSAGEBOX("别人已锁住了当前库，建议您再试几次，"+chr(13)+"取消将不存储当前修改了的数据！",32+0+5,"") =4     
         retry
     else 
         return 
     endif
endif
if  nerr=1705        
 && 1705为别人正在独占打开数据库，当前工作站企图想打开数据库
 && 或别人正在共享数据库，当前工作站企图想独占数据库      
     if MESSAGEBOX("别人已在使用当前库，你需等到他结束工作后才可独占数据表，建议您再试几次，取消将放弃此项工作！",32+0+5,"") =4     
         retry
     else 
         return 
     endif
endif



proc 单击关闭
if messagebox("您真的要退出系统吗？",32+1+256,"请注意")=1
 do 退出系统
endif
return 

proc 重新登录
on shut
clear events

proc 退出系统
pub不退出=.f.
on shut
clear events
      
      
proc deltree
para c_dir
if .not. DirEctory(c_dir)
  return .f.
endif
dime m_tmp_dir(1)
m_tmp_dir(1)=allt(c_dir)
n_tag=1
do while .t.
  n_Ok=adir(m_目录列表,m_tmp_dir(n_tag)+"\*.","D")
  n_OK=n_ok-2
  =adel(M_目录列表,1)
  =adel(M_目录列表,1)
  l_dir=.f.   &&是否有目录的标志
  for n_tmp=1 to n_ok
    if "D" $ m_目录列表(n_tmp,5)
      l_dir=.t.
      exit
    endif
  endfor
  if l_dir
    n_tag=n_tag+1
    dime m_tmp_dir(n_tag)
    m_tmp_dir(n_tag)=m_tmp_dir(n_tag-1)+"\"+allt(m_目录列表(n_tmp,1))
  else
    c_tmp=m_tmp_dir(n_tag)+"\*.*"
    erase (c_tmp) recycle
    rd (m_tmp_dir(n_tag))