Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 ADO  [new]
Guest1
Member

Откуда: Кристиан Гислер - ТЫ ЛУЧШИЙ !!! :)))
Сообщений: 1349
Как программно подключить ADO 2.6 ?
Не хотелось бы делать это вручную на каждой машине пользователя .
Спасибо.
27 фев 06, 08:40    [2392983]     Ответить | Цитировать Сообщить модератору
 Re: ADO  [new]
Программист-Любитель
Member

Откуда:
Сообщений: 16839
Именно 2.6 и никакую другую ?

Возможно неколько путей решения проблемы.

В списке ссылок проекта доступны версии 2.0 2.1 2.5 2.6 2.7 2.8 библиотек АДО и библиотеки Recordset (only) librаry.

1. Вы можете декларировать требование наличия офиса не ниже 2003 на машинах, где разворчиваете свой проект.

2. Можно подключить версию 2.1, которая будет работать на всех версиях аксесс, начиная от 97 (не уверен на 100%).

3. Можно НЕ подключать никакой библиотеки, а НА ЭТАПЕ запуска приложения програмно перебрать версии от 2.8 вниз, пока на данном компьютере не найдется самая свежая версия.

4. Можно высветить диалоовое окно и выбрать конкретный файл dll (tlb) вручную.

Пример кода для 3 способа:

класс LinkReference
Public Name As String
Public Guid As String
Public MaxVersion As Double
Public MinVersion As Double
Public Reference As Reference

Public Sub Initialize( _
    sName As String, sGUID As String, _
    dbMaxVersion As Double, dbMinVersion As Double)

    Name = sName
    Guid = sGUID
    MaxVersion = dbMaxVersion
    MinVersion = dbMinVersion
    
End Sub

класс LinkReferences

Option Compare Database
Option Explicit

'Name:         ADODB
'BuiltIn       False
'IsBroken      False
'FullPath:     C:\Program Files\Common Files\System\ado\msado25.tlb
'Version:      2.5
'GUID:         {00000205-0000-0010-8000-00AA006D2EA4}

'Name:         ADOX
'BuiltIn       False
'IsBroken      False
'FullPath:     C:\Program Files\Common Files\System\ado\msadox.dll
'Version:      2.7
'GUID:         {00000600-0000-0010-8000-00AA006D2EA4}

'ADODB  2  8  {2A75196C-D9EB-4129-B803-931327F72D5C}    C:\Program Files\Common Files\System\ado\msado15.dll
'ADODB  2  7  {EF53050B-882E-4776-B643-EDA472E8E3F2}    C:\Program Files\Common Files\System\ado\msado27.tlb
'ADODB  2  6  {00000206-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msado26.tlb
'Îäíà è òà æå áèáëèîòåêà â ðàçíûõ âåðñèÿõ Office
'ïîäêëþ÷àåòñÿ èç ÐÀÇÍÛÕ ôàéëîâ ..\msado25.tlb ..\msado15.dll
'ADODB  2  5  {00000205-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msado25.tlb
'ADODB  2  5  {00000205-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msado15.dll
'ADODB  2  1  {00000201-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msado21.tlb
'ADODB  2  0  {00000200-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msado20.tlb

'ADOX   2  8  {00000600-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msADOX.dll
'ADOX   2  7  {00000600-0000-0010-8000-00AA006D2EA4}    C:\Program Files\Common Files\System\ado\msADOX.dll

Public Verbose As Boolean
Public ReferenceCollection As Collection

Private Sub Class_Initialize()

    'MsgBox "Class_Initialize"
    Verbose = False
    Set ReferenceCollection = New Collection

End Sub

Private Sub Class_Terminate()

    'MsgBox "Class_Terminate"
    Dim i As Integer, ref As LinkReference
    For i = ReferenceCollection.Count To 1 Step -1
        Set ref = ReferenceCollection.Item(i)
        Set ref.Reference = Nothing
        ReferenceCollection.Remove (i)
    Next i
    Set ReferenceCollection = Nothing

End Sub

Public Sub OpenLog(Optional sMessage As String = "Starting Application")

    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Output As #1
    Print #1, sMessage, Now
    Print #1, ""
    Close #1

End Sub

