clsbackupdatabase.cls

企业ERP系统 采用VB+SQL2000实现。 有客户合约

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBackupDatabase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Dim SrcPath As String
Dim dstpath As String
Dim IsReceived As Boolean
Private WithEvents wskServer As Winsock
Attribute wskServer.VB_VarHelpID = -1

Private Sub SendFile()
    Dim BufFile As String
    Dim LnFile As Long
    Dim nLoop As Long
    Dim nRemain As Long
    Dim Cn As Long
    
    On Error GoTo GLocal:
    LnFile = FileLen(App.Path & "\DatabaseBack\UniLeaderDatabase")
    If LnFile > 8192 Then
        nLoop = Fix(LnFile / 8192)
        
        nRemain = LnFile Mod 8192
    Else
        nLoop = 0
        nRemain = LnFile
    End If
    
    If LnFile = 0 Then
        MsgBox "錯誤的數據備份", vbCritical, "提示"
        Exit Sub
    End If
    SrcPath = App.Path & "\DatabaseBack\UniLeaderDatabase"
    Open SrcPath For Binary As #1
    If nLoop > 0 Then
        For Cn = 1 To nLoop
            BufFile = String(8192, " ")
            Get #1, , BufFile
            wskServer.SendData BufFile
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        Next
        If nRemain > 0 Then
            BufFile = String(nRemain, " ")
            Get #1, , BufFile
            wskServer.SendData BufFile
            IsReceived = False
            While IsReceived = False
                DoEvents
            Wend
        End If
    Else
        BufFile = String(nRemain, " ")
        Get #1, , BufFile
        wskServer.SendData BufFile
        IsReceived = False
        While IsReceived = False
            DoEvents
        Wend
    End If
    wskServer.SendData "Msg_Eof_"
    MsgBox "已成功將數據備份到服務器", vbInformation + vbOKOnly, "恭喜"
    Close #1
    Exit Sub
GLocal:
    MsgBox Err.Description
    
End Sub
Public Function File_Exists(sFileName As String) As Boolean
If sFileName <> "" Then File_Exists = (Dir(sFileName, vbNormal Or vbReadOnly Or vbHidden Or vbSystem Or vbArchive) <> "")
End Function

Private Sub Form_Load()
    wskServer.Protocol = sckTCPProtocol
    wskServer.LocalPort = 1001
    wskServer.Listen
End Sub
Private Sub WskServer_Close()
    StatusBar1.SimpleText = "狀態：沒有連接..."
    wskServer.Close
End Sub

Private Sub WskServer_Connect()
    StatusBar1.SimpleText = "狀態：已連接"
End Sub


Private Sub WskServer_ConnectionRequest(ByVal requestID As Long)
    If wskServer.State <> sckClosed Then wskServer.Close
    wskServer.Accept requestID
    StatusBar1.SimpleText = "請求連接"
    wskServer.SendData "Msg_Cok_" & "d:\UniLeaderDatabase" & Right(Year(Now), 2) & IIf(Len(Month(Now) < 2), "0" & Month(Now), Month(Now)) & Day(Now)
    StatusBar1.SimpleText = "狀態：已連接"
End Sub

Private Sub WskServer_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
    If Number <> 0 Then
         StatusBar1.SimpleText = "狀態：沒有連接..."
    End If
End Sub

Private Sub WskServer_SendComplete()
'    WskClient.SendData "Msg_Eof_"    'end of file tag

End Sub

Private Sub WskClient_SendProgress(ByVal bytesSent As Long, ByVal bytesRemaining As Long)
'    DoEvents
'    lbByteSend.Caption = "Bytes Sent: " & bytesSent & " Of " & bytesRemaining
'    lbByteSend.Refresh
    
End Sub

Private Sub WskServer_DataArrival(ByVal bytesTotal As Long)
    Dim RecBuffer As String
    On Error GoTo GLocal
    wskServer.GetData RecBuffer
    Select Case Left(RecBuffer, 7)
        Case "Msg_OkS"
            StatusBar1.SimpleText = "發送數據"
                objDatabase.ExecCmd "BACKUP DATABASE UniLeaderDatabase TO DISK ='" & App.Path & "\DatabaseBack\UniLeaderDatabase" & "'"
'                If File_Exists(App.Path & "\DatabaseBack\UniLeaderDatabase") = False Then
'                    WskServer.SendData ("Msg_Ebk_")
'                Else
'                    SendFile
'                End If
                 SendFile
        Case "Msg_Con"
                StatusBar1.SimpleText = "請求連接"
                wskServer.SendData ("Msg_Cok_")
        Case "Msg_Rec"  'Block Received
            StatusBar1.SimpleText = "發送完成"
            IsReceived = True
    End Select
    
    Exit Sub
GLocal:
    MsgBox Err.Description
    Unload Me
End Sub

Private Sub Class_Initialize()
     Set wskServer = New Winsock
End Sub