www.pudn.com > kelon.rar > mod04.bas

Attribute VB_Name = "mod04" 
Option Explicit 
 
Public Cn_Des As New ADODB.Connection 
 
Public Sub OpenODBC(ByVal vCn As ADODB.Connection, ByVal nConn As String) 
    Dim ConnectionString As String 
    Dim PWDString As String 
     
    Dim i As Long 
    Dim sSect As String: sSect = "local" 
    Dim arry As Variant 
    Dim Arryls As Variant 
    Dim NewCon As String 
    Dim ss As String 
     
    ss = pGetString(iniFn, sSect, "PS001") 
    PWDString = MM2Text(ss) 
     
    ss = pGetString(iniFn, sSect, nConn) 
    ConnectionString = Replace(ss, "@1@", PWDString) 
     
    On Local Error Resume Next 
    vCn.Close 
    On Local Error GoTo 0 
    vCn.ConnectionString = ConnectionString 
    vCn.Properties("Prompt") = adPromptComplete '定义：如果连接串不存在，则进行提示 
    vCn.Open '打开连接 
    If ConnectionString <> vCn.ConnectionString Then '自动取得连接 
        arry = Split(vCn.ConnectionString, ";")        '按;分离 
        For i = 0 To UBound(arry)        '重新组合 
            If InStr(arry(i), "PWD") Then 
'                Arry(I) = "PWD=@1@" '在这里可对口令加密后回写. 略 
                Arryls = Split(arry(i), "=") 
                PWDString = Text2MM(Arryls(1)) 
                Call WritePrivateProfileString(sSect, "PS001", PWDString, iniFn) 
                arry(i) = "PWD=@1@" 
            End If 
            If i = 0 Then 
                NewCon = arry(i) 
            Else 
                NewCon = NewCon + ";" + arry(i) 
            End If 
            Call WritePrivateProfileString(sSect, nConn, NewCon, iniFn) 
        Next 
         
    End If 
End Sub