vb6自动更新和恢复文件的一种方法

最新推荐文章于 2011-04-12 14:46:00 发布

YFY

最新推荐文章于 2011-04-12 14:46:00 发布

阅读量1.3k

点赞数

文章标签： vb string function integer output windows

本文链接：https://blog.csdn.net/YFY/article/details/2282300

版权

vb6自动更新和恢复文件的一种方法
Attribute VB_Name = "mdlPublic"
Option Explicit

'//*****************************************************************************
'// 定义文件操作部分结构以及API函数
Public Const MAX_PATH = 260
Public Const INVALID_HANDLE_VALUE = -1
Private Const MOVEFILE_REPLACE_EXISTING = &H1    '// 如目标文件存在，则将其替换
Private Const MOVEFILE_COPY_ALLOWED = &H2        '// 如移动到一个不同的卷
                                                 '// 则复制文件并删除原来的文件
Private Const MOVEFILE_DELAY_UNTIL_REBOOT = &H4 '// 移动操作在系统下次重新启动时正式进行。
                                                 '// 这样便可在Windows NT中改换系统文件

Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime   As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh    As Long
        nFileSizeLow     As Long
        dwReserved0      As Long
        dwReserved1      As Long
        cFileName        As String * MAX_PATH
        cAlternate       As String * 14
End Type

Private Type UDTInspectControl
    nSetWatchDogTime   As Long     '* 设置看门狗时的本机启动时间
    nReceiveMsgTimes   As Long     '* 接收到消息的次数
    bReceiveMsgGood    As Boolean '* 是否已经接收到主程序工作正常的消息
    bForbidWatchDog    As Boolean '* 是否禁止写看门狗(用于强制重新启动)
    bRestartMeForce    As Boolean '* 是否强制重新启动计算机
    bReceiveADWrokGood As Boolean '* 是否已经接收到拨号程序工作正常的消息
End Type

'// 根据文件名查找文件
'// 执行成功，返回一个搜索句柄。如果出错，返回一个INVALID_HANDLE_VALUE常数.
'// 一旦不再需要，应该用FindClose函数关闭这个句柄
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
                        ByVal lpFileName As String, _
                        lpFindFileData As WIN32_FIND_DATA _
                        ) As Long

'// 根据调用FindFirstFile函数时指定的一个文件名查找下一个文件
'// 非零表示成功，零表示失败。如不再有与指定条件相符的文件，会将GetLastError设置成ERROR_NO_MORE_FILES
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" ( _
                         ByVal hFindFile As Long, _
                         lpFindFileData As WIN32_FIND_DATA _
                         ) As Long

'// 关闭由FindFirstFile函数创建的一个搜索句柄
'// 非零表示成功，零表示失败。会设置GetLastError
Public Declare Function FindClose Lib "kernel32" ( _
                        ByVal hFindFile As Long _
                        ) As Long

'// 删除指定文件
'// 非零表示成功，零表示失败。会设置GetLastError
Public Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" ( _
                        ByVal lpFileName As String _
                        ) As Long

'// 移动文件。如dwFlags设为零，则MoveFile完全等价于MoveFileEx
'// 非零表示成功，零表示失败。会设置GetLastError
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" ( _
                         ByVal lpExistingFileName As String, _
                         ByVal lpNewFileName As String _
                         ) As Long

'// 移动文件。如dwFlags设为零，则MoveFileEx完全等价于MoveFile
'// 非零表示成功，零表示失败。会设置GetLastError
Private Declare Function MoveFileEx Lib "kernel32" Alias "MoveFileExA" ( _
                         ByVal lpExistingFileName As String, _
                         ByVal lpNewFileName As String, _
                         ByVal dwFlags As Long _
                         ) As Long

'// 复制文件 bFailIfExists如果设为非零，那么一旦目标文件已经存在，则函数调用会失败。否则目标文件被改写。
'// 非零表示成功，零表示失败。会设置GetLastError
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" ( _
                         ByVal lpExistingFileName As String, _
                         ByVal lpNewFileName As String, _
                         ByVal bFailIfExists As Long _
                         ) As Long

Global gprevWndproc   As Long    '// 保存窗体消息处理句柄，用于退出程序时恢复Windows消息处理
Global gQuitIsPermit As Boolean '// 标识程序退出是否被允许标识
Global gTryCloseOtherProcess As Boolean '// 标识是否尝试关闭其它进程
Global gudtControl    As UDTInspectControl

