📄 mypubproc.prg
字号:
*-- 公共调用过程或函数
#include ../inc/system.h
*-- ===============================================================
*程序名称：AutoAddOne.prg
*程序功能：给字符串中含有数字的部分+1
*使用方法：AutoAddOne(cCode,nLen)
*变量说明：cCode是要转换的字符串；nLen是字符串中数字的宽度
*程序说明：许多时候我们需要对字符型数据进行编号的自动累加， 象000001，ABC0001，X-001
* 等格式，处理这些数据的关键是针对字符串中数字一段的部分进行累加计算，并给
* 出空缺的数字高位上的0，即必须前导0。
*-- ===============================================================
* 程序清单：
Func AutoAddOne
para cCode,nLen
priv cRightCode,cLeftCode,cNewCode,n0
*cRightCode 为字符串中右边数字部分
*cLeftCode 为字符串中左边的不参与运算的部分，一般为字母
*cNewCode 程序中运算得到的新的数据
*n0 即前导0的个数。
cCode=rtrim(cCode)
cRightCode=right(cCode,nLen)
cLeftCode=left(cCode,len(cCode)-nLen)
if len(cRightCode)<nLen
messagebox("自动增加的字符宽度("+allt(str(len(cRightCode)))+")小于设定的宽度("+allt(str(nLen))+")！",16,"警告")
retu ""
endif
cNewCode=allt(str(val(cRightCode)+1))
n0=nLen-len(cNewCode)
if n0>=0
cNewCode=repl('0',n0)+cNewCode
else
messagebox("字符宽度已超出了预先设定的最大值("+repl('9',nLen)+")！",16,"警告")
retu ""
endif
cCode=cLeftCode+cNewCode
retu cCode
*-- ===============================================================
*-- ===============================================================
*-- 将一个数字前面补零
Func AddZero
*-- ===============================================================
Para tcOldChar,tnMaxLen
if len(allt(tcOldChar)) < tnMaxLen and !empty(tcOldChar)
tcOldChar=repl('0',tnMaxLen-len(allt(tcOldChar)) ) + allt(tcOldChar)
endif
retu tcOldChar
*-- ===============================================================
*-- ===============================================================
*-- 关闭数据表函数
*-- ===============================================================
Func CloseDB
para db_name
if used("&db_name")
sele "&db_name"
use
endif
retu
*-- ===============================================================
*-- ===============================================================
*-- 打开连接
*-- ===============================================================
Func OpenURL
para cURL
IF EMPTY(cURL)
RETURN .F.
ENDIF
DECLARE INTEGER ShellExecute ;
IN SHELL32.DLL ;
INTEGER nWinHandle,;
STRING cOperation,;
STRING cFileName,;
STRING cParameters,;
STRING cDirectory,;
INTEGER nShowWindow
return shellexecute(0,"open","&cURL","","",1)
*-- ===============================================================
*-- ===============================================================
*-- 打开数据表函数
*-- ===============================================================
Func OpenDB
para db_name,alias_name,isExclusive
Priv lcErrorHandExp
lcErrorHandExp = on("error")
Do While .T.
isNoError = .T.
isOpenError = .F.
lcErrorMsg = ""
if type("alias_name") <> "C"
*-- 没有传递别名
alias_name = db_name
if upper(right(db_name,4)) # ".DBF"
db_name = db_name + ".dbf"
endif
else
*-- 传递了别名
endif
if used("&alias_name")
sele "&alias_name"
if isExclusive
use
else
isNoError = .T.
exit
endif
endif
lnErrorNo = -1
on error lnErrorNo = error() && 捕捉错误代码
if !file("&db_name")
lcErrorMsg = "指定的文件“&db_name.”不存在！ "
isOpenError = .T.
else
if isExclusive
use "&db_name" alias "&alias_name" again in 0 exclusive
else
use "&db_name" alias "&alias_name" again in 0 share
endif
if lnErrorNo = 1707 && 缺少 CDX 时的报错
messagebox("缺少数据文件“&db_name.”的索引文件，已忽略！",48,"警告")
loop
endif
lcErrmsg = message()
sele "&alias_name"
if lnErrorNo > 0 && isOpenError
if isExclusive
lcErrorMsg = "不能独占打开文件“&db_name.”！"
else
lcErrorMsg = "不能共享打开文件“&db_name.”！"
endif
lcErrorMsg = lcErrorMsg + chr(13) + '(' + lcErrmsg + ')'
endif
endif
if empty(lcErrorMsg)
isNoError = .T.
exit
else
if messagebox( lcErrorMsg +chr(13)+chr(13)+ "这可能会影响下面的计算，是否重试？",1+4+16,"错误") = 2
isNoError = .F.
exit
else
loop
endif
endif
Enddo
on error &lcErrorHandExp
retu isNoError
*-- ===============================================================
*-- ===============================================================
*-- 从 INI 文件读取内容
*-- ===============================================================
Func Readini
para lcHeader, lcEntry, lnBufferSize
private lcBuffer
lnBufferSize = lnBufferSize + 1
*-- 声明API函数
DECLARE INTEGER GetPrivateProfileString IN Win32API AS GetPrivStr ;
String cSection, String cKey, String cDefault, String @cBuffer, ;
Integer nBufferSize, String cINIFile
*-- 指定要读取的内容的长度，先用空字符来定义，
* 有多少长度，就在Space()里指定多少，后面的chr(0)并没有实际的意义，
* 但是如果去掉后，Space()里指定的长度就比实际长度少一位。
lcBuffer = space(lnBufferSize) + chr(0)
*-- 读取指定的内容
=GetPrivStr(lcHeader, lcEntry, "", ;
@lcBuffer, LEN(lcBuffer), ;
"&gcSystemIni")
*-- 读到的内容存放与变量 lcBuffer
lcBuffer = allt(left(lcBuffer,lnBufferSize))
retu left(lcBuffer,len(lcBuffer)-1)
*-- ===============================================================
*-- ===============================================================
*-- 新建机码 RegCreateKey
*-- 传回值：.T.表成功，.F.表示创建失败
*-- ===============================================================
Func NewRegKey
para sub_key
*建立机码
DECLARE INTEGER RegCreateKey IN Win32API INTEGER nHKey,STRING cSubKey, INTEGER @nHandle
#DEFINE HKEY_CLASSES_ROOT -2147483648
#DEFINE HKEY_CURRENT_USER -2147483647
#DEFINE HKEY_LOCAL_MACHINE -2147483646
#DEFINE HKEY_USERS -2147483645
#DEFINE ERROR_SUCCESS 0
retu RegCreateKey(HKEY_LOCAL_MACHINE,sub_key,0)
*-- ===============================================================
*-- ===============================================================
*-- 读取字串值 ReadRegistryString
*-- 传回值：字串或 ""
*-- ===============================================================
FUNCTION ReadReg
PARAMETERS Entry
SubKey = SysRegName_loc && 此代码不属于函数段，为了部分程序的特殊需要
*SubKey = "Software\Microsoft\Windows\CurrentVersion\Run"
*开启机码
DECLARE INTEGER RegOpenKey IN Win32API INTEGER nHKey,STRING cSubKey, INTEGER @nHandle
*关闭开启的机码
DECLARE INTEGER RegCloseKey IN Win32API INTEGER nHKey
HKEY = -2147483646
LOCAL nHandle, nResult, nBufferSize, cDataBuffer, nType
nHandle=0
*开启机码
nResult=RegOpenKey(HKey,SubKey,@nHandle)
IF nResult#0
RETURN ""
ENDIF
* 使用RegQueryValueEx决定资料型态
DECLARE INTEGER RegQueryValueEx IN Win32API ;
INTEGER nHKey,STRING lpszValueName,INTEGER dwReserved,INTEGER @lpdwType, STRING @lpbData, INTEGER @lpcbData
*将值传回 buffer
cDataBuffer=SPACE(256)
nBufferSize=LEN(cDataBuffer)
nType=1
nResult= RegQueryValueEx(nHandle,Entry,0,@nType,@cDataBuffer,@nBufferSize)
=RegCloseKey(nHandle)
IF nResult#0
RETURN ""
ENDIF
IF nBufferSize <2
RETURN ""
* 空字串
ENDIF
*去除空白字元及字串後的 NULL
RETURN SUBSTR(CHRTRAN(cDataBuffer,CHR(0),""),1,nBufferSize)
*-- ===============================================================
*-- ===============================================================
*-- 向 INI 文件写入内容
*-- ===============================================================
Func WriteIni
para lcHeader, lcEntry, lcValue
*-- 声明API函数
DECLARE INTEGER WritePrivateProfileString IN Win32API AS WritePrivStr ;
String cSection, String cKey, String cValue, String cINIFile
*-- 写入指定的内容
=WritePrivStr(lcHeader, lcEntry, lcValue, "&gcSystemIni")
retu
*-- ===============================================================
*-- ===============================================================
*-- 写入字串值 WriteRegistryString *** 传回值：.T.成功,.F.失败
*-- ===============================================================
FUNCTION WriteReg
LPARAMETERS Entry, Value
*开启机码
SubKey = SysRegName_loc && 此代码不属于函数段，为了部分程序的特殊需要
DECLARE INTEGER RegOpenKey IN Win32API INTEGER nHKey,STRING cSubKey, INTEGER @nHandle
DECLARE INTEGER RegCloseKey IN Win32API INTEGER nHKey
HKEY = -2147483646
LOCAL nHandle, nResult, nSize, cDataBuffer, nType
nHandle=0
nResult=RegOpenKey(HKey,SubKey,@nHandle)
IF nResult#0
RETURN .F.
ENDIF
DECLARE INTEGER RegSetValueEx IN Win32API ;
INTEGER nHKey, STRING lpszEntry,INTEGER dwReserved, INTEGER fdwType, STRING lpbData, INTEGER cbData
* fdwType 键类型 ：
* 0 - 二进制类型
* 1 - 字符型
nSize=LEN(Value)
nResult=RegSetValueEx(nHandle,Entry,0,0,Value,nSize)
=RegCloseKey(nHandle)
IF nResult#0
RETURN .F.
ENDIF
RETURN .T.
*-- ===============================================================
*-- ===============================================================
*-- 秒到小时的转换
*-- ===============================================================
Func sec2hour
para nSecond
private lcHMS
local lnHour,lnMinute,lnSecond
lcHMS = ""
*-- hour
lnHour = int(nSecond / 3600)
if lnHour > 0
lcHMS = lcHMS + allt(str(lnHour))+"小时"
endif
nSecond = mod(nSecond,3600)
lnMinute = int(nSecond / 60)
if lnMinute > 0
lcHMS = lcHMS + allt(str(lnMinute))+"分"
endif
nSecond = mod(nSecond,60)
if nSecond > 0
lcHMS = lcHMS + allt(str(nSecond))+"秒"
endif
if empty(lcHMS)
lcHMS = "0秒"
endif
retu lcHMS
*-- ===============================================================
*-- ===============================================================
*-- 文章标题：让程序自动去完成MSGBOX的确认操作
*-- 程序说明：建立一个MESSAGEBOX对话框，当没有用户去响应时，自动在一定时间内响应回车事件
*-- 原作：Matt Weinbender SoftServ, Inc. 5/3/2000
*-- 由红虎简化该程序
*-- 使用： ?MsgBoxTmr("对话框信息","对话框标题",按纽类型(参考messagebox()帮助),等待时间(单位:秒))
*-- 返回： 同messagebox()一样
*-- 注意： 如果在 VFP5 中运行，需要 FoxTools.FLL
*-- 如果在 VFP6 中，就无需了。
*------------------------------------------------------------------
*-- ===============================================================
FUNCTION MsgBoxTmr
*-- 接受参数，最多4个
LPARAMETERS lcMsgText, lcMsgTitle, lnButtons, lnWaitSecs
*-- 检查传递的参数
*-- 等待时间必须大于等于0，如果等于0，为不等待
if type("lnWaitSecs") # "N"
lnWaitSecs = 0
else
if lnWaitSecs < 0
lnWaitSecs = 0
endif
endif
*-- 按纽类型为，0,1,1+16,2+32+256...等形式
if type("lnButtons") # "N"
lnButtons = 0
endif
*-- 标题为字符，默认用主窗口标题
if type("lcMsgTitle") # "C"
lcMsgTitle = _screen.caption
endif
*-- 信息内容为字符
if type("lcMsgText") # "C"
lcMsgText = "无提示信息"
endif
*-- 创建时钟对象
*!* showwait("自动确认对话框...",1)
*!* do form test_auto_msg with lnWaitSecs
*!* do definetimer
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -