原来在测试 VB Code 呀！来两个试试： Option Explicit Sub Main() End End Sub
KAO！ 楼上的判断能力太差了吧！！！
'很久很久不用VB，已经不记得VB代码长什么样子了
Option base 1 #Const DebugVersion = 1 LSet c = b 我也试试
终于有VB的了!!!!我来测试几下!!!!'API生成一个窗体,上面有一个文本框以及一个按钮. '点击按钮可以弹出一个MSGBOX. ' '嗷嗷叫的老马 收集 Option ExplicitPublic Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long Public Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Public 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 Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) Public Type WNDCLASS style As Long lpfnwndproc As Long cbClsextra As Long cbWndExtra2 As Long hInstance As Long hIcon As Long hCursor As Long hbrBackground As Long lpszMenuName As String lpszClassName As String End Type Public Type POINTAPI x As Long y As Long End Type Public Type Msg hwnd As Long message As Long wParam As Long lParam As Long time As Long pt As POINTAPI End TypePublic Const CS_VREDRAW = &H1 Public Const CS_HREDRAW = &H2 Public Const BF_FLAT = &H4000Public Const CW_USEDEFAULT = &H80000000Public Const ES_MULTILINE = &H4&Public Const WS_BORDER = &H800000 Public Const WS_CHILD = &H40000000 Public Const WS_OVERLAPPED = &H0& Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME Public Const WS_SYSMENU = &H80000 Public Const WS_THICKFRAME = &H40000 Public Const WS_MINIMIZEBOX = &H20000 Public Const WS_MAXIMIZEBOX = &H10000 Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)Public Const WS_EX_CLIENTEDGE = &H200&Public Const COLOR_WINDOW = 5Public Const WM_DESTROY = &H2 Public Const WM_LBUTTONDOWN = &H201 Public Const WM_LBUTTONUP = &H202Public Const IDC_ARROW = 32512&Public Const IDI_APPLICATION = 32512&Public Const GWL_WNDPROC = (-4)Public Const SW_SHOWNORMAL = 1Public Const MB_OK = &H0& Public Const MB_ICONEXCLAMATION = &H30& '声明几个我们需要的变量?常量:Public Const gClassName = "MyClassName" Public Const gAppName = "My Window Caption"Public gButOldProc As Long Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As Long '入口函数:'Sub Main()'代码如下:Public Sub Main() Dim wMsg As Msg ''Call procedure to register window classname. If false, then exit. If RegisterWindowClass = False Then Exit Sub
''Create window If CreateWindows Then ''Loop will exit when WM_QUIT is sent to the window. Do While GetMessage(wMsg, 0&, 0&, 0&) Call TranslateMessage(wMsg) Call DispatchMessage(wMsg) Loop End If Call UnregisterClass(gClassName$, App.hInstance) End SubPublic Function RegisterWindowClass() As Boolean Dim wc As WNDCLASS
wc.style = CS_HREDRAW Or CS_VREDRAW wc.lpfnwndproc = GetAddress(AddressOf WndProc) ''Address in memory of default window procedure. wc.hInstance = App.hInstance wc.hIcon = LoadIcon(0&, IDI_APPLICATION) ''Default application icon wc.hCursor = LoadCursor(0&, IDC_ARROW) ''Default arrow wc.hbrBackground = COLOR_WINDOW ''Default a color for window. wc.lpszClassName = gClassName$ RegisterWindowClass = RegisterClass(wc) <> 0
End Function Public Function CreateWindows() As Boolean
End Function'窗体运行的主函数，在注册这个窗体时已经指定的 Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim strTemp As String'处理消息，这里指处理了WM_DESTROY消息 Select Case uMsg& Case WM_DESTROY: ''Since DefWindowProc doesn't automatically call ''PostQuitMessage (WM_QUIT). We need to do it ourselves. ''You can use DestroyWindow to get rid of the window manually. Call PostQuitMessage(0&) End Select ''Let windows call the default window procedure since we're done. WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)End Function'又添加了一个Button的处理过程Public Function ButtonWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg& Case WM_LBUTTONUP: Call MessageBox(gHwnd&, "You clicked the button!", App.Title, MB_OK Or MB_ICONEXCLAMATION) End Select
End FunctionPublic Function GetAddress(ByVal lngAddr As Long) As Long GetAddress = lngAddr& End Function
'调用WScript.Shell生成快捷方式 ' '嗷嗷叫的老马 收集 ' Option ExplicitPublic Function CreateLnkFile(ByVal FilePath As String, Optional ByVal LnkFileTitle As String, Optional ByVal ToPath As String, Optional ByVal IconIndex As Integer) As Integer 'FilePath 是要创建快捷方式的文件，全路径！ 'LnkFileTitle 快捷方式文件的名字，如果忽略就是原本文件的名称 'ToPath 目标路径，要创建快捷方式的路径（不带文件名）,如果忽略就用桌面的路径 'IconIndex 要创建方式文件的图标索引值，如果忽略就为0(0为文件本身的图标)，如果超过文件本身的图标索引值，就为0 '如果要为文件夹创建快捷方式，就要在FilePath加上一个"\" 例如：如果要创建C盘根目录就不应该用C: 而是用C:\ Dim intDoIt As Integer, WSHShell As Object, MyShortcut As Object, DesktopPath As String Dim FileName As String Dim FileDir As String
On Error Resume Next
Set WSHShell = CreateObject("WScript.Shell") FileName = Dir(FilePath) If FileName = "" And Right(FilePath, 1) <> "\" Then CreateLnkFile = 0: Exit Function '如果文件不存在就返回0并退出函数 If LnkFileTitle = "" Then LnkFileTitle = FileName '如果没有指定快捷方式的名字就用原来的文件名 If ToPath = "" Then '如果没有指定目标的路径 ToPath = WSHShell.SpecialFolders("Desktop") '就用桌面为目标的路径 End If If Right(ToPath, 1) <> "\" Then ToPath = ToPath & "\" FileDir = Left(FilePath, InStrRev(FilePath, "\", , vbTextCompare) - 1) Set MyShortcut = WSHShell.CreateShortcut(ToPath & LnkFileTitle & ".lnk") MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(FilePath) MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(FileDir) MyShortcut.WindowStyle = 4 MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings(FilePath & " , " & IconIndex) MyShortcut.Save CreateLnkFile = 1 '成功返回 If Err Then CreateLnkFile = 0 End If End Function
'************************************************************************* '**模 块 名：GetSystemTypeMod '**说 明：判断操作系统类型 '**创 建 人：嗷嗷叫的老马 '**日 期：2003年10月27日 '**版 本：V1.0 '************************************************************************* Option ExplicitPublic Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 End TypePublic Declare Function GetVersionEx Lib "kernel32" Alias _ "GetVersionExA" (lpVersionInformation As _ OSVERSIONINFO) As BooleanPublic Const VER_PLATFORM_WIN32s = 0 Public Const VER_PLATFORM_WIN32_WINDOWS = 1 Public Const VER_PLATFORM_WIN32_NT = 2Public Function GetSystemType() As Long Dim Ver As OSVERSIONINFO
If Ver.dwPlatformId = 0 Then '是WIN32 GetSystemType = 0 ElseIf Ver.dwPlatformId = 1 Then 'Win95或Win98" GetSystemType = 1 ElseIf Ver.dwPlatformId = 2 Then 'NT内核系统(2000/XP等) GetSystemType = 2 Else '无法取得,出错...... GetSystemType = -1 End If End Function
再来个自杀的.....嘿嘿'************************************************************************* '**模 块 名：KillMeBas '**说 明：自杀模块(使用BAT文件法) '**创 建 人：嗷嗷叫的老马 '**日 期：2003年11月17日 '**描 述：千万不要在IDE里调用本函数,不然会删除VB6.EXE '**版 本：V1.0 '************************************************************************* Option ExplicitPublic Sub KillMe() Dim mPath As String
If Right$(App.Path, 1) = "\" Then mPath = App.Path Else mPath = App.Path & "\" End If
Open mPath & "Demon.bat" For Output As #1 Print #1, ":Repeat" & vbCrLf & _ "del """ & mPath & App.EXEName & ".exe""" & vbCrLf & _ "if exist """ & mPath & App.EXEName & ".exe""" & " goto Repeat" & vbCrLf & _ "del %0" Close #1 Shell mPath & "Demon.bat", vbHide End Sub
老马，问一下 del 0%，这是什么意思？是不是删除*.bat文件本身？
Option ExplicitPrivate Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As LongSub Main() Do Call MessageBox(0, vbNullString, vbNullString, 64) Loop End Sub
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Longprivate sub test() if 回复>3 then msgbox "拒绝灌水" else msgbox "测试代码" end if end sub
本帖最后由 daisy8675 于 2008-05-29 21:51:40 编辑
哈哈~~~看谁还来灌!!再灌就关XHW~~~
private sub test() if 老马出现次数>3 then 关老马XHW end sub
Private Sub Test() If 板猪给我的分 < 10 ^ 5 Then Call 老马自杀程序 End Sub
只要你把工具稍微修改一下，如遇到用户名为"Sandrer"的，就多给10倍分，好不好？
原来在测试 VB Code 呀！来两个试试：
Option Explicit
Sub Main()
End
End Sub
楼上的判断能力太差了吧！！！
'很久很久不用VB，已经不记得VB代码长什么样子了
#Const DebugVersion = 1
LSet c = b
我也试试
'点击按钮可以弹出一个MSGBOX.
'
'嗷嗷叫的老马 收集
Option ExplicitPublic Declare Function RegisterClass Lib "user32" Alias "RegisterClassA" (Class As WNDCLASS) As Long
Public Declare Function UnregisterClass Lib "user32" Alias "UnregisterClassA" (ByVal lpClassName As String, ByVal hInstance As Long) As Long
Public Declare Function DefWindowProc Lib "user32" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As Msg, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
Public Declare Function TranslateMessage Lib "user32" (lpMsg As Msg) As Long
Public Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As Msg) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Any) As Long
Public Declare Function LoadIcon Lib "user32" Alias "LoadIconA" (ByVal hInstance As Long, ByVal lpIconName As String) As Long
Public Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Public 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
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long)
Public Type WNDCLASS
style As Long
lpfnwndproc As Long
cbClsextra As Long
cbWndExtra2 As Long
hInstance As Long
hIcon As Long
hCursor As Long
hbrBackground As Long
lpszMenuName As String
lpszClassName As String
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Type Msg
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End TypePublic Const CS_VREDRAW = &H1
Public Const CS_HREDRAW = &H2
Public Const BF_FLAT = &H4000Public Const CW_USEDEFAULT = &H80000000Public Const ES_MULTILINE = &H4&Public Const WS_BORDER = &H800000
Public Const WS_CHILD = &H40000000
Public Const WS_OVERLAPPED = &H0&
Public Const WS_CAPTION = &HC00000 ' WS_BORDER Or WS_DLGFRAME
Public Const WS_SYSMENU = &H80000
Public Const WS_THICKFRAME = &H40000
Public Const WS_MINIMIZEBOX = &H20000
Public Const WS_MAXIMIZEBOX = &H10000
Public Const WS_OVERLAPPEDWINDOW = (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)Public Const WS_EX_CLIENTEDGE = &H200&Public Const COLOR_WINDOW = 5Public Const WM_DESTROY = &H2
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202Public Const IDC_ARROW = 32512&Public Const IDI_APPLICATION = 32512&Public Const GWL_WNDPROC = (-4)Public Const SW_SHOWNORMAL = 1Public Const MB_OK = &H0&
Public Const MB_ICONEXCLAMATION = &H30&
'声明几个我们需要的变量?常量:Public Const gClassName = "MyClassName"
Public Const gAppName = "My Window Caption"Public gButOldProc As Long
Public gHwnd As Long, gButtonHwnd As Long, gEditHwnd As Long '入口函数:'Sub Main()'代码如下:Public Sub Main() Dim wMsg As Msg ''Call procedure to register window classname. If false, then exit.
If RegisterWindowClass = False Then Exit Sub
''Create window
If CreateWindows Then
''Loop will exit when WM_QUIT is sent to the window.
Do While GetMessage(wMsg, 0&, 0&, 0&)
Call TranslateMessage(wMsg)
Call DispatchMessage(wMsg)
Loop
End If Call UnregisterClass(gClassName$, App.hInstance)
End SubPublic Function RegisterWindowClass() As Boolean Dim wc As WNDCLASS
wc.style = CS_HREDRAW Or CS_VREDRAW
wc.lpfnwndproc = GetAddress(AddressOf WndProc) ''Address in memory of default window procedure.
wc.hInstance = App.hInstance
wc.hIcon = LoadIcon(0&, IDI_APPLICATION) ''Default application icon
wc.hCursor = LoadCursor(0&, IDC_ARROW) ''Default arrow
wc.hbrBackground = COLOR_WINDOW ''Default a color for window.
wc.lpszClassName = gClassName$ RegisterWindowClass = RegisterClass(wc) <> 0
End Function
Public Function CreateWindows() As Boolean
''开始创建窗体'主窗体.
gHwnd& = CreateWindowEx(0&, gClassName$, gAppName$, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, 208, 150, 0&, 0&, App.hInstance, ByVal 0&)
''创建一个按钮
gButtonHwnd& = CreateWindowEx(0&, "Button", "Click Here", WS_CHILD Or BF_FLAT, 58, 90, 85, 25, gHwnd&, 0&, App.hInstance, 0&)
''创建一个(WS_EX_CLIENTEDGE、ES_MULTILINE风格的TextBox
gEditHwnd& = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "This is the edit control." & vbCrLf & "As you can see, it's multiline.", WS_CHILD Or ES_MULTILINE Or BF_FLAT, 0&, 0&, 200, 80, gHwnd&, 0&, App.hInstance, 0&)'"Button ","Edit"系统中已经注册过了所以这里直接用
'创建完别忘了显示出来否则是隐藏的 Call ShowWindow(gHwnd&, SW_SHOWNORMAL)
Call ShowWindow(gButtonHwnd&, SW_SHOWNORMAL)
Call ShowWindow(gEditHwnd&, SW_SHOWNORMAL)'记下按钮处理过错的当前所在地址gButOldProc& = GetWindowLong(gButtonHwnd&, GWL_WNDPROC)'指向新的处理过程地址
Call SetWindowLong(gButtonHwnd&, GWL_WNDPROC, GetAddress(AddressOf ButtonWndProc)) CreateWindows = (gHwnd& <> 0)
End Function'窗体运行的主函数，在注册这个窗体时已经指定的
Public Function WndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Dim strTemp As String'处理消息，这里指处理了WM_DESTROY消息 Select Case uMsg&
Case WM_DESTROY:
''Since DefWindowProc doesn't automatically call
''PostQuitMessage (WM_QUIT). We need to do it ourselves.
''You can use DestroyWindow to get rid of the window manually.
Call PostQuitMessage(0&)
End Select
''Let windows call the default window procedure since we're done.
WndProc = DefWindowProc(hwnd&, uMsg&, wParam&, lParam&)End Function'又添加了一个Button的处理过程Public Function ButtonWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Select Case uMsg&
Case WM_LBUTTONUP:
Call MessageBox(gHwnd&, "You clicked the button!", App.Title, MB_OK Or MB_ICONEXCLAMATION)
End Select
ButtonWndProc = CallWindowProc(gButOldProc&, hwnd&, uMsg&, wParam&, lParam&)
End FunctionPublic Function GetAddress(ByVal lngAddr As Long) As Long
GetAddress = lngAddr&
End Function
'
'嗷嗷叫的老马 收集
'
Option ExplicitPublic Function CreateLnkFile(ByVal FilePath As String, Optional ByVal LnkFileTitle As String, Optional ByVal ToPath As String, Optional ByVal IconIndex As Integer) As Integer
'FilePath 是要创建快捷方式的文件，全路径！
'LnkFileTitle 快捷方式文件的名字，如果忽略就是原本文件的名称
'ToPath 目标路径，要创建快捷方式的路径（不带文件名）,如果忽略就用桌面的路径
'IconIndex 要创建方式文件的图标索引值，如果忽略就为0(0为文件本身的图标)，如果超过文件本身的图标索引值，就为0
'如果要为文件夹创建快捷方式，就要在FilePath加上一个"\" 例如：如果要创建C盘根目录就不应该用C: 而是用C:\
Dim intDoIt As Integer, WSHShell As Object, MyShortcut As Object, DesktopPath As String
Dim FileName As String
Dim FileDir As String
On Error Resume Next
Set WSHShell = CreateObject("WScript.Shell")
FileName = Dir(FilePath)
If FileName = "" And Right(FilePath, 1) <> "\" Then CreateLnkFile = 0: Exit Function
'如果文件不存在就返回0并退出函数
If LnkFileTitle = "" Then LnkFileTitle = FileName
'如果没有指定快捷方式的名字就用原来的文件名
If ToPath = "" Then
'如果没有指定目标的路径
ToPath = WSHShell.SpecialFolders("Desktop")
'就用桌面为目标的路径
End If
If Right(ToPath, 1) <> "\" Then ToPath = ToPath & "\"
FileDir = Left(FilePath, InStrRev(FilePath, "\", , vbTextCompare) - 1)
Set MyShortcut = WSHShell.CreateShortcut(ToPath & LnkFileTitle & ".lnk")
MyShortcut.TargetPath = WSHShell.ExpandEnvironmentStrings(FilePath)
MyShortcut.WorkingDirectory = WSHShell.ExpandEnvironmentStrings(FileDir)
MyShortcut.WindowStyle = 4
MyShortcut.IconLocation = WSHShell.ExpandEnvironmentStrings(FilePath & " , " & IconIndex)
MyShortcut.Save
CreateLnkFile = 1
'成功返回
If Err Then
CreateLnkFile = 0
End If
End Function
'**模 块 名：GetSystemTypeMod
'**说 明：判断操作系统类型
'**创 建 人：嗷嗷叫的老马
'**日 期：2003年10月27日
'**版 本：V1.0
'*************************************************************************
Option ExplicitPublic Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End TypePublic Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As _
OSVERSIONINFO) As BooleanPublic Const VER_PLATFORM_WIN32s = 0
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
Public Const VER_PLATFORM_WIN32_NT = 2Public Function GetSystemType() As Long
Dim Ver As OSVERSIONINFO
Ver.dwOSVersionInfoSize = Len(Ver)
Call GetVersionEx(Ver)
If Ver.dwPlatformId = 0 Then
'是WIN32
GetSystemType = 0
ElseIf Ver.dwPlatformId = 1 Then
'Win95或Win98"
GetSystemType = 1
ElseIf Ver.dwPlatformId = 2 Then
'NT内核系统(2000/XP等)
GetSystemType = 2
Else
'无法取得,出错......
GetSystemType = -1
End If
End Function
'**模 块 名：KillMeBas
'**说 明：自杀模块(使用BAT文件法)
'**创 建 人：嗷嗷叫的老马
'**日 期：2003年11月17日
'**描 述：千万不要在IDE里调用本函数,不然会删除VB6.EXE
'**版 本：V1.0
'*************************************************************************
Option ExplicitPublic Sub KillMe()
Dim mPath As String
If Right$(App.Path, 1) = "\" Then
mPath = App.Path
Else
mPath = App.Path & "\"
End If
Open mPath & "Demon.bat" For Output As #1
Print #1, ":Repeat" & vbCrLf & _
"del """ & mPath & App.EXEName & ".exe""" & vbCrLf & _
"if exist """ & mPath & App.EXEName & ".exe""" & " goto Repeat" & vbCrLf & _
"del %0"
Close #1
Shell mPath & "Demon.bat", vbHide
End Sub
del 0%，这是什么意思？是不是删除*.bat文件本身？
Option ExplicitPrivate Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As LongSub Main()
Do
Call MessageBox(0, vbNullString, vbNullString, 64)
Loop
End Sub
Private Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Longprivate sub test()
if 回复>3 then
msgbox "拒绝灌水"
else
msgbox "测试代码"
end if
end sub
if 老马出现次数>3 then 关老马XHW
end sub
Private Sub Test()
If 板猪给我的分 < 10 ^ 5 Then Call 老马自杀程序
End Sub
MessageBox这个声明很多余！
今天装了个VB6想写两句，简直无从下手。我不得不感叹VS08的IDE已经强大到变态了。