cslogin.frm

VB 设计的排课管理系统,轻松解决排课难的问题！

VERSION 5.00
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Begin VB.Form Form9 
   BackColor       =   &H00C0C0FF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "SQL数据库后台配置"
   ClientHeight    =   3540
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5535
   Icon            =   "cslogin.frx":0000
   LinkTopic       =   "Form9"
   MaxButton       =   0   'False
   ScaleHeight     =   3540
   ScaleWidth      =   5535
   StartUpPosition =   2  '屏幕中心
   Begin VB.TextBox Text4 
      Height          =   375
      Left            =   3840
      TabIndex        =   12
      Text            =   "Text4"
      Top             =   -1000
      Width           =   735
   End
   Begin VB.TextBox Text3 
      Height          =   375
      Left            =   2760
      TabIndex        =   11
      Text            =   "Text3"
      Top             =   -1000
      Width           =   855
   End
   Begin VB.TextBox Text2 
      Height          =   270
      Left            =   1680
      TabIndex        =   10
      Text            =   "Text2"
      Top             =   -1000
      Width           =   975
   End
   Begin StoneXP.XPButton XPButton1 
      Height          =   375
      Left            =   1920
      TabIndex        =   0
      Top             =   2760
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ButtonStyle     =   1
      Caption         =   "连接并登陆"
      MouseIcon       =   "cslogin.frx":F84A
      MousePointer    =   99
   End
   Begin StoneXP.XPFrame XPFrame2 
      Height          =   1455
      Left            =   480
      TabIndex        =   1
      Top             =   1080
      Visible         =   0   'False
      Width           =   4575
      _ExtentX        =   8070
      _ExtentY        =   2566
      Caption         =   "远程服务器配置"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BackColor       =   16761024
      LeftSpace       =   0
      RightSpace      =   0
      RoundSize       =   0
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   0
         Left            =   1200
         TabIndex        =   2
         Top             =   360
         Width           =   975
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         Index           =   1
         Left            =   3240
         TabIndex        =   4
         Top             =   360
         Width           =   975
      End
      Begin VB.TextBox Text1 
         Appearance      =   0  'Flat
         BorderStyle     =   0  'None
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   210
         IMEMode         =   3  'DISABLE
         Index           =   2
         Left            =   1200
         PasswordChar    =   "*"
         TabIndex        =   6
         Top             =   900
         Width           =   975
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "服务器名称:"
         Height          =   255
         Left            =   120
         TabIndex        =   7
         Top             =   360
         Width           =   1095
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "帐号:"
         Height          =   255
         Left            =   2640
         TabIndex        =   5
         Top             =   360
         Width           =   495
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "密码:"
         Height          =   255
         Left            =   600
         TabIndex        =   3
         Top             =   885
         Width           =   495
      End
   End
   Begin StoneXP.XPRadioButton XPRadioButton3 
      Height          =   375
      Left            =   960
      TabIndex        =   8
      Top             =   480
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "远程服务器"
      BackColor       =   12632319
   End
   Begin StoneXP.XPRadioButton XPRadioButton4 
      Height          =   375
      Left            =   3480
      TabIndex        =   9
      Top             =   480
      Width           =   1215
      _ExtentX        =   2143
      _ExtentY        =   661
      Value           =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "本地服务器"
      BackColor       =   12632319
   End
End
Attribute VB_Name = "Form9"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim buff As String
Dim buff1 As String
Dim buff2 As String

Private Sub Form_Load()
buff = String(255, 0)
Text1(0).BackColor = RGB(133, 146, 178)
Text1(1).BackColor = RGB(133, 146, 178)
Text1(2).BackColor = RGB(133, 146, 178)
ret1 = GetPrivateProfileString("LOGINSQL", "SERVER", "", buff, 256, App.path & "\login.ini")
If ret1 <> 0 Then
  Text2.Text = buff
  ret2 = GetPrivateProfileString("LOGINSQL", "LOGIN", "", buff, 256, App.path & "\login.ini")
  If ret2 = 0 Then
  cnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=pk;Data Source=."
  seladmin
  Exit Sub
  End If
  Text3.Text = buff
  ret3 = GetPrivateProfileString("LOGINSQL", "PASSWORD", "", buff, 256, App.path & "\login.ini")
  Text4.Text = buff
  tkOpenSQLServerDB Text2.Text, "pk", Text3.Text, Text4.Text
  seladmin
End If
End Sub

Private Sub ipserver()
On Error GoTo tkFinish
server = Text1(0).Text
loginname = Text1(1).Text
Password = Text1(2).Text
Unload Me
tkOpenSQLServerDB server, "master", loginname, Password
Dim sql As String
sql = "select * from sysdatabases Where Name = 'pk'"
Set rs = cnn.Execute(sql)
If Not rs.EOF Then
cnn.Close
tkOpenSQLServerDB server, "pk", loginname, Password
ret1 = WritePrivateProfileString("LOGINSQL", "SERVER", server, App.path & "\login.ini")
ret2 = WritePrivateProfileString("LOGINSQL", "LOGIN", loginname, App.path & "\login.ini")
ret3 = WritePrivateProfileString("LOGINSQL", "PASSWORD", Password, App.path & "\login.ini")
seladmin
Exit Sub
End If
sql = "select * from sysdatabases where name='master'"
Set rs = cnn.Execute(sql)
Dim path As String
For i = Len(rs.Fields(10)) To 1 Step -1
path = Mid(rs.Fields(10), i, 1)
 If path = "\" Then
  path = Mid(rs.Fields(10), 1, i)
 Exit For
 End If
