账套创建_oracle套帐怎么建立-CSDN博客

Option Explicit
Const CompanyName As String = "一卡通系统"

Private Sub CmdExit_Click()
Unload Me
End Sub

Private Sub CmdOk_Click()
On Error GoTo err
Dim DataBaseSetup As Boolean
DataBaseSetup = False

Dim Flag As Integer
Dim StrCn As String
Dim SQLsTmp As String
Dim pCnn As Connection
Dim rs As Recordset
Dim i As Integer
Dim a() As Byte

Flag = 0
List1.Clear
If Text(0).Text = "" Then
MsgBox "请输入服务器名称或IP地址！", 48, "提示信息"
Text(0).SetFocus
Exit Sub
End If

If optUse(1).Value Then
If Trim(Text(1).Text) = "" Then
MsgBox "请输入登录标识（如：sa）！", 48, "提示信息"
Text(1).SetFocus
Exit Sub
End If
End If

If Trim(Text(3).Text) = "" Then
MsgBox "请输入数据库名称！", 48, "提示信息"
Text(3).SetFocus
Exit Sub
End If
CmdOk.Enabled = False
Screen.MousePointer = 11
Flag = 1
List1.AddItem "正在检测与服务器连接..."
List1.Refresh
If optUse(1).Value Then
StrCn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & Text(1).Text & ";Initial Catalog=master;Data Source=" & Text(0).Text & ";Password=" & Text(2).Text
Else
StrCn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=master;Data Source=" & Text(0).Text
End If
Set pCnn = New Connection
pCnn.CursorLocation = adUseClient
pCnn.Open StrCn
List1.AddItem "服务器连接成功！"
List1.Refresh

SQLsTmp = "SELECT name FROM sysdatabases WHERE name='" & Text(3).Text & "' "
Set rs = pCnn.Execute(SQLsTmp)
If rs.RecordCount > 0 Then
DataBaseSetup = True
If Opt2.Value Then
If MsgBox("数据库已存在！继续执行将会丢失以前所有数据！是否继续安装数据库？", vbYesNo + 32, "提示信息") = vbNo Then
List1.AddItem "数据库安装被取消。"
List1.Refresh
Screen.MousePointer = 0
CmdOk.Enabled = True
Exit Sub
End If
End If

Else
Flag = 3
List1.AddItem "正在创建数据库..."
List1.Refresh
SQLsTmp = "CREATE DATABASE " & Text(3).Text
pCnn.Execute (SQLsTmp)
List1.AddItem "数据库创建成功！"
List1.Refresh
End If

List1.AddItem "正在检测与数据连接..."
List1.Refresh
Flag = 2
If optUse(1).Value Then
StrCn = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=" & Text(1).Text & ";Initial Catalog=" & Text(3).Text & ";Data Source=" & Text(0).Text & ";Password=" & Text(2).Text
Else
StrCn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Text(3).Text & ";Data Source=" & Text(0).Text
End If
Set pCnn = New Connection
pCnn.CursorLocation = adUseClient
pCnn.Open StrCn

List1.AddItem "数据库连接成功！"
List1.Refresh

Flag = 4
List1.AddItem "正在创建数据表..."
If Opt2.Value Or DataBaseSetup = False Then
For i = 1 To 7
a = LoadResData(100 + i, "CUSTOM")
a(1) = 0
a(0) = 45
pCnn.Execute a
Next i
End If

For i = 1 To 73
a = LoadResData(200 + i, "CUSTOM")
a(1) = 0
a(0) = 45
pCnn.Execute a
Next i
List1.AddItem "数据表创建成功！"
List1.Refresh
CmdOk.Enabled = True
Screen.MousePointer = 0

If Opt2.Value Or DataBaseSetup = False Then
SQLsTmp = "DELETE FROM mj_dayprog"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into mj_dayprog values(1,'24小时通行','1899-12-30 00:00:01.000','1899-12-30 23:59:01.000','1899-12-30 23:59:01.000','1899-12-30 23:59:01.000 ',1)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into mj_dayprog values(2,'24小时禁止通行','1899-12-30 00:00:01.000','1899-12-30 00:00:01.000','1899-12-30 00:00:01.000','1899-12-30 00:00:01.000',1)"
pCnn.Execute SQLsTmp

