welcome to  小楼听风雨

<<  < 2008 - >  >>
1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30 31



 Please please me.

http://remark.ys168.com/

Can you feel that?.....shit


 
我的分类

日志更新

最新评论

留言板

 

搜索


Blog信息
  • 日志:113
  • 评论:110
  • 留言:2
  • 访问:

 




vb写入odbc,注册表,文件搜索
remix 发表于 2008-5-28 18:05:00

最近写了一个关于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的程序。


阅读全文 | 回复(1) | 引用通告 | 编辑

Re:vb写入odbc,注册表,文件搜索
Marcade(游客)发表评论于2008-5-30 9:20:00

interesting ... vb code ... very good ... can't read the chinese; but at least i understand the code part, hehe ..
个人主页 | 引用 | 返回 | 删除 | 回复

发表评论:

    大名:
    密码: (游客无须输入密码)
    主页:
    标题:
    正在载入数据,请稍候……