Public Sub LogMessage(Message As String, Optional SkipLine As Boolean = True)

    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Append As #1
    Print #1, Message, Now
    If SkipLine Then
        Print #1, ""
    End If
    Close #1

End Sub

Public Function CheckReference( _
    sName As String, Optional iMajor As Integer, Optional iMinor As Integer, _
    Optional sGUID As String, Optional sFullPath As String) As Boolean

    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Append As #1
    
    Dim ref As Reference
    For Each ref In Application.References
        If Not ref.IsBroken Then
            If ref.Name = sName Then
                iMajor = ref.Major: iMinor = ref.Minor
                sGUID = ref.Guid:   sFullPath = ref.FullPath
                Print #1, "CheckReference", _
                    ref.Name, ref.Major, ref.Minor, ref.Guid, ref.FullPath
                Print #1, "": Close #1
                If Verbose Then
                    MsgBox ref.Name & ", " & _
                        ref.Major & ", " & ref.Minor & ", " & _
                        ref.Guid & ", " & ref.FullPath
                End If
                CheckReference = True
                Exit Function
            End If
        End If
    Next ref
    
    CheckReference = False
    Print #1, "CheckReference Failed", sName
    Print #1, "": Close #1
    Exit Function

End Function

Public Function CheckReferences()

    CheckReferences = True
    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Append As #1
    
    Dim ref As Reference
    For Each ref In Application.References
        If Not ref.IsBroken Then
            Print #1, ref.Name, ref.Major, ref.Minor, ref.Guid, ref.FullPath
            If Verbose Then
                MsgBox ref.Name & ", " & _
                    ref.Major & ", " & ref.Minor & ", " & _
                    ref.Guid & ", " & ref.FullPath
            End If
        Else
            Print #1, "<Broken reference>", ref.Major, ref.Minor, ref.Guid, "<Unknown FullPath>"
            If Verbose Then
                MsgBox "<Broken reference>" & ", " & _
                    ref.Major & ", " & ref.Minor & ", " & _
                    ref.Guid & ", " & "<Unknown FullPath>"
            End If
            CheckReferences = False
        End If
    Next ref
    
    Print #1, ""
    Close #1

End Function

Public Function MakeRowsource() As String

    Dim ref As Reference, s As String
    For Each ref In Application.References
        If Not ref.IsBroken Then
            s = s & _
                ref.Name & ";" & _
                ref.Major & ";" & ref.Minor & ";" & _
                ref.Guid & ";" & ref.FullPath & ";"
        Else
            s = s & _
                "<Broken reference>" & ";" & _
                ref.Major & ";" & ref.Minor & ";" & _
                ref.Guid & ";" & "<Unknown FullPath>" & ";"
        End If
    Next ref
    MakeRowsource = s

End Function

Public Function LinkReferenceFromFile( _
    sFileName As String, _
    Optional sName As String, _
    Optional iMajor As Integer, Optional iMinor As Integer, _
    Optional sGUID As String, Optional sFullPath As String) As Boolean
    
    If Not IsNull(sFileName) And Len(Trim(sFileName)) > 0 Then
        On Error Resume Next
        Application.References.AddFromFile (sFileName)
        On Error GoTo 0
        If Err.Number = 0 Then
            Dim ref As Reference, bFound As Boolean: bFound = False
            For Each ref In Application.References
                If Not ref.IsBroken And ref.FullPath = sFileName Then
                    bFound = True
                    Exit For
                End If
            Next ref
            If bFound Then
                sName = ref.Name
                iMajor = ref.Major: iMinor = ref.Minor
                sGUID = ref.Guid:   sFullPath = ref.FullPath
                Dim lnkReference As LinkReference
                Set lnkReference = New LinkReference
                lnkReference.Initialize _
                    ref.Name, ref.Guid, _
                    iMajor + iMinor / 10, iMajor + iMinor / 10
                Set lnkReference.Reference = ref
                ReferenceCollection.Add lnkReference, ref.Name
                Open Application.CurrentProject.Path & "\\" & "Application.Log" _
                     For Append As #1
                Print #1, "AddFromFile", ref.Name, _
                    ref.Major, ref.Minor, _
                    ref.Guid, ref.FullPath
                Print #1, "": Close #1
                If Verbose Then
                    MsgBox _
                        "AddFromFile" & " " & lnkReference.Name & " " & _
                        iMajor & " " & iMinor & " " & lnkReference.Guid & _
                        "Error" & " " & Err.Number & " " & Err.Description
                End If
                LinkReferenceFromFile = True
                Exit Function
            Else 'bFound
                Open Application.CurrentProject.Path & "\\" & "Application.Log" _
                     For Append As #1
                Print #1, "AddFromFile", _
                    sFileName, "Reference was not found in collection"
                Print #1, "": Close #1
                If Verbose Then
                    MsgBox _
                        "Áèáëèîòåêà/ññûëêà íå íàéäåíà â êîëëåêöèè ïîñëå äîáàâëåíèÿ", _
                        vbCritical + vbOKOnly
                End If
            End If 'bFound
        Else 'Err.Number = 0
            Open Application.CurrentProject.Path & "\\" & "Application.Log" _
                 For Append As #1
            Print #1, "AddFromFile", _
                sFileName, "Error", Err.Number, Err.Description
            Print #1, "": Close #1
            If Verbose Then
                MsgBox _
                    "Äîáàâëåíèå áèáëèîòåêè/ññûëêè èç ôàéëà " & sFileName & " " & _
                    "Error" & " " & Err.Number & " " & Err.Description
            End If
            Err.Clear
        End If 'Err.Number = 0
    End If 'IsNull(sFileName) And Len(Trim(sFileName))
    
    sName = ""
    iMajor = 0: iMinor = 0
    sGUID = "": sFullPath = ""
    LinkReferenceFromFile = False
    Exit Function

