📄 form_restoredatabase.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form Frm_RestoerDatabase
BorderStyle = 1 'Fixed Single
Caption = "套帐恢复"
ClientHeight = 4215
ClientLeft = 3165
ClientTop = 1890
ClientWidth = 7830
HelpContextID = 1018
Icon = "Form_RestoreDatabase.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4215
ScaleWidth = 7830
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "删除"
Height = 285
Left = 6300
TabIndex = 13
ToolTipText = "删除备份文件"
Top = 3330
Width = 1245
End
Begin VB.TextBox Text1
Height = 285
Index = 3
Left = 5850
Locked = -1 'True
TabIndex = 12
Top = 2460
Width = 1635
End
Begin VB.CommandButton Command2
Height = 315
Left = 7470
Picture = "Form_RestoreDatabase.frx":038A
Style = 1 'Graphical
TabIndex = 10
Top = 2460
Width = 315
End
Begin VB.CommandButton Command1
Caption = "取消&C"
Height = 285
Index = 1
Left = 6300
TabIndex = 9
Top = 3750
Width = 1245
End
Begin VB.CommandButton Command1
Caption = "恢复"
Height = 285
Index = 0
Left = 6300
TabIndex = 8
ToolTipText = "恢复套帐"
Top = 2910
Width = 1245
End
Begin VB.TextBox Text1
Height = 285
Index = 2
Left = 5850
TabIndex = 7
Top = 1740
Width = 1635
End
Begin VB.TextBox Text1
Height = 285
Index = 1
Left = 5850
TabIndex = 6
Top = 1020
Width = 1635
End
Begin VB.TextBox Text1
Height = 285
Index = 0
Left = 5850
TabIndex = 3
Top = 360
Width = 1635
End
Begin VB.Frame Frame1
Caption = "备份文件"
Height = 4155
Left = 30
TabIndex = 0
Top = 30
Width = 5685
Begin MSComctlLib.ListView List_data
Height = 3915
Left = 60
TabIndex = 1
Top = 180
Width = 5565
_ExtentX = 9816
_ExtentY = 6906
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "数据库名"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "备份文件名"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "备份时间"
Object.Width = 3881
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "备份路径"
Object.Width = 8819
EndProperty
End
End
Begin VB.Label Label1
Caption = "路径:"
Height = 165
Index = 3
Left = 5850
TabIndex = 11
Top = 2250
Width = 795
End
Begin VB.Label Label1
Caption = "数据库名:"
Height = 165
Index = 2
Left = 5850
TabIndex = 5
Top = 1500
Width = 795
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "套帐名称:"
Height = 180
Index = 1
Left = 5850
TabIndex = 4
Top = 840
Width = 810
End
Begin VB.Label Label1
Caption = "编号:"
Height = 255
Index = 0
Left = 5850
TabIndex = 2
Top = 150
Width = 795
End
End
Attribute VB_Name = "Frm_RestoerDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim mitem As ListItem
Dim R_SQLSERVER As String
Dim R_USERID As String
Dim R_PASSWORD As String
Private Sub Command1_Click(Index As Integer)
If Index = 1 Then Unload Me: Exit Sub
If List_data.ListItems.Count < 1 Then MsgBox "没有可恢复的数据库！ ", 16: Exit Sub
YesNoStr = MsgBox("你是否要恢复数据库名为(" & List_data.SelectedItem.Text & ")和数据库备份文件名为(" & List_data.SelectedItem.SubItems(1) & ")的套帐？ ", vbYesNo + 32)
If YesNoStr = vbNo Then Exit Sub
If Trim(Text1(0).Text) = "" Then MsgBox "套帐编码不能为空！ ", 16: Text1(0).SetFocus: Exit Sub
If Trim(Text1(1).Text) = "" Then MsgBox "套帐名称不能为空！ ", 16: Text1(1).SetFocus: Exit Sub
If Trim(Text1(2).Text) = "" Then MsgBox "数据库名不能为空！ ", 16: Text1(2).SetFocus: Exit Sub
If IsNumeric(Text1(2).Text) Then MsgBox "数据库名不能为数值！ ", 16: Text1(2).SetFocus: Exit Sub
If Trim(Text1(3).Text) = "" Then MsgBox "数据库路径不能为空！ ", 16: Text1(3).SetFocus: Exit Sub
'--------------------------
Dim Data_Error As Integer
Dim Data_ErrorName As String
On Error GoTo Exit_error
TextFile
Class.StatusBar "正在检测数据库信息...", False
Me.MousePointer = 12
If Conn_System1.State = 1 Then Conn_System1.Close
Conn_System1.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & R_SQLSERVER & "; Initial Catalog=master;", R_USERID, R_PASSWORD
Class.StatusBar "", True
Me.MousePointer = 0
Class.StatusBar "正在恢复套帐信息...", False
Me.MousePointer = 12
If Cw_DataEnvi.Connection2.State = 1 Then Cw_DataEnvi.Connection2.Close
Cw_DataEnvi.Connection2.Open "Provider=SQLOLEDB.1;Persist Security Info=False;Data Source=" & R_SQLSERVER & "; Initial Catalog=master;", R_USERID, R_PASSWORD
'-----------------
Cw_DataEnvi.dbo_HD_AddDatabase Trim(Text1(2).Text), Trim(Text1(3).Text) _
, Text1(1).Tag, "Erp5data", List_data.SelectedItem.SubItems(3), Trim(Text1(1).Text), Trim(Text1(0).Text) _
, R_SQLSERVER, "SQL Server 7.0", Data_Error, Data_ErrorName
Class.StatusBar "", True
Me.MousePointer = 0
If Cw_DataEnvi.Connection2.State = 1 Then Cw_DataEnvi.Connection2.Close
If Data_Error = 1 Then
Form_main.Form_Load
MsgBox "套帐恢复成功！ ", 48
Unload Me
Else
MsgBox "套帐恢复失败！ ", 16
End If
Exit Sub
'-----------------
Exit_error:
Class.StatusBar "", True
Me.MousePointer = 0
Select Case Err.Number
Case -2147467259
MsgBox "数据服务器错误！", 16
Case -2147217843
MsgBox "用户名或口令错误！", 16
Case Else
MsgBox Err.Description & "(" & Err.Number & ")", 16
End Select
End Sub
Private Sub Command2_Click()
Frm_Path.Show 1
If PathStr <> "" Then Text1(3).Text = PathStr
End Sub
Private Sub Command3_Click()
On Error GoTo Exit_error
Dim DiskFile As String
If List_data.ListItems.Count < 1 Then MsgBox "没有可删除的备份文件！ ", 16: Exit Sub
YesNoStr = MsgBox("你是否要删除文件名为(" & List_data.SelectedItem.SubItems(1) & ")的数据库备份文件？ ", vbYesNo + 32)
If YesNoStr = vbNo Then Exit Sub
DiskFile = Trim(List_data.SelectedItem.SubItems(3)) + "\" + Trim(List_data.SelectedItem.SubItems(1)) + ".Bak"
If Len(Dir$(DiskFile)) > 0 Then
Kill DiskFile
End If
Conn_System.Execute "delete HDSystem_BakDataBases where Number=" & Mid(List_data.SelectedItem.Key, 2, Len(List_data.SelectedItem.Key))
Form_Load
Exit Sub
Exit_error:
MsgBox Err.Description & "(" & Err.Number & ")", 16
End Sub
Private Sub Form_Load()
Dim aDo_Bakdatabase As New Recordset
Set aDo_Bakdatabase = Conn_System.Execute("select * from HDSystem_BakDataBases")
With aDo_Bakdatabase
List_data.ListItems.Clear
Do While Not .EOF
Set mitem = List_data.ListItems.Add()
mitem.Text = !DataBaseName
mitem.SubItems(1) = !BakName
mitem.SubItems(2) = !BakDate
mitem.SubItems(3) = !BakPath
mitem.Key = "T" & !Number
.MoveNext
Loop
.Close
Set aDo_Bakdatabase = Nothing
End With
If List_data.ListItems.Count > 0 Then
Text1(3).Text = App.Path
Text1(1).Text = List_data.SelectedItem.Text
Text1(1).Tag = List_data.SelectedItem.SubItems(1)
Text1(2).Text = List_data.SelectedItem.Text
End If
End Sub
Private Sub List_data_ItemClick(ByVal Item As MSComctlLib.ListItem)
Text1(1).Text = List_data.SelectedItem.Text
Text1(1).Tag = List_data.SelectedItem.SubItems(1)
Text1(2).Text = List_data.SelectedItem.Text
End Sub
Private Sub TextFile()
On Error Resume Next
Dim Fsote As Variant
Dim Tste As Variant
Dim Dqhs As Integer, Dqnr As String
Dim i As Integer
Set Fsote = CreateObject("Scripting.FileSystemObject")
Set Tste = Fsote.OpenTextFile(App.Path + "\System_Erp.txt", 1)
For i = 1 To 4
Dqnr = Trim(Tste.ReadLine)
If InStr(1, UCase(Dqnr), "SQLSERVER=") <> 0 Then
R_SQLSERVER = Mid(Dqnr, InStr(1, UCase(Dqnr), "SQLSERVER=") + 10, Len(Dqnr))
End If
If InStr(1, UCase(Dqnr), "USERID=") <> 0 Then
R_USERID = Mid(Dqnr, InStr(1, UCase(Dqnr), "USERID=") + 7, Len(Dqnr))
End If
If InStr(1, UCase(Dqnr), "PASSWORD=") <> 0 Then
R_PASSWORD = Mmjm2(Mid(Dqnr, InStr(1, UCase(Dqnr), "PASSWORD=") + 9, Len(Dqnr)))
End If
Next i
Exit Sub
End Sub
Private Function Mmjm2(Srmm As String) As String '密码解密模块
Dim Zfcte As Integer
Mmjm2 = ""
For jsqte = 1 To Int(Len(Srmm) / 3)
Zfcte = Val(Mid(Srmm, (jsqte - 1) * 3 + 1, 3)) - Int(Len(Srmm) / 3) - jsqte
Mmjm2 = Mmjm2 + Chr(Zfcte)
Next jsqte
End Function
Private Sub Text1_Change(Index As Integer)
If Index = 3 Then
If Len(Trim(Text1(3).Text)) = 3 Then Text1(3).Text = Mid(Trim(Text1(3)), 1, 2)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -