新建 文本文档.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