unit ToolEscaner;

interface
uses
 ExtCtrls,Urlmon,SysUtils,windows;

 {
   Autor:Crack81
   para: Indetectables.net

    Agradecimientos a club delphi por la funcion  CreateHBITMAPFromFile para cargar
    imagenes dentro de un timage

 }


procedure URLToImage(Image: TImage; URL: String); //carga una url en un timage
function urlFromHmtl(const html:string):string;//regresa una url desde el html
function htmlToPng_Html(const html:string):String;
implementation

//obtiene codigo html y busca la url que contiene la imagen del scaner
function htmlToPng_Html(const html:string):String;
var
cad1,cad2:string;
inicio:Integer;
I: Integer;
begin
 cad1:=html;

 inicio:=pos('img src= ',cad1);
 inicio:=inicio+length('img src= ')+1;

 for I :=inicio to length(cad1) do
 begin
   if cad1[i]=char(39) then
     break;

   cad2:=cad2+cad1[i];
 end;

 result:=cad2;
end;

//obtenemos el codigo html de la pagian a redericcionar
function urlFromHmtl(const html: string): string;
var
new:string;
posicion,i,start:integer;
const
 buscar='window.location = ';
begin
   posicion:=Pos(buscar,html);
   start:=posicion+length(buscar)+1;

   new:='';
   for I :=start to length(html) do
   begin
     if html[i]='"' then
        break;

     new:=new+html[i];
   end;

  result:=new;
end;



//estas funciones son necesaria para usar el gdi que sera
//utilizado para cargar imagenes de formato png, jpg, bmp etc;
function GdiplusStartup(var GdiToken: DWORD; Startup, Output: PBYTE): DWORD; stdcall external 'gdiplus';
function GdipCreateBitmapFromFile(lpFileName: PWCHAR; var GBitmap: THANDLE): DWORD; stdcall external 'gdiplus';
function GdipCreateHBITMAPFromBitmap(GBitmap: THANDLE; var hBitmap: HBITMAP; BKColor: DWORD): DWORD; stdcall external 'gdiplus';
procedure GdiplusShutdown(GdiToken: DWORD); stdcall external 'gdiplus';

//funcin pricipal para cargar las imagens dentro de un timage
function CreateHBITMAPFromFile(cFileName: string): HBITMAP;
var
  FileName: array of WCHAR;
  size: integer;
  gdiplusToken: DWORD;
  GdiPlusStartupInput: array[0..2] of int64;
  GBitmap: THANDLE;

begin
  Result:= 0;
  //la parte comentada abajo se omitio de la funcion porque en versiones recientes
  //de delphi no es necesaria la conversion a unicode ya que ya lo posee por defecto
  //si se utilizaa delphi menor a 2009 añada la parte de codigo de abajo

  // Pasamos a Unicode
  {SetLength(FileName, lstrlen(pchar(cFileName))+1);
  size:= lstrlen(pchar(cFileName))*sizeof(WCHAR)+1;
  MultiByteToWideChar(CP_ACP, 0, cFileName, -1, @FileName[0], size);
   }
  // Inicializamos GDI+.
  GdiPlusStartupInput[0]:= 1; GdiPlusStartupInput[1]:= 0;
  if GdiplusStartup(gdiplusToken, @GdiPlusStartupInput, nil) = 0 then
  begin
    GdipCreateBitmapFromFile(pchar(cFileName), GBitmap);
    GdipCreateHBITMAPFromBitmap(GBitmap, Result, 0);

    // Cerramos GDI+
    GdiplusShutdown(gdiplusToken);
  end;
end;


procedure URLToImage(Image: TImage; URL: String);
const
MAX_PATH=260;
var
  Buff: array[0..MAX_PATH] of Char;
begin
  URLDownloadToCacheFile(nil, PChar(URL), Buff, SizeOf(Buff),0,nil);
  //Image.Picture.LoadFromFile(Buff); si se intenta cargar de esta forma dara error
  Image.Picture.Bitmap.Handle:=CreateHBITMAPFromFile(Buff);
 DeleteFile(Buff);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP, jpeg, pngimage, IWProgressIndicator;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Image1: TImage;
    Button3: TButton;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    ruta:string;//ruta del fichero escogido
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses
IdMultipartFormData,toolEscaner,unit2;




procedure TForm1.Button1Click(Sender: TObject);
var
  sResponse: string;
  MPData: TIdMultiPartFormDataStream;
  Furl,htmlImagen,linkImagen:string;
  Stream: TMemoryStream;
begin


  if not FileExists(ruta) then
  begin
    showmessage('El archivo no existe ');
    Exit;
  end;

  Button3.Enabled:=false;
  MPData := TIdMultiPartFormDataStream.Create;
  try
     MPData.AddFile('uploadedfile',ruta,'multipart/form-data');
     MPData.AddFormField('upload_file','upload_file');

     IdHTTP1.Request.UserAgent:='Mozilla/5.0 (Windows NT 6.1; WOW64; rv:12.0) Gecko/20100101 Firefox/12.0';
     try
       ShowMessage('Escaneando fichero espere un momento ');
       sResponse := IdHTTP1.Post('http://refud.me/scan.php',mpdata);

       except
       on E:Exception do
       begin
         Showmessage('Error al escanear el fichero ');
         Exit;
       end;
     end;
  finally
     MPData.Free;
  end;

   try

      Furl:=urlFromHmtl(sResponse);
      htmlImagen:=IdHTTP1.Get(Furl);
      linkImagen:=htmlToPng_Html(htmlImagen);
      URLToImage(Form2.Image1,linkImagen);  //cargar la imagen en el timage del
      //segundo form

     except
     on E:Exception do
     begin
       Showmessage('Error al cargar la imagen ');
       Exit;
     end;

   end;
    Showmessage('Operacion realizada con exito');
    Button3.Enabled:=true;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
     ruta:=OpenDialog1.FileName;
     Edit1.Text:=ruta;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Form2.ShowModal;
end;

end.

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;

type
  TForm2 = class(TForm)
    ScrollBox1: TScrollBox;
    Image1: TImage;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

end.