【VB开源代码栏目提醒】:网学会员为需要VB开源代码的朋友们搜集整理了frmBase.frm相关资料,希望对各位网友有所帮助!
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmBase
BorderStyle = 4 'Fixed ToolWindow
Caption = "ADO编程"
ClientHeight = 6765
ClientLeft = 45
ClientTop = 285
ClientWidth = 8760
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6765
ScaleWidth = 8760
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
Caption = "打开数据库"
Height = 735
Left = 0
TabIndex = 4
Top = 0
Width = 2775
Begin VB.TextBox txtBase
Height = 285
Left = 120
TabIndex = 6
Top = 360
Width = 1815
End
Begin VB.CommandButton Command1
Caption = "打开"
Height = 315
Left = 2040
TabIndex = 5
Top = 360
Width = 615
End
End
Begin MSComctlLib.StatusBar sb
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 3
Top = 6510
Width = 8760
_ExtentX = 15452
_ExtentY = 450
Style = 1
SimpleText = "ADO编程"
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin MSComctlLib.ListView lstv
Height = 6975
Left = 3600
TabIndex = 2
Top = 0
Width = 8175
_ExtentX = 14420
_ExtentY = 12303
LabelWrap = -1 'True
HideSelection = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 0
End
Begin VB.CommandButton Command2
Caption = "隐藏"
Height = 330
Left = 2880
TabIndex = 1
Top = 120
Width = 615
End
Begin MSComDlg.CommonDialog cd
Left = 2880
Top = 1920
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin MSComctlLib.ImageList il
Left = 2880
Top = 4560
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":059C
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":0B38
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":10D4
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":1670
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmBase.frx":2244
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView trv
Height = 6495
Left = 0
TabIndex = 0
Top = 840
Width = 3495
_ExtentX = 6165
_ExtentY = 11456
_Version = 393217
Style = 7
ImageList = "il"
BorderStyle = 1
Appearance = 1
End
End
Attribute VB_Name = "frmBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Gconn As New ADODB.Connection
Dim Rs As ADODB.Recordset
Dim RsField As ADODB.Recordset
Dim MaTable As String
Dim Num As Long
Dim BaseConn As String
Dim ChaineConn As String
Private Sub Command1_Click()
Dim Node As Node
Dim etape1 As Node
Dim etape2 As Node
cd.Filter = "Base Access|*.mdb"
cd.ShowOpen
ChaineConn = BaseConn & cd.FileName
If cd.FileName = "" Then Exit Sub
trv.Nodes.Clear
Gconn.Open ChaineConn
Set Rs = Gconn.OpenSchema(adSchemaTables)
Set Node = trv.Nodes.Add(, , , "<Base>", 1, 1)
Node.Expanded = True
Do While Not Rs.EOF
Select Case LCase(Rs.Fields(3))
Case "table"
Num = 2
Case Is = "view"
Num = 5
Case "system table"
Num = 6
Case Else
Num = 4
End Select
Set etape1 = trv.Nodes.Add(Node, tvwChild, , Rs.Fields(2).Value, Num, Num)
Set RsField = Gconn.OpenSchema(adSchemaColumns)
Do While Not RsField.EOF
If RsField.Fields(2) = Rs.Fields(2) Then
Set etape2 = trv.Nodes.Add(etape1, tvwChild, , RsField.Fields(3), 3, 3)
End If
RsField.MoveNext
Loop
Rs.MoveNext
Loop
Gconn.Close
End Sub
Private Sub Command2_Click()
Static Flag As Boolean
Flag = Not Flag
If Not Flag Then
Me.Width = 12000
Command2.Caption = "隐藏"
Else
Me.Width = 3615
Command2.Caption = "显示"
End If
End Sub
Private Sub Form_Load()
Me.Width = 12000
'sb.Panels(1).Width = 5000
BaseConn = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source="
End Sub
Private Sub trv_NodeClick(ByVal Node As MSComctlLib.Node)
Dim rep As Long
Dim RsPrivate As ADODB.Recordset
Dim item As ListItem
Dim Requete As String
Dim H, G As Integer
Gconn.Open ChaineConn
MaTable = Replace(Node.FullPath, "<Base>\", "")
rep = InStr(MaTable, "\")
If rep > 0 Then
MaTable = Left$(MaTable, rep - 1)
End If
Requete = "select * from " & MaTable
On Error GoTo hdl
Set RsPrivate = Gconn.Execute(Requete)
lstv.ListItems.Clear
lstv.ColumnHeaders.Clear
For H = 0 To RsPrivate.Fields.Count - 1
lstv.ColumnHeaders.Add , , RsPrivate.Fields(H).Name
Next
lstv.View = lvwReport
Do While Not RsPrivate.EOF
Set item = lstv.ListItems.Add(, , RsPrivate.Fields(0))
For G = 1 To RsPrivate.Fields.Count - 1
item.SubItems(G) = RsPrivate.Fields(G)
Next
RsPrivate.MoveNext
Loop
'sb.Panels(1).Text = "Ok"
Gconn.Close
Exit Sub
hdl:
'sb.Panels(1).Text = Err.Description
On Error Resume Next
Gconn.Close
End Sub
上一篇:
bkcjunit.pas
下一篇:
“文化力”的认识和发展1805字