$PBExportHeader$uo_reg.sru
forward
global type uo_reg from nonvisualobject
end type
end forward
global type uo_reg from nonvisualobject
end type
global uo_reg uo_reg
type prototypes
Function ulong GetModuleFileName(ulong hModule,ref string lpFileName,ulong nSize) LIBRARY "kernel32.dll" ALIAS FOR "GetModuleFileNameA"
Function boolean GetVolumeInformationA(string lpRootPathName,ref string lpVolumeNameBuffer,ulong nVolumeNameSize,ref ulong lpVolumeSerialNumber,ref ulong lpMaximumComponentLength,ref ulong lpFileSystemFlags,ref string lpFileSystemNameBuffer,ulong nFileSystemNameSize) LIBRARY "kernel32.dll"
Function ulong CopyFile(ref string lpExistingFileName,ref string lpNewFileName,ulong bFailIfExists) LIBRARY "kernel32.dll" ALIAS FOR "CopyFileA"
FUNCTION ulong GetSystemDirectory(ref string lpBuffer,ulong nSize) LIBRARY "kernel32.dll" ALIAS FOR "GetSystemDirectoryA"
FUNCTION ulong GetModuleHandle(ref string lpModuleName) LIBRARY "kernel32.dll"
FUNCTION ulong GetModuleUsage(uint ModuleHandle) LIBRARY "kernel32.dll"
end prototypes
type variables
string str_AppPath
end variables
forward prototypes
public subroutine of_database_reg (string str_sources, string db_name, string db_path, boolean reg_fs)
public function string uf_disk_getserialnumber ()
public function string of_reg_code (string str_disk_number)
public subroutine of_app_path ()
public function string of_reg_gs_code (string str_gs)
public function integer of_copy_driver (string str_file, string sys_path)
public function integer of_app_run ()
end prototypes
if (answer= -1) or (upper(str_Installed)<>upper("Installed"))then
IF not FileExists(str_WOD50T) Then
//以下要拷贝文件WOD50T.DLL
str_temp=str_appdir+"WOD50T.DLL"
if of_copy_driver(str_temp,str_WOD50T)=-1 then
return;
end if
//以下要拷贝文件dbl50t.dll
str_temp=str_appdir+"dbl50t.dll"
if of_copy_driver(str_temp,str_dbl50t)=-1 then
return;
end if
//以下要拷贝文件wl50ent.dll
str_temp=str_appdir+"wl50ent.dll"
if of_copy_driver(str_temp,str_wl50ent)=-1 then
return;
end if
//以下要拷贝文件wtr50t.dll
str_temp=str_appdir+"wtr50t.dll"
if of_copy_driver(str_temp,str_wtr50t)=-1 then
return;
end if
End IF
//设置ODBC\ODBCINST.INI\ODBC DRIVERS
Answer=RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\ODBC DRIVERS","Sybase SQL Anywhere 5.0", RegString!, "Installed")
IF Answer = -1 Then
MessageBox("错误！","应用程序无法设置ODBC\ODBCINST.INI\ODBC DRIVERS，系统将终止运行！",Information!) //程序中不折行
halt close
Return
End if
//设置ODBC\ODBCINST.INI\
Answer1=RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Sybase SQL Anywhere 5.0", "CPTimeout", RegString!, "not pooled")
Answer2=RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Sybase SQL Anywhere 5.0", "Driver", RegString!,str_WOD50T)
Answer3=RegistrySet("HKEY_LOCAL_MACHINE\Software\ODBC\ODBCINST.INI\Sybase SQL Anywhere 5.0", "Setup", RegString!,str_WOD50T)
IF Answer1 = -1 OR Answer2 = -1 OR Answer3 = -1 Then
MessageBox("错误！","应用程序无法设置ODBC\ODBCINST.INI，系统将终止运行！",Information!)//程序中不折行
halt close
Return
End if
end if
//读取要注册的数据源是否已存在
Answer=RegistryGet("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources", str_Sources, RegString!, str_mess)
if (answer= -1) or (upper(str_mess)<>upper("Sybase SQL Anywhere 5.0")) or (reg_fs) then
//设置数据源名称
Answer=RegistrySet("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources", str_Sources, RegString!, "Sybase SQL Anywhere 5.0")
if answer= -1 then
MessageBox("错误！","应用程序无法设置ODBC DATA SOURCE名称，系统将终止运行！",Information!) //程序中不折行
halt close
Return
end if
//设置ODBC.ini细节
Answer1=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "driver", Regstring!, str_WOD50T)
Answer2=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "start", Regstring!, ls_Start)
Answer3=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "autostop", Regstring!, "yes")
Answer4=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "DataBaseFile", Regstring!, db_path)
Answer5=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "DataBaseName", Regstring!, db_name)
IF Answer1 = -1 OR Answer2 = -1 OR Answer3 = -1 OR Answer4 = -1 OR Answer5 = -1 Then
MessageBox("错误！","应用程序无法设置ODBC.INI细节，系统将终止运行！",Information!)
halt close
Return
End if
else
Answer1=RegistryGet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "DataBaseFile", Regstring!, str_path)
if answer1= -1 or str_path<>db_path then
//设置ODBC.ini细节
Answer1=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "driver", Regstring!, str_WOD50T)
Answer2=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "start", Regstring!, ls_Start)
Answer3=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "autostop", Regstring!, "yes")
Answer4=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "DataBaseFile", Regstring!, db_path)
Answer5=RegistrySet("HKEY_current_user\software\odbc\odbc.ini\"+str_sources, "DataBaseName", Regstring!, db_name)
IF Answer1 = -1 OR Answer2 = -1 OR Answer3 = -1 OR Answer4 = -1 OR Answer5 = -1 Then
MessageBox("错误！","应用程序无法设置ODBC.INI细节，系统将终止运行！",Information!)
halt close
Return
End if
end if
end if
end subroutine
public function string uf_disk_getserialnumber ();//获取与一个磁盘卷有关的信息
IF not GetVolumeInformationA(as_RootPathName,ls_VolumeNameBuffer,256,ll_VolumeSerialNumber,ll_MaximumComponentLength,ll_FileSystemFlags,ls_FileSystemNameBuffer,256) THEN
SetNull(ll_VolumeSerialNumber)
END IF
RETURN String(ll_VolumeSerialNumber)
end function
public function string of_reg_code (string str_disk_number);string str_ch,str_code
integer len_str,i,i_ch[8],j//生成8位注册码
str_code=''
if isnull(str_disk_number) then
str_disk_number=''
end if
for i=1 to 8
i_ch[i]=mod(i_ch[i],155)
choose case i_ch[i]
case is>130
i_ch[i]=i_ch[i]/2
case is>90
i_ch[i]=i_ch[i]/2 + 25
case is>65
i_ch[i]=i_ch[i]
case is>40
i_ch[i]+=25
case is>15
i_ch[i]+=50
case is>0
i_ch[i]+=65
case else
i_ch[i]=65
end choose
str_code=str_code+char(i_ch[i])
next
return str_code;
end function
public subroutine of_app_path ();string str_ch,str_app_gsmc
integer int_ret,l_str,i
for i=1 to 10
i_ch[i]=mod(i_ch[i],155)
choose case i_ch[i]
case is>130
i_ch[i]=i_ch[i]/2
case is>90
i_ch[i]=i_ch[i]/2 + 25
case is>65
i_ch[i]=i_ch[i]
case is>40
i_ch[i]+=25
case is>15
i_ch[i]+=50
case is>0
i_ch[i]+=65
case else
i_ch[i]=65
end choose
str_code=str_code+char(i_ch[i])
next
return str_code;
end function
public function integer of_copy_driver (string str_file, string sys_path);long ulng_result
if not FileExists(str_file) then
messagebox("错误！","缺少文件在"+str_file+"，系统将终止运行！",StopSign!)
MessageBox("错误！","系统中没有安装SYBASE SQL ANYWHERE 的驱动程序，系统将终止运行！",StopSign!)
halt close
Return -1
end if
//拷贝文件
ulng_result=CopyFile(str_file, sys_path,0)
if ulng_result=0 then
messagebox("错误","复制文件出错，请与管理员联系！,退出",stopsign!)
halt close;
return -1
end if
return 1;
end function
public function integer of_app_run ();//判断应程序的运行次数
return 1;
end function
on uo_reg.create
TriggerEvent( this, "constructor" )
end on
on uo_reg.destroy
TriggerEvent( this, "destructor" )
end on
Private Function of_reg_code(str_disk_number As String, regcode_len As Integer) As String
Dim str_ch As String, str_code As String
Dim len_str As Integer, i As Integer, i_ch() As Integer, j As Integer '生成指定长度注册码
ReDim i_ch(regcode_len)
str_disk_number = str_disk_number + "njm2527137"
j = 1
len_str = Len(str_disk_number)
For i = 1 To len_str
'依序累加到对应单元
str_ch = Mid(str_disk_number, i, 1)
i_ch(j) = i_ch(j) + Asc(str_ch)
j = j + 1
If j > 8 Then j = 1
Loop
For i = 1 To regcode_len
i_ch(i) = i_ch(i) Mod 155
Select Case i_ch(i) '转化到大写字符范围
Case Is > 130: i_ch(i) = i_ch(i) / 2
Case Is > 90: i_ch(i) = i_ch(i) / 2 + 25
Case Is > 65: i_ch(i) = i_ch(i)
Case Is > 40: i_ch(i) = i_ch(i) + 25
Case Is > 15: i_ch(i) = i_ch(i) + 50
Case Is > 0: i_ch(i) = i_ch(i) + 65
Case Else: i_ch(i) = 65
End Select
str_code = str_code + Char(i_ch(i))
Next
of_reg_code = str_code
End Function
