comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

[Delphi] Unit DH Tools 0.2

  • 0 Respuestas
  • 1581 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Mayo 14, 2016, 01:45:08 pm »
Hola les traigo una Unit en Delphi , se llama DH_Tools y tiene las siguientes funciones :

  • Realizar una peticion GET a una pagina y capturar la respuesta
  • Realizar una peticion POST a una pagina y capturar la respuesta
  • Crear o escribir en un archivo
  • Leer un archivo
  • Ejecutar comandos y recibir la respuesta
  • HTTP FingerPrinting
  • Recibir el codigo de respuesta HTTP de una pagina
  • Limpiar repetidos en un array
  • Limpiar URL en un array a partir de la "query"
  • Split casero xD
  • Descargar archivos de internet
  • Capturar el nombre del archivo de una URL
  • URI Split
  • MD5 Encode
  • Capturar el MD5 de un archivo
  • Resolve IP


El codigo :

Código: Delphi
  1. // Unit : DH Tools
  2. // Version : 0.2
  3. // (C) Doddy Hackman 2015
  4.  
  5. unit DH_Tools;
  6.  
  7. interface
  8.  
  9. uses SysUtils, Windows, WinInet, Classes, IdHTTP, Generics.Collections, URLMon,
  10.   IdURI, IdHashMessageDigest, WinSock;
  11.  
  12. function toma(const pagina: string): UTF8String;
  13. function tomar(pagina: string; postdata: AnsiString): string;
  14. procedure savefile(filename, texto: string);
  15. function read_file(const archivo: TFileName): String;
  16. function console(cmd: string): string;
  17. function http_finger(page: string): string;
  18. function response_code(page: string): string;
  19. function clean_list(const list: TList<String>): TList<String>;
  20. function cut_list(const list: TList<String>): TList<String>;
  21. function regex(text: String; deaca: String; hastaaca: String): String;
  22. function download_file(page, save: string): bool;
  23. function get_url_file(Url: string): string;
  24. function uri_split(Url, opcion: string): string;
  25. function md5_encode(text: string): string;
  26. function md5_file(const filename: string): string;
  27. function resolve_ip(const target: string): string;
  28.  
  29. implementation
  30.  
  31. function toma(const pagina: string): UTF8String;
  32.  
  33. // Credits : Based on http://www.scalabium.com/faq/dct0080.htm
  34. // Thanks to www.scalabium.com
  35.  
  36. var
  37.   nave1: HINTERNET;
  38.   nave2: HINTERNET;
  39.   tou: DWORD;
  40.   codez: UTF8String;
  41.   codee: array [0 .. 1023] of byte;
  42.   finalfinal: string;
  43.  
  44. begin
  45.  
  46.   try
  47.  
  48.     begin
  49.  
  50.       finalfinal := '';
  51.       Result := '';
  52.  
  53.       nave1 := InternetOpen
  54.         ('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0',
  55.         INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  56.  
  57.       nave2 := InternetOpenUrl(nave1, PChar(pagina), nil, 0,
  58.         INTERNET_FLAG_RELOAD, 0);
  59.  
  60.       repeat
  61.  
  62.       begin
  63.         InternetReadFile(nave2, @codee, SizeOf(codee), tou);
  64.         SetString(codez, PAnsiChar(@codee[0]), tou);
  65.         finalfinal := finalfinal + codez;
  66.       end;
  67.  
  68.       until tou = 0;
  69.  
  70.       InternetCloseHandle(nave2);
  71.       InternetCloseHandle(nave1);
  72.  
  73.       Result := finalfinal;
  74.     end;
  75.  
  76.   except
  77.     //
  78.   end;
  79. end;
  80.  
  81. function regex(text: String; deaca: String; hastaaca: String): String;
  82. begin
  83.   Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
  84.   SetLength(text, AnsiPos(hastaaca, text) - 1);
  85.   Result := text;
  86. end;
  87.  
  88. function tomar(pagina: string; postdata: AnsiString): string;
  89.  
  90. // Credits : Based on  : http://tulisanlain.blogspot.com.ar/2012/10/how-to-send-http-post-request-in-delphi.html
  91. // Thanks to Tulisan Lain
  92.  
  93. const
  94.   accept: packed array [0 .. 1] of LPWSTR = (PChar('*/*'), nil);
  95.  
  96. var
  97.   nave3: HINTERNET;
  98.   nave4: HINTERNET;
  99.   nave5: HINTERNET;
  100.   todod: array [0 .. 1023] of AnsiChar;
  101.   numberz: Cardinal;
  102.   numberzzz: Cardinal;
  103.   finalfinalfinalfinal: string;
  104.  
  105. begin
  106.  
  107.   try
  108.  
  109.     begin
  110.  
  111.       finalfinalfinalfinal := '';
  112.       Result := '';
  113.  
  114.       nave3 := InternetOpen
  115.         (PChar('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0'),
  116.         INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  117.  
  118.       nave4 := InternetConnect(nave3, PChar(regex(pagina, '://', '/')),
  119.         INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
  120.  
  121.       nave5 := HttpOpenRequest(nave4, PChar('POST'), PChar(get_url_file(pagina)
  122.         ), nil, nil, @accept, 0, 1);
  123.  
  124.       HttpSendRequest(nave5,
  125.         PChar('Content-Type: application/x-www-form-urlencoded'),
  126.         Length('Content-Type: application/x-www-form-urlencoded'),
  127.         PChar(postdata), Length(postdata));
  128.  
  129.       repeat
  130.  
  131.       begin
  132.  
  133.         InternetReadFile(nave5, @todod, SizeOf(todod), numberzzz);
  134.  
  135.         if numberzzz = SizeOf(todod) then
  136.         begin
  137.           Result := Result + AnsiString(todod);
  138.         end;
  139.         if numberzzz > 0 then
  140.           for numberz := 0 to numberzzz - 1 do
  141.           begin
  142.             finalfinalfinalfinal := finalfinalfinalfinal + todod[numberz];
  143.           end;
  144.  
  145.       end;
  146.  
  147.       until numberzzz = 0;
  148.  
  149.       InternetCloseHandle(nave3);
  150.       InternetCloseHandle(nave4);
  151.       InternetCloseHandle(nave5);
  152.  
  153.       Result := finalfinalfinalfinal;
  154.  
  155.     end;
  156.  
  157.   except
  158.     //
  159.   end;
  160. end;
  161.  
  162. procedure savefile(filename, texto: string);
  163. var
  164.   ar: TextFile;
  165.  
  166. begin
  167.  
  168.   AssignFile(ar, filename);
  169.   FileMode := fmOpenWrite;
  170.  
  171.   if FileExists(filename) then
  172.     Append(ar)
  173.   else
  174.     Rewrite(ar);
  175.  
  176.   Write(ar, texto);
  177.   CloseFile(ar);
  178.  
  179. end;
  180.  
  181. function read_file(const archivo: TFileName): String;
  182. var
  183.   lista: TStringList;
  184. begin
  185.  
  186.   if (FileExists(archivo)) then
  187.   begin
  188.  
  189.     lista := TStringList.Create;
  190.     lista.Loadfromfile(archivo);
  191.     Result := lista.text;
  192.     lista.Free;
  193.  
  194.   end;
  195. end;
  196.  
  197. function console(cmd: string): string;
  198. // Credits : Function ejecutar() based in : http://www.delphidabbler.com/tips/61
  199. // Thanks to www.delphidabbler.com
  200.  
  201. var
  202.   parte1: TSecurityAttributes;
  203.   parte2: TStartupInfo;
  204.   parte3: TProcessInformation;
  205.   parte4: THandle;
  206.   parte5: THandle;
  207.   control2: Boolean;
  208.   contez: array [0 .. 255] of AnsiChar;
  209.   notengoidea: Cardinal;
  210.   fix: Boolean;
  211.   code: string;
  212.  
  213. begin
  214.  
  215.   code := '';
  216.  
  217.   with parte1 do
  218.   begin
  219.     nLength := SizeOf(parte1);
  220.     bInheritHandle := True;
  221.     lpSecurityDescriptor := nil;
  222.   end;
  223.  
  224.   CreatePipe(parte4, parte5, @parte1, 0);
  225.  
  226.   with parte2 do
  227.   begin
  228.     FillChar(parte2, SizeOf(parte2), 0);
  229.     cb := SizeOf(parte2);
  230.     dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
  231.     wShowWindow := SW_HIDE;
  232.     hStdInput := GetStdHandle(STD_INPUT_HANDLE);
  233.     hStdOutput := parte5;
  234.     hStdError := parte5;
  235.   end;
  236.  
  237.   fix := CreateProcess(nil, PChar('cmd.exe /C ' + cmd), nil, nil, True, 0, nil,
  238.     PChar('c:/'), parte2, parte3);
  239.  
  240.   CloseHandle(parte5);
  241.  
  242.   if fix then
  243.  
  244.     repeat
  245.  
  246.     begin
  247.       control2 := ReadFile(parte4, contez, 255, notengoidea, nil);
  248.     end;
  249.  
  250.     if notengoidea > 0 then
  251.     begin
  252.       contez[notengoidea] := #0;
  253.       code := code + contez;
  254.     end;
  255.  
  256.     until not(control2) or (notengoidea = 0);
  257.  
  258.   Result := code;
  259.  
  260. end;
  261.  
  262. function http_finger(page: string): string;
  263. var
  264.   nave: TIdHTTP;
  265.   resultado: string;
  266. begin
  267.  
  268.   nave := TIdHTTP.Create(nil);
  269.   nave.Request.UserAgent :=
  270.     'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
  271.   nave.Get(page);
  272.   resultado := '[+] ' + nave.Response.ResponseText + sLineBreak + '[+] Date : '
  273.     + DateTimeToStr(nave.Response.Date) + sLineBreak + '[+] Server : ' +
  274.     nave.Response.Server + sLineBreak + '[+] Last-Modified : ' +
  275.     DateTimeToStr(nave.Response.LastModified) + sLineBreak + '[+] ETag : ' +
  276.     nave.Response.ETag + sLineBreak + '[+] Accept-Ranges : ' +
  277.     nave.Response.AcceptRanges + sLineBreak + '[+] Content-Length : ' +
  278.     IntToStr(nave.Response.ContentLength) + sLineBreak + '[+] Connection : ' +
  279.     nave.Response.Connection + sLineBreak + '[+] Content-Type : ' +
  280.     nave.Response.ContentType;
  281.   Result := resultado;
  282. end;
  283.  
  284. function response_code(page: string): string;
  285. var
  286.   nave: TIdHTTP;
  287.   code: string;
  288. begin
  289.   nave := TIdHTTP.Create(nil);
  290.   nave.Request.UserAgent :=
  291.     'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
  292.   try
  293.     begin
  294.       nave.Head(page);
  295.       code := IntToStr(nave.ResponseCode);
  296.     end;
  297.   except
  298.     begin
  299.       code := '404';
  300.     end;
  301.   end;
  302.   Result := code;
  303. end;
  304.  
  305. function clean_list(const list: TList<String>): TList<String>;
  306. var
  307.   lista: TList<String>;
  308.   elemento: string;
  309.  
  310. begin
  311.   lista := TList<String>.Create;
  312.   for elemento in list do
  313.   begin
  314.     if not lista.Contains(elemento) then
  315.     begin
  316.       lista.Add(elemento);
  317.     end;
  318.   end;
  319.   Result := lista;
  320. end;
  321.  
  322. function cut_list(const list: TList<String>): TList<String>;
  323. var
  324.   lista: TList<String>;
  325.   elemento: string;
  326.   otralista: TStrings;
  327. begin
  328.   lista := TList<String>.Create;
  329.   for elemento in list do
  330.   begin
  331.     if (Pos('=', elemento) > 0) then
  332.     begin
  333.       otralista := TStringList.Create;
  334.       ExtractStrings(['='], [], PChar(elemento), otralista);
  335.       lista.Add(otralista[0] + '=');
  336.     end;
  337.   end;
  338.   Result := lista;
  339. end;
  340.  
  341. function download_file(page, save: string): bool;
  342. begin
  343.   UrlDownloadToFile(nil, PChar(page), PChar(save), 0, nil);
  344.   if FileExists(save) then
  345.   begin
  346.     Result := True;
  347.   end
  348.   else
  349.   begin
  350.     Result := False;
  351.   end;
  352. end;
  353.  
  354. function get_url_file(Url: string): string;
  355. var
  356.   URI: TIdURI;
  357. begin
  358.   URI := TIdURI.Create(Url);
  359.   Result := URI.Document;
  360. end;
  361.  
  362. function uri_split(Url, opcion: string): string;
  363. var
  364.   URI: TIdURI;
  365. begin
  366.   URI := TIdURI.Create(Url);
  367.   if opcion = 'host' then
  368.   begin
  369.     Result := URI.Host;
  370.   end;
  371.   if opcion = 'port' then
  372.   begin
  373.     Result := URI.Port;
  374.   end;
  375.   if opcion = 'path' then
  376.   begin
  377.     Result := URI.Path;
  378.   end;
  379.   if opcion = 'file' then
  380.   begin
  381.     Result := URI.Document;
  382.   end;
  383.   if opcion = 'query' then
  384.   begin
  385.     Result := URI.Params;
  386.   end;
  387.   if opcion = '' then
  388.   begin
  389.     Result := 'Error';
  390.   end;
  391. end;
  392.  
  393. function md5_encode(text: string): string;
  394. var
  395.   md5: TIdHashMessageDigest5;
  396. begin
  397.   md5 := TIdHashMessageDigest5.Create;
  398.   Result := LowerCase(md5.HashStringAsHex(text));
  399. end;
  400.  
  401. function md5_file(const filename: string): string;
  402. var
  403.   md5: TIdHashMessageDigest5;
  404.   stream: TFileStream;
  405. begin
  406.   if (FileExists(filename)) then
  407.   begin
  408.     md5 := TIdHashMessageDigest5.Create;
  409.     stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
  410.     Result := LowerCase(md5.HashStreamAsHex(stream));
  411.   end
  412.   else
  413.   begin
  414.     Result := 'Error';
  415.   end;
  416. end;
  417.  
  418. function resolve_ip(const target: string): string;
  419. var
  420.   socket: TWSAData;
  421.   uno: PHostEnt;
  422.   dos: TInAddr;
  423.   ip: string;
  424. begin
  425.   try
  426.     begin
  427.       WSAStartup($101, socket);
  428.       uno := WinSock.GetHostByName(PAnsiChar(AnsiString(target)));
  429.       dos := PInAddr(uno^.h_Addr_List^)^;
  430.       ip := WinSock.inet_ntoa(dos);
  431.       if ip = '' then
  432.       begin
  433.         Result := 'Error';
  434.       end
  435.       else
  436.       begin
  437.         Result := ip;
  438.       end;
  439.     end;
  440.   except
  441.     Result := 'Error';
  442.   end;
  443. end;
  444.  
  445. end.
  446.  
  447. // The End ?
  448.  

Ejemplos de uso :

Código: Delphi
  1. unit dh;
  2.  
  3. interface
  4.  
  5. uses
  6.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  7.   System.Classes, Vcl.Graphics,
  8.   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DH_Tools,
  9.   Generics.Collections;
  10.  
  11. type
  12.   TForm1 = class(TForm)
  13.     Memo1: TMemo;
  14.     Button1: TButton;
  15.     procedure Button1Click(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.   public
  19.     { Public declarations }
  20.   end;
  21.  
  22. var
  23.   Form1: TForm1;
  24.  
  25. implementation
  26.  
  27. {$R *.dfm}
  28.  
  29. procedure TForm1.Button1Click(Sender: TObject);
  30. var
  31.   paginas: TList<String>;
  32.   pagina: string;
  33.   lista: TList<String>;
  34.   code: string;
  35. begin
  36.  
  37.   // code := toma('http://localhost/login.php');
  38.   // ShowMessage(code);
  39.  
  40.   // code := tomar('http://localhost/login.php','usuario=test&password=test&control=Login');
  41.   // ShowMessage(code);
  42.  
  43.   // savefile('logs.txt','test');
  44.  
  45.   // code := read_file('logs.txt');
  46.   // ShowMessage(code);
  47.  
  48.   // code := console('ver');
  49.   // ShowMessage(code);
  50.  
  51.   // code := http_finger('http://www.petardas.com');
  52.   // ShowMessage(code);
  53.  
  54.   // code := response_code('http://www.petardas.com');
  55.   // ShowMessage(code);
  56.  
  57.   {
  58.     paginas := TList<String>.Create;
  59.     paginas.AddRange(['test1', 'test1', 'test3', 'test4', 'test5']);
  60.     lista := clean_list(paginas);
  61.  
  62.     for pagina in lista do
  63.     begin
  64.     Memo1.Lines.Add('Value : ' + pagina);
  65.     end;
  66.   }
  67.  
  68.   {
  69.     paginas := TList<String>.Create;
  70.     paginas.AddRange(['http://localhost/sql1.php?id=dsadasad',
  71.     'http://localhost/sql2.php?id=dsadasad',
  72.     'http://localhost/sql3.php?id=dsadasad',
  73.     'http://localhost/sql3.php?id=dsadasad']);
  74.     lista := cut_list(clean_list(paginas));
  75.  
  76.     for pagina in lista do
  77.     begin
  78.     Memo1.Lines.Add('Value : ' + pagina);
  79.     end;
  80.   }
  81.  
  82.   {
  83.     if (download_file('http://localhost/test.rar', 'test.rar')) then
  84.     begin
  85.     ShowMessage('Yeah');
  86.     end
  87.     else
  88.     begin
  89.     ShowMessage('Error');
  90.     end;
  91.   }
  92.  
  93.   // ShowMessage(get_url_file('http://localhost/sql.php?id=dsadsadsa'));
  94.  
  95.   // ShowMessage(uri_split('http://localhost/sql.php?id=dsadsadd','query'));
  96.  
  97.   // ShowMessage(md5_encode('123'));
  98.  
  99.   // ShowMessage(md5_file('c:/xampp/xampp-control.exe'));
  100.  
  101.   // ShowMessage(resolve_ip('www.petardas.com'));
  102.  
  103. end;
  104.  
  105. end.
  106.  

Eso seria todo.
« Última modificación: Mayo 14, 2016, 01:46:41 pm por Doddy »

 

¿Te gustó el post? COMPARTILO!



Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3260
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2050
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3502
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1477
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon
Poner splash screen con progress bar en delphi

Iniciado por ANTRAX

Respuestas: 0
Vistas: 2982
Último mensaje Febrero 24, 2010, 04:54:23 pm
por ANTRAX