'/*================================================================
' *
' * 函数名：UpdateBootFile
' *
' * 参    数：无
' *
' * 功能描述: 更新引导文件
' *
' * 返回值：无
' *
' * 异常处理：继续执行，最后检查并记录错误
' *
' * 作    者：Shi.Mingjie 2004/11/04
' *
' ================================================================*/
Public Sub UpdateBootFile()
    On Error Resume Next

    Err.Clear

    Dim szFileSource As String
    Dim szFileDst    As String
    Dim szSearchFile As String
    Dim nCopyFlag    As Long
    Dim nRetval      As Long

    nCopyFlag = MOVEFILE_REPLACE_EXISTING
    szSearchFile = Dir(App.Path & "/Download/Vids.exe")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/Download/" & szSearchFile
        szFileDst = App.Path & "/" & szSearchFile

        nRetval = MoveFileEx(szFileSource, szFileDst, nCopyFlag)

        If nRetval <> 0 Then
            Call WriteToLog("Public->UpdateBootFile", " 更新引导程序：" & szFileSource & "-->" & szFileDst & " 成功... ", 2)
        Else
            Call WriteToLog("Public->UpdateBootFile", " 更新引导程序：" & szFileSource & "-->" & szFileDst & " 失败！ MoveFileEx 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->UpdateBootFile", " 更新引导程序不存在未找到文件: " & App.Path & "/Download/Vids.exe", 4)
    End If

    If Err.Number <> 0 Then
        Call WriteToLog("Public->UpdateBootFile", " 异常: " & Err.Number & " " & Err.Description, 4)
    End If
End Sub

