定义全局外部函数:
//获取文件夹的外部API函数
Function ulong GetCurrentDirectoryA (ulong textlen, ref string dirtext) library "KERNEL32.DLL" alias for "GetCurrentDirectoryA;Ansi"
//处理注册表的外部API函数
FUNCTION ulong RegSetValueEx(ulong hKey,ref string lpValueName,ulong Reserved,ulong dwType,ref Any lpData,ulong cbData) LIBRARY "advapi32.dll" ALIAS FOR "RegSetValueExA"
//注册ODBC
//自定义函数af_autoreg_odbc(string as_database)
//string as_database
//return integer
Int reg_result
String ls_dir,ls_system,ls_sys,ls_install,ls_system_driver,ls_system_setup
String ls_date,ls_run
ls_dir = GetCurrentDirectory()
If Right(ls_dir,1) <> '\' Then ls_dir = ls_dir + "\"
ls_system = ls_dir + "dbodbc8.dll" //odbc接口文件
ls_date = ls_dir +"database\" + as_database //数据库文件
ls_run = ls_dir +"dbeng8.exe " //ASA运行文件
If Not FileExists( ls_system) Then
MessageBox("","找不到文件dbodbc8.dll,请确定文件在程序文件夹 "+ ls_dir + "内!")
Return -1
End If
If Not FileExists(ls_date) Then
MessageBox("","找不到数据库文件 " + as_database + ",请确定文件在 " + ls_dir +"database内!")
Return -1
End If
If FileExists(ls_run) Then
ls_run = ls_run +" -Q -d -c8m " //参数-q 运行时隐藏asa数据库
Else
MessageBox("","找不到文件dbeng8.exe,请确定文件在程序文件夹 " + ls_dir +"内")
Return -1
End If
//检查ASA数据源是否安装
ls_sys = "HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\ODBC DRIVERS"
RegistryGet(ls_sys, "Adaptive Server Anywhere 8.0", RegString!,ls_install) //ASA数据源是否注册
If Trim(ls_install) <> "Installed" Then //注册ASA数据源,为了直观 ,我把健值都写出来,实际可以用string代替,这样代码看上去没那么长
reg_result = RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\ODBC DRIVERS","Adaptive Server Anywhere 8.0",RegString!,"Installed")
reg_result = RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Adaptive Server Anywhere 8.0","driver",RegString!,ls_system)
reg_result = RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Adaptive Server Anywhere 8.0","setup",RegString!,ls_system)
MessageBox("","Adaptive Server Anywhere 8.0 注册成功!")
//Else
// //如果已安装,运行调试参数按系统执行
// RegistryGet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Adaptive Server Anywhere 8.0","driver",RegString!,ls_system_driver)
// RegistryGet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Adaptive Server Anywhere 8.0","setup",RegString!,ls_system_setup)
// If ls_system_driver = ls_system_setup and trim(ls_system_driver) <> '' and trim(ls_system_setup) <> '' then
// ls_system = ls_system_driver
// End if
End if
//注册ODBC , 如果不返回1 做错误处理
Integer li_err
Constant String gs_KeyODBC = 'HKEY_CURRENT_USER\SOFTWARE\ODBC\ODBC.INI\zcqc'
li_err = RegistrySet(gs_KeyODBC,"Autostop",RegString!,"Yes")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"Compress",RegString!,"No")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"Debug",RegString!,"No")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"DisableMultiRowFetch",RegString!,"No")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"DatabaseFile",RegString!,ls_date )
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"Description",RegString!,'zcqc')
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"Driver",RegString!,ls_system)
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"EngineName",RegString!,'zcqc')
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"UID",RegString!,"dba")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"PWD",RegString!,"sql")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet(gs_KeyODBC,"Start",RegString!,ls_run )
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
li_err = RegistrySet("HKEY_CURRENT_USER\software\odbc\odbc.ini\odbc data sources","zcqc",RegString!,"Adaptive Server Anywhere 8.0")
If li_err <> 1 Then //其它的一样,就不写了
MessageBox("","注册ASA数据库出错,请删除原有数据源后重新注册!")
Return -1
End If
Return 0