SQLsTmp = "DELETE FROM ht_eventtype"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into ht_eventtype values(1000,'刷卡开门',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1001,'无效卡',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1002,'密码开门',0)"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into ht_eventtype values(1003,'密码错误',0)"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into ht_eventtype values(1010,'无效时区',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1011,'假日管制',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1111,'潜回尝试',0)"
pCnn.Execute SQLsTmp

'SQLsTmp = "insert into ht_eventtype values(1011,'密码错误',0)"
'pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1012,'无效时区(密码)',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(1013,'假日管制(密码)',0)"
pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(1014,'跟随锁定',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(1015,'读卡器禁止',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(1016,'卡禁止',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(1017,'地点错误',0)"
' pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(2000,'门无故开启报警',0)"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into ht_eventtype values(2001,'开门超时报警',0)"
pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(2100,'防撬报警',0)"
pCnn.Execute SQLsTmp

' SQLsTmp = "insert into ht_eventtype values(2002,'启动输入',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(3009,'控制器断电',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(3010,'控制器上电',0)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into ht_eventtype values(4000,'非法卡',0)"
' pCnn.Execute SQLsTmp
SQLsTmp = "insert into ht_eventtype values(9999,'批量读卡',0)"
pCnn.Execute SQLsTmp

SQLsTmp = "insert into kq_dayprog (starttime,endtime,tname,starttime1,endtime1) VALUES('1900-01-01 00:00:001','1900-01-01 00:00:001','放假','1900-01-01 00:00:001','1900-01-01 00:00:001') "
pCnn.Execute SQLsTmp

SQLsTmp = "DELETE FROM sys_parameters"
pCnn.Execute SQLsTmp

SQLsTmp = "INSERT INTO sys_parameters(companyname) values( '" & CompanyName & "') "
pCnn.Execute SQLsTmp

' SQLsTmp = "DELETE FROM mj_weekprog"
' pCnn.Execute SQLsTmp
'
' SQLsTmp = "insert into mj_weekprog(idno,tname,monday,tuesday,wednesday,thursday,friday,saturday,sunday,holiday,description,defaultuse ) values(1,'全周通行',1,1,1,1,1,1,1,1,'',1)"
' pCnn.Execute SQLsTmp
' SQLsTmp = "insert into mj_weekprog(idno,tname,monday,tuesday,wednesday,thursday,friday,saturday,sunday,holiday,description,defaultuse ) values(2,'全周禁止',2,2,2,2,2,2,2,2,'',1)"
' pCnn.Execute SQLsTmp

SQLsTmp = "INSERT INTO rs_user(tname,password,employeeid,departmentid,usergroupid,dpt) VALUES('管理员','',0,0,0,1)"
pCnn.Execute SQLsTmp

End If

SQLsTmp = "DELETE FROM systemuse"
pCnn.Execute SQLsTmp

SQLsTmp = "INSERT INTO systemuse(rsuse,xfuse,kquse,mjuse,tccuse,xguse,sysuse,htuse) VALUES(1" _
& "," & Check3.Value _
& "," & Check1.Value _
& "," & Check2.Value _
& "," & Check4.Value _
& "," & Check5.Value _
& ",1,1)"
pCnn.Execute SQLsTmp

SQLsTmp = "INSERT INTO sys_kq (starttime1) VALUES(30)"
pCnn.Execute SQLsTmp

MsgBox "数据库安装成功！", 48, "提示信息"
Exit Sub
err:
Select Case Flag
Case 1
List1.AddItem "无法登录SQL Server 服务器！"
Case 2
List1.AddItem "数据库连接失败！"
Case 3
List1.AddItem "数据库创建失败！"
Case 4
List1.AddItem "数据表创建失败！"
End Select
List1.Refresh
MsgBox "数据库安装失败！", 48, "提示信息"
CmdOk.Enabled = True
Screen.MousePointer = 0
'MsgBox "数据库安装不成功！", 48, "提示信息"
End Sub

Private Sub PicExit_Click()
CmdExit_Click
End Sub

Private Sub PicOk_Click()
CmdOk_Click
End Sub