End Function
    
Public Function LinkReferenceFromGUID( _
    sName As String, _
    dbMaxVersion As Double, dbMinVersion As Double, _
    sGUID As String _
) As Double
    
    On Error Resume Next
    LinkReferenceFromGUID = 0#
    
    Dim lnkReference As LinkReference
    Set lnkReference = New LinkReference
    lnkReference.Initialize sName, sGUID, dbMaxVersion, dbMinVersion
    
    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Append As #1
    Print #1, "LinkReferenceFromGUID", lnkReference.Name, lnkReference.Guid, "from", dbMaxVersion, "to", dbMinVersion
    
    Dim version As Double, iMajor As Integer, iMinor As Integer
    If dbMinVersion = 0# Then dbMinVersion = dbMaxVersion
    For version = dbMaxVersion To dbMinVersion Step -0.1
        iMajor = Int(version)
        iMinor = Int((version - iMajor) * 10 + 0.01)
        Application.References.AddFromGuid lnkReference.Guid, iMajor, iMinor
        DoEvents
        If Err.Number = 0 Then
            Set lnkReference.Reference = _
                Application.References.Item(Application.References.Count)
            ReferenceCollection.Add lnkReference, sName
            Print #1, "AddFromGuid", _
                lnkReference.Reference.Name, _
                lnkReference.Reference.Major, lnkReference.Reference.Minor, _
                lnkReference.Reference.Guid, lnkReference.Reference.FullPath
            Print #1, ""
            Close #1
            If Verbose Then
                MsgBox _
                    "AddFromGuid" & " " & _
                    lnkReference.Reference.Name & " " & _
                    lnkReference.Reference.Major & " " & _
                    lnkReference.Reference.Minor & " " & _
                    lnkReference.Reference.Guid & " " & _
                    lnkReference.Reference.FullPath
            End If
            LinkReferenceFromGUID = version
            Exit Function
        Else
            Print #1, "AddFromGuid", _
                lnkReference.Name, iMajor, iMinor, _
                lnkReference.Guid, "Error", Err.Number, Err.Description
            If Verbose Then
                MsgBox _
                    "AddFromGuid" & " " & lnkReference.Name & " " & _
                    iMajor & " " & iMinor & " " & lnkReference.Guid & _
                    "Error" & " " & Err.Number & " " & Err.Description
            End If
            Err.Clear
        End If
    Next version

    If Verbose Then
        MsgBox _
            "LinkReferenceFromGUID Failed" & " " & _
            lnkReference.Name & " " & _
            lnkReference.MaxVersion & " " & _
            lnkReference.MinVersion & " " & _
            lnkReference.Guid
    End If
    Print #1, "LinkReferenceFromGUID Failed"
    Print #1, ""
    Close #1
    LinkReferenceFromGUID = 0
    Exit Function