'/*================================================================
' *
' * 函数名：UpdateLoopFile
' *
' * 参    数：无
' *
' * 功能描述: 更新线圈文件
' *
' * 返回值：无
' *
' * 异常处理：继续执行，最后检查并记录错误
' *
' * 作    者：Shi.Mingjie 2004/11/04
' *
' ================================================================*/
Public Sub UpdateLoopFile()
    On Error Resume Next

    Err.Clear

    Dim szFileSource As String
    Dim szFileDst    As String
    Dim szSearchFile As String
    Dim nCopyFlag    As Long
    Dim nRetval      As Long
    Dim bUpdatePara0 As Boolean
    Dim bUpdatePara1 As Boolean

    nCopyFlag = MOVEFILE_REPLACE_EXISTING
    szSearchFile = Dir(App.Path & "/download/Para0.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/download/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = MoveFileEx(szFileSource, szFileDst, nCopyFlag)

        If nRetval <> 0 Then
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ MoveFileEx 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件失败下载文件: " & App.Path & "/download/Para0.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/download/Para1.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/download/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = MoveFileEx(szFileSource, szFileDst, nCopyFlag)

        If nRetval <> 0 Then
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ MoveFileEx 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件失败下载文件: " & App.Path & "/download/Para1.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/download/Para2.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/download/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = MoveFileEx(szFileSource, szFileDst, nCopyFlag)

        If nRetval <> 0 Then
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ MoveFileEx 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件失败下载文件: " & App.Path & "/download/Para2.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/download/Para3.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/download/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = MoveFileEx(szFileSource, szFileDst, nCopyFlag)

        If nRetval <> 0 Then
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ MoveFileEx 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->UpdateBootFile", " 更新线圈文件失败下载文件: " & App.Path & "/download/Para3.bin" & " 不存在！", 4)
    End If

    If Err.Number <> 0 Then
        Call WriteToLog("Public->UpdateBootFile", " 异常: " & Err.Number & " " & Err.Description, 4)
    End If
End Sub

'/*================================================================
' *
' * 函数名：ResumeBootFile
' *
' * 参    数：无
' *
' * 功能描述: 还原引导文件
' *
' * 返回值：无
' *
' * 异常处理：继续执行，最后检查并记录错误
' *
' * 作    者：Shi.Mingjie 2004/11/04
' *
' ================================================================*/
Public Sub ResumeBootFile()
    On Error Resume Next

    Err.Clear

    Dim szFileSource As String
    Dim szFileDst    As String
    Dim szSearchFile As String
    Dim nRetval      As Long

    szSearchFile = Dir(App.Path & "/VidsDefault/Vids.exe")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/VidsDefault/" & szSearchFile
        szFileDst = App.Path & "/" & szSearchFile

        nRetval = CopyFile(szFileSource, szFileDst, 0&)

        If nRetval <> 0 Then
            Call WriteToLog("Public->ResumeBootFile", " 还原引导程序：" & szFileSource & "-->" & szFileDst & " 成功... ", 2)
        Else
            Call WriteToLog("Public->ResumeBootFile", " 还原引导程序：" & szFileSource & "-->" & szFileDst & " 失败！ CopyFile 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->ResumeBootFile", " 还原引导程序失败引导程序文件: " & App.Path & "/VidsDefault/Vids.exe" & " 不存在！", 4)
    End If

    If Err.Number <> 0 Then
        Call WriteToLog("Public->ResumeBootFile", " 异常: " & Err.Number & " " & Err.Description, 4)
    End If
End Sub

'/*================================================================
' *
' * 函数名：ResumeLoopFile
' *
' * 参    数：无
' *
' * 功能描述: 还原线圈文件
' *
' * 返回值：无
' *
' * 异常处理：继续执行，最后检查并记录错误
' *
' * 作    者：Shi.Mingjie 2004/11/04
' *
' ================================================================*/
Public Sub ResumeLoopFile()
    On Error Resume Next

    Err.Clear

    Dim szFileSource As String
    Dim szFileDst    As String
    Dim szSearchFile As String
    Dim nRetval      As Long
    Dim bUpdatePara0 As Boolean
    Dim bUpdatePara1 As Boolean

    szSearchFile = Dir(App.Path & "/vdsdefault/Para0.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/vdsdefault/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = CopyFile(szFileSource, szFileDst, 0&)

        If nRetval <> 0 Then
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ CopyFile 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件失败线圈文件: " & App.Path & "/vdsdefault/Para0.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/vdsdefault/Para1.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/vdsdefault/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = CopyFile(szFileSource, szFileDst, 0&)

        If nRetval <> 0 Then
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ CopyFile 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件失败下载文件: " & App.Path & "/vdsdefault/Para1.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/vdsdefault/Para2.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/vdsdefault/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = CopyFile(szFileSource, szFileDst, 0&)

        If nRetval <> 0 Then
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ CopyFile 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件失败下载文件: " & App.Path & "/vdsdefault/Para2.bin" & " 不存在！", 4)
    End If

    szSearchFile = Dir(App.Path & "/vdsdefault/Para3.bin")
    If (Len(szSearchFile) <> 0) Then
        szFileSource = App.Path & "/vdsdefault/" & szSearchFile
        szFileDst = "c:/LoopPara/" & szSearchFile

        nRetval = CopyFile(szFileSource, szFileDst, 0&)

        If nRetval <> 0 Then
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 成功...", 2)
        Else
            Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件：" & szFileSource & "-->" & szFileDst & " 失败！ CopyFile 返回 " & nRetval, 4)
        End If
    Else
        Call WriteToLog("Public->ResumeLoopFile", " 还原线圈文件失败下载文件: " & App.Path & "/vdsdefault/Para3.bin" & " 不存在！", 4)
    End If

    If Err.Number <> 0 Then
        Call WriteToLog("Public->ResumeLoopFile", " 异常: " & Err.Number & " " & Err.Description, 4)
    End If
End Sub

'/*================================================================
' *
' * 函数名：WriteToLog
' *
' * 参    数：szPosition     事件发生的程序位置
' *           szDescription 对于事件的描述
' *           iEventSign     事件的标识号 1-4
' *                          1 自动事件 2 程序事件 3 警告 4 异常
' *           nErrorNumber   系统提供的错误号默认为0无错
' *           bNewSeparate   日志段落分隔标识符号
' *
' * 功能描述: 记运行时可捕获错误,重要事件,关键操作记录
' *
' * 返回值：无
' *
' * 异常处理：关闭申请的文件号
' *
' * 作    者：Shi.Mingjie 2003/09/16
' *
' ================================================================*/
Public Sub WriteToLog(ByVal szPosition As String, _
                      ByVal szDescription As String, _
                      ByVal iEventSign As Integer, _
                      Optional ByVal bNewSeparate As Boolean = False)
    On Error GoTo ErrHandle

    Dim szLogFileName        As String
    Dim iFileNumber          As Integer
    Dim szCurrentTime        As String
    Dim lpWin32FileData      As WIN32_FIND_DATA
    Dim nFindFileHandle      As Long

    szCurrentTime = Format$(Date$, "yyyy-MM-dd") & Space(1) & Format$(Time$, "HH:mm:ss")

    szLogFileName = App.Path & "/log/vids_Inspect.evt"
    iFileNumber = FreeFile

    nFindFileHandle = FindFirstFile(szLogFileName, lpWin32FileData)
    Call FindClose(nFindFileHandle)

    If INVALID_HANDLE_VALUE = nFindFileHandle Then '// 如果系统日志文件不存在则创建
        Open szLogFileName For Output As #iFileNumber
            If bNewSeparate Then
                Print #iFileNumber, ""
            End If
            Print #iFileNumber, szCurrentTime & "|" & iEventSign & "|" & szPosition & "|" & szDescription
        Close #iFileNumber
    Else                                              '// 如果系统日志文件存在则追加
        If lpWin32FileData.nFileSizeLow > 51120 Then '// 适应无线传输需要，减少日志文件大小
            DoEvents
            DeleteFile szLogFileName
            DoEvents
            Open szLogFileName For Output As #iFileNumber
                If bNewSeparate Then
                    Print #iFileNumber, ""
                End If
                Print #iFileNumber, szCurrentTime & "|" & iEventSign & "|" & szPosition & "|" & szDescription
            Close #iFileNumber
        Else
            Open szLogFileName For Append As #iFileNumber
                If bNewSeparate Then
                    Print #iFileNumber, ""
                End If
                Print #iFileNumber, szCurrentTime & "|" & iEventSign & "|" & szPosition & "|" & szDescription
            Close #iFileNumber
        End If
    End If

    Exit Sub
ErrHandle:
    Close #iFileNumber
End Sub

YFY

关注

0
点赞
踩
0

收藏

觉得还不错? 一键收藏
0
评论
复制链接

分享到 QQ

分享到新浪微博

扫一扫