[Delphi] Unit DH Tools 0.2

Iniciado por BigBear, 14 Mayo 2016, 18:45 PM

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

BigBear

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) [Seleccionar]

    // Unit : DH Tools
    // Version : 0.2
    // (C) Doddy Hackman 2015

    unit DH_Tools;

    interface

    uses SysUtils, Windows, WinInet, Classes, IdHTTP, Generics.Collections, URLMon,
      IdURI, IdHashMessageDigest, WinSock;

    function toma(const pagina: string): UTF8String;
    function tomar(pagina: string; postdata: AnsiString): string;
    procedure savefile(filename, texto: string);
    function read_file(const archivo: TFileName): String;
    function console(cmd: string): string;
    function http_finger(page: string): string;
    function response_code(page: string): string;
    function clean_list(const list: TList<String>): TList<String>;
    function cut_list(const list: TList<String>): TList<String>;
    function regex(text: String; deaca: String; hastaaca: String): String;
    function download_file(page, save: string): bool;
    function get_url_file(Url: string): string;
    function uri_split(Url, opcion: string): string;
    function md5_encode(text: string): string;
    function md5_file(const filename: string): string;
    function resolve_ip(const target: string): string;

    implementation

    function toma(const pagina: string): UTF8String;

    // Credits : Based on http://www.scalabium.com/faq/dct0080.htm
    // Thanks to www.scalabium.com

    var
      nave1: HINTERNET;
      nave2: HINTERNET;
      tou: DWORD;
      codez: UTF8String;
      codee: array [0 .. 1023] of byte;
      finalfinal: string;

    begin

      try

        begin

          finalfinal := '';
          Result := '';

          nave1 := InternetOpen
            ('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0',
            INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

          nave2 := InternetOpenUrl(nave1, PChar(pagina), nil, 0,
            INTERNET_FLAG_RELOAD, 0);

          repeat

          begin
            InternetReadFile(nave2, @codee, SizeOf(codee), tou);
            SetString(codez, PAnsiChar(@codee[0]), tou);
            finalfinal := finalfinal + codez;
          end;

          until tou = 0;

          InternetCloseHandle(nave2);
          InternetCloseHandle(nave1);

          Result := finalfinal;
        end;

      except
        //
      end;
    end;

    function regex(text: String; deaca: String; hastaaca: String): String;
    begin
      Delete(text, 1, AnsiPos(deaca, text) + Length(deaca) - 1);
      SetLength(text, AnsiPos(hastaaca, text) - 1);
      Result := text;
    end;

    function tomar(pagina: string; postdata: AnsiString): string;

    // Credits : Based on  : http://tulisanlain.blogspot.com.ar/2012/10/how-to-send-http-post-request-in-delphi.html
    // Thanks to Tulisan Lain

    const
      accept: packed array [0 .. 1] of LPWSTR = (PChar('*/*'), nil);

    var
      nave3: HINTERNET;
      nave4: HINTERNET;
      nave5: HINTERNET;
      todod: array [0 .. 1023] of AnsiChar;
      numberz: Cardinal;
      numberzzz: Cardinal;
      finalfinalfinalfinal: string;

    begin

      try

        begin

          finalfinalfinalfinal := '';
          Result := '';

          nave3 := InternetOpen
            (PChar('Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0'),
            INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);

          nave4 := InternetConnect(nave3, PChar(regex(pagina, '://', '/')),
            INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);

          nave5 := HttpOpenRequest(nave4, PChar('POST'), PChar(get_url_file(pagina)
            ), nil, nil, @accept, 0, 1);

          HttpSendRequest(nave5,
            PChar('Content-Type: application/x-www-form-urlencoded'),
            Length('Content-Type: application/x-www-form-urlencoded'),
            PChar(postdata), Length(postdata));

          repeat

          begin

            InternetReadFile(nave5, @todod, SizeOf(todod), numberzzz);

            if numberzzz = SizeOf(todod) then
            begin
              Result := Result + AnsiString(todod);
            end;
            if numberzzz > 0 then
              for numberz := 0 to numberzzz - 1 do
              begin
                finalfinalfinalfinal := finalfinalfinalfinal + todod[numberz];
              end;

          end;

          until numberzzz = 0;

          InternetCloseHandle(nave3);
          InternetCloseHandle(nave4);
          InternetCloseHandle(nave5);

          Result := finalfinalfinalfinal;

        end;

      except
        //
      end;
    end;

    procedure savefile(filename, texto: string);
    var
      ar: TextFile;

    begin

      AssignFile(ar, filename);
      FileMode := fmOpenWrite;

      if FileExists(filename) then
        Append(ar)
      else
        Rewrite(ar);

      Write(ar, texto);
      CloseFile(ar);

    end;

    function read_file(const archivo: TFileName): String;
    var
      lista: TStringList;
    begin

      if (FileExists(archivo)) then
      begin

        lista := TStringList.Create;
        lista.Loadfromfile(archivo);
        Result := lista.text;
        lista.Free;

      end;
    end;

    function console(cmd: string): string;
    // Credits : Function ejecutar() based in : http://www.delphidabbler.com/tips/61
    // Thanks to www.delphidabbler.com

    var
      parte1: TSecurityAttributes;
      parte2: TStartupInfo;
      parte3: TProcessInformation;
      parte4: THandle;
      parte5: THandle;
      control2: Boolean;
      contez: array [0 .. 255] of AnsiChar;
      notengoidea: Cardinal;
      fix: Boolean;
      code: string;

    begin

      code := '';

      with parte1 do
      begin
        nLength := SizeOf(parte1);
        bInheritHandle := True;
        lpSecurityDescriptor := nil;
      end;

      CreatePipe(parte4, parte5, @parte1, 0);

      with parte2 do
      begin
        FillChar(parte2, SizeOf(parte2), 0);
        cb := SizeOf(parte2);
        dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
        wShowWindow := SW_HIDE;
        hStdInput := GetStdHandle(STD_INPUT_HANDLE);
        hStdOutput := parte5;
        hStdError := parte5;
      end;

      fix := CreateProcess(nil, PChar('cmd.exe /C ' + cmd), nil, nil, True, 0, nil,
        PChar('c:/'), parte2, parte3);

      CloseHandle(parte5);

      if fix then

        repeat

        begin
          control2 := ReadFile(parte4, contez, 255, notengoidea, nil);
        end;

        if notengoidea > 0 then
        begin
          contez[notengoidea] := #0;
          code := code + contez;
        end;

        until not(control2) or (notengoidea = 0);

      Result := code;

    end;

    function http_finger(page: string): string;
    var
      nave: TIdHTTP;
      resultado: string;
    begin

      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      nave.Get(page);
      resultado := '[+] ' + nave.Response.ResponseText + sLineBreak + '[+] Date : '
        + DateTimeToStr(nave.Response.Date) + sLineBreak + '[+] Server : ' +
        nave.Response.Server + sLineBreak + '[+] Last-Modified : ' +
        DateTimeToStr(nave.Response.LastModified) + sLineBreak + '[+] ETag : ' +
        nave.Response.ETag + sLineBreak + '[+] Accept-Ranges : ' +
        nave.Response.AcceptRanges + sLineBreak + '[+] Content-Length : ' +
        IntToStr(nave.Response.ContentLength) + sLineBreak + '[+] Connection : ' +
        nave.Response.Connection + sLineBreak + '[+] Content-Type : ' +
        nave.Response.ContentType;
      Result := resultado;
    end;

    function response_code(page: string): string;
    var
      nave: TIdHTTP;
      code: string;
    begin
      nave := TIdHTTP.Create(nil);
      nave.Request.UserAgent :=
        'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:25.0) Gecko/20100101 Firefox/25.0';
      try
        begin
          nave.Head(page);
          code := IntToStr(nave.ResponseCode);
        end;
      except
        begin
          code := '404';
        end;
      end;
      Result := code;
    end;

    function clean_list(const list: TList<String>): TList<String>;
    var
      lista: TList<String>;
      elemento: string;

    begin
      lista := TList<String>.Create;
      for elemento in list do
      begin
        if not lista.Contains(elemento) then
        begin
          lista.Add(elemento);
        end;
      end;
      Result := lista;
    end;

    function cut_list(const list: TList<String>): TList<String>;
    var
      lista: TList<String>;
      elemento: string;
      otralista: TStrings;
    begin
      lista := TList<String>.Create;
      for elemento in list do
      begin
        if (Pos('=', elemento) > 0) then
        begin
          otralista := TStringList.Create;
          ExtractStrings(['='], [], PChar(elemento), otralista);
          lista.Add(otralista[0] + '=');
        end;
      end;
      Result := lista;
    end;

    function download_file(page, save: string): bool;
    begin
      UrlDownloadToFile(nil, PChar(page), PChar(save), 0, nil);
      if FileExists(save) then
      begin
        Result := True;
      end
      else
      begin
        Result := False;
      end;
    end;

    function get_url_file(Url: string): string;
    var
      URI: TIdURI;
    begin
      URI := TIdURI.Create(Url);
      Result := URI.Document;
    end;

    function uri_split(Url, opcion: string): string;
    var
      URI: TIdURI;
    begin
      URI := TIdURI.Create(Url);
      if opcion = 'host' then
      begin
        Result := URI.Host;
      end;
      if opcion = 'port' then
      begin
        Result := URI.Port;
      end;
      if opcion = 'path' then
      begin
        Result := URI.Path;
      end;
      if opcion = 'file' then
      begin
        Result := URI.Document;
      end;
      if opcion = 'query' then
      begin
        Result := URI.Params;
      end;
      if opcion = '' then
      begin
        Result := 'Error';
      end;
    end;

    function md5_encode(text: string): string;
    var
      md5: TIdHashMessageDigest5;
    begin
      md5 := TIdHashMessageDigest5.Create;
      Result := LowerCase(md5.HashStringAsHex(text));
    end;

    function md5_file(const filename: string): string;
    var
      md5: TIdHashMessageDigest5;
      stream: TFileStream;
    begin
      if (FileExists(filename)) then
      begin
        md5 := TIdHashMessageDigest5.Create;
        stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyWrite);
        Result := LowerCase(md5.HashStreamAsHex(stream));
      end
      else
      begin
        Result := 'Error';
      end;
    end;

    function resolve_ip(const target: string): string;
    var
      socket: TWSAData;
      uno: PHostEnt;
      dos: TInAddr;
      ip: string;
    begin
      try
        begin
          WSAStartup($101, socket);
          uno := WinSock.GetHostByName(PAnsiChar(AnsiString(target)));
          dos := PInAddr(uno^.h_Addr_List^)^;
          ip := WinSock.inet_ntoa(dos);
          if ip = '' then
          begin
            Result := 'Error';
          end
          else
          begin
            Result := ip;
          end;
        end;
      except
        Result := 'Error';
      end;
    end;

    end.

    // The End ?


    Ejemplos de uso :

    Código (delphi) [Seleccionar]

    unit dh;

    interface

    uses
      Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
      System.Classes, Vcl.Graphics,
      Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DH_Tools,
      Generics.Collections;

    type
      TForm1 = class(TForm)
        Memo1: TMemo;
        Button1: TButton;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;

    var
      Form1: TForm1;

    implementation

    {$R *.dfm}

    procedure TForm1.Button1Click(Sender: TObject);
    var
      paginas: TList<String>;
      pagina: string;
      lista: TList<String>;
      code: string;
    begin

      // code := toma('http://localhost/login.php');
      // ShowMessage(code);

      // code := tomar('http://localhost/login.php','usuario=test&password=test&control=Login');
      // ShowMessage(code);

      // savefile('logs.txt','test');

      // code := read_file('logs.txt');
      // ShowMessage(code);

      // code := console('ver');
      // ShowMessage(code);

      // code := http_finger('http://www.petardas.com');
      // ShowMessage(code);

      // code := response_code('http://www.petardas.com');
      // ShowMessage(code);

      {
        paginas := TList<String>.Create;
        paginas.AddRange(['test1', 'test1', 'test3', 'test4', 'test5']);
        lista := clean_list(paginas);

        for pagina in lista do
        begin
        Memo1.Lines.Add('Value : ' + pagina);
        end;
      }

      {
        paginas := TList<String>.Create;
        paginas.AddRange(['http://localhost/sql1.php?id=dsadasad',
        'http://localhost/sql2.php?id=dsadasad',
        'http://localhost/sql3.php?id=dsadasad',
        'http://localhost/sql3.php?id=dsadasad']);
        lista := cut_list(clean_list(paginas));

        for pagina in lista do
        begin
        Memo1.Lines.Add('Value : ' + pagina);
        end;
      }

      {
        if (download_file('http://localhost/test.rar', 'test.rar')) then
        begin
        ShowMessage('Yeah');
        end
        else
        begin
        ShowMessage('Error');
        end;
      }

      // ShowMessage(get_url_file('http://localhost/sql.php?id=dsadsadsa'));

      // ShowMessage(uri_split('http://localhost/sql.php?id=dsadsadd','query'));

      // ShowMessage(md5_encode('123'));

      // ShowMessage(md5_file('c:/xampp/xampp-control.exe'));

      // ShowMessage(resolve_ip('www.petardas.com'));

    end;

    end.


    Eso seria todo.