最近写了一个关于paradox数据库的小东西,碰到了一些问题,写出来。
------------------写入odbc,简单一点先从register到处来一个odbc的模版(注意应该有2处地方),然后放在安装包里面,执行程序时只需要写入需要修改的部分就可以了。写到ini文件里面,注意文件的路径应该是“\\”分隔符,然后用Shell("regedit /s " & strIniFile, vbHide)写入注册表,/s表示不会有是否导入的提示。(其间费了半天劲,直接用api读写register,但是写出来的odbc有错,据说有特殊的api专门用于写odbc的。但是还是写成ini这样的方法比较方便)
用到2(3)个api函数。
Private Declare WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Sub saveSetting()
On Error Resume Next
strDatabaseHome = Dir1.Path
'Debug.Print strDatabaseHome
strVideoHome = Dir2.Path
'Debug.Print strVideoHome
If configureINI(strDataSourceName, strDataSourceName, strDatabaseHome) = False Then
MsgBox "Configure ini file error", vbCritical, "Error"
strDatabaseHome = ""
strVideoHome = ""
Exit Sub
End If
Dim lFlag As Long
lFlag = Shell("regedit /s " & strIniFile, vbHide)
MsgBox "Configure setting successfully", vbInformation, "Information"
Me.Hide
Exit Sub
End Sub
configureINI(ByVal Source As String, ByVal DesSource As String, ByVal dataHome As String) As Boolean
configureINI = True
If Dir(strIniFile) = "" Then
configureINI = False
Exit
End If
Dim lFlag As Long
Dim myDataHome As String
myDataHome = Replace(dataHome, "\", "\\")
lFlag = WritePrivateProfileString("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\" & Source, """DefaultDir""", """" & myDataHome & """", "C:\test\test.ini")
If lFlag = 0 Then
configureINI = False
Exit
End If
lFlag = WritePrivateProfileString("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\" & Source, """Deion""", """" & DesSource & """", "C:\test\test.ini")
If lFlag = 0 Then
configureINI = False
Exit
End If
End
-------------------------------------文件的遍历搜索,没有用到api,用的是dir函数。思想也比较简单,遍历主目录,再遍历子目录。
Public TreeSearch(ByVal sPath As String, ByVal sFileSpec As String) As Boolean
On Error Resume Next
TreeSearch = False
Dim sDir As String
Dim sSubDirs() As String
Dim lngIndex As Long
lngIndex = 0
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
sDir = Dir(sPath & sFileSpec)
While Len(sDir) <> 0
strVideoFile = sPath & sFileSpec
iCount = iCount + 1
TreeSearch = True
sDir = Dir
Wend
sDir = Dir(sPath, vbDirectory)
Do While Len(sDir)
'Skip parent and current folder
If Left(sDir, 1) <> "." And Left(sDir, 1) <> ".." Then
If (GetAttr(sPath & sDir) And vbDirectory) = vbDirectory Then
lngIndex = lngIndex + 1
ReDim Preserve sSubDirs(1 To lngIndex)
sSubDirs(lngIndex) = sPath & sDir & "\"
End If
End If
sDir = Dir
Loop
Dim i As Long
For i = 1 To lngIndex
If TreeSearch(sSubDirs(i), sFileSpec) = True Then
TreeSearch = True
End If
Next
End
----------------------------BDE,说一点是如果vb读取paradox数据库,要安装bde,否则报错的。可以把这个包放在整个程序的安装包里,安装完毕后执行安装BDE的程序。