📄 frm_main.frm
字号:
VERSION 5.00
Begin VB.Form Frm_Main
BorderStyle = 1 'Fixed Single
Caption = "导出数据库结构到HTML文件 - 欢迎访问 www.5ivb.net"
ClientHeight = 4035
ClientLeft = 45
ClientTop = 330
ClientWidth = 6285
Icon = "Frm_Main.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 4035
ScaleWidth = 6285
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame3
Caption = "请选择保存HTML文件的目录"
Height = 855
Left = 120
TabIndex = 18
Top = 2820
Width = 6045
Begin VB.TextBox txtHtmlName
Enabled = 0 'False
Height = 345
Left = 120
Locked = -1 'True
TabIndex = 20
Top = 330
Width = 4305
End
Begin VB.CommandButton cmdBrowseHtmlFile
Caption = "浏览目录"
Height = 435
Left = 4500
TabIndex = 19
Top = 270
Width = 1395
End
End
Begin VB.Frame Frame2
Caption = "ACCESS 数据库"
Height = 765
Left = 120
TabIndex = 11
Top = 90
Width = 6045
Begin VB.CommandButton cmdOut
Caption = "导出"
Height = 405
Left = 5250
TabIndex = 14
Top = 240
Width = 675
End
Begin VB.TextBox txtDbName
Enabled = 0 'False
Height = 315
Left = 1110
Locked = -1 'True
TabIndex = 13
Top = 270
Width = 3315
End
Begin VB.CommandButton cmdBrowseDbFile
Caption = "选择"
Height = 405
Left = 4500
TabIndex = 12
Top = 240
Width = 675
End
Begin VB.Label labCaption
AutoSize = -1 'True
Caption = "数据库："
Height = 180
Index = 4
Left = 360
TabIndex = 17
Top = 330
Width = 720
End
End
Begin VB.Frame Frame1
Caption = "SQL SERVER 数据库"
Height = 1875
Left = 120
TabIndex = 1
Top = 900
Width = 6045
Begin VB.CommandButton cmdOutSQL
Caption = "导出"
Height = 1335
Left = 4500
TabIndex = 10
Top = 330
Width = 1395
End
Begin VB.TextBox txtLoginPassWord
Height = 315
IMEMode = 3 'DISABLE
Left = 1110
PasswordChar = "#"
TabIndex = 9
Top = 1350
Width = 3315
End
Begin VB.TextBox txtLoginName
Height = 315
Left = 1110
TabIndex = 8
Top = 1010
Width = 3315
End
Begin VB.TextBox txtDataBaseName
Height = 315
Left = 1110
TabIndex = 7
Top = 670
Width = 3315
End
Begin VB.TextBox txtServerAddress
Height = 315
Left = 1110
TabIndex = 6
Top = 330
Width = 3315
End
Begin VB.Label labCaption
AutoSize = -1 'True
Caption = "密码："
Height = 180
Index = 3
Left = 540
TabIndex = 5
Top = 1410
Width = 540
End
Begin VB.Label labCaption
AutoSize = -1 'True
Caption = "用户名："
Height = 180
Index = 2
Left = 360
TabIndex = 4
Top = 1065
Width = 720
End
Begin VB.Label labCaption
AutoSize = -1 'True
Caption = "数据库名："
Height = 180
Index = 1
Left = 180
TabIndex = 3
Top = 735
Width = 900
End
Begin VB.Label labCaption
AutoSize = -1 'True
Caption = "服务器："
Height = 180
Index = 0
Left = 360
TabIndex = 2
Top = 390
Width = 720
End
End
Begin VB.Label lblState
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 660
TabIndex = 16
Top = 3780
Width = 90
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "状态："
Height = 180
Left = 120
TabIndex = 15
Top = 3780
Width = 540
End
Begin VB.Label Label2
AutoSize = -1 'True
Height = 180
Left = 180
TabIndex = 0
Top = 2850
Width = 90
End
End
Attribute VB_Name = "Frm_Main"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'选择 ACCESS 数据库（暂不支持带密码的数据库）
Private Sub cmdBrowseDbFile_Click()
Dim strFileName As String '用户选择的数据库文件
strFileName = BrowseForFile(Me.hWnd, "选择一个数据库")
If strFileName <> "" Then
txtDbName.Text = strFileName
End If
End Sub
'选择一个保存 HTML 文件的目录。
Private Sub cmdBrowseHtmlFile_Click()
Dim strDir As String '目录
Dim strFileName As String '文件名
Dim intStart As Integer '最后一个 "\" 的位置
If txtDbName.Text = "" Then
If txtDataBaseName.Text = "" Then
MsgBox "请先选择一个数据库！", vbInformation
Exit Sub
Else
strFileName = txtDataBaseName.Text
End If
Else
intStart = InStrRev(txtDbName.Text, "\")
strFileName = Fun_GetStr(txtDbName.Text, "\", ".", intStart)
End If
strDir = BrowseForFolder(Me.hWnd, "选择一个目录")
If strDir <> "" Then
txtHtmlName.Text = strDir & strFileName & ".HTML"
End If
End Sub
'导出 ACCESS 数据库
Private Sub cmdOut_Click()
If Len(Trim(txtHtmlName.Text)) = 0 Then
MsgBox "请选择要导出的目录！", vbInformation
cmdBrowseHtmlFile.SetFocus
Exit Sub
End If
If Len(Trim(txtDbName.Text)) = 0 Then
MsgBox "请选择数据库！", vbInformation
cmdBrowseDbFile.SetFocus
Exit Sub
End If
cmdOut.Enabled = False
VB.Screen.MousePointer = 11
'调用导出 ACCESS 到 HTML 的函数。
Call DbToHtml(txtDbName.Text, txtHtmlName.Text)
VB.Screen.MousePointer = 0
cmdOut.Enabled = True
End Sub
'导出SQL SERVER 数据库
Private Sub cmdOutSQL_Click()
Dim strSource As String '数据服务器地址
Dim strDataBaseName As String '数据库名称
Dim strLoginName As String '登录数据库服务器的用户名
Dim strLoginPassWord As String '登录数据库服务器密码
Dim strConn As String '连接串
strDataBaseName = txtDataBaseName.Text
strSource = txtServerAddress.Text
strLoginName = txtLoginName.Text
strLoginPassWord = txtLoginPassWord.Text
If Len(Trim(strSource)) = 0 Then
MsgBox "请输入服务器名或IP！", vbInformation
txtServerAddress.SetFocus
Exit Sub
End If
If Len(Trim(strDataBaseName)) = 0 Then
MsgBox "请输入数据库名！", vbInformation
txtDataBaseName.SetFocus
Exit Sub
End If
If Len(Trim(strLoginName)) = 0 Then
MsgBox "请输入数据库登录名！", vbInformation
txtLoginName.SetFocus
Exit Sub
End If
If Len(Trim(strLoginPassWord)) = 0 Then
MsgBox "请输入登录密码名！", vbInformation
txtLoginPassWord.SetFocus
Exit Sub
End If
If Len(Trim(txtHtmlName.Text)) = 0 Then
MsgBox "请选择要导出的目录！", vbInformation
cmdBrowseHtmlFile.SetFocus
Exit Sub
End If
cmdOutSQL.Enabled = False
strConn = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
"Initial Catalog=" & strDataBaseName & _
";Data Source=" & strSource & _
";User ID=" & strLoginName & _
";Password=" & strLoginPassWord
VB.Screen.MousePointer = 11
'调用导出 SQL SERVER 到 HTML 的函数。
Call SqlServerToHtml(strConn, txtHtmlName.Text)
VB.Screen.MousePointer = 0
cmdOutSQL.Enabled = True
End Sub
'更改一下导出的文件名（即和数据库名相同）
Private Sub txtDataBaseName_LostFocus()
Dim strTemp As String '临时存放文件名
Dim intStart As Integer '最后一个"\"位置
strTemp = txtHtmlName.Text
If Len(strTemp) = 0 Then
Exit Sub
End If
intStart = InStrRev(strTemp, "\")
strTemp = Left$(strTemp, intStart) & txtDataBaseName.Text & ".HTML"
txtHtmlName.Text = strTemp
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -