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] Base64 Image Encoder 0.2

  • 0 Respuestas
  • 1328 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil
« en: Septiembre 17, 2016, 06:15:09 pm »
Un programa en Delphi para codificar cualquier imagen a Base64 para usar en HTML , se puede copiar el codigo en el portapapeles o guardar en un archivo desde el programa mismo.

Una imagen :



El codigo :

Código: Delphi
  1. // Base64 Image Encoder 0.2
  2. // (C) Doddy Hackman 2016
  3.  
  4. unit encoder;
  5.  
  6. interface
  7.  
  8. uses
  9.   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  10.   System.Classes, Vcl.Graphics,
  11.   Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
  12.   Vcl.Menus, Vcl.Controls, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
  13.   Vcl.Styles.Utils.SysStyleHook,
  14.   Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
  15.   Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips, IdCoderMIME, ShellApi,
  16.   Vcl.ImgList, Vcl.ExtCtrls, Vcl.Imaging.pngimage;
  17.  
  18. type
  19.   TFormHome = class(TForm)
  20.     gbEnterFilename: TGroupBox;
  21.     txtFilename: TEdit;
  22.     btnLoad: TButton;
  23.     gbOutput: TGroupBox;
  24.     mmOutput: TMemo;
  25.     btnEncode: TButton;
  26.     pmOptions: TPopupMenu;
  27.     copy: TMenuItem;
  28.     save: TMenuItem;
  29.     odLoad: TOpenDialog;
  30.     clear: TMenuItem;
  31.     sdSave: TSaveDialog;
  32.     ilIconos: TImageList;
  33.     imgLogo: TImage;
  34.     procedure btnEncodeClick(Sender: TObject);
  35.     procedure btnLoadClick(Sender: TObject);
  36.     procedure FormCreate(Sender: TObject);
  37.     procedure clearClick(Sender: TObject);
  38.     procedure copyClick(Sender: TObject);
  39.     procedure saveClick(Sender: TObject);
  40.   private
  41.     procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
  42.   public
  43.     { Public declarations }
  44.   end;
  45.  
  46. var
  47.   FormHome: TFormHome;
  48.  
  49. implementation
  50.  
  51. {$R *.dfm}
  52. // Functions
  53.  
  54. function message_box(title, message_text, type_message: string): string;
  55. begin
  56.   if not(title = '') and not(message_text = '') and not(type_message = '') then
  57.   begin
  58.     try
  59.       begin
  60.         if (type_message = 'Information') then
  61.         begin
  62.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
  63.             MB_ICONINFORMATION);
  64.         end
  65.         else if (type_message = 'Warning') then
  66.         begin
  67.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
  68.             MB_ICONWARNING);
  69.         end
  70.         else if (type_message = 'Question') then
  71.         begin
  72.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
  73.             MB_ICONQUESTION);
  74.         end
  75.         else if (type_message = 'Error') then
  76.         begin
  77.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
  78.             MB_ICONERROR);
  79.         end
  80.         else
  81.         begin
  82.           MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
  83.             MB_ICONINFORMATION);
  84.         end;
  85.         Result := '[+] MessageBox : OK';
  86.       end;
  87.     except
  88.       begin
  89.         Result := '[-] Error';
  90.       end;
  91.     end;
  92.   end
  93.   else
  94.   begin
  95.     Result := '[-] Error';
  96.   end;
  97. end;
  98.  
  99. // Function to DragDrop
  100.  
  101. // Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
  102. // Thanks to ecfisa
  103.  
  104. var
  105.   bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;
  106.  
  107. procedure TFormHome.DragDropFile(var Msg: TMessage);
  108. var
  109.   nombre_archivo, extension: string;
  110.   limite, number: integer;
  111.   path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
  112. begin
  113.   limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
  114.   if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
  115.     for number := 0 to limite do
  116.     begin
  117.       bypass_window(number, 1);
  118.     end;
  119.   for number := 0 to limite do
  120.   begin
  121.     DragQueryFile(Msg.WParam, number, path, 255);
  122.  
  123.     //
  124.  
  125.     if (FileExists(path)) then
  126.     begin
  127.       nombre_archivo := ExtractFilename(path);
  128.       extension := ExtractFileExt(path);
  129.       extension := StringReplace(extension, '.', '',
  130.         [rfReplaceAll, rfIgnoreCase]);
  131.       if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
  132.       begin
  133.         txtFilename.Text := path;
  134.         message_box('Base64 Image Encoder 0.2', 'Image loaded', 'Information');
  135.       end
  136.       else
  137.       begin
  138.         message_box('Base64 Image Encoder 0.2', 'The image is not valid',
  139.           'Warning');
  140.       end;
  141.     end;
  142.  
  143.     //
  144.  
  145.   end;
  146.   DragFinish(Msg.WParam);
  147. end;
  148.  
  149. function base64_encodefile(filename: String): String;
  150. var
  151.   stream: TFileStream;
  152.   base64: TIdEncoderMIME;
  153.   output: string;
  154. begin
  155.   if (FileExists(filename)) then
  156.   begin
  157.     try
  158.       begin
  159.         base64 := TIdEncoderMIME.Create(nil);
  160.         stream := TFileStream.Create(filename, fmOpenRead);
  161.         output := TIdEncoderMIME.EncodeStream(stream);
  162.         stream.Free;
  163.         base64.Free;
  164.         if not(output = '') then
  165.         begin
  166.           Result := output;
  167.         end
  168.         else
  169.         begin
  170.           Result := 'Error';
  171.         end;
  172.       end;
  173.     except
  174.       begin
  175.         Result := 'Error';
  176.       end;
  177.     end;
  178.   end
  179.   else
  180.   begin
  181.     Result := 'Error';
  182.   end;
  183. end;
  184.  
  185. function savefile(archivo, texto: string): BOOL;
  186. var
  187.   open_file: TextFile;
  188. begin
  189.   try
  190.     begin
  191.       AssignFile(open_file, archivo);
  192.       FileMode := fmOpenWrite;
  193.  
  194.       if FileExists(archivo) then
  195.       begin
  196.         Append(open_file);
  197.       end
  198.       else
  199.       begin
  200.         Rewrite(open_file);
  201.       end;
  202.       Write(open_file, texto);
  203.       CloseFile(open_file);
  204.       Result := True;
  205.     end;
  206.   except
  207.     Result := False;
  208.   end;
  209. end;
  210.  
  211. //
  212.  
  213. procedure TFormHome.btnEncodeClick(Sender: TObject);
  214. var
  215.   archivo: string;
  216.   nombre_archivo: string;
  217.   extension: string;
  218.   img_encoded: string;
  219.   html_generate: string;
  220. begin
  221.  
  222.   archivo := txtFilename.Text;
  223.   if (FileExists(archivo)) then
  224.   begin
  225.     nombre_archivo := ExtractFilename(archivo);
  226.     extension := ExtractFileExt(archivo);
  227.     extension := StringReplace(extension, '.', '',
  228.       [rfReplaceAll, rfIgnoreCase]);
  229.     nombre_archivo := StringReplace(nombre_archivo, '.' + extension, '',
  230.       [rfReplaceAll, rfIgnoreCase]);
  231.     nombre_archivo := StringReplace(nombre_archivo, ' ', '',
  232.       [rfReplaceAll, rfIgnoreCase]);
  233.     if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
  234.     begin
  235.       try
  236.         begin
  237.           img_encoded := base64_encodefile(archivo);
  238.           if not(img_encoded = '') then
  239.           begin
  240.             html_generate := '<img title="' + nombre_archivo +
  241.               '" src="data:image/' + extension + ';base64,' +
  242.               img_encoded + '" />';
  243.  
  244.             mmOutput.Lines.Add(html_generate);
  245.             mmOutput.Lines.Add(sLineBreak);
  246.  
  247.             message_box('Base64 Image Encoder 0.2', 'Done', 'Information');
  248.           end
  249.           else
  250.           begin
  251.             message_box('Base64 Image Encoder 0.2',
  252.               'An error has occurred in the program', 'Error');
  253.           end;
  254.         end;
  255.       except
  256.         begin
  257.           message_box('Base64 Image Encoder 0.2',
  258.             'An error has occurred in the program', 'Error');
  259.         end;
  260.       end;
  261.     end
  262.     else
  263.     begin
  264.       message_box('Base64 Image Encoder 0.2',
  265.         'The file extension is not allowed', 'Warning');
  266.     end;
  267.   end
  268.   else
  269.   begin
  270.     message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
  271.   end;
  272. end;
  273.  
  274. procedure TFormHome.btnLoadClick(Sender: TObject);
  275. begin
  276.   if odLoad.Execute then
  277.   begin
  278.     txtFilename.Text := odLoad.filename;
  279.   end;
  280. end;
  281.  
  282. procedure TFormHome.clearClick(Sender: TObject);
  283. begin
  284.   mmOutput.clear;
  285.   message_box('Base64 Image Encoder 0.2', 'Output cleaned', 'Information');
  286. end;
  287.  
  288. procedure TFormHome.copyClick(Sender: TObject);
  289. begin
  290.   mmOutput.SelectAll;
  291.   mmOutput.CopyToClipboard;
  292.   message_box('Base64 Image Encoder 0.2', 'Output copied to the clipboard',
  293.     'Information');
  294. end;
  295.  
  296. procedure TFormHome.FormCreate(Sender: TObject);
  297. begin
  298.  
  299.   //
  300.  
  301.   if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
  302.   begin
  303.     @bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
  304.       'ChangeWindowMessageFilter');
  305.     bypass_window(WM_DROPFILES, 1);
  306.     bypass_window(WM_COPYDATA, 1);
  307.     bypass_window($0049, 1);
  308.   end;
  309.   DragAcceptFiles(Handle, True);
  310.  
  311.   //
  312.  
  313.   UseLatestCommonDialogs := False;
  314.   odLoad.InitialDir := GetCurrentDir;
  315.   odLoad.Filter :=
  316.     'JPG files (*.jpg)|*.JPG|PNG Files (*.png)|*.PNG|BMP File (*.bmp)|*.BMP';
  317. end;
  318.  
  319. procedure TFormHome.saveClick(Sender: TObject);
  320. var
  321.   file_output, output, html: string;
  322. begin
  323.   try
  324.     begin
  325.       sdSave.InitialDir := GetCurrentDir;
  326.       sdSave.Filter := 'HTML file|*.html';
  327.       if sdSave.Execute then
  328.       begin
  329.         output := mmOutput.Text;
  330.         file_output := sdSave.filename;
  331.         if not(file_output = '') then
  332.         begin
  333.           if not(output = '') then
  334.           begin
  335.             output := StringReplace(output, sLineBreak, sLineBreak + '</br>',
  336.               [rfReplaceAll, rfIgnoreCase]);
  337.             html := '<html>' + sLineBreak + '<body>' + output + sLineBreak +
  338.               '</body>' + sLineBreak + '</html>';
  339.             if (FileExists(file_output)) then
  340.             begin
  341.               DeleteFile(file_output);
  342.             end;
  343.             savefile(file_output, html);
  344.             if (FileExists(file_output)) then
  345.             begin
  346.               ShellExecute(0, nil, PChar(file_output), nil, nil, SW_SHOWNORMAL);
  347.             end;
  348.             message_box('Base64 Image Encoder 0.2', 'File created',
  349.               'Information');
  350.           end
  351.           else
  352.           begin
  353.             message_box('Base64 Image Encoder 0.2', 'Output is empty',
  354.               'Warning');
  355.           end;
  356.         end
  357.         else
  358.         begin
  359.           message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
  360.         end;
  361.       end;
  362.     end;
  363.   except
  364.     begin
  365.       message_box('Base64 Image Encoder 0.2',
  366.         'An error has occurred in the program', 'Warning');
  367.     end;
  368.   end;
  369. end;
  370.  
  371. end.
  372.  
  373. // The End ?
  374.  

Si quieren bajar el programa lo pueden hacer de aca :

No tienes permisos para ver links. Registrate o Entra con tu cuenta.

Eso seria todo.
« Última modificación: Septiembre 17, 2016, 06:17:36 pm por Doddy »

 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1984
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

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

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3258
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Project Arsenal X 0.2 (Regalo de navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 2575
Último mensaje Diciembre 28, 2015, 10:27:44 am
por BigBear
[Delphi] Creacion de un Troyano de conexion inversa

Iniciado por BigBear

Respuestas: 4
Vistas: 3336
Último mensaje Mayo 05, 2017, 09:10:55 am
por _inicio_cerrarsesión