frmztsqlbackup.frm

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

VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmZTSQLBackup 
   Caption         =   "账套备份"
   ClientHeight    =   4995
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5565
   Icon            =   "frmZTSQLBackup.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   4995
   ScaleWidth      =   5565
   StartUpPosition =   1  '所有者中心
   Begin VB.ComboBox cboZTSelect 
      Height          =   300
      Left            =   1350
      TabIndex        =   6
      Text            =   "cboZTSelect"
      Top             =   120
      Width           =   1995
   End
   Begin VB.TextBox TxtFileName 
      Height          =   285
      Left            =   1320
      TabIndex        =   5
      Top             =   600
      Width           =   2580
   End
   Begin VB.CommandButton CmdBrowse 
      Caption         =   "浏览"
      Height          =   300
      Left            =   3960
      TabIndex        =   4
      Top             =   600
      Width           =   735
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确定(&O)"
      Height          =   345
      Left            =   900
      TabIndex        =   3
      Top             =   4485
      Width           =   1065
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "退出(&Q)"
      Height          =   345
      Left            =   3510
      TabIndex        =   2
      Top             =   4485
      Width           =   1065
   End
   Begin VB.CommandButton cmdSet 
      Caption         =   "设置(&S)"
      Height          =   345
      Left            =   2205
      TabIndex        =   1
      Top             =   4485
      Width           =   1065
   End
   Begin RichTextLib.RichTextBox RTBfile 
      Height          =   3390
      Left            =   0
      TabIndex        =   0
      Top             =   1020
      Width           =   5505
      _ExtentX        =   9710
      _ExtentY        =   5980
      _Version        =   393217
      Enabled         =   -1  'True
      ScrollBars      =   3
      TextRTF         =   $"frmZTSQLBackup.frx":0442
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "账套选择："
      Height          =   180
      Left            =   180
      TabIndex        =   8
      Top             =   210
      Width           =   900
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "备份文件："
      Height          =   180
      Left            =   240
      TabIndex        =   7
      Top             =   645
      Width           =   900
   End
End
Attribute VB_Name = "frmZTSQLBackup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents Cnn As ADODB.Connection
Attribute Cnn.VB_VarHelpID = -1


Public Function CreateDirctory(ByVal sPath As String, Optional ByVal IsFile As Boolean = True)
Dim i As Integer
Dim sTempPath As String
i = InStr(1, sPath, "\")
While i > 1
    sTempPath = Left$(sPath, i - 1)
    If IsFile Then
        If i < LenB(sPath) Then
            If Dir(sTempPath, vbDirectory) = "" Then
                MkDir sTempPath
            End If
        End If
    Else
        If Dir(sTempPath, vbDirectory) = "" Then
            MkDir sTempPath
        End If
    End If
    i = InStr(i + 1, sPath, "\")
Wend
End Function

Public Function SQLBackup(ByVal sDatabase As String, ByVal sFileName As String, ByVal sLogFile As String) As Boolean
CreateDirctory sLogFile
RTBfile.text = "备份开始..."
RTBfile.text = RTBfile.text + vbCrLf + "备份账套：" + sDatabase
RTBfile.text = RTBfile.text + vbCrLf + "备份文件：" + sFileName
RTBfile.text = RTBfile.text + vbCrLf + "备份时间：" + Format(Date, "yyyy-MM-dd") + " " + Format(Time, "hh:mm:dd")
On Error Resume Next
Set Cnn = New ADODB.Connection
Cnn.Open gloSys.cnnSys.ConnectionString
Cnn.Execute "Backup DataBase " + sDatabase + " to Disk='" + sFileName + "'"
On Error GoTo 0
Set Cnn = Nothing
RTBfile.SaveFile sLogFile
End Function

Private Sub CmdBrowse_Click()
frmServerPath.uConnection = gloSys.cnnSys
'frmServerPath.TxtFileName = TxtFileName
frmServerPath.Show 1, Me
If frmServerPath.OK Then
    TxtFileName = frmServerPath.FileName
End If
Unload frmServerPath
End Sub

Private Sub cmdCancel_Click()
Unload Me
End Sub

Public Sub cmdOK_Click()
Dim sAccountID As String
'合法性检查
If cboZTSelect.text = "" Then
   MsgBox "账套名不能为空!", vbOKOnly, "提示"
   cboZTSelect.SetFocus
   Exit Sub
End If
    
If TxtFileName = "" Then
   MsgBox "备份文件名不能为空!", vbOKOnly, "提示"
   TxtFileName.SetFocus
   Exit Sub
End If
If MsgBox("是否备份？（并覆盖文件）", vbQuestion + vbYesNo, "") = vbNo Then Exit Sub

If Trim(cboZTSelect.text) = "财务系统表" Then
  sAccountID = "ykcwsysdb"
Else
  sAccountID = "CWDB" & Mid(Trim(cboZTSelect.text), 1, InStr(1, Trim(cboZTSelect.text), "=") - 1)
End If
SQLBackup sAccountID, TxtFileName, App.Path + "\BackLog\" + Format(Date, "yyyymmdd") + ".log"
Call SaveSetting(App.Title, "Backup", "SQLUserId", cboZTSelect.text)
Call SaveSetting(App.Title, "Backup", "SQLBackupPath", Trim$(Left(TxtFileName.text, InStrRev(TxtFileName.text, "\"))))
End Sub

Private Sub cmdSet_Click()
frmAutoBackup.Show 1, Me
End Sub

Private Sub Cnn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
Dim i As Integer
Dim oErr As Error
If adStatus = adStatusOK Then
    RTBfile.text = RTBfile.text + vbCrLf + "成功备份。"
Else
    For Each oErr In Cnn.Errors
        Set oErr = Cnn.Errors(i)
        RTBfile.text = RTBfile.text + vbCrLf + "错误：(" + CStr(oErr.NativeError) + ") " + vbCrLf + oErr.Description + ""
    Next
    RTBfile.text = RTBfile.text + vbCrLf + "备份失败。"
    Cnn.Errors.Clear
End If
End Sub

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 = "SQL" Then
    If GetSetting(App.Title, "Backup", "SQLUserId", "") = "ykcwsysdb" Then
       cboZTSelect.text = "财务系统表"
    Else
       cboZTSelect.text = GetSetting(App.Title, "Backup", "SQLUserId", "")
    End If
    TxtFileName.text = GetSetting(App.Title, "Backup", "SQLBackupPath", "") & "" & Format(Date, "yyyymmdd") & ".dat"
End If
End Sub