Next
MsgBox "第一次登陆，正在新建数据库！", vbInformation, "新建数据库"
sql = "create database pk"
MsgBox "执行系统备份的还原！", vbInformation, "还原数据库"
Set rs = cnn.Execute(sql)
sql = "RESTORE DATABASE pk FROM disk='" & App.path & "\sql\pk'  With Move 'pk_data' TO '" & path & "pk.mdf', Move 'pk_log' TO '" & path & "pk.ldf'"
Set rs = cnn.Execute(sql)
cnn.Close
tkOpenSQLServerDB server, "pk", loginname, Password
ret1 = WritePrivateProfileString("LOGINSQL", "SERVER", server, App.path & "\login.ini")
ret2 = WritePrivateProfileString("LOGINSQL", "LOGIN", loginname, App.path & "\login.ini")
ret3 = WritePrivateProfileString("LOGINSQL", "PASSWORD", Password, App.path & "\login.ini")
seladmin
tkFinish:
Me.Show
End Sub

Private Sub tkOpenSQLServerDB( _
        tkServerName As String, _
        tkDefaultDatabase As String, _
        tkUserID As String, _
        tkPassword As String _
    )

    On Error GoTo tkFinish
    On Error GoTo tkFinish
    
    cnn.Open "Provider=SQLOLEDB.1;" & _
        "Data Source=" & tkServerName & ";" & _
        "Use Procedure for Prepare=1;" & _
        "Auto Translate=True;" & _
        "Packet Size=4096;" & _
        "Use Encryption for Data=False;" & _
        "Tag with column collation when possible=False", _
        tkUserID, _
        tkPassword
    cnn.DefaultDatabase = tkDefaultDatabase
    Exit Sub
tkFinish:
    MsgBox "登录失败！", vbInformation, "系统提示"
End Sub

Private Sub bdserver()
On Error GoTo tkFinish
Unload Me
cnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;Data Source=."
Dim sql As String
sql = "select * from sysdatabases Where Name = 'pk'"
Set rs = cnn.Execute(sql)
If Not rs.EOF Then
cnn.Close
cnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=pk;Data Source=."
ret1 = WritePrivateProfileString("LOGINSQL", "SERVER", "127.0.0.1", App.path & "\login.ini")
ret2 = WritePrivateProfileString("LOGINSQL", "LOGIN", "", App.path & "\login.ini")
ret3 = WritePrivateProfileString("LOGINSQL", "PASSWORD", "", App.path & "\login.ini")
seladmin
Exit Sub
End If
sql = "select * from sysdatabases where name='master'"
Set rs = cnn.Execute(sql)
Dim path As String
For i = Len(rs.Fields(10)) To 1 Step -1
path = Mid(rs.Fields(10), i, 1)
 If path = "\" Then
  path = Mid(rs.Fields(10), 1, i)
 Exit For
 End If
Next
MsgBox path
MsgBox "第一次登陆，正在新建数据库！", vbInformation, "新建数据库"
sql = "create database pk"
MsgBox "执行系统备份的还原！", vbInformation, "还原数据库"
Set rs = cnn.Execute(sql)
sql = "RESTORE DATABASE pk FROM disk='" & App.path & "\sql\pk'  With Move 'pk_data' TO '" & path & "pk.mdf', Move 'pk_log' TO '" & path & "pk.ldf'"
Set rs = cnn.Execute(sql)
cnn.Close
cnn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=pk;Data Source=."
ret1 = WritePrivateProfileString("LOGINSQL", "SERVER", "127.0.0.1", App.path & "\login.ini")
ret2 = WritePrivateProfileString("LOGINSQL", "LOGIN", "", App.path & "\login.ini")
ret3 = WritePrivateProfileString("LOGINSQL", "PASSWORD", "", App.path & "\login.ini")
seladmin
Exit Sub
tkFinish:
MsgBox "本地登陆出现错误!"
Me.Show
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
    Call XPButton1_Click
End If
End Sub
Public Sub seladmin() '查看用户状态
If kc1.State = adStateOpen Then '表状态
kc1.Close
End If
kc1.Open "select * from 登陆", cnn, adOpenStatic, adLockReadOnly, adCmdText
If kc1.RecordCount = 0 Then
Set kc1 = cnn.Execute("insert into 登陆 values('admin','admin','超级管理员')")
End If
Unload Form9
nknumber = 6
Form1.Show 1
End Sub

Private Sub XPButton1_Click()
If XPRadioButton3.Value = True Then
  If Text1(0).Text = "" Or Text1(1).Text = "" Then
  MsgBox "远程服务器名或帐号不可为空!", vbInformation, "错误"
  Exit Sub
  Else
   ipserver
   Exit Sub
  End If
End If
If XPRadioButton4.Value = True Then
bdserver
Exit Sub
End If
End Sub

Private Sub XPRadioButton3_Click()
If XPRadioButton3.Value = True Then
XPFrame2.Visible = True
Else
XPFrame2.Visible = False
End If
End Sub

Private Sub XPRadioButton4_Click()
If XPRadioButton4.Value = True Then
XPFrame2.Visible = False
Else
XPFrame2.Visible = True
End If
End Sub