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