home *** CD-ROM | disk | FTP | other *** search
- VERSION 5.00
- Begin VB.UserDocument VbtoADFdoc
- ClientHeight = 3570
- ClientLeft = 45
- ClientTop = 270
- ClientWidth = 9225
- HScrollSmallChange= 15
- ScaleHeight = 3570
- ScaleWidth = 9225
- VScrollSmallChange= 15
- Begin VB.Frame Frame2
- Caption = " Query Using RDSServer.DataFactory "
- Height = 3015
- Left = 120
- TabIndex = 0
- Top = 240
- Width = 8655
- Begin VB.TextBox txtServer
- Height = 375
- Left = 3600
- TabIndex = 6
- Top = 720
- Width = 4455
- End
- Begin VB.ListBox List1
- Height = 2205
- Left = 240
- TabIndex = 5
- Top = 360
- Width = 1932
- End
- Begin VB.TextBox txtGetRecordset
- Height = 372
- Left = 3600
- TabIndex = 3
- Top = 1680
- Width = 4452
- End
- Begin VB.TextBox txtConnect
- Height = 372
- Left = 3600
- TabIndex = 2
- Top = 1200
- Width = 4452
- End
- Begin VB.CommandButton cmdGetRecordset
- Caption = "&Run"
- Height = 372
- Left = 3600
- TabIndex = 1
- Top = 2280
- Width = 1572
- End
- Begin VB.Label Label4
- Caption = "Enter valid Server, Connect, and Query properties and click Run"
- Height = 255
- Left = 3600
- TabIndex = 9
- Top = 360
- Width = 4815
- End
- Begin VB.Label Label3
- Caption = "Query:"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2640
- TabIndex = 8
- Top = 1800
- Width = 735
- End
- Begin VB.Label Label2
- Caption = "Server:"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2640
- TabIndex = 7
- Top = 840
- Width = 735
- End
- Begin VB.Label Label1
- Caption = "Connect:"
- BeginProperty Font
- Name = "MS Sans Serif"
- Size = 8.25
- Charset = 0
- Weight = 700
- Underline = 0 'False
- Italic = 0 'False
- Strikethrough = 0 'False
- EndProperty
- Height = 255
- Left = 2640
- TabIndex = 4
- Top = 1320
- Width = 735
- End
- End
- End
- Attribute VB_Name = "VbtoADFdoc"
- Attribute VB_GlobalNameSpace = False
- Attribute VB_Creatable = True
- Attribute VB_PredeclaredId = False
- Attribute VB_Exposed = True
- Dim ads As New RDS.DataSpace
- Dim adf As Object
-
- Private Sub UserDocument_Initialize()
- txtServer.Text = "http://"
- txtConnect.Text = "Dsn=AdvWorks;Uid=;Pwd=;"
- txtGetRecordset.Text = "Select ProductName from Products"
- End Sub
-
- Private Sub cmdGetRecordset_Click()
- On Error GoTo cmdGetRecordset_Click
- If Trim(txtServer.Text) = "http://" And Len(Trim(txtServer.Text)) = 7 Then
- MsgBox "Please enter a valid server name."
- Else
- MousePointer = vbHourglass
-
- 'Create AdvancedDataFactory using CreateObject Method of Advanced Data Space
- Set adf = ads.CreateObject("RDSServer.DataFactory", CStr(txtServer.Text))
-
- 'Populate ListBox with Recordset
- Dim objADORs As Object
- Set objADORs = adf.Query(CStr(txtConnect.Text), CStr(txtGetRecordset.Text))
- List1.Clear
- While Not objADORs.EOF
- List1.AddItem objADORs(0).Value
- objADORs.MoveNext
- Wend
- MousePointer = vbNormal
- End If
- Exit Sub
- cmdGetRecordset_Click:
- MousePointer = vbNormal
- MsgBox Err.Description
- End Sub
-
-