[Delphi] Unit DH Tools 0.2

// 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 ?

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.