moddatabaseback.bas

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

Attribute VB_Name = "modDatabaseBack"
Option Explicit
Dim SrcPath As String
Dim dstpath As String
Dim IsReceived As Boolean
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 & "\" & LocalAddr)
    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, "Client Message"
        Exit Sub
    End If
    SrcPath = App.Path & "\" & LocalAddr
    Open SrcPath For Binary As #1
    If nLoop > 0 Then
        For Cn = 1 To nLoop
            BufFile = String(8192, " ")
            Get #1, , BufFile
            WskClient.SendData BufFile
            IsReceived = False
            StatusBar1.SimpleText = "發送字節: " & Cn * 81092 & " Of " & LnFile
            While IsReceived = False
                DoEvents
            Wend
        Next
        If nRemain > 0 Then
            BufFile = String(nRemain, " ")
            Get #1, , BufFile
            WskClient.SendData BufFile
            IsReceived = False
            StatusBar1.SimpleText = "發送字節: " & LnFile & " Of " & LnFile
            While IsReceived = False
                DoEvents
            Wend
        End If
    Else
        BufFile = String(nRemain, " ")
        Get #1, , BufFile
        WskClient.SendData BufFile
        IsReceived = False
        While IsReceived = False
            DoEvents
        Wend
    End If
    WskClient.SendData "Msg_Eof_"
    MsgBox "已成功將數據備份到服務器", vbInformation + vbOKOnly, "恭喜"
    Close #1
    Exit Sub
GLocal:
    MsgBox Err.Description
    
End Sub

Private Sub CmdClose_Click()
   Unload Me
End Sub

Private Sub CmdConnect_Click()
        On Error Resume Next
        WskClient.Connect "127.0.0.1", 1001
        If Err <> 0 Then
            WskClient.Close
        End If
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 CmdUpback_Click()
    Dim FName_Only As String
    If File_Exists(App.Path & "\" & LocalAddr) Then
        Kill App.Path & "\" & LocalAddr
    End If
    If opEnterMode.item(1).Value = True Then
       objDatabase.ExecCmd "BACKUP DATABASE UniLeaderDatabase TO DISK ='" & App.Path & "\" & LocalAddr & "'"
        If File_Exists(App.Path & "\" & LocalAddr) = False Then
           MsgBox "沒有讀取到備份文件", vbCritical, "提示"
        Else ' 发送文件
           If WskClient.State <> sckClosed Then
              WskClient.SendData "Msg_Dst_" & "d:\UniLeaderDatabase" & Right(Year(Now), 2) & IIf(Len(Month(Now) < 2), "0" & Month(Now), Month(Now)) & Day(Now)
           End If
        End If
    Else
        objDatabase.ExecCmd "BACKUP DATABASE UniLeaderDatabase TO DISK ='" & App.Path & "\" & LocalAddr & "'"
        MsgBox "備份成功!", vbOKOnly, "恭喜"
    End If
End Sub

Private Sub Command3_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    WskClient.Protocol = sckTCPProtocol
    
End Sub

Private Sub opEnterMode_Click(Index As Integer)
     CmdConnect.Enabled = True
End Sub
Private Sub WskClient_Close()
    StatusBar1.SimpleText = "狀態：沒有連接..."
    WskClient.Close
End Sub

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

Private Sub WskClient_DataArrival(ByVal bytesTotal As Long)
    Dim recBuffer As String
    
    WskClient.GetData recBuffer
    
    Select Case Left(recBuffer, 7)
    Case "Msg_Rec"  'Block Received
        IsReceived = True
    Case "Msg_OkS"  'Ok you can begin to send file
        SendFile
    Case "Msg_Res"  'resent bad block
        'implement this case
    Case "Msg_Err"  'error
        'implement this case
    End Select
End Sub

Private Sub WskClient_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 WskClient_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