?? frmmain.frm
字號:
VERSION 5.00
Begin VB.Form kf_frm_server
AutoRedraw = -1 'True
BorderStyle = 1 'Fixed Single
Caption = "配置數據服務器"
ClientHeight = 5490
ClientLeft = 150
ClientTop = 435
ClientWidth = 4365
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5490
ScaleWidth = 4365
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command1
Caption = "配置完成"
Height = 330
Left = 1440
TabIndex = 6
Top = 4995
Width = 1770
End
Begin VB.ComboBox cboDatabases
Appearance = 0 'Flat
BackColor = &H00FFFF00&
Enabled = 0 'False
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 810
Style = 2 'Dropdown List
TabIndex = 5
Top = 4425
Width = 2625
End
Begin VB.Frame Frame1
Height = 3675
Left = 360
TabIndex = 0
Top = 270
Width = 3555
Begin VB.CommandButton cmdConnect
Appearance = 0 'Flat
Caption = "測試連接 "
Default = -1 'True
Height = 375
Left = 945
TabIndex = 4
Top = 3060
Width = 1665
End
Begin VB.TextBox txtPassword
Appearance = 0 'Flat
BackColor = &H00FFFF00&
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
IMEMode = 3 'DISABLE
Left = 660
PasswordChar = "*"
TabIndex = 3
Top = 2580
Width = 2415
End
Begin VB.TextBox txtUser
Appearance = 0 'Flat
BackColor = &H00FFFF00&
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 615
TabIndex = 2
Top = 1530
Width = 2415
End
Begin VB.TextBox txtServer
Appearance = 0 'Flat
BackColor = &H00FFFF00&
BeginProperty Font
Name = "Courier New"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 615
TabIndex = 1
Top = 570
Width = 2415
End
Begin VB.Label Label3
Caption = "密碼"
Height = 255
Left = 600
TabIndex = 9
Top = 2160
Width = 1215
End
Begin VB.Label Label2
Caption = "用戶名"
Height = 255
Left = 600
TabIndex = 8
Top = 1200
Width = 1095
End
Begin VB.Label Label1
Caption = "計算機IP地址"
Height = 255
Left = 600
TabIndex = 7
Top = 240
Width = 1455
End
End
Begin VB.Label Label4
Caption = "數據庫"
Height = 255
Left = 840
TabIndex = 10
Top = 4080
Width = 1335
End
End
Attribute VB_Name = "kf_frm_server"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bDBLoading As Boolean
Dim bSPLoading As Boolean
Dim bServerLoading As Boolean
Private Sub Command1_Click()
If Trim(cboDatabases.Text) = "" Then
MsgBox "請您注冊服務器信息并選擇所要連接的數據庫！配置完成之前必須進行測試連接，防止不必要的錯誤發生！", vbOKOnly, "系統提示"
Exit Sub
End If
bServerLoading = True
DoEvents
Select Case True
Case Trim(txtServer.Text) = ""
MsgBox "服務器必須輸入！", vbOKOnly, "系統警告"
txtServer.SetFocus
txtServer.SelStart = 0
txtServer.SelLength = Len(txtServer)
Case Trim(txtUser.Text) = ""
MsgBox "請輸入登錄服務器用戶名！", vbOKOnly, "系統警告"
Case Trim(txtPassword.Text) = ""
MsgBox "請您輸入服務器密碼！", vbOKOnly, "系統警告"
Case Trim(cboDatabases.Text) = ""
MsgBox "請您選擇所要連接的數據庫！配置完成之前必須進行測試連接，防止不必要的錯誤！", vbOKOnly, "系統提示"
Case Else
Dim aaa, bbb, ccc, ddd
aaa = Trim(txtServer.Text)
bbb = Trim(txtUser.Text)
ccc = Trim(txtPassword.Text)
ddd = Trim(cboDatabases.Text)
ConnectionString = "PROVIDER=MSDASQL;driver={SQL Server};server=" & aaa & ";uid=" & bbb & ";pwd=" & ccc & ";database=" & ddd & ";"
If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database") = "Error" Then
CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion"
modRegistry.DeleteRegKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database"
SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database", ConnectionString
End If
If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database") = "" Then
SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database", ConnectionString
End If
If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database") <> "" Then
modRegistry.DeleteRegKeyValue HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database"
SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\MinorVersion", "database", ConnectionString
End If
End Select
bServerLoading = False
MsgBox "服務器配置成功！請您重新啟動系統！", vbOKOnly, "注冊成功！"
End
End Sub
Private Sub Form_Load()
'-- Subclass the rtb so we can scroll the line numbers
txtServer.Text = gCurrentServer
txtUser.Text = gCurrentUser
txtPassword.Text = gCurrentPassword
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
'-- kill the subclass so we don't screw up someone's machinecboSprocs
End Sub
Private Sub Form_Resize()
On Error Resume Next
' If frmMain.Height < 5925 Then frmMain.Height = 5925
' If frmMain.Width < 3450 Then frmMain.Width = 3450
' FrameParams.Width = Me.Width - 2920
' lvSP.Width = FrameParams.Width - 240
' lblParameters.Width = lvSP.Width
'
' tabCode.Width = Me.Width - 240
' DoEvents
' Container.Width = tabCode.Width - 240
' Container.Height = tabCode.Height - 780
' rtbSQL.Height = Container.Height + 10
' picLines.Height = Container.Height
' lblSPCode.Width = Container.Width
' rtbSQL.Width = Container.Width - picLines.Width
' rtbVB.Height = Container.Height
' lblVBCode.Width = Container.Width
' rtbVB.Width = Container.Width
' rtbASP.Height = Container.Height
' lblASPCode.Width = Container.Width
' rtbASP.Width = Container.Width
' tabCode.Height = Me.Height - 4900
'
' ' Refresh the line numbers
' DrawLines picLines
' If Container.Height <> tabCode.Height - 780 Then Form_Resize
End Sub
Public Sub DrawLines(picTo As PictureBox)
Dim lLine As Long
Dim lCount As Long
Dim lCurrent As Long
Dim hBr As Long
Dim lEnd As Long
Dim lhDC As Long
Dim bComplete As Boolean
Dim tR As RECT
Dim tTR As RECT
Dim oCol As OLE_COLOR
Dim lStart As Long
Dim lEndLine As Long
Dim tPO As POINTAPI
Dim lLineHeight As Long
Dim hPen As Long
Dim hPenOld As Long
lhDC = picTo.hdc
DrawText lhDC, "Hy", 2, tTR, DT_CALCRECT
lLineHeight = tTR.Bottom - tTR.Top
If lCount < 50 Then lCount = 50
GetClientRect picTo.hwnd, tR
lEnd = tR.Bottom - tR.Top
hBr = CreateSolidBrush(TranslateColor(picTo.BackColor))
FillRect lhDC, tR, hBr
DeleteObject hBr
tR.Left = 2
tR.Right = tR.Right - 2
tR.Top = 0
tR.Bottom = tR.Top + lLineHeight
SetTextColor lhDC, TranslateColor(vbButtonShadow)
Do
' Ensure correct colour:
If (lLine = lCurrent) Then
SetTextColor lhDC, TranslateColor(vbWindowText)
ElseIf (lLine = lEndLine + 1) Then
SetTextColor lhDC, TranslateColor(vbButtonShadow)
End If
' Draw the line number:
DrawText lhDC, CStr(lLine + 1), -1, tR, DT_RIGHT
' Increment the line:
lLine = lLine + 1
' Increment the position:
OffsetRect tR, 0, lLineHeight
If (tR.Bottom > lEnd) Or (lLine + 1 > lCount) Then
bComplete = True
End If
Loop While Not bComplete
' Draw a line...
MoveToEx lhDC, tR.Right + 1, 0, tPO
hPen = CreatePen(PS_SOLID, 1, TranslateColor(vbButtonShadow))
hPenOld = SelectObject(lhDC, hPen)
LineTo lhDC, tR.Right + 1, lEnd
SelectObject lhDC, hPenOld
DeleteObject hPen
If picTo.AutoRedraw Then
picTo.Refresh
End If
End Sub
Private Sub cboSprocs_Click()
DoEvents
If bDBLoading Then Exit Sub
If cboDatabases.Text = "Choose Sproc" Then Exit Sub
If cboDatabases.Text = gCurrentSproc Then Exit Sub
Screen.MousePointer = vbHourglass
Create_Connection db_sql, gCurrentDatabase, Trim(txtServer.Text), Trim(txtUser.Text), Trim(txtPassword.Text)
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdConnect_Click()
fwq = 0
bServerLoading = True
cboDatabases.Clear
DoEvents
Select Case True
Case Trim(txtServer.Text) = ""
MsgBox "服務器必須輸入！", vbOKOnly, "系統警告"
txtServer.SetFocus
txtServer.SelStart = 0
txtServer.SelLength = Len(txtServer)
Case Trim(txtUser.Text) = ""
MsgBox "請輸入登錄服務器用戶名！", vbOKOnly, "系統警告"
Case Trim(txtPassword.Text) = ""
MsgBox "請您輸入登錄服務器密碼", vbOKOnly, "系統警告"
Case Else
Screen.MousePointer = vbHourglass
gCurrentServer = Trim(txtServer.Text)
gCurrentUser = Trim(txtUser.Text)
gCurrentPassword = Trim(txtPassword.Text)
bDBLoading = True
Create_Connection db_sql, "Master", gCurrentServer, gCurrentUser, gCurrentPassword
Set oRS = ExecuteSP("sp_databases", sp_Select)
If fwq = 1 Then
MsgBox "對不起！信息錯誤，請重新輸入", vbOKOnly, "警告！"
GoTo aa:
End If
If Not oRS Is Nothing Then
Do Until oRS.EOF
cboDatabases.AddItem oRS("Database_Name")
oRS.MoveNext
Loop
cboDatabases.Text = "Master"
cboDatabases.Enabled = True
End If
aa:
bDBLoading = False
Screen.MousePointer = vbDefault
End Select
bServerLoading = False
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -