frmztrestore.frm

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

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmZTRestore 
   Caption         =   "账套恢复"
   ClientHeight    =   4755
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6255
   Icon            =   "frmZTRestore.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   4755
   ScaleWidth      =   6255
   StartUpPosition =   2  '屏幕中心
   Begin VB.ComboBox cboZTSelect 
      Height          =   300
      Left            =   1350
      TabIndex        =   8
      Text            =   "cboZTSelect"
      Top             =   0
      Width           =   1995
   End
   Begin VB.TextBox TxtFileName 
      Height          =   285
      Left            =   1395
      TabIndex        =   7
      Top             =   900
      Width           =   2580
   End
   Begin VB.CommandButton CmdBrowse 
      Caption         =   "浏览"
      Height          =   300
      Left            =   3960
      TabIndex        =   6
      Top             =   900
      Width           =   735
   End
   Begin VB.TextBox txtExePath 
      Height          =   270
      Left            =   1395
      TabIndex        =   5
      Top             =   450
      Width           =   2085
   End
   Begin VB.CommandButton CmdExeBrowse 
      Caption         =   "浏览"
      Height          =   300
      Left            =   3510
      TabIndex        =   4
      Top             =   450
      Width           =   735
   End
   Begin VB.CommandButton cmdCZ 
      Caption         =   "重置"
      Height          =   300
      Left            =   4275
      TabIndex        =   3
      Top             =   450
      Width           =   735
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Height          =   345
      Left            =   1230
      TabIndex        =   2
      Top             =   4365
      Width           =   1065
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "退出(&Q)"
      Height          =   345
      Left            =   3840
      TabIndex        =   1
      Top             =   4365
      Width           =   1065
   End
   Begin RichTextLib.RichTextBox RTBfile 
      Height          =   3030
      Left            =   0
      TabIndex        =   0
      Top             =   1260
      Width           =   6225
      _ExtentX        =   10980
      _ExtentY        =   5345
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   3
      TextRTF         =   $"frmZTRestore.frx":0442
   End
   Begin MSComDlg.CommonDialog CommonOpen 
      Left            =   4455
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      DialogTitle     =   "打开"
      Filter          =   "*.dmp"
      InitDir         =   "c:\"
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "账套选择："
      Height          =   180
      Left            =   180
      TabIndex        =   11
      Top             =   90
      Width           =   900
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "执行程序："
      Height          =   180
      Left            =   180
      TabIndex        =   10
      Top             =   495
      Width           =   900
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "默认恢复文件："
      Height          =   180
      Left            =   90
      TabIndex        =   9
      Top             =   990
      Width           =   1260
   End
End
Attribute VB_Name = "frmZTRestore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
    (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, _
    lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, _
    lpTotalNumberOfClusters As Long) As Long
    
Dim WithEvents oLaunch As RedirectLib.Application
Attribute oLaunch.VB_VarHelpID = -1

Private Sub CmdBrowse_Click()
    Dim i As Integer
    CommonOpen.FileName = "c:\expdat" & Format(Date, "yyyymmdd") & ".dmp"
    CommonOpen.Filter = ".dmp"
    CommonOpen.InitDir = "c:\"
    CommonOpen.ShowOpen
    If Trim(CommonOpen.FileName) = "" Then
    Else
    i = InStr(1, CommonOpen.FileName, ".", vbTextCompare)
        If g_FLAT = "ORACLE" Then
            If Mid(CommonOpen.FileName, i + 1, 3) <> "dmp" And Mid(CommonOpen.FileName, i + 1, 3) <> "DMP" Then
               TxtFileName = Mid(CommonOpen.FileName, 1, i) & "dmp"
            Else
               TxtFileName = CommonOpen.FileName
            End If
        End If
    End If

End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Private Sub cmdCZ_Click()
Dim sCommandName As String
Dim reg As New CRegistry
If g_FLAT = "ORACLE" Then
    sCommandName = "imp80.exe"
    reg.OpenKey localmachine, "software/oracle", True
    txtExePath.text = reg.ReadValue("oracle_home") & "\bin\IMP80.EXE"
End If

End Sub

Private Sub CmdExeBrowse_Click()
    Dim i As Integer
    CommonOpen.FileName = txtExePath
    CommonOpen.Filter = ".exe"
    CommonOpen.InitDir = "c:\"
    CommonOpen.ShowOpen
    If Trim(CommonOpen.FileName) = "" Then
    Else
    i = InStr(1, CommonOpen.FileName, ".", vbTextCompare)
        If g_FLAT = "ORACLE" Then
            If Mid(CommonOpen.FileName, i + 1, 3) <> "dmp" And Mid(CommonOpen.FileName, i + 1, 3) <> "DMP" Then
               txtExePath = Mid(CommonOpen.FileName, 1, i) & "dmp"
            Else
               txtExePath = CommonOpen.FileName
            End If
        Else
            If Mid(CommonOpen.FileName, i + 1, 3) <> "dat" And Mid(CommonOpen.FileName, i + 1, 3) <> "DAT" Then
               txtExePath = Mid(CommonOpen.FileName, 1, i) & "dmp"
            Else
               txtExePath = CommonOpen.FileName
            End If

        End If
    End If

End Sub
Private Sub cmdOK_Click()
  Dim pidNotepad As Long
  Dim f As New FileSystemObject
  Dim cmd As ADODB.Command
  Dim val As Double
  Dim sClause As String
  Dim sLog As String
  Dim sAccountID As String
  Dim rSt As ADODB.Recordset
  Set rSt = New ADODB.Recordset
  Set cmd = New ADODB.Command
'建立连接
  Dim cnnVirtual As ADODB.Connection
  Set cnnVirtual = New ADODB.Connection
  cnnVirtual.Open GetConnectString(g_FLAT, gloSys.sServer, _
  "system", "manager")
  cmd.ActiveConnection = cnnVirtual
  cmd.CommandType = adCmdText
'合法性检查
    If cboZTSelect.text = "" Then
       MsgBox "账套名不能为空!", vbOKOnly, "提示"
       cboZTSelect.SetFocus
       Exit Sub
    End If
    
    If txtExePath = "" Then
       MsgBox "执行程序名不能为空!", vbOKOnly, "提示"
       txtExePath.SetFocus
       Exit Sub
    End If
    
    If TxtFileName = "" Then
       MsgBox "备份文件名不能为空!", vbOKOnly, "提示"
       TxtServerName.SetFocus
       Exit Sub
    End If
    '检查恢复文件是否存在
    t = Trim(TxtFileName.text)
    If Dir(t) <> "" Then
    Else
        MsgBox "恢复文件不存在！", vbInformation, "提示"
        TxtFileName.SetFocus
        Exit Sub
    End If
On Error GoTo ErrMessageSec:
     cmdOK.Enabled = False
     cmdCancel.Enabled = False
'执行恢复
     '形成执行命令字串
     If g_FLAT = "ORACLE" Then
        If Trim(cboZTSelect.text) = "财务系统表" Then
          sAccountID = "ykcwsysdb"
        Else
          sAccountID = "CWDB" & Mid(Trim(cboZTSelect.text), 1, InStr(1, Trim(cboZTSelect.text), "=") - 1)
        End If
     End If
     sLog = Replace(TxtFileName.text, ".dmp", "imp.txt")
     If Trim(cboZTSelect.text) = "财务系统表" Then
       sClause = Trim$(txtExePath) + " " + "ykcwsysdb/horse" & "@" & gloSys.sServer & " file=" & Trim(TxtFileName.text)
     Else
        sClause = Trim$(txtExePath) + " " + Trim(sAccountID) & "/YK" & Trim(sAccountID) & "@" & gloSys.sServer & " file=" & Trim(TxtFileName.text)
     End If
'    sClause = sClause + " log=" + sLog + " full=y"
     sClause = sClause + " full=y"
     '删除用户，建用户
      If g_FLAT = "ORACLE" Then
         rSt.Open "select * from sys.all_users  where username= '" & sAccountID & "'", gloSys.cnnSys, adOpenStatic, adLockReadOnly
'      Else
'         rst.Open "select * from master..sysdatabases where name='" & sAccountID & "'", gloSys.cnnSys, adOpenStatic, adLockReadOnly
      End If
     If rSt.RecordCount > 0 Then
        cmd.CommandText = "drop user " & sAccountID & " cascade"
        cmd.Execute
     End If
     cmd.CommandText = "CREATE USER " & sAccountID & " IDENTIFIED BY " & s.decrypt(gloSys.sPassword) & _
       " DEFAULT TABLESPACE CW_ts TEMPORARY TABLESPACE CW_tsTmp" & _
       " QUOTA UNLIMITED ON CW_ts QUOTA UNLIMITED ON CW_tsTmp"
    cmd.Execute
    cmd.CommandText = "ALTER USER " & sAccountID & " IDENTIFIED BY yk" & sAccountID
    cmd.Execute
    cmd.CommandText = "GRANT DBA TO " & sAccountID
    cmd.Execute
     '开始执行
    oLaunch.Name = sClause
    Select Case oLaunch.Start
    Case laAlreadyRunning
                
    Case laWindowsError
        oLaunch.Stop
        MsgBox "Windows error: " & CStr(oLaunch.LastErrorNumber) & "!"
    Case laOk
    End Select
    RTBfile.SaveFile sLog
    Exit Sub
ErrMessageSec:
    MsgBox "正在恢复过程中！应用程序运行出错！", vbInformation, "提示"
    cmdOK.Enabled = True
    cmdCancel.Enabled = True

End Sub

Public Function LoadFileToRtf(ByVal sLog As String) As Boolean
On Error GoTo Err:
    RTBfile.LoadFile sLog
    RTBfile.Refresh
    LoadFileToRtf = True
    Exit Function
Err:
    LoadFileToRtf = False
End Function

Private Sub Form_Load()
Dim rSt As New ADODB.Recordset
cboZTSelect.Clear
cboZTSelect.AddItem "财务系统表"
cboZTSelect.Refresh
With rSt
  .CursorLocation = adUseClient
  .Open "SELECT * FROM tSYS_Account A,tSYS_Trade B " & _
                "WHERE A.TradeID=B.ID ORDER BY A.AccountID", _
            gloSys.cnnSys, adOpenStatic, adLockReadOnly
   
    If .RecordCount <> 0 Then
        Do Until .EOF
            cboZTSelect.AddItem .Fields("AccountID").Value & "=" & _
                 .Fields("AccountName").Value
            .MoveNext
        Loop
    End If
   .Close
End With
cboZTSelect.Refresh

Dim i As Integer
If g_FLAT = "ORACLE" Then
    If GetSetting(App.Title, "Backup", "OracleUserId", "") = "ykcwsysdb" Then
       cboZTSelect.text = "财务系统表"
    Else
       cboZTSelect.text = GetSetting(App.Title, "Backup", "OracleUserId", "")
    End If
    txtExePath.text = Replace(GetSetting(App.Title, "Backup", "OracleExefilepath", ""), "EXP80", "IMP80")
    TxtFileName.text = GetSetting(App.Title, "Backup", "OracleBackupPath", "") & "expdat" & Format(Date, "yyyymmdd") & ".dmp"
End If

Set oLaunch = New RedirectLib.Application
oLaunch.BufferSize = 8192
oLaunch.Wait = 500
End Sub

Private Sub oLaunch_DataReceived(ByVal sData As String)
    RTBfile.text = RTBfile.text + sData
    RTBfile.SelStart = Len(RTBfile.text)
End Sub

Private Sub oLaunch_ProcessEnded()
MsgBox "账套恢复完成！", vbInformation, "提示"
cmdOK.Enabled = True
cmdCancel.Enabled = True
End Sub

Private Sub RTBfile_Change()
DoEvents
RTBfile.Refresh
End Sub