📄 func_this.prg
字号:
*--名称 flyfaraway的函数/过程集1 （系统级）
*--数据库类型
*--版本日期 2007.10.04
*--函数/过程列表
* ReadRegValue 读注册表值
* WriteRegValue 写注册表值
* EnumRegKey 枚举注册键
* ReadIniSection 读INI文件节
* ReadIniKey 读INI文件键值
* WriteIniSection 写INI文件节
* WriteIniKey 写INI文件键值
* ShowWaiting 显示正在处理提示表单
* ClearWaiting 清除正在处理提示表单
* GetDir2 选择文件夹
* Num2Long
* Record_Err_Mess 解析错误信息
* SaveAlias 保存旧区
* RestoreAlias 还原区
* Set_Cursor_Updatable 设置spt视图更新选项
* IsSelAccset 是否选择了数据库
* HavePower 判断权限
* IsSqldbused 判断SQLServer2000数据库是否正在使用
* TestConnDB 测试连接数据库函数
* SQLConnStr 组合SQLServer连接串
* Ref_MainGrid 刷新主窗口表格
* List_DelALL 清空数据库列表
FUNCTION ReadRegValue &&读注册表项目
LPARAMETERS lpN_HKEY,lpC_path,lpC_item
* lpN_HKEY HKEY值
* lpC_path 路径 "\software\microsoft"
* lpC_item 项目 "sn"
DECLARE Integer RegOpenKeyEx IN Win32API Integer nHKey,String @cSubKey,Integer nReserved,Integer nAccessMask,Integer @nHandle
DECLARE Integer RegCreateKey IN Win32API Integer nHKey,String @cSubKey,Integer @nResult
DECLARE Integer RegCloseKey IN Win32API Integer nHKey
DECLARE Integer RegQueryValueEx IN Win32API Integer nHKey,String @ValueName, Integer dwReserved,Integer @lpdwType, String @lpbData, Integer @lpcbData
LOCAL ERROR_SUCCESS,REG_SZ,REG_EXPAND_SZ,lcNaccess,lcNhand2,lcNerr,lcCbuff,lcNBuffLen,lcNregtype
ERROR_SUCCESS =0 &&OK
REG_SZ =1 && Data string
REG_EXPAND_SZ =2 && Unicode string
lcNaccess=1
lcNhand2=0
lcNerr=RegOpenKeyEx(lpN_HKEY,@lpC_path,0,lcNaccess,@lcNhand2) &&打开键
IF lcNerr<>ERROR_SUCCESS AND RegCreateKey(lpN_HKEY,@lpC_path,@lcNhand2)<>ERROR_SUCCESS
&&打开失败，尝试建立Key，失败，返回.F.
RegCloseKey(lcNhand2)
RETURN .F.
ENDIF
lcCbuff=SPACE(256)
lcNBuffLen=LEN(lcCbuff)
lcNregtype=0
lcNerr=RegQueryValueEx(lcNhand2,@lpC_item,0,@lcNRegtype,@lcCbuff,@lcNBuffLen)
IF lcNerr=ERROR_SUCCESS AND INLIST(lcNRegtype,REG_SZ,REG_EXPAND_SZ)
RegCloseKey(lcNhand2)
RETURN LEFT(lcCbuff,lcNBuffLen-1)
ELSE
RETURN .F.
ENDIF
ENDFUNC
* ---- END
FUNCTION WriteRegValue &&写注册表项目
LPARAMETERS lpN_HKEY,lpC_path,lpC_item,lpC_value,lpN_type
* lpN_HKEY HKEY值
* lpC_path 路径 "\software\microsoft"
* lpC_item 项目 "sn"
* lpC_value 值 "111-1111111"
* lpN_type 值类型
DECLARE Integer RegOpenKeyEx IN Win32API Integer nHKey,String @cSubKey,Integer nReserved,Integer nAccessMask,Integer @nHandle
DECLARE Integer RegCreateKey IN Win32API Integer nHKey,String @cSubKey,Integer @nResult
DECLARE Integer RegCloseKey IN Win32API Integer nHKey
DECLARE Integer RegSetValueEx IN Win32API Integer hHKey,String lpszValueName,Integer dwReserved,Integer fdwType, String lpbData, Integer cbData
LOCAL ERROR_SUCCESS,REG_SZ,REG_EXPAND_SZ,REG_DWORD,lcNaccess,lcNhand2,lcNerr,lcNBuffLen
ERROR_SUCCESS =0 &&OK
REG_SZ =1 && Data string
REG_EXPAND_SZ =2 && Unicode string
REG_DWORD =4 && A 32-bit number.
lcNaccess=1
lcNhand2=0
lcNerr=RegOpenKeyEx(lpN_HKEY,@lpC_path,0,lcNaccess,@lcNhand2) &&打开键
IF lcNerr<>ERROR_SUCCESS AND RegCreateKey(lpN_HKEY,@lpC_path,@lcNhand2)<>ERROR_SUCCESS
&&打开失败，尝试建立Key，失败，返回.F.
RegCloseKey(lcNhand2)
RETURN .F.
ENDIF
lpC_value=RTRIM(lpC_value)
lcNBuffLen=LEN(lpC_value)
IF VARTYPE(lpN_type)<>"N" OR (lpN_type<REG_SZ AND lpN_type>REG_DWORD)
lpN_type=REG_SZ
ENDIF
lcNerr=RegSetValueEx(lcNhand2,@lpC_item,0,lpN_type,@lpC_value,lcNBuffLen)
RegCloseKey(lcNhand2)
RETURN lcNerr=ERROR_SUCCESS
* ---- END
FUNCTION EnumRegKey &&枚举注册键
LPARAMETERS lpN_HKEY,lpC_path
* lpN_HKEY HKEY值
* lpC_path 路径 "\software\microsoft"
DECLARE Integer RegOpenKeyEx IN Win32API Integer nHKey,String @cSubKey,Integer nReserved,Integer nAccessMask,Integer @nHandle
DECLARE Integer RegCreateKey IN Win32API Integer nHKey,String @cSubKey,Integer @nResult
DECLARE Integer RegCloseKey IN Win32API Integer nHKey
DECLARE Integer RegEnumKey IN Win32API Integer nHKey,Integer iSubKey,String @lpszName, Integer @cchName
DECLARE Integer RegEnumKeyEx IN Win32API Integer nHKey,Integer iSubKey,String @lpszName, Integer @cchName,Integer dwReserved,String @lpszName, Integer @cchName,String @cchName
DECLARE Integer RegEnumValue IN Win32API Integer nHKey,Integer iValue, String @lpszValue,Integer @lpcchValue, Integer lpdwReserved, Integer @lpdwType,String @lpbData, Integer @lpcbData
LOCAL ERROR_SUCCESS,REG_SZ,REG_EXPAND_SZ,REG_DWORD,lcNaccess,lcNhand2,lcNerr
ERROR_SUCCESS =0 &&OK
REG_SZ =1 && Data string
REG_EXPAND_SZ =2 && Unicode string
REG_DWORD =4 && A 32-bit number.
lcNaccess=1
lcNhand2=0
lcNerr=RegOpenKeyEx(lpN_HKEY,@lpC_path,0,lcNaccess,@lcNhand2) &&打开键
IF lcNerr<>ERROR_SUCCESS AND RegCreateKey(lpN_HKEY,@lpC_path,@lcNhand2)<>ERROR_SUCCESS
&&打开失败，尝试建立Key，失败，返回.F.
RegCloseKey(lcNhand2)
RETURN .F.
ENDIF
LOCAL lcNkeycnt,lcNkeysize,lcCnewkey,lcCbuff,lcNlen,lcCrettime,lcNerr,lcOcoll
lcOcoll=CREATEOBJECT("Collection") &&建立集合
lcNkeycnt=0
DO WHILE .T. &&循环
lcNkeysize=0
lcCnewkey=space(100)
lcNkeysize=len(lcCnewkey)
lcCbuff=space(100)
lcNlen=len(lcCbuff)
lcCrettime=space(100)
lcNerr=RegEnumKeyEx(lcNhand2,lcNkeycnt,@lcCnewkey,@lcNkeysize,0,@lcCbuff,@lcNlen,@lcCrettime)
IF lcNerr=ERROR_EOF OR lcNerr<>ERROR_SUCCESS &&错误或结束，跳出
EXIT
ENDIF
lcCnewkey=LEFT(ALLTRIM(lcCnewkey),LEN(ALLTRIM(lcCnewkey))-1)
lcNkeycnt=lcNkeycnt+1
lcOcoll.Add(lcCnewkey)
ENDDO
RegCloseKey(lcNhand2)
RETURN lcOcoll
* ---- END
FUNCTION ReadIniSection &&读INI文件节 返回 "picture=back.bmp"+chr(0)+"left=10"+chr(0)
LPARAMETERS lpCfile,lpCsect
* lpCfile ini文件
* lpCsect 节
Declare INTEGER GetPrivateProfileSection IN win32api;
STRING lpAppName,;
STRING @ lpReturnedString,;
INTEGER nSize,;
STRING lpFileName
lpCfile=IIF(EMPTY(JUSTPATH(lpCfile)),FULLPATH(CURDIR())+lpCfile,lpCfile) &&若INI文件无路径,则当前目录
LOCAL lcNsize,lcCbuff
lcNsize=16384
lcCbuff=REPLICATE(CHR(0),lcNsize)
lcNsize=GetPrivateProfileSection(lpCsect,@lcCbuff,lcNsize,lpCfile)
RETURN LEFT(lcCbuff,lcNsize)
* ---- END
FUNCTION ReadIniKey &&读INI文件键值
LPARAMETERS lpCfile,lpCsect,lpCkey
* lpCfile ini文件
* lpCsect 节
* lpCkey 键
Declare INTEGER GetPrivateProfileString IN win32api;
STRING lpAppName,;
STRING lpKeyName,;
STRING lpDefault,;
STRING @ lpReturnedString,;
INTEGER nSize,;
STRING lpFileName
lpCfile=IIF(EMPTY(JUSTPATH(lpCfile)),FULLPATH(CURDIR())+lpCfile,lpCfile) &&若INI文件无路径,则当前目录
LOCAL lcNsize,lcCbuff
lcNsize=16384
lcCbuff=REPLICATE(CHR(0),lcNsize)
lcNsize=GetPrivateProfileString(lpCsect,lpCkey,"",@lcCbuff,lcNsize,lpCfile)
RETURN LEFT(lcCbuff,lcNsize)
* ---- END
FUNCTION WriteIniSection &&写INI文件节
LPARAMETERS lpCfile,lpCsect,lpCstring
* lpCfile ini文件
* lpCsect 节
* lpCstring 键及值 例子 1、"" 只增加节 2、"picture=back.bmp"+chr(0)+"left=10"+chr(0)
Declare WritePrivateProfileSection IN win32api;
STRING lpAppName,;
STRING lpString,;
STRING lpFileName
lpCfile=IIF(EMPTY(JUSTPATH(lpCfile)),FULLPATH(CURDIR())+lpCfile,lpCfile) &&若INI文件无路径,则当前目录
RETURN WritePrivateProfileSection(lpCsect,lpCstring,lpCfile)
* ---- END
FUNCTION WriteIniKey &&写INI文件键值
LPARAMETERS lpCfile,lpCsect,lpCkey,lpCstring
* lpCfile ini文件
* lpCsect 节
* lpCkey 键
* lpCstring 值
Declare WritePrivateProfileString IN win32api;
STRING lpAppName,;
STRING lpKeyName,;
STRING lpString,;
STRING lpFileName
lpCfile=IIF(EMPTY(JUSTPATH(lpCfile)),FULLPATH(CURDIR())+lpCfile,lpCfile) &&若INI文件无路径,则当前目录
RETURN WritePrivateProfileString(lpCsect,lpCkey,lpCstring,lpCfile)
* ---- END
PROCEDURE ShowWaiting &&显示正在处理提示表单
LPARAMETERS lcCtips,lcNsec,lcCpic
*-- lcCtips 提示信息
*-- lcNsec 显示秒数
*-- lcCpic 图片文件
LOCAL lcActform
TRY &&取当前表单名称
lcActform=_Screen.ActiveForm.Name
CATCH
lcActform=""
ENDTRY
TRY &&_Screen创建等待对象
_Screen.o_waiting=.NULL.
CATCH
_Screen.AddProperty("o_waiting",.NULL.)
ENDTRY
_Screen.o_waiting=CREATEOBJECT("waiting",lcCtips,lcNsec,lcCpic) &&创建等待对话框
_Screen.o_waiting.SHOW &&显示
INKEY(0.1)
IF !EMPTY(lcActform) &&激活调用表单
ACTIVATE WINDOW (lcActform)
ENDIF
ENDPROC
* ---- END
PROCEDURE ShowWaiting2 &&显示正在处理提示表单
LPARAMETERS lcCtips,lcNsec,lcCpic
*-- lcCtips 提示信息
*-- lcNsec 显示秒数
*-- lcCpic 图片文件
LOCAL lcActform
TRY &&取当前表单名称
lcActform=_Screen.ActiveForm.Name
CATCH
lcActform=""
ENDTRY
TRY &&_Screen创建等待对象
_Screen.o_waiting=.NULL.
CATCH
_Screen.AddProperty("o_waiting",.NULL.)
ENDTRY
_Screen.o_waiting=CREATEOBJECT("waiting2",lcCtips,lcNsec,lcCpic) &&创建等待对话框
_Screen.o_waiting.SHOW &&显示
INKEY(0.1)
IF !EMPTY(lcActform) &&激活调用表单
ACTIVATE WINDOW (lcActform)
ENDIF
ENDPROC
* ---- END
PROCEDURE ClearWaiting &&清除正在处理提示表单
WAIT CLEAR
TRY &&释放等待对象
_Screen.o_waiting.Release
CATCH
ENDTRY
ENDPROC
* ---- END
FUNCTION GetDir2 &&选择文件夹
LPARAMETERS lpCmess,lpNroot
*- lpCmess 选择文件夹提示信息
*- lpNroot 指定根目录 0:我的电脑;
1:IE目录;
2:程序菜单;
3:控制面板;
4:打印机;
5:我的文档;
6:收藏夹;
7:启动;
8:Recent;
9:SendTo;
10:回收站;
11:开始菜单
lpCmess=IIF(VARTYPE(lpCmess)<>"C","选择文件夹",lpCmess)
lpNroot=IIF(VARTYPE(lpNroot)<>"N",0,lpNroot)
Declare integer SHBrowseForFolder in shell32 string
Declare integer SHGetPathFromIDList in shell32 integer, string @
Declare integer FindWindow in win32api string, string
LOCAL lcOheap
lcOheap =CREATEOBJECT("HeapForGetDir2")
With lcOheap
howner = FindWindow("", _screen.caption)
pidlroot = lpNroot
pszdisplayname= .CopyToHeap("d:\temp")
lpsztitle = .CopyToHeap(lpCmess)
ulflags = 0
lpfn = 0
lnparam = 0
iimage = 0
browseinfo = Num2Long(howner) ;
+ Num2Long(pidlroot) ;
+ Num2Long(pszdisplayname);
+ Num2Long(lpsztitle) ;
+ Num2Long(ulflags) ;
+ Num2Long(lpfn) ;
+ Num2Long(lnparam) ;
+ Num2Long(iimage)
lcRhn = SHBrowseForFolder(browseinfo)
Endwith
Release lcOheap
lcCpath = SPACE(512)
IF SHGetPathFromIDList(lcRhn,@lcCpath)=1
lcCpath=LEFT(lcCpath,AT(CHR(0),lcCpath)-1)
ELSE
lcCpath=""
ENDIF
RETURN lcCpath &&返回路径
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -