VB6消息截获处理、删除只读文件、API创建多层文件夹

VB6消息截获处理、删除只读文件、API创建多层文件夹
Attribute VB_Name = "mdlMessage"
'/***********************************************************************
'* 文件名：mdlMessage.bas
'* 文件描述：提供主窗体消息截获 特别处理应用系统异常消息
'* 创建人：Shi.Mingjie 2004/07/15
'* 版本号：1.0
'* 修改记录：
'* 版权所有 2003-2004
'*
'************************************************************************/

Option Explicit

Private Const WM_CLOSE = &H10 '* 系统消息 关闭进程
Private Const WM_RESTARTCOMPUTERFORCE = &H477 '* 自定义消息 重新启动计算机

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Global gprevWndproc As Long '// 保存窗体消息处理句柄，用于退出程序时恢复Windows消息处理

'/*================================================================
' *
' * 函 数 名：WndProc
' *
' * 参 数：ByVal hwnd As Long
' * ByVal Msg As Long 消息代码
' * ByVal wParam As Long
' * ByVal lParam As Long
' *
' * 功能描述: 截获窗体消息，处理自定义消息，其余消息归还Windows处理
' *
' * 返 回 值：默认
' *
' * 异常处理：跳到下一行继续执行
' *
' * 作 者：Shi.Mingjie 2003/07/15
' *
' ================================================================*/
Public Function WndProc(ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

On Error Resume Next

Select Case Msg
Case WM_RESTARTCOMPUTERFORCE '// 自定义消息 系统不可恢复异常，需要强制重新启动计算机
Call WriteToLog("Message->WndProc", "收到强制重新启动消息...", 2)
gudtControl.bRestartMeForce = True
Case Else '// 其他消息交由Windows处理
WndProc = CallWindowProc(gprevWndproc, hwnd, Msg, wParam, lParam)
End Select

End Function

'/*===============================================================
' *
' * 函 数 名：CreateFlag
' *
' * 参 数：szFlagFile 标识文件名
' *
' * 功能描述: 创建指定标识文件
' *
' * 返 回 值：成功返回TRUE，失败返回FALSE
' *
' * 异常处理：异常记录，返回失败
' *
' * 作 者：Shi.Mingjie 2004/11/03
' *
' ================================================================*/
Private Function CreateFlag(ByVal szFlagFile As String) As Boolean
On Error GoTo ErrHandle

Close #245
Open (App.Path & "/" & szFlagFile) For Output As #245
Close #245
CreateFlag = True

Exit Function
ErrHandle:
CreateFlag = False
Call WriteToLog("Message->CreateFlag : " & szFlagFile, "发生异常：" & Err.Description, 4)
End Function

'界面消息处理的代码
Private Const WM_CLOSE = &H10

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long _
) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String _
) As Long

Private Const GWL_WNDPROC = (-4)

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long _
) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) As Long

'Load
gprevWndproc = GetWindowLong(Me.hwnd, GWL_WNDPROC) '* 获取当前消息处理句柄
SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf WndProc '* 设置当前消息处理函数

'Unload
SetWindowLong Me.hwnd, GWL_WNDPROC, gprevWndproc '* 恢复消息Windows处理

'/*================================================================
' *
' * 函 数 名：ClearSpecialFile
' *
' * 参 数：无
' *
' * 功能描述: 自动删除指定文件列表中的文件
' *
' * 返 回 值：无
' *
' * 异常处理：跳出函数处理，记录错误到日志
' *
' * 作 者：Shi.Mingjie 2003/07/15
' *
' ================================================================*/
Private Sub ClearSpecialFile()
On Error GoTo ErrHandle

Dim szFile As String
Dim iFileNumber As Integer
Dim iCycleControl As Integer
Dim szFileList(100) As String
Dim i As Integer
Dim lpWin32FileData As WIN32_FIND_DATA
Dim nFindFileHandle As Long

szFile = Dir(App.Path & "/vidsClear.ini")
If Len(szFile) <> 0 Then
iFileNumber = FreeFile
Open szFile For Input As #iFileNumber
iCycleControl = 1
Do Until EOF(iFileNumber)
If iCycleControl <= 100 Then
Line Input #iFileNumber, szFileList(iCycleControl)
iCycleControl = iCycleControl + 1
Else
Exit Do
End If
Loop
Close #iFileNumber

For i = 1 To iCycleControl - 1

nFindFileHandle = FindFirstFile(szFileList(i), lpWin32FileData)
Call FindClose(nFindFileHandle)

If INVALID_HANDLE_VALUE <> nFindFileHandle Then
If 0 = DeleteFile(szFileList(i)) Then
If 0 <> SetFileAttributes(szFileList(i), FILE_ATTRIBUTE_NORMAL) Then
DoEvents
If 0 = DeleteFile(szFileList(i)) Then
Call WriteToLog("Main->ClearSpecialFile", "删除指定文件：" & szFileList(i) & " 失败！", 3)
End If
Else
Call WriteToLog("Main->ClearSpecialFile", "更改文件：" & szFileList(i) & " 属性失败！", 3)
End If
End If
End If
Next i
Else
Call WriteToLog("Main->ClearSpecialFile", "未找到指定文件：" & App.Path & "/vdsClear.ini", 3)
End If

Exit Sub
ErrHandle:
Call WriteToLog("Main->ClearSpecialFile", "异常：" & Err.Description, 3)
End Sub

'/*================================================================
' *
' * 函 数 名：CreateFolder
' *
' * 参 数：szCheckFolder 需要检测的文件夹
' *
' * 功能描述: 检查参数中传入的文件夹,不存在则创建
' *
' * 返 回 值：成功返回 TRUE,失败返回 FALSE
' *
' * 异常处理：记入日志
' *
' * 作 者：Shi.Mingjie 2003/09/16
' *
' ================================================================*/
Private Function CreateFolder(ByVal szCheckFolder As String) As Boolean
On Error GoTo ErrHandle

Dim szFolderBuff As Variant
Dim nFolderLayer As Long
Dim szFolderNow As String
Dim i As Long
Dim attFolder As SECURITY_ATTRIBUTES
Dim szFolder As String

szFolderNow = ""
szFolderBuff = Split(szCheckFolder, "/", 20)
nFolderLayer = UBound(szFolderBuff)
If nFolderLayer < 1 Then
CreateFolder = False
Else
CreateFolder = True

attFolder.nLength = Len(attFolder)
attFolder.lpSecurityDescriptor = &O0
attFolder.bInheritHandle = False

szFolderNow = szFolderBuff(0)
For i = 1 To UBound(szFolderBuff)
szFolderNow = szFolderNow & "/" & szFolderBuff(i)
szFolder = Dir(szFolderNow, vbDirectory)
If 0 = Len(szFolder) Then
If CreateDirectory(szFolderNow, attFolder) = 0 Then
Call WriteToLog("Main->CreateFolder", "[Failure] create: " & szFolderNow, 4)
CreateFolder = False
End If
End If
Next i
End If

Exit Function
ErrHandle:
CreateFolder = False
Call WriteToLog("Public->CreateFolder", " [Exception] create: " & szCheckFolder & " ErrNo: " & Err.Number & " Description: " & Err.Description, 4)
End Function