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 / Form1.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-01-19  |  11.1 KB  |  349 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "ADO Connection Class Demonstration Project"
  5.    ClientHeight    =   6105
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   7440
  9.    ForeColor       =   &H80000008&
  10.    LinkTopic       =   "Form1"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   6105
  14.    ScaleWidth      =   7440
  15.    StartUpPosition =   3  'Windows Default
  16.    Begin VB.Frame Frame2 
  17.       Caption         =   "Database Properties"
  18.       Height          =   2295
  19.       Left            =   2280
  20.       TabIndex        =   4
  21.       Top             =   120
  22.       Width           =   5055
  23.       Begin VB.TextBox Text5 
  24.          Height          =   285
  25.          Left            =   1440
  26.          TabIndex        =   13
  27.          Top             =   1680
  28.          Width           =   3495
  29.       End
  30.       Begin VB.TextBox Text4 
  31.          Height          =   285
  32.          Left            =   1440
  33.          TabIndex        =   12
  34.          Top             =   1320
  35.          Width           =   3495
  36.       End
  37.       Begin VB.TextBox Text3 
  38.          Height          =   285
  39.          Left            =   1440
  40.          TabIndex        =   11
  41.          Top             =   960
  42.          Width           =   3495
  43.       End
  44.       Begin VB.TextBox Text2 
  45.          Height          =   285
  46.          Left            =   1440
  47.          TabIndex        =   10
  48.          Top             =   600
  49.          Width           =   3495
  50.       End
  51.       Begin VB.CheckBox chkUseNTSecurity 
  52.          Caption         =   "Use NT Security to Login"
  53.          Height          =   255
  54.          Left            =   120
  55.          TabIndex        =   5
  56.          Top             =   240
  57.          Width           =   2175
  58.       End
  59.       Begin VB.Label Label5 
  60.          AutoSize        =   -1  'True
  61.          Caption         =   "Password:"
  62.          Height          =   195
  63.          Left            =   120
  64.          TabIndex        =   9
  65.          Top             =   1680
  66.          Width           =   735
  67.       End
  68.       Begin VB.Label Label4 
  69.          AutoSize        =   -1  'True
  70.          Caption         =   "Username:"
  71.          Height          =   195
  72.          Left            =   120
  73.          TabIndex        =   8
  74.          Top             =   1320
  75.          Width           =   765
  76.       End
  77.       Begin VB.Label Label3 
  78.          AutoSize        =   -1  'True
  79.          Caption         =   "Database Name:"
  80.          Height          =   195
  81.          Left            =   120
  82.          TabIndex        =   7
  83.          Top             =   960
  84.          Width           =   1200
  85.       End
  86.       Begin VB.Label Label2 
  87.          AutoSize        =   -1  'True
  88.          Caption         =   "ServerName:"
  89.          Height          =   195
  90.          Left            =   120
  91.          TabIndex        =   6
  92.          Top             =   600
  93.          Width           =   930
  94.       End
  95.    End
  96.    Begin VB.TextBox Text1 
  97.       BeginProperty Font 
  98.          Name            =   "Courier"
  99.          Size            =   12
  100.          Charset         =   0
  101.          Weight          =   400
  102.          Underline       =   0   'False
  103.          Italic          =   0   'False
  104.          Strikethrough   =   0   'False
  105.       EndProperty
  106.       Height          =   3495
  107.       Left            =   120
  108.       MultiLine       =   -1  'True
  109.       ScrollBars      =   3  'Both
  110.       TabIndex        =   3
  111.       Top             =   2520
  112.       Width           =   7215
  113.    End
  114.    Begin VB.Frame Frame1 
  115.       Caption         =   "Database Type"
  116.       Height          =   1935
  117.       Left            =   120
  118.       TabIndex        =   1
  119.       Top             =   120
  120.       Width           =   2055
  121.       Begin VB.OptionButton optProvider 
  122.          Caption         =   "Excel 8.0 Files (XLS)"
  123.          Height          =   195
  124.          Index           =   4
  125.          Left            =   120
  126.          TabIndex        =   17
  127.          Top             =   1680
  128.          Width           =   1815
  129.       End
  130.       Begin VB.OptionButton optProvider 
  131.          Caption         =   "Dbase III Files (DBF)"
  132.          Height          =   255
  133.          Index           =   3
  134.          Left            =   120
  135.          TabIndex        =   16
  136.          Top             =   1320
  137.          Width           =   1815
  138.       End
  139.       Begin VB.OptionButton optProvider 
  140.          Caption         =   "SQL Server"
  141.          Height          =   255
  142.          Index           =   2
  143.          Left            =   120
  144.          TabIndex        =   15
  145.          Top             =   960
  146.          Width           =   1215
  147.       End
  148.       Begin VB.OptionButton optProvider 
  149.          Caption         =   "Access 2000 (Jet 4.0)"
  150.          Height          =   255
  151.          Index           =   1
  152.          Left            =   120
  153.          TabIndex        =   14
  154.          Top             =   600
  155.          Width           =   1875
  156.       End
  157.       Begin VB.OptionButton optProvider 
  158.          Caption         =   "Access 95 (Jet 3.51)"
  159.          Height          =   255
  160.          Index           =   0
  161.          Left            =   120
  162.          TabIndex        =   2
  163.          Tag             =   "0"
  164.          Top             =   240
  165.          Width           =   1815
  166.       End
  167.    End
  168.    Begin VB.CommandButton Command1 
  169.       Caption         =   "Open"
  170.       Height          =   255
  171.       Left            =   120
  172.       TabIndex        =   0
  173.       Top             =   2160
  174.       Width           =   2055
  175.    End
  176. Attribute VB_Name = "Form1"
  177. Attribute VB_GlobalNameSpace = False
  178. Attribute VB_Creatable = False
  179. Attribute VB_PredeclaredId = True
  180. Attribute VB_Exposed = False
  181. Option Explicit
  182. Dim Conn As New AdoConnectionClass
  183. Private Sub chkUseNTSecurity_Click()
  184. If chkUseNTSecurity.Value = 0 Then
  185.     EnableControl "label4"
  186.     EnableControl "Text4"
  187.     EnableControl "label5"
  188.     EnableControl "Text5"
  189.     DisableControl "label4"
  190.     DisableControl "Text4"
  191.     DisableControl "label5"
  192.     DisableControl "Text5"
  193. End If
  194. End Sub
  195. Private Sub Command1_Click()
  196. On Error Resume Next
  197. Dim PopGrid As ADODB.Recordset
  198. Dim RandonAccessSQLServerConnection As Integer
  199. Text1 = ""
  200. RandonAccessSQLServerConnection = Rnd * 1
  201. Select Case optProvider(0).Tag
  202.     Case 0, 1 'Open an Access 95-2000 database
  203.         'The lines below do the same thing.
  204.         'the OpenAccess method it's only a shortcut.
  205.         If RandonAccessSQLServerConnection = 1 Then
  206.             'Function OpenAccess open only JET 4.0
  207.             If Not Conn.OpenAccess(Text3.Text, Text5.Text) Then GoTo Failed
  208.         Else
  209.             If optProvider(0).Tag = 0 Then
  210.                 Conn.ProviderConst = pdsajet
  211.             Else
  212.                 Conn.ProviderConst = pdsajet40
  213.             End If
  214.             Conn.DataSource = Text3.Text
  215.             Conn.Password = Text5.Text
  216.             If Not Conn.DataOpen Then GoTo Failed
  217.         End If
  218.         
  219.     Case 2 'Open an SQL Server database
  220.         'The lines below do the same thing.
  221.         'the OpenSQLServer method it's only a shortcut.
  222.         If RandonAccessSQLServerConnection = 1 Then
  223.             If Not Conn.OpenSQLServer(Text2.Text, Text3.Text, Text4.Text, Text5.Text, IIf(chkUseNTSecurity.Value = 0, False, True)) Then GoTo Failed
  224.         Else
  225.             Conn.ProviderConst = pdsasqlserver
  226.             Conn.DataSource = Text2.Text
  227.             Conn.InitialCatalog = Text3.Text
  228.             Conn.UseNTSecurity = IIf(chkUseNTSecurity.Value = 0, False, True)
  229.             Conn.UserID = Text4.Text
  230.             Conn.Password = Text5.Text
  231.             If Not Conn.DataOpen Then GoTo Failed
  232.         End If
  233.     Case 3 'Open an Dbase III database directory
  234.         Conn.ProviderConst = pdsadbase
  235.         Conn.DataSource = Text3.Text
  236.         If Not Conn.DataOpen Then GoTo Failed
  237.     Case 4 'Open an Excel 8.0 database directory
  238.         Conn.ProviderConst = pdsaexcel
  239.         Conn.DataSource = Text3.Text
  240.         If Not Conn.DataOpen Then GoTo Failed
  241. End Select
  242. Set PopGrid = Conn.Connection.OpenSchema(adSchemaTables)
  243. Text1 = "List of Tables on Database:" & vbCrLf & "---------------------------" & vbCrLf
  244. Do While Not PopGrid.EOF
  245.     Text1.Text = Text1.Text & PopGrid.Fields("TABLE_NAME").Value & vbCrLf
  246.     PopGrid.MoveNext
  247. Exit Sub
  248. Failed:
  249. MsgBox "The database could not be opened!", vbCritical, "Error"
  250. End Sub
  251. Private Sub Form_Load()
  252. chkUseNTSecurity.Enabled = False
  253. DisableControl "label2"
  254. DisableControl "Text2"
  255. DisableControl "label3"
  256. DisableControl "Text3"
  257. DisableControl "label4"
  258. DisableControl "Text4"
  259. DisableControl "label5"
  260. DisableControl "Text5"
  261. End Sub
  262. Private Sub optProvider_Click(Index As Integer)
  263. optProvider(0).Tag = Index
  264. chkUseNTSecurity.Value = 0
  265. Select Case Index
  266.     Case 0, 1 'Access 95 - 2000
  267.         Label3 = "Database Name:"
  268.         
  269.         If Index = 0 Then
  270.             Conn.ProviderConst = pdsajet
  271.         Else
  272.             Conn.ProviderConst = pdsajet40
  273.         End If
  274.         
  275.         chkUseNTSecurity.Enabled = False
  276.         
  277.         DisableControl "label2"
  278.         DisableControl "Text2"
  279.         
  280.         EnableControl "label3"
  281.         EnableControl "Text3"
  282.         
  283.         DisableControl "label4"
  284.         DisableControl "Text4"
  285.         
  286.         EnableControl "label5"
  287.         EnableControl "Text5"
  288.         
  289.     Case 2 'SQL Server
  290.         Label3 = "Database Name:"
  291.         
  292.         Conn.ProviderConst = pdsasqlserver
  293.         
  294.         chkUseNTSecurity.Enabled = True
  295.         
  296.         EnableControl "label2"
  297.         EnableControl "Text2"
  298.         
  299.         EnableControl "label3"
  300.         EnableControl "Text3"
  301.         
  302.         EnableControl "label4"
  303.         EnableControl "Text4"
  304.         
  305.         EnableControl "label5"
  306.         EnableControl "Text5"
  307.     Case 3, 4
  308.         If Index = 3 Then
  309.             Label3 = "DBFs Directory:"
  310.             Conn.ProviderConst = pdsadbase
  311.         Else
  312.             Label3 = "XLS Name:"
  313.             Conn.ProviderConst = pdsaexcel
  314.         End If
  315.         chkUseNTSecurity.Enabled = False
  316.         
  317.         DisableControl "label2"
  318.         DisableControl "Text2"
  319.         
  320.         EnableControl "label3"
  321.         EnableControl "Text3"
  322.         
  323.         DisableControl "label4"
  324.         DisableControl "Text4"
  325.         
  326.         DisableControl "label5"
  327.         DisableControl "Text5"
  328.         
  329. End Select
  330. End Sub
  331. Private Sub DisableControl(ByVal ControlName As String)
  332.     If TypeOf Me.Controls(ControlName) Is VB.Label Then
  333.         Me.Controls(ControlName).ForeColor = vbGrayText
  334.     Else
  335.         Me.Controls(ControlName).ForeColor = vbGrayText
  336.         Me.Controls(ControlName).BackColor = vbButtonFace
  337.     End If
  338.     Me.Controls(ControlName).Enabled = False
  339. End Sub
  340. Private Sub EnableControl(ByVal ControlName As String)
  341.     If TypeOf Me.Controls(ControlName) Is VB.Label Then
  342.         Me.Controls(ControlName).ForeColor = vbWindowText
  343.     Else
  344.         Me.Controls(ControlName).ForeColor = vbWindowText
  345.         Me.Controls(ControlName).BackColor = vbWindowBackground
  346.     End If
  347.     Me.Controls(ControlName).Enabled = True
  348. End Sub
  349.