[Delphi] Base64 Image Encoder 0.2

Iniciado por BigBear, Septiembre 17, 2016, 06:15:09 PM

Tema anterior - Siguiente tema

0 Miembros y 2 Visitantes están viendo este tema.

Septiembre 17, 2016, 06:15:09 PM Ultima modificación: Septiembre 17, 2016, 06:17:36 PM por Doddy
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

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

You are not allowed to view links. You are not allowed to view links. Register or Login or You are not allowed to view links. Register or Login.

Eso seria todo.