?? 新建 文本文檔.txt
字號:
“退出”按鈕單擊事件
Private sub cmd cancale_click()
Unload Me
End Sub
檢查數據服務器是否存在的指定的別名
Function chechAlias(s As String) As Boolean
On Error GoTo AliasErr
Dim Retvalue As Long
Dim KeyId As Long
Dim BufSize As Long
Retvalue=Regcreatkey(HEKEY_LOCAL_MACHINE,gREGKEY_SQALIAS_LOC,KeyId)
If Revalue=0 Then
Retvalue=RegQueryvalueEx(keyid, s, 0%, REG_SG,0%, Bufsize)
If bufsize<2 Then
Esle
checkAlias= Ture
End if
Exit Fuction
Aliaserr:
msgbox Err.Description
checkAlias=False
End If
Exit Function
AliasErr:
MsgBox Err.Description
checkAlias= False
End Fuction
建立數據庫服務器別名
Private Sub CreateAlias(s As String)
On Error Goto AliasErr
Dim keyvalue As String
Dim Retvalue As long
Dim keyid As long
Retvlaue=regcreatekey(HEKEY_LOCAL_MACHINE,gREGKEY_SQLAIAS_LOC,KEYID)
keyvalue=Inputbox
If keyvalue=""Then exit sub
keyvalue="DBMSSOCN,"+Trim(keyvalue)
retvalue=regsetvalueEx(keyId,s,0%,REG_sz,Byval keyvalue,len(keyvalue)+1)
Msgbo "別名:" +s+"建立成功!"
Exit sub
AliasErr:
MSgBox Err.Descirption
End sub
初始化按鈕單擊事件
private sub cmdstart_click()
const DBName="xjg1"
Dim cn As New ADODB.Connection,s As String
If txtDB=""Then
MsgBox"請輸入別名!"
Exit sub
End if
If Not checkAlias(txtDB) Then
Tf MsgBox("別名不存在,是否建立?",vbYesNo)=vbYes Then
CreateAlias txtDB
Else
Exit sub
End if
End If
On Error GoTo CreateDBErr
If MsgBox("建立數據庫:"+DBName+"嗎?",vbYesNo)= vbYes Then
If Option2.value Then
strcon= "provider=SQLOLEDB.1;Password="+txtPWD+";User ID="+txtUSER+";"Initial catalog=master;Data Source="+txtDB
Else
Strcon="Provide=SQLOLEDB.1;Integrated security=SSPI:Initial catalog=master;Data source="+txtDB
End If
cn.connectionstring=strcon
cn.open
cn.Execute "create database"+DBName
cn.Close
End If
If Option2.value Then
strCon ="provide=SQLOLEDB.1;Password="+ txtPWD +";User ID="+txtUSER+";Initial catalog="+DBName+";Data Source="+txtDB
Else
strCon="Provider=SQLOLEDB.1;Integrate security = SSPI;Initial catalog="+DBName+;Data Source=" +txtDB
End if
cn.ConnctionString=strcon
cn.open
cn.BeginTrans
On Error GoTo InstallErr
Open App.Path+"\xjgl.sql"For Input As #1
While Not EOF(1)
Line Input #1,s
If Ucase(Trim(s))="Go" Then
cn.Execute(strSQl)
strSQL=""
Else
strSQL=strSQl+strSql+vbCrlf+s
End If
wend
Close #1
cn.Execute "INSERT INTO 用戶信息(用戶名,密碼) VALUES('admin','admin')"
cn.commitTrans
MsgBox"初始化數據庫完成!"
Exit Sub
installErr:
MsgBox Err.Description
cn.RollbackTrans
Exit Sub
CreateDBErr:
MsgBox Err.Description
End Sub
windows 集成驗證
Private Sub Option1_click()
txtUSER.Enabled=Option2.Value
txtPWD.Enabled=Option2.Value
End Sub
SQL 混合驗證
Privated Sub Option2_click()
txtUSER.Enabled=Option2.Value
txtPWD.Enabled=Option2.Value
txtUSER.SetFocus
End Sub
"退出"按鈕單擊事件
Privated Sub cmdExit_click()
End
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -