Una imagen :
El codigo :
// Base64 Image Encoder 0.2
// (C) Doddy Hackman 2016
unit encoder;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,
Vcl.Menus, Vcl.Controls, Vcl.Styles.Utils.ComCtrls, Vcl.Styles.Utils.Menus,
Vcl.Styles.Utils.SysStyleHook,
Vcl.Styles.Utils.SysControls, Vcl.Styles.Utils.Forms,
Vcl.Styles.Utils.StdCtrls, Vcl.Styles.Utils.ScreenTips, IdCoderMIME, ShellApi,
Vcl.ImgList, Vcl.ExtCtrls, Vcl.Imaging.pngimage;
type
TFormHome = class(TForm)
gbEnterFilename: TGroupBox;
txtFilename: TEdit;
btnLoad: TButton;
gbOutput: TGroupBox;
mmOutput: TMemo;
btnEncode: TButton;
pmOptions: TPopupMenu;
copy: TMenuItem;
save: TMenuItem;
odLoad: TOpenDialog;
clear: TMenuItem;
sdSave: TSaveDialog;
ilIconos: TImageList;
imgLogo: TImage;
procedure btnEncodeClick(Sender: TObject);
procedure btnLoadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure clearClick(Sender: TObject);
procedure copyClick(Sender: TObject);
procedure saveClick(Sender: TObject);
private
procedure DragDropFile(var Msg: TMessage); message WM_DROPFILES;
public
{ Public declarations }
end;
var
FormHome: TFormHome;
implementation
{$R *.dfm}
// Functions
function message_box(title, message_text, type_message: string): string;
begin
if not(title = '') and not(message_text = '') and not(type_message = '') then
begin
try
begin
if (type_message = 'Information') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONINFORMATION);
end
else if (type_message = 'Warning') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONWARNING);
end
else if (type_message = 'Question') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONQUESTION);
end
else if (type_message = 'Error') then
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONERROR);
end
else
begin
MessageBox(FormHome.Handle, PChar(message_text), PChar(title),
MB_ICONINFORMATION);
end;
Result := '[+] MessageBox : OK';
end;
except
begin
Result := '[-] Error';
end;
end;
end
else
begin
Result := '[-] Error';
end;
end;
// Function to DragDrop
// Based in : http://www.clubdelphi.com/foros/showthread.php?t=85665
// Thanks to ecfisa
var
bypass_window: function(Msg: Cardinal; dwFlag: Word): BOOL; stdcall;
procedure TFormHome.DragDropFile(var Msg: TMessage);
var
nombre_archivo, extension: string;
limite, number: integer;
path: array [0 .. MAX_COMPUTERNAME_LENGTH + MAX_PATH] of char;
begin
limite := DragQueryFile(Msg.WParam, $FFFFFFFF, path, 255) - 1;
if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
for number := 0 to limite do
begin
bypass_window(number, 1);
end;
for number := 0 to limite do
begin
DragQueryFile(Msg.WParam, number, path, 255);
//
if (FileExists(path)) then
begin
nombre_archivo := ExtractFilename(path);
extension := ExtractFileExt(path);
extension := StringReplace(extension, '.', '',
[rfReplaceAll, rfIgnoreCase]);
if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
begin
txtFilename.Text := path;
message_box('Base64 Image Encoder 0.2', 'Image loaded', 'Information');
end
else
begin
message_box('Base64 Image Encoder 0.2', 'The image is not valid',
'Warning');
end;
end;
//
end;
DragFinish(Msg.WParam);
end;
function base64_encodefile(filename: String): String;
var
stream: TFileStream;
base64: TIdEncoderMIME;
output: string;
begin
if (FileExists(filename)) then
begin
try
begin
base64 := TIdEncoderMIME.Create(nil);
stream := TFileStream.Create(filename, fmOpenRead);
output := TIdEncoderMIME.EncodeStream(stream);
stream.Free;
base64.Free;
if not(output = '') then
begin
Result := output;
end
else
begin
Result := 'Error';
end;
end;
except
begin
Result := 'Error';
end;
end;
end
else
begin
Result := 'Error';
end;
end;
function savefile(archivo, texto: string): BOOL;
var
open_file: TextFile;
begin
try
begin
AssignFile(open_file, archivo);
FileMode := fmOpenWrite;
if FileExists(archivo) then
begin
Append(open_file);
end
else
begin
Rewrite(open_file);
end;
Write(open_file, texto);
CloseFile(open_file);
Result := True;
end;
except
Result := False;
end;
end;
//
procedure TFormHome.btnEncodeClick(Sender: TObject);
var
archivo: string;
nombre_archivo: string;
extension: string;
img_encoded: string;
html_generate: string;
begin
archivo := txtFilename.Text;
if (FileExists(archivo)) then
begin
nombre_archivo := ExtractFilename(archivo);
extension := ExtractFileExt(archivo);
extension := StringReplace(extension, '.', '',
[rfReplaceAll, rfIgnoreCase]);
nombre_archivo := StringReplace(nombre_archivo, '.' + extension, '',
[rfReplaceAll, rfIgnoreCase]);
nombre_archivo := StringReplace(nombre_archivo, ' ', '',
[rfReplaceAll, rfIgnoreCase]);
if (extension = 'jpg') or (extension = 'png') or (extension = 'bmp') then
begin
try
begin
img_encoded := base64_encodefile(archivo);
if not(img_encoded = '') then
begin
html_generate := '<img title="' + nombre_archivo +
'" src="data:image/' + extension + ';base64,' +
img_encoded + '" />';
mmOutput.Lines.Add(html_generate);
mmOutput.Lines.Add(sLineBreak);
message_box('Base64 Image Encoder 0.2', 'Done', 'Information');
end
else
begin
message_box('Base64 Image Encoder 0.2',
'An error has occurred in the program', 'Error');
end;
end;
except
begin
message_box('Base64 Image Encoder 0.2',
'An error has occurred in the program', 'Error');
end;
end;
end
else
begin
message_box('Base64 Image Encoder 0.2',
'The file extension is not allowed', 'Warning');
end;
end
else
begin
message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
end;
end;
procedure TFormHome.btnLoadClick(Sender: TObject);
begin
if odLoad.Execute then
begin
txtFilename.Text := odLoad.filename;
end;
end;
procedure TFormHome.clearClick(Sender: TObject);
begin
mmOutput.clear;
message_box('Base64 Image Encoder 0.2', 'Output cleaned', 'Information');
end;
procedure TFormHome.copyClick(Sender: TObject);
begin
mmOutput.SelectAll;
mmOutput.CopyToClipboard;
message_box('Base64 Image Encoder 0.2', 'Output copied to the clipboard',
'Information');
end;
procedure TFormHome.FormCreate(Sender: TObject);
begin
//
if (Win32MajorVersion = 6) and (Win32MinorVersion > 0) then
begin
@bypass_window := GetProcAddress(LoadLibrary('user32.dll'),
'ChangeWindowMessageFilter');
bypass_window(WM_DROPFILES, 1);
bypass_window(WM_COPYDATA, 1);
bypass_window($0049, 1);
end;
DragAcceptFiles(Handle, True);
//
UseLatestCommonDialogs := False;
odLoad.InitialDir := GetCurrentDir;
odLoad.Filter :=
'JPG files (*.jpg)|*.JPG|PNG Files (*.png)|*.PNG|BMP File (*.bmp)|*.BMP';
end;
procedure TFormHome.saveClick(Sender: TObject);
var
file_output, output, html: string;
begin
try
begin
sdSave.InitialDir := GetCurrentDir;
sdSave.Filter := 'HTML file|*.html';
if sdSave.Execute then
begin
output := mmOutput.Text;
file_output := sdSave.filename;
if not(file_output = '') then
begin
if not(output = '') then
begin
output := StringReplace(output, sLineBreak, sLineBreak + '</br>',
[rfReplaceAll, rfIgnoreCase]);
html := '<html>' + sLineBreak + '<body>' + output + sLineBreak +
'</body>' + sLineBreak + '</html>';
if (FileExists(file_output)) then
begin
DeleteFile(file_output);
end;
savefile(file_output, html);
if (FileExists(file_output)) then
begin
ShellExecute(0, nil, PChar(file_output), nil, nil, SW_SHOWNORMAL);
end;
message_box('Base64 Image Encoder 0.2', 'File created',
'Information');
end
else
begin
message_box('Base64 Image Encoder 0.2', 'Output is empty',
'Warning');
end;
end
else
begin
message_box('Base64 Image Encoder 0.2', 'File not found', 'Warning');
end;
end;
end;
except
begin
message_box('Base64 Image Encoder 0.2',
'An error has occurred in the program', 'Warning');
end;
end;
end;
end.
// The End ?
Si quieren bajar el programa lo pueden hacer de aca : [Enlace externo eliminado para invitados].
Eso seria todo.