home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD149972152001.psc / AdoConnectionClass.cls next >
Encoding:
Visual Basic class definition  |  2001-02-15  |  7.3 KB  |  253 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "AdoConnectionClass"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. Option Explicit
  17.  
  18. Public Enum pdsaProvider
  19.     pdsajet = 1
  20.     pdsasqlserver = 2
  21.     pdsajet40 = 3
  22.     pdsaoracle = 4
  23.     pdsaodbc = 5
  24.     pdsadbase = 6
  25.     pdsaexcel = 7
  26. End Enum
  27.  
  28. Dim moConn As ADODB.Connection
  29.  
  30. Dim mAppRole As String
  31. Dim mAppRolePassword As String
  32. Dim mCursorLocation As CursorLocationEnum
  33. Dim mDataSource As String
  34. Dim mInitialCatalog As String
  35. Dim mPassword As String
  36. Dim mProvider As String
  37. Dim mProviderConst As pdsaProvider
  38. Dim mUDLFileName As String
  39. Dim mUseNTSecurity As Boolean
  40. Dim mUserID As String
  41. Event Connected()
  42. Event Disconnected()
  43.  
  44.  
  45. Public Property Get ProviderConst() As pdsaProvider
  46.     ProviderConst = mProviderConst
  47. End Property
  48. Public Property Let ProviderConst(NewI As pdsaProvider)
  49.     mProviderConst = NewI
  50.     Select Case NewI
  51.         Case 1 'Jet 3.51
  52.             mProvider = "Microsoft.Jet.OLEDB.3.51"
  53.         Case 2 'SQL Server
  54.             mProvider = "sqloledb"
  55.         Case 3 'Jet 4.0
  56.             mProvider = "Microsoft.Jet.OLEDB.4.0"
  57.         Case 4 'Oracle
  58.             mProvider = "msdaora"
  59.         Case 5 'ODBC
  60.             mProvider = "msdasql.1"
  61.         Case 6 'Dbase
  62.             mProvider = "Microsoft.Jet.OLEDB.4.0" ';Extended Properties=dBASE III
  63.         Case 7 'Excel 8.0
  64.             mProvider = "Microsoft.Jet.OLEDB.4.0" ';Extended Properties=Excel 8.0
  65.         Case Else 'Jet 3.51
  66.             mProvider = "Microsoft.Jet.OLEDB.3.51"
  67.             mProviderConst = 1
  68.     End Select
  69. End Property
  70. Public Property Get AppRole() As String
  71.     AppRole = mAppRole
  72. End Property
  73. Public Property Let AppRole(ByVal NewI As String)
  74.     mAppRole = NewI
  75. End Property
  76. Public Property Get AppRolePassword() As String
  77.     AppRolePassword = mAppRolePassword
  78. End Property
  79. Public Property Let AppRolePassword(ByVal NewI As String)
  80.     mAppRolePassword = NewI
  81. End Property
  82. Public Property Get CursorLocation() As CursorLocationEnum
  83.     CursorLocation = mCursorLocation
  84. End Property
  85. Public Property Let CursorLocation(ByVal NewI As CursorLocationEnum)
  86.     mCursorLocation = NewI
  87. End Property
  88. Public Property Get DataSource() As String
  89.     DataSource = mDataSource
  90. End Property
  91. Public Property Let DataSource(ByVal NewI As String)
  92.     mDataSource = NewI
  93. End Property
  94. Public Property Get InitialCatalog() As String
  95.     InitialCatalog = mInitialCatalog
  96. End Property
  97. Public Property Let InitialCatalog(ByVal NewI As String)
  98.     mInitialCatalog = NewI
  99. End Property
  100. Public Property Get Password() As String
  101.     Password = mPassword
  102. End Property
  103. Public Property Let Password(ByVal NewI As String)
  104.     mPassword = NewI
  105. End Property
  106. Public Property Get Provider() As String
  107.     Provider = mProvider
  108. End Property
  109. Public Property Let Provider(ByVal NewI As String)
  110.     mProvider = NewI
  111. End Property
  112. Public Property Get UDLFileName() As String
  113.     UDLFileName = mUDLFileName
  114. End Property
  115. Public Property Let UDLFileName(ByVal NewI As String)
  116.     mUDLFileName = NewI
  117. End Property
  118. Public Property Get UseNTSecurity() As Boolean
  119.     UseNTSecurity = mUseNTSecurity
  120. End Property
  121. Public Property Let UseNTSecurity(ByVal NewI As Boolean)
  122.     mUseNTSecurity = NewI
  123. End Property
  124. Public Property Get UserID() As String
  125.     UserID = mUserID
  126. End Property
  127. Public Property Let UserID(ByVal NewI As String)
  128.     mUserID = NewI
  129. End Property
  130. Public Property Get Connection() As ADODB.Connection
  131.     Set Connection = moConn
  132. End Property
  133. Public Function DataOpen() As Boolean
  134. On Error GoTo erro
  135. If moConn.State = adStateOpen Then
  136.     moConn.Close
  137. End If
  138. moConn.CursorLocation = mCursorLocation
  139. moConn.ConnectionString = Me.ConnectionString
  140. moConn.Mode = adModeReadWrite
  141. moConn.Open
  142.  
  143. On Error GoTo 0
  144. Call AppRoleSet
  145. RaiseEvent Connected
  146. DataOpen = True
  147. sair:
  148. Exit Function
  149. erro:
  150. RaiseEvent Disconnected
  151. Err.Raise vbObjectError + 1, "AdoConnectionClass", Err.Description, Err.HelpFile, Err.HelpContext
  152. DataOpen = False
  153. Resume sair
  154. End Function
  155. Public Function ConnectionString()
  156. Dim strRet As String
  157. If mUDLFileName = "" Then
  158.     strRet = "Provider=" & mProvider & _
  159.              ";Data Source=" & mDataSource
  160. Else
  161.     strRet = "File Name=" & mUDLFileName
  162. End If
  163.  
  164. Select Case mProviderConst
  165.     Case pdsajet, pdsajet40
  166.         'Nenhum C≤digo extra necessßrio
  167.         '<No extra code necessary>
  168.         If mPassword <> "" Then strRet = strRet & ";Jet OLEDB:Database Password=" & mPassword
  169.     
  170.     Case pdsasqlserver
  171.         If mInitialCatalog <> "" Then
  172.             strRet = strRet & ";Initial Catalog = " & mInitialCatalog
  173.         End If
  174.         If mUseNTSecurity Then
  175.             strRet = strRet & ";Integrated Security=SSPI"
  176.         Else
  177.             If mUserID <> "" Then
  178.                 strRet = strRet & ";User ID=" & mUserID
  179.                 If mPassword <> "" Then strRet = strRet & ";Password=" & mPassword
  180.             End If
  181.         End If
  182.     Case pdsaoracle
  183.         'Nenhum C≤digo extra necessßrio
  184.         '<No extra code necessary>
  185.     Case pdsaodbc
  186.         'Nenhum C≤digo extra necessßrio
  187.         '<No extra code necessary>
  188.     Case pdsadbase
  189.         strRet = strRet & ";Extended Properties=dBASE III;"
  190.     Case pdsaexcel
  191.         strRet = strRet & ";Extended Properties=Excel 8.0;"
  192.         
  193. End Select
  194.  
  195. ConnectionString = strRet
  196. End Function
  197. Private Function AppRoleSet()
  198. Dim SQL As String
  199. On Error GoTo erro
  200.  
  201. 'Somente ira executar se for SQLServer.
  202. 'Nota: Esse procedimento soh functiona para o SQL Server 7.0,
  203. 'para a versπo 6.5 ou anterior deixe a propriedade AppRole em branco.
  204.  
  205. '<This routine only will be executed if this are a SQLServer connection.>
  206. '<Note: This procedure will only work for SQL Server 7.0.>
  207. '<to version 6.5 or below leave the property AppRole blank.>
  208. If mProviderConst = pdsasqlserver And mAppRole <> "" Then
  209.     SQL = "EXEC sp_setAppRole '" & mAppRole & "', '" & mAppRolePassword & "'"
  210.     moConn.Execute SQL
  211. End If
  212.     
  213. sair:
  214. Exit Function
  215. erro:
  216. Err.Raise Err.Number, "AdoConnectionClass", Err.Description, Err.HelpFile, Err.HelpContext
  217. Resume sair
  218.  
  219. End Function
  220. Private Sub Class_Initialize()
  221. Set moConn = New ADODB.Connection
  222. mCursorLocation = adUseServer
  223. moConn.CursorLocation = adUseServer
  224. ProviderConst = pdsajet
  225. End Sub
  226. Private Sub Class_Terminate()
  227. Set moConn = Nothing
  228. End Sub
  229. Public Function OpenAccess(ByVal Database As String, Optional Password As String) As Boolean
  230. ProviderConst = pdsajet40
  231. DataSource = Database
  232. InitialCatalog = ""
  233. UserID = ""
  234. mPassword = Password
  235. OpenAccess = DataOpen()
  236.  
  237. End Function
  238. Public Function OpenSQLServer(ByVal ServerName As String, Database As String, Optional ByVal UserName As String, Optional ByVal Password As String, Optional ByVal NTSecurity As Boolean) As Boolean
  239. ProviderConst = pdsasqlserver
  240. DataSource = ServerName
  241. InitialCatalog = Database
  242. If NTSecurity Then
  243.     UseNTSecurity = True
  244. Else
  245.     UseNTSecurity = False
  246.  
  247.     UserID = UserName
  248.     Password = Password
  249. End If
  250. OpenSQLServer = DataOpen()
  251.  
  252. End Function
  253.