158 lines
4.8 KiB
OpenEdge ABL
158 lines
4.8 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
Persistable = 0 'NotPersistable
|
|
DataBindingBehavior = 0 'vbNone
|
|
DataSourceBehavior = 0 'vbNone
|
|
MTSTransactionMode = 0 'NotAnMTSObject
|
|
END
|
|
Attribute VB_Name = "CDBAccess"
|
|
Attribute VB_GlobalNameSpace = True
|
|
Attribute VB_Creatable = True
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
|
|
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
|
|
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
|
|
'==============================================================================
|
|
'
|
|
' File : DBAccess.cls
|
|
' Date : 22.03.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' *shared*
|
|
'
|
|
' Abstraktion von ADODB.connection
|
|
'
|
|
' TODO: Server-Connection und eine Client-Connection halten.
|
|
'
|
|
'==============================================================================
|
|
'
|
|
' History:
|
|
'
|
|
' Date : 22.03.1999
|
|
' Version: 1.00
|
|
' Author : Andreas Schmidt, lindner&partner
|
|
'
|
|
' Erste dokumentierte Version nach Übernahme des
|
|
' SAP-Konverter-Projekts von Reinhard Lindner.
|
|
'
|
|
'==============================================================================
|
|
|
|
Option Explicit
|
|
|
|
'--- Klassen GUID
|
|
Private Const GUID_CLASS_SYSTEM As String = "{D8CF5675-2151-11D2-9396-CA53FC3C99A4}"
|
|
Private Const GUID_CLASS_LANGUAGE As String = "{D8CF5672-2151-11D2-9396-CA53FC3C99A4}"
|
|
Private Const GUID_CLASS_RESOURCE As String = "{E1715082-1E37-11D2-9396-444553540000}"
|
|
Private Const GUID_CLASS_ProductAccessoriesPage As String = "{E1715081-1E37-11D2-9396-444553540000}"
|
|
|
|
'--- Definitionen für die Erzeugung von GUIDs als OIDs
|
|
Private Type tGUID
|
|
bytes(15) As Byte
|
|
End Type
|
|
|
|
'--- Private Declares
|
|
Private Declare Function CoCreateGuid Lib "OLE32.dll" (guid As tGUID) As Long
|
|
Private Declare Function StringFromGUID2 Lib "OLE32.dll" (guid As tGUID, ByVal lpszString As String, ByVal lMax As Long) As Long
|
|
|
|
' Private Member
|
|
' --------------
|
|
Private m_ADOConnection As ADODB.connection
|
|
Private m_bADOConnectionOpen As Boolean
|
|
Private m_sUserName As String
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : Connect
|
|
' Purpose : Connects to a given database
|
|
' Parameters : Database Name, Database Path
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Function connect(sUserName As String, sPW As String, sDBName As String, sDBPath As String) As Boolean
|
|
Dim sADOConnectionString As String
|
|
|
|
On Error GoTo ConnectionError
|
|
|
|
sADOConnectionString = "DRIVER={Microsoft Access Driver (*.mdb)};" & _
|
|
"DBQ=" & sDBName & ";" & _
|
|
"DefaultDir=" & sDBPath & ";" & _
|
|
"UID=" & sUserName & ";PWD=" & sPW & ";"
|
|
|
|
Set m_ADOConnection = New ADODB.connection
|
|
m_ADOConnection.ConnectionString = sADOConnectionString
|
|
m_ADOConnection.ConnectionTimeout = 30
|
|
m_ADOConnection.Provider = "MSDASQL"
|
|
m_ADOConnection.Open
|
|
|
|
m_bADOConnectionOpen = True
|
|
m_sUserName = sUserName
|
|
|
|
connect = True
|
|
Exit Function
|
|
|
|
ConnectionError:
|
|
m_bADOConnectionOpen = False
|
|
m_sUserName = ""
|
|
Exit Function
|
|
|
|
End Function
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : CloseConnection
|
|
' Purpose :
|
|
' Parameters : NA
|
|
' Return val : NA
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Public Sub CloseConnection()
|
|
On Error Resume Next
|
|
m_ADOConnection.Close
|
|
Set m_ADOConnection = Nothing
|
|
m_bADOConnectionOpen = False
|
|
On Error GoTo 0
|
|
End Sub
|
|
|
|
' @return true = ADO-Connection vorhanden
|
|
'
|
|
Public Function isADOConnectionOpen() As Boolean
|
|
isADOConnectionOpen = m_bADOConnectionOpen
|
|
End Function
|
|
|
|
' @return Referenz auf die ADO-Connection
|
|
'
|
|
Public Function getConnection() As ADODB.connection
|
|
Set getConnection = m_ADOConnection
|
|
End Function
|
|
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
' Name : CreateGUID
|
|
' Purpose : Erzeugen einer eindeutigen Objekt-Identifikation (OID).
|
|
' Windows GUIDs sind per Definition eindeutig!
|
|
' Parameters : NA
|
|
' Return val : GUID
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
Private Function CreateGUID() As String
|
|
Dim guid As tGUID
|
|
Dim s As String
|
|
Dim n As Long
|
|
|
|
s = Space(100)
|
|
|
|
CoCreateGuid guid
|
|
n = StringFromGUID2(guid, s, Len(s))
|
|
|
|
CreateGUID = Left$(StrConv(s, vbFromUnicode), n - 1)
|
|
End Function
|
|
|
|
' Helper für Fehlerausgaben
|
|
'
|
|
' @param sInfo optionaler Hinweistext
|
|
'
|
|
Private Sub showError(sMethod As String, Optional sInfo As String)
|
|
Call modError.showError("CDBAccess." + sMethod, sInfo)
|
|
End Sub
|
|
|
|
|