End Function
    
Public Function LinkADODB() As Double

    Dim Name As String, Major As Integer, Minor As Integer, _
        Guid As String, FullPath As String
    Name = "ADODB"
    If CheckReference(Name, Major, Minor, Guid, FullPath) Then
        LinkADODB = Major + Minor / 10
    Else
        LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 3#, 2.8, _
                "{2A75196C-D9EB-4129-B803-931327F72D5C}")
        If LinkADODB = 0# Then LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 2.7, 2.7, _
                "{EF53050B-882E-4776-B643-EDA472E8E3F2}")
        If LinkADODB = 0# Then LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 2.6, 2.6, _
                "{00000206-0000-0010-8000-00AA006D2EA4}")
        If LinkADODB = 0# Then LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 2.5, 2.5, _
                "{00000205-0000-0010-8000-00AA006D2EA4}")
        If LinkADODB = 0# Then LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 2.1, 2.1, _
                "{00000201-0000-0010-8000-00AA006D2EA4}")
        If LinkADODB = 0# Then LinkADODB = _
            LinkReferenceFromGUID( _
                "ADODB", 2#, 2#, _
                "{00000200-0000-0010-8000-00AA006D2EA4}")
    End If
    
End Function

Public Function LinkADOX() As Double

    Dim Name As String, Major As Integer, Minor As Integer, _
        Guid As String, FullPath As String
    Name = "ADOX"
    If CheckReference(Name, Major, Minor, Guid, FullPath) Then
        LinkADOX = Major + Minor / 10
    Else
        LinkADOX = _
            LinkReferenceFromGUID( _
                "ADOX", 3#, 2#, _
                "{00000600-0000-0010-8000-00AA006D2EA4}")
    End If
    
End Function

Public Function UnlinkReference(vReference As Variant) As Boolean
    
    Open Application.CurrentProject.Path & "\\" & "Application.Log" For Append As #1
    
    Dim sName As String, iNomer As Integer, ref As Reference
    If VarType(vReference) = vbString Then
        sName = vReference
        On Error Resume Next
        Set ref = Application.References(sName)
        On Error GoTo 0
    Else
        iNomer = vReference
        On Error Resume Next
        Set ref = Application.References(iNomer)
        On Error GoTo 0
    End If
    If ref Is Nothing Then
        Print #1, "UnlinkReference " & vReference & " not found"
        Print #1, ""
        If Verbose Then
            MsgBox _
                "UnlinkReference " & vReference & " not found"
        End If
        UnlinkReference = False
        GoTo EXIT_FUNCTION
    End If
    If Err.Number = 0 Then
        With ref
            Print #1, "UnlinkReference", _
                .Name, .Major, .Minor, _
                .Guid, .FullPath
            Print #1, ""
            If Verbose Then
                MsgBox "UnlinkReference " & _
                    .Name & " " & .Major & " " & .Minor & " " & _
                    .Guid & " " & .FullPath
            End If
        End With
    Else
        Print #1, "UnlinkReference", _
            vReference, "not found in Refences Collection"
        Print #1, ""
        If Verbose Then
            MsgBox "UnlinkReference " & vReference & " " & _
                "not found in Refences Collection"
        End If
        Err.Clear
        UnlinkReference = False
        GoTo EXIT_FUNCTION
    End If
    
    On Error Resume Next
    If Len(sName) > 0 Then
        Application.References.Remove Application.References(sName)
    Else
        Application.References.Remove Application.References(iNomer)
    End If
    DoEvents
    On Error GoTo 0
    
    If Err.Number <> 0 Then
        Print #1, "UnlinkReference", _
            vReference, "Error", Err.Number, Err.Description
        Print #1, ""
        If Verbose Then
            MsgBox "UnlinkReference " & vReference & " " & _
                "Error " & CStr(Err.Number) & " " & Err.Description
        End If
        Err.Clear
        UnlinkReference = False
        GoTo EXIT_FUNCTION
    Else
        UnlinkReference = True
        GoTo EXIT_FUNCTION
    End If

EXIT_FUNCTION:
    Close #1
    Exit Function

End Function
27 фев 06, 09:51    [2393194]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить