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 :
// 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 :
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.