frmrestoredata.frm

一个用VB写的财务软件源码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmRestoreData 
   Caption         =   "财务系统恢复"
   ClientHeight    =   4815
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5280
   Icon            =   "frmRestoreData.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   5280
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog dLg 
      Left            =   4290
      Top             =   4320
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "打开文件"
   End
   Begin VB.TextBox txtLine 
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00800000&
      Height          =   2175
      Left            =   240
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   5
      Top             =   1440
      Width           =   4815
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      CausesValidation=   0   'False
      Height          =   345
      Left            =   2760
      TabIndex        =   4
      Top             =   4320
      Width           =   825
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Default         =   -1  'True
      Height          =   345
      Left            =   1500
      TabIndex        =   3
      Top             =   4320
      Width           =   825
   End
   Begin VB.TextBox txtPath 
      Height          =   315
      Left            =   210
      TabIndex        =   1
      Top             =   600
      Width           =   4005
   End
   Begin VB.CommandButton cmdBrowse 
      Caption         =   "浏览(&B)"
      Height          =   345
      Left            =   4200
      TabIndex        =   0
      Top             =   600
      Width           =   825
   End
   Begin MSComctlLib.ProgressBar pbr 
      Height          =   375
      Left            =   90
      TabIndex        =   7
      Top             =   3780
      Width           =   5055
      _ExtentX        =   8916
      _ExtentY        =   661
      _Version        =   393216
      Appearance      =   1
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "恢复信息(&R):"
      Height          =   180
      Left            =   240
      TabIndex        =   6
      Top             =   1200
      Width           =   1080
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "请选择文件："
      Height          =   180
      Left            =   240
      TabIndex        =   2
      Top             =   300
      Width           =   1080
   End
End
Attribute VB_Name = "frmRestoreData"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_cnn As ADODB.Connection
Dim WithEvents CreateDB As clsCreateDB
Attribute CreateDB.VB_VarHelpID = -1
Dim Script As clsScript
Dim sFile As TableFileForXML.clsTBinfo

'选择备份的文本文件
Private Sub CmdBrowse_Click()
On Error GoTo errhandler
With dLg
    .CancelError = True
    .FileName = ""
    .Filter = "XML File(*.xml)|*.xml"
    .Flags = cdlOFNFileMustExist Or cdlOFNHelpButton Or _
                cdlOFNHideReadOnly Or cdlOFNNoReadOnlyReturn
    .ShowOpen
    txtPath.text = .FileName
    txtLine.text = sFile.ReadSoapSummary(.FileName)
End With
errhandler:
    Exit Sub
End Sub


Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdOk_Click()
If txtPath.text = "" Then
    MsgBox "请选择所要恢复的文件!", vbInformation, "提示"
    Exit Sub
End If
On Error GoTo errorhandle:
Set Script = New clsScript
Script.usFileType = "Xml"
Script.usScriptFilename = Trim(txtPath.text)
CreateDB.cnnVirtual = m_cnn
CreateDB.uInitContent = sFile
CreateDB.Append Script
pbr.Max = 500
pbr.Min = 0
pbr.Value = 0

CreateDB.DoExecute
pbr.Value = 500
MsgBox "恢复完成！", vbInformation, "提示"
Exit Sub
errorhandle:
MsgBox "在数据的恢复过程中，遇到意外情况，请与系统管理员联系！" & Err.Description, vbInformation, "提示"
Exit Sub
End Sub

Private Sub CreateDB_ExecuteCount(ByVal Count As Long)
pbr.Value = Count Mod pbr.Max
End Sub

Private Sub Form_Load()
Set CreateDB = New clsCreateDB
Set sFile = New TableFileForXML.clsTBinfo

Dim g As GlobalInterface.clsGlobal
Set g = New GlobalInterface.clsGlobal
g.cnnMain = m_cnn
g.g_FLAT = g_FLAT
sFile.iGlo = g

End Sub
Public Property Let GetCnn(ByVal vNewValue As Variant)
 Set m_cnn = vNewValue
End Property
Private Sub tb_FinishNumber(ByVal l As Long)
DoEvents
pbr.Value = l
'Me.Caption = l
End Sub