* 以下为本系统的公用自定义函数
************************************************************************************
* 功能: 信息提示盒(info_box) *
* 传递参数: 信息提示串,信息提示窗口标题(默认为“信息提示板”),信息窗口模式编号 *
* 返回值: 信息提示窗口按钮的编号(数值型) *
************************************************************************************
PROCEDURE info_box
para info_str,win_name,mode0
win_name=IIF(EMPTY(win_name),'信息提示板',win_name)
m.opbut=MESSAGEBOX((info_str),mode0,(win_name))
return m.opbut
ENDPROC
*****************************************************
* 功能: 退出系统(exit_sys)*
* 传递参数: (无)*
* 返回值: 信息提示窗口按钮的编号(数值型)*
*****************************************************
PROCEDURE exit_sys
m.exit_ch=info_box('您真的要退出本系统吗？','退出系统',36)
if m.exit_ch=6
close all
on shutdown
on error
clear
clear dlls
set sysmenu to defa
* modi window screen
cancel
endif
return m.exit_ch
ENDPROC
*
PROCEDURE shut_sys
* m.exit_ch=info_box('您真的要退出本系统吗？','退出系统',36)
*if m.exit_ch=6
* close all
on shutdown
on error
clear
clear dlls
set sysmenu to defa
quit
*endif
*return m.exit_ch
ENDPROC
*********************************************************
* 功能:自动折行(split_line)*
* 传递参数: 字符串,行宽度,行数*
* 返回值: 经过折行处理后的字符串(字符型)*
* 说明: 其中变量mzf1,mzf2需要定义为全程变量*
*********************************************************
PROCEDURE split_line
para mzfc,mhkd,mhs
priv mcd,mhs0,mi,mfhc
publ mzf1,mzf2
mhs0=0
mcd=len(mzfc)
mfhc=''
mzf=''
mi=1
do while mi<mcd
mzf1=subs(mzfc,mi,1)
mzf2=subs(mzfc,mi+1,1)
do case
case asc(mzf1)<161
mfhc=mfhc+mzf1
if len(mfhc)=mhkd
mhs0=mhs0+1
if mhs0=mhs
return padr(mfhc,mhkd,' ')
else
mfhc=''
endif
endif
mi=mi+1
case asc(mzf1)>160.and.asc(mzf2)>160
if len(mfhc)+2<mhkd
mfhc=mfhc+mzf1+mzf2
mi=mi+2
else
if len(mfhc)+2=mhkd
mfhc=mfhc+mzf1+mzf2
mi=mi+2
endif
mhs0=mhs0+1
if mhs0=mhs
return padr(mfhc,mhkd,' ')
else
mfhc=''
endif
endif
endcase
enddo
if mhs0=mhs-1
return padr(mfhc+iif(asc(mzf2)<161,mzf2,''),mhkd,' ')
else
return space(mhkd)
endif
return space(mhkd)
ENDPROC
*********************************************************
* 功能: 捕捉错误(exec_com)*
* 传递参数: 需要执行的foxpro命令*
* 返回值: 错误编号(数值型)*
* 说明: 错误编号非0,则说明foxpro命令格式或书写有错误*
*********************************************************
PROCEDURE exec_com
para comm
priv syserr,onerr
syserr=0
onerr=on('error')
on error syserr=error()
set console off
&comm
set console on
on error &onerr
return syserr
ENDPROC
******************************************************
* 功能: 字符串加密(STR_CODE)
* 传递参数: 字符串,模式(0表示加密,非0为解密)
* 返回值: 经过加密或解密的字符串
******************************************************
PROCEDURE STR_CODE
PARA S,MODE
PRIV ALL
S1=''
FOR I=1 TO LEN(S)
S1=S1+BYTECODE(SUBS(S,I,1),MODE)
ENDFOR
RETURN S1
ENDPROC
*
PROCEDURE BYTECODE
PARA B,MODE
PRIV ALL
SYS_JMB1=''
SYS_JMB2=''
ZZ=FOPEN('JMB.SYS')
IF ZZ#-1
FOR I=1 TO 128
SYS_JMB1=SYS_JMB1+FREAD(ZZ,1)
ENDFOR
FOR I=1 TO 128
SYS_JMB2=SYS_JMB2+FREAD(ZZ,1)
ENDFOR
ENDIF
I=ASC(B)
IF MODE=0
S=IIF(I<129,SUBS(SYS_JMB1,I+1,1),SUBS(SYS_JMB2,I-127,1))
ELSE
WZ=AT(B,SYS_JMB1)
WZ=IIF(WZ=0,AT(B,SYS_JMB2)+128,WZ)
S=CHR(WZ-1)
ENDIF
=FCLOSE(ZZ)
RETURN S
ENDPROC
******************************************************
* 功能: 取出用逗号分隔的字符串(getword)
* 传递参数: 字符串,逗号的序号
* 返回值: 子串
******************************************************
PROCEDURE getword
para S,xh,spstr
PRIV ALL
GS=OCCURS(spstr,S)
IF XH>GS+1
ZC=''
ELSE
WZ1=IIF(XH=1,1,AT(spstr,S,XH-1)+1)
WZ2=IIF(XH=GS+1,LEN(S)+1,AT(spstr,S,XH))
ZC=SUBS(S,WZ1,WZ2-WZ1)
ENDIF
RETURN ZC
ENDPROC
******************************************************
* 功能: 返回某年某月的最后一天(date_last)
* 传递参数: 年,月(数值型)
* 返回值: 日期型的年.月.日
******************************************************
PROCEDURE date_last
PARA nn,yy
n=IIF(yy=12,nn+1,nn)
y=IIF(yy=12,1,yy+1)
RETU CTOD(STR(n,4)+'.'+RIGHT('0'+ALLTRIM(STR(y)),2)+'.'+'01')-1
ENDPROC
****************************************************************************
* 功能:中文日期的年份(CCYEAR)
* 传递参数: 用户指定的日期或系统日期(日期型)
* 返回值: 汉字年份(字符串)
****************************************************************************
PROCEDURE ccyear
para m_edate
if type('m_edate')<>'D' or empty(m_edate)
return ''
endif
priv m_szc,m_i,m_cdate,m_cc
set cent on
set date ansi
m_szc='○一二三四五六七八九'
m_cdate=padl(dtoc(m_edate),10,'0')
m_cc=subs(m_szc,val(subs(m_cdate,1,1))*2+1,2)
m_cc=m_cc+subs(m_szc,val(subs(m_cdate,2,1))*2+1,2)
m_cc=m_cc+subs(m_szc,val(subs(m_cdate,3,1))*2+1,2)
m_cc=m_cc+subs(m_szc,val(subs(m_cdate,4,1))*2+1,2)+'年'
do while left(m_cc,2)='○'
m_cc=right(m_cc,len(m_cc)-2)
enddo
return m_cc
ENDPROC
****************************************************************************
* 功能:中文日期的月份(CCmonth)
* 传递参数: 用户指定的日期或系统日期(日期型)
* 返回值: 汉字月份(字符串)
****************************************************************************
PROCEDURE ccmonth
para m_edate
if type('m_edate')<>'D' or empty(m_edate)
return ''
endif
priv m_szc,m_i,m_cdate,m_cc
set cent on
set date ansi
m_szc='○一二三四五六七八九'
m_cdate=dtoc(m_edate)
m_cc=subs(m_szc,val(subs(m_cdate,6,1))*2+1,2)
m_cc=iif(m_cc='○','',iif(m_cc='一','十',m_cc))
m_cc0=subs(m_szc,val(subs(m_cdate,7,1))*2+1,2)
m_cc=m_cc+iif(m_cc0='○','',m_cc0)+'月'
return m_cc
ENDPROC
****************************************************************************
* 功能:中文日期的日子(CCday)
* 传递参数: 用户指定的日期或系统日期(日期型)
* 返回值: 汉字日子(字符串)
****************************************************************************
PROCEDURE ccday
para m_edate
if type('m_edate')<>'D' or empty(m_edate)
return ''
endif
priv m_szc,m_i,m_cdate,m_cc
set cent on
set date ansi
m_szc='○一二三四五六七八九'
m_cdate=dtoc(m_edate)
m_cc=subs(m_szc,val(subs(m_cdate,9,1))*2+1,2)
m_cc=iif(m_cc='○','',iif(m_cc='一','十',m_cc+'十'))
m_cc0=subs(m_szc,val(subs(m_cdate,10,1))*2+1,2)
m_cc=m_cc+iif(m_cc0='○','',m_cc0)+'日'
return m_cc
ENDPROC
****************************************************************************
* 功能: 将日期转换为中文日期(CCdate)
* 传递参数: 用户指定的日期或系统日期(日期型)
* 返回值: 汉字日期(字符串)
****************************************************************************
PROCEDURE ccdate
para m_edate
if type('m_edate')<>'D' or empty(m_edate)
return ''
endif
return ccyear(m_edate)+ccmonth(m_edate)+ccday(m_edate)
ENDPROC
****************************************************************************
* 功能: 求出指定日期的星期数(CCweek)
* 传递参数: 用户指定的日期或系统日期(日期型)
* 返回值: 汉字星期XX(字符串)
****************************************************************************
PROCEDURE ccweek
para m_edate
if type('m_edate')<>'D' or empty(m_edate)
return ''
endif
priv m_szc,m_cc
m_szc='日一二三四五六'
m_cc='星期'+subs(m_szc,(dow(m_edate)-1)*2+1,2)
return m_cc
ENDPROC
******************************************************
* 功能: 播放声音(PLAY_VOICE)
* 传递参数: .WAV文件(这些文件存放的默认路径为VOICE)
* 返回值: 无
******************************************************
PROCEDURE PLAY_VOICE
PARAMETERS outside_wav_file
outside_wav_file=IIF(EMPTY(justpath(outside_wav_file)),'sound\'+outside_wav_file,outside_wav_file)
IF EMPTY(outside_wav_file) OR PARA()=0 OR !FILE('&outside_wav_file')
RETURN
ENDIF
CREATE CURSOR wav_base (wav_file G)
APPEND BLANK
APPEND GENERAL wav_file FROM '&outside_wav_file' LINK
@ 0,0 SAY wav_file VERB 0
SELECT wav_base
USE
ENDPROC
*************************************************************
* 功能: 根据传递的代码值到指定数据表中取汉字内容 *
* 参数: DMZ 代码值 *
* DMK 代码库名,不含目录时为code\目录中的代码库*
* DMZD 代码项字段名,缺省或为空''时为 '代码'*
* DMHZZD 代码汉字字段名,缺省或为空''时为 '名称'*
* SJKTJ 代码数据表过滤条件*
* 返回值: 对应代码的汉字内容*
*************************************************************
PROCEDURE dm_hz
PARA dmz,dmk,dmzd,dmhzzd,sjktj
sele_are=SELE() &&保存工作区
s_wjm=IIF('.DBF'$UPPE(dmk),dmk,dmk+'.DBF')
s_wjm=IIF(empty(justpath(s_wjm)),'code\'+s_wjm,s_wjm)
s_wjm1=juststem(s_wjm) &&数据表别名
sjktj=IIF(PARAMETERS()<5,'',sjktj)
dmzd=IIF(EMPTY(dmzd),s_wjm1+'.代码',dmzd)
dmhzzd=IIF(EMPTY(dmhzzd),s_wjm1+'.名称',dmhzzd)
wjused_=.F.
IF USED(s_wjm1)
SELE (s_wjm1)
wjused_=.T.
ELSE
IF FILE(s_wjm)
USE (s_wjm) in 0
SELE (s_wjm1)
ELSE
=info_box('打开文件出错或数据表文件&s_wjm.不存在!','',48)
SELE (sele_are)
RETU ''
ENDIF
ENDIF
*
setfilt=SET('FILTER')
SET FILT TO &sjktj
LOCA FOR &dmzd = dmz
funcrtv=&dmhzzd
SET FILT TO &setfilt
IF !wjused_
SELE (s_wjm1)
USE
ENDIF
SELE (sele_are)
RETU IIF(TYPE('FUNCRTV')='C',ALLTRIM(funcrtv),funcrtv)
ENDPROC
********************************************************************
* 功能：从"SYSTEM.cfg"读取设置
********************************************************************
PROCEDURE READSET
PARA STR1
M.FINDSTR=.F.
FH=FOPEN('SYSTEM.CFG')
IF FH=-1
RETURN ''
ENDIF
LINE=''
DO WHILE NOT FEOF(FH)
LINE=FGETS(FH)
IF UPPER(LEFT(LINE,LEN(STR1)))=UPPER(STR1)
M.FINDSTR=.T.
EXIT
ELSE
M.FINDSTR=.F.
ENDIF
ENDDO
=FCLOSE(FH)
RETURN IIF(M.FINDSTR,RIGHT(LINE,LEN(LINE)-LEN(STR1)),.F.)
ENDPROC
*
PROCEDURE WRITESET
PARA STR1,NR
IF NOT FILE('SYSTEM.cfg')
M.HANDLE=FCREATE('SYSTEM.cfg')
=FPUTS(M.HANDLE,STR1+NR)
=FCLOSE(M.HANDLE)
RETURN
ENDIF
IF FILE('SYSTEM.BAK')
ERASE SYSTEM.BAK
ENDIF
RENA SYSTEM.cfg TO SYSTEM.BAK
M.HANDLE=FOPEN('SYSTEM.BAK',2)
HD=FCREATE('SYSTEM.cfg')
M.WD=.F.
DO WHILE NOT FEOF(HANDLE)
OLDSTR=LTRIM(FGETS(HANDLE))
IF STR1==UPPE(LEFT(OLDSTR,LEN(STR1)))
=FPUTS(HD,STR1+NR)
M.WD=.T.
ELSE
=FPUTS(HD,OLDSTR)
ENDIF
ENDDO
IF NOT M.WD
=FPUTS(HD,STR1+NR)
ENDIF
=FCLOSE(HD)
=FCLOSE(HANDLE)
ENDPROC
****************************************************************************
* 功能:错误处理程序(err_pro)
* 传递参数: 当前执行程序名称(一般为"sys(16)")
****************************************************************************
PROCEDURE err_pro
PARAMETERS curprg
LOCAL lnchoice,errinfo,cwts,errsrc,errsyntax,errstr,cr_flag,curdev
STORE "错误来源: " TO errsrc
STORE "错误语句: " TO errsyntax
STORE "错误信息: " TO errstr
STORE CHR(13) TO cr_flag
STORE "" TO errinfo
curdev=SYS(101)
SET DEVICE TO SCREEN
DO CASE
CASE ERROR()=108
cwts='当前文件已经被另外的用户打开。'
CASE ERROR()=109
cwts='当前记录已经被另外的用户加锁。'
CASE ERROR()=110
cwts='当前操作需要用独占方式打开数据文件。'
CASE ERROR()=111
cwts='不能打开一个只读文件。'
CASE ERROR()=125
cwts='打印机没有准备好,请准备好打印机!'
OTHERWISE
cwts=MESSAGE()
ENDCASE
errinfo = errinfo + errsrc + IIF(LEN(curprg)>60,LEFT(curprg,57)+"...",PADR(curprg,60," ")) + cr_flag
errinfo = errinfo + errsyntax + IIF(LEN(MESSAGE(1))>60,LEFT(MESSAGE(1),57)+"...",PADR(MESSAGE(1),60," ")) + cr_flag
errinfo = errinfo + errstr + IIF(LEN(cwts)>60,LEFT(cwts,57)+"...",PADR(cwts,60," "))
lnchoice = info_box(errinfo,"错误提示",2+48+512)
DO CASE
CASE lnchoice = 3 &&停止
SET DEVICE TO &curdev
cancel
CASE lnchoice = 4 &&重试
SET DEVICE TO &curdev
RETRY
CASE lnchoice = 5 &&忽略
SET DEVICE TO &curdev
RETURN
ENDCASE
ENDPROC
****************************************************************************
* 功能: 关闭或显示系统工具栏(mtoolbar)
* 传递参数: 关闭/显示（逻辑值.T.或.F.）
****************************************************************************
PROCEDURE mtoolbar
PARAMETERS baronoff
DIMENSION mtoolsbar[22,2]
mtoolsbar[1,1] ='color palette'
mtoolsbar[2,1] ='database designer'
mtoolsbar[3,1] ='form controls'
mtoolsbar[4,1] ='form designer'
mtoolsbar[5,1] ='print preview'
mtoolsbar[6,1] ='query designer'
mtoolsbar[7,1] ='report designer'
mtoolsbar[8,1] ='report controls'
mtoolsbar[9,1] ='layout'
mtoolsbar[10,1] ='standard'
mtoolsbar[11,1] ='view designer'
mtoolsbar[12,1] ='调色板'
mtoolsbar[13,1] ='数据库设计器'
mtoolsbar[14,1] ='表单控件'
mtoolsbar[15,1] ='表单设计器'
mtoolsbar[16,1] ='打印预览'
mtoolsbar[17,1] ='查询设计器'
mtoolsbar[18,1] ='报表设计器'
mtoolsbar[19,1] ='报表控件'
mtoolsbar[20,1] ='布局'
mtoolsbar[21,1] ='常用'
mtoolsbar[22,1] ='视图设计器'
FOR i = 1 TO ALEN(mtoolsbar,1)
IF WEXIST(mtoolsbar[i,1])
mtoolsbar[i,2] = WVISIBLE(mtoolsbar[i,1])
IF !baronoff
IF mtoolsbar[i,2]
DEACTIVATE WINDOW (mtoolsbar[i,1]) &&关闭系统工具栏
ENDIF
ELSE
IF NOT mtoolsbar[i,2]
ACTIVATE WINDOW (mtoolsbar[i,1]) &&显示系统工具栏
ENDIF
ENDIF
ENDIF
ENDFOR
RELEASE mtoolsbar
ENDPROC
************************************************************
* 功能: 确定指定字体描述的字符的宽度（txt_hei）
* 传递参数: 字体描述串（格式如FONT '宋体',12 STYLE 'N'）
* 返回值: 宽度数值
************************************************************
PROCEDURE txt_wid
PARAMETERS str1,str2 &&被测字符串，字体描述串
style_pos = ATC("STYLE",str2)
font_pos = ATC("FONT",str2)
fontstr = IIF(style_pos # 0 , STUFF(str2,style_pos,5,",") , str2)
fontstr = IIF(font_pos # 0 , STUFF(fontstr,font_pos,4,"") , fontstr)
RETURN TXTWIDTH(str1,&fontstr) * FONTMETRIC(6,&fontstr) / FONTMETRIC(6)
ENDPROC
************************************************************
* 功能: 确定指定字体描述的字符的高度（txt_hei）
* 传递参数: 字体描述串（格式如FONT '宋体',12 STYLE 'N'）
* 返回值: 高度数值
************************************************************
PROCEDURE txt_hei
PARAMETERS str2 &&字体描述串
style_pos = ATC("STYLE",str2)
font_pos = ATC("FONT",str2)
fontstr = IIF(style_pos # 0 , STUFF(str2,style_pos,5,",") , str2)
fontstr = IIF(font_pos # 0 , STUFF(fontstr,font_pos,4,"") , fontstr)
RETURN FONTMETRIC(1,&fontstr)/FONTMETRIC(1)
ENDPROC
************************************************************
* 功能: 数值转换到日期(ntod)
* 传递参数: 数值型的年、月、日
* 返回值: 日期型数据
************************************************************
PROCEDURE ntod
PARAMETERS yyyy,mm,dd
yyyy = STR(yyyy,4)
mm = CHRTRAN(STR(mm,2)," ","0")
dd = CHRTRAN(STR(dd,2)," ","0")
RETURN CTOD(yyyy+"."+mm+"."+dd)
ENDPROC
************************************************************
* 功能: 数值型数据加分节号(sec_mrk)
* 传递参数: 数值型数据转换为字符串，并去掉前后空格的字符串
* 返回值: 加分节号后的数字字符串
************************************************************
PROCEDURE sec_mrk
PARAMETERS numstr
PRIVATE xsd,numstr1,numstr2,numarr,i,num_xb,count_,ret_val
STORE "" TO numstr1,numstr2,ret_val
xsd = AT(".",numstr)
numstr1 = IIF(xsd=0,numstr,LEFT(numstr,xsd-1))
numstr2 = IIF(xsd=0,"",SUBSTR(numstr,xsd+1))
num3pos=0
FOR i=LEN(numstr1) TO 1 STEP -1
num3pos=num3pos+1
IF num3pos=3
numstr1=STUFF(numstr1,i,0,',')
num3pos=0
ENDIF
ENDFOR
ret_val = numstr1 + IIF(EMPTY(numstr2),"","."+numstr2)
RETURN IIF(LEFT(ret_val,1)=",",STUFF(ret_val,1,1,""),ret_val)
ENDPROC
**************************************************************************
* 函 数 名：ins_string *
* 功 能：在某插入点插入或替换指定的字符串 *
* 传递参数：obj_str = 某对象的原有值（字符型） *
* Sel_Start = 某对象插入点的起始位置（数值型） *
* Sel_Length= 在某对象上从插入点开始选择的字符串长度（数值型） *
* ins_str = 用户指定的需要插入或替换的字符串（字符型） *
* 返 回 值：经过加工后的新字符串（字符型） *
**************************************************************************
PROCEDURE ins_string
PARAMETERS obj_str,Sel_Start,Sel_Length,ins_str
IF Sel_Start=LEN(ALLTRIM(obj_str)) &&插入点在已有字符尾部
obj_str=ALLTRIM(obj_str)+ins_str
ELSE &&插入点在已有字符中间
IF Sel_Length=0 &&没选择需要删除的子字符串
obj_str=STUFF(obj_str,Sel_Start+1,0,ins_str)
ELSE &&选择了需要删除的子字符串
replstr=STUFF(obj_str,Sel_Start+1,Sel_Length,"")
obj_str=STUFF(replstr,Sel_Start+1,0,ins_str)
ENDIF
ENDIF
RETURN obj_str
ENDPROC
**************************************************************************
* 函 数 名：get_userinfo *
* 功 能：从注册表中获取用户信息 *
* 传递参数：username = 用户名 , usercorp = 组织名 *
* 返 回 值：参量返回用户名和组织名（字符型） *
* 引用方法：=get_userinfo(@username , @usercorp) *
**************************************************************************
PROCEDURE get_userinfo
PARAMETERS username , usercorp
DECLARE INTEGER RegOpenKeyEx IN ADVAPI32 INTEGER nKey,STRING @cSubKey, INTEGER nReserved,INTEGER nAccessMask, INTEGER @nResult
DECLARE INTEGER RegQueryValueEx IN ADVAPI32 INTEGER nKey,STRING cValueName, INTEGER nReserved, INTEGER @nType,STRING @cBuffer, INTEGER @nBufferSize
DECLARE INTEGER RegCloseKey IN ADVAPI32 INTEGER nKey
DECLARE INTEGER GetProfileString IN KERNEL32 AS GetProStr String cSection, String cKey, String cDefault,String @cBuffer, Integer nBufferSize
UserName = ""
UserCorp = ""
lnResult = 0
Buffer = SPACE(128)
BufferSize = LEN(Buffer)
IF UPPER(OS()) = "WINDOWS NT" OR ("WINDOWS 4" $ UPPER(OS())) OR ("WINDOWS NT" $ UPPER(OS()))
lcKey = IIF("NT" $ UPPER(OS()), "Software\Microsoft\Windows NT\CurrentVersion","Software\Microsoft\Windows\CurrentVersion")
lnError = RegOpenKeyEx(-2147483646,lcKey , 0, 1, @lnresult)
IF lnError = 0
LnType = 0
Buffer = SPACE(128)
BufferSize = LEN(Buffer)
LnError = RegQueryValueEx(lnresult, "Registeredowner",0, @lnType, @Buffer, @BufferSize)
IF lnError = 0 AND Buffer <> CHR(0)
UserName = LEFT(Buffer, BufferSize - 1)
ENDIF
lnType = 0
Buffer = SPACE(128)
BufferSize = LEN(Buffer)
lnError = RegQueryValueEx(lnresult,"RegisteredOrganization", 0, @lnType,@Buffer, @BufferSize)
IF lnError = 0 AND Buffer <> CHR(0)
UserCorp = LEFT(Buffer, BufferSize - 1)
ENDIF
ENDIF
=RegCloseKey(lnResult)
ELSE
RetVal = GetProStr("MS USER INFO", "DEFNAME", "",@Buffer, BufferSize)
UserName = LEFT(Buffer, RetVal)
RetVal = GetProStr("MS USER INFO", "DEFCOMPANY", "",@Buffer, BufferSize)
UserCorp = LEFT(Buffer, RetVal)
ENDIF
ENDPROC
**************************************************************************
* 函 数 名：get_driver *
* 功 能：获得合法驱动器号 *
* 传递参数：(无) *
* 返 回 值：合法的驱动器号连接在一起的字符串（字符型） 形如：2335|ACDE *
* 说 明：系统函数drivetype的返回值，含义如下： *
* 2，软盘驱动器号 ； 3，硬盘逻辑分区号 ； 5，光盘驱动器号 *
* 4，网络驱动器号 ； 6，虚拟磁盘驱动器号 ； 1，无驱动器号 *
**************************************************************************
PROCEDURE get_driver
PRIVATE ALL
m.driver_xh = ''
m.driver_zm = ''
FOR i=1 TO 26
driver_no = CHR(64 + i)
m.driver_zm = m.driver_zm + IIF(DRIVETYPE(driver_no) # 1,driver_no,'')
m.driver_xh = m.driver_xh + IIF(DRIVETYPE(driver_no) # 1,ALLTRIM(STR(DRIVETYPE(driver_no))),'')
ENDFOR
RETURN UPPER(m.driver_xh+'|'+m.driver_zm)
ENDPROC
**************************************************************************
* 函 数 名：get_rand *
* 功 能：获得指定整型数字间的随机数 *
* 传递参数：起始数字，截止数字(整型) *
* 返 回 值：起始至截止数字之间的一个数字（数值型） *
**************************************************************************
PROCEDURE get_rand
PARAMETERS start_num , end_num
RETURN INT(((end_num - start_num)+1)*RAND() + start_num)
ENDPROC
**************************************************************************
* 函 数 名：_isdigit *
* 功 能：判断输入的字符串是否是数字字串,不区分字母和汉字 *
* 传递参数：字符串,可以包含小数点,正负号,字母和汉字视同非数字字串 *
* 返 回 值：.T./.F.（逻辑型） *
**************************************************************************
PROCEDURE _isdigit
PARAMETERS sp_string
funcretvalue = .T.
avail_chr = '+-.0123456789'
sp_string_len = LEN(ALLTRIM(sp_string))
FOR ic=1 TO sp_string_len
per_chr = SUBSTR(ALLTRIM(sp_string) , ic , 1)
IF per_chr = SPACE(1)
LOOP
ENDIF
IF NOT (per_chr $ avail_chr)
funcretvalue = .F.
EXIT
ENDIF
ENDFOR
RETURN funcretvalue
ENDPROC
**************************************************************************
* 函 数 名：_dtoc *
* 功 能：将日期型日期转换为字符串 *
* 传递参数：日期型/字符型日期,返回值模式 *
* 返 回 值：字符串日期,返回值模式=1返回年,=2返回年月,=其它则返回年月日 *
**************************************************************************
PROCEDURE _dtoc
PARAMETERS _date , ret_all , ret_mode
m._ret_mode = IIF(PARAMETERS()<3,0,m.ret_mode)
IF TYPE('_date')='D'
_yyyy = ALLTRIM(STR(YEAR(_date),4))
_mm = CHRTRAN(STR(MONTH(_date),2),' ','0')
_dd = CHRTRAN(STR(DAY(_date),2),' ','0')
ELSE
_date = ALLTRIM(_date)
IF EMPTY(_date)
RETURN ' . . '
ELSE
split_chr_num = OCCURS('.',_date)
DO CASE
CASE split_chr_num = 0
_yyyy = _date
_mm = IIF(ret_all,SPACE(2),'')
_dd = IIF(ret_all,SPACE(2),'')
CASE split_chr_num = 1
_yyyy = getword(_date,1,'.')
_mm = getword(_date,2,'.')
_dd = IIF(ret_all,SPACE(2),'')
CASE split_chr_num = 2
_yyyy = getword(_date,1,'.')
_mm = getword(_date,2,'.')
_dd = getword(_date,3,'.')
ENDCASE
ENDIF
ENDIF
DO CASE
CASE m._ret_mode = 1
RETURN _yyyy
CASE m._ret_mode = 2
RETURN _yyyy+'.'+_mm
OTHERWISE
RETURN _yyyy+'.'+_mm+'.'+_dd
ENDCASE
ENDPROC
****************************************************
*通过报名号查询照片
****************************************************
PROCEDURE ZX
para kh1
aa='photos\'+kh1+'.jpg'
if .not.file(aa)
aa='images\a1.jpg'
endif
return aa
最新回复