📄 mypubproc.bak

📁 foxpro连接sqlserver的例子
💻 BAK
📖 第 1 页 / 共 2 页
字号:
12 下一页
*-- 公共调用过程或函数
#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 RemoveZero
*-- ===============================================================
Para tcOldChar
Priv lnZeroNum
lnZeroNum = 1
do while .T.
	if	substr(tcOldChar,lnZeroNum,1) = '0'
		lnZeroNum = lnZeroNum + 1
	else
		exit
	endif
enddo
tcOldChar = substr(tcOldChar,lnZeroNum)
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
*-- ===============================================================


*-- ===============================================================
*-- 日期转换函数：　根据企业情况，会将每一个月的统计日定制，
*-- 如：每一个月的25日作为月底结算，26日就是下一个月了，因此
*-- 需要进行日期转换，当日期为大于25日的都要作为下一个月的日期
*-- 定义系统变量 _MonthCountDay 月结日，默认 = 25 号
*-- 但是每年的12月，要结算到31日。
*-- ===============================================================
Func date2new
para tdCurDate
Local lnYear,lnMonth,lnDay,lnNewDate
*-- 传递当前日期
if	type("tdCurDate") <> "D"
	messagebox("参数传递错误！",16,"程序错误")
	retu tdCurDate	&& .Null.
endif

*-- 当前日期的号数
lnDay	= day(tdCurDate)
*-- 当前日期的月数
lnMonth	= month(tdCurDate)
*-- 当前日期的年数
lnYear	= year(tdCurDate)

if	lnMonth < 12
	if	lnDay > _MonthCountDay	&& 默认为25日
		*-- 当号数大于月结日，月数加 1
		lnMonth	= lnMonth + 1
		if	lnMonth	>= 13
			*-- 当月数大于13时，年数加 1
			lnYear	= lnYear + 1
			lnMonth	= 1
		endif
	endif
endif

if	lnMonth = 12
	lnDay	= 31
else
	lnDay	= _MonthCountDay
endif
*-- 新的日期以1号作为标准	
for d=lnDay to 1 step -1
	ldNewDate	= ctod(str(lnYear,4) + "." + str(lnMonth,2) + "." + str(d,2) )
	if	empty(ldNewDate)
		loop
	else
		exit
	endif
endfor

retu ldNewDate
*-- ===============================================================


*-- ===============================================================
*-- 从 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
*-- 由红虎简化该程序
12 下一页
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -