Оглавление Кодирование бинарных файлов (MIME base84)


Главная форма программы.

Практикуемся в использовании потоков: TFileStream, TBase64EncodingStream, TBase64DecodingStream. Программа кодирует файлы (бинарные, в частности - картинки) используя кодировку MIME - base64. Полученный код состоит только из 64 текстовых символов: ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/ и может быть передан по каналам, пропускающим только этот алфавит (например, некоторые протоколы, используемые Интернетом). Этот код можно использовать как данные в SQL-запросах и таким образом хранить бинарные данные (в закодированном текстовом виде) в базах данных. Расплата за это - увеличение объема данных на 33%.

Кроме этого, программа демонстрирует копирование файлов - с использованием потоков TFileStream. Для тестирования правильности кодировки есть процедура, создающая тестовый бинарный файл, содержащий заданное количество случайных байт (0..255)

Остались нерешенные проблемы (в основном русификация):
  1. В тексте исходника .pas часто приходится использовать функцию AnsiToUtf8()
  2. Не понимет русские имена файлов при открытии (OPenDialog) и превращает их в крякозябры (UTF8) (SaveDialog) если пытаться записать такой файл. Однако, файлы эти открываются блокнотом. ++ Исправлено
  3. Вывод русского текста из файла .txt в Memo (при копировании): похоже, нужно его преобразовывать ansitoutf8 ибо крякозябры ++ Исправлено
  4. При кодировании - нельзя кодировать один и тот же файл дважды подряд (занят? - не закрыт?) ++ Исправлено: добавлено InStream.Free;
Похоже, что UTF8 - родная кодировка для Лазаруса. Или где-то это переключается (буду искать) и смена кодировки исходника на эти проблемы не влияет.

Текст главного модуля (исправленный, а в архиве - (пока) неисправленный)

{ В Лазарусе постепенно привыкаешь к тому, что поиск описаний
через Ctrl-щелчок при наведении курсора на идентификатор не хуже, чем 
справка Делфи (если понимать Object Pascal)
}

unit unmain;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Menus, base64;

type

  { TForm1 }

  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Memo1: TMemo;
    MenuItem1: TMenuItem;
    decode: TMenuItem;
    randfile: TMenuItem;
    Quit: TMenuItem;
    SD1: TSaveDialog;
    b64_encode: TMenuItem;
    CopyStream: TMenuItem;
    OD1: TOpenDialog;
    procedure CopyStreamClick(Sender: TObject);
    procedure decodeClick(Sender: TObject);
    procedure QuitClick(Sender: TObject);
    procedure b64_encodeClick(Sender: TObject);
    procedure randfileClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Form1: TForm1; 

implementation

{ TForm1 }

procedure TForm1.CopyStreamClick(Sender: TObject);
var InStream, OutStream: TFileStream;
len, CountIn, CountOut : integer;
bur: ansistring;
FNameOD1,FNameSD1: ansistring;

begin
  Memo1.Clear;
  OD1.Title:= AnsiToUTF8('Выберите файл для копирования');
  SD1.Title:= AnsiToUTF8('Задайте имя для сохраняемого файла');
  if (OD1.Execute and SD1.Execute) then
    begin
      FNameOD1:= UTF8ToAnsi(OD1.FileName);
      FNameSD1:= UTF8ToAnsi(SD1.FileName);
      InStream := TFileStream.Create(FNameOD1, fmOPenREad);
      OutStream:= TFileStream.Create(FNameSD1, fmCreate);

      len:= InStream.Size;
      SetLength(bur,len);
      countIn := InStream.Read(bur[1],Len);
      countOut:= OutStream.Write(bur[1],Len);

      Memo1.Text:= AnsiToUTF8(bur);
      Memo1.Lines.Append('_____________________________');
      Memo1.Lines.Append
      (AnsiToUTF8('Прочтено: ')+IntToStr(countIn)+AnsiToUTF8(' из ')
        + IntToStr(len) + AnsiToUTF8(' байт текста') );
      Memo1.Lines.Append
      (AnsiToUTF8('Записано: ')+IntToStr(countOut)+AnsiToUTF8(' из ')
        + IntToStr(countIn) + AnsiToUTF8(' байт текста'));
      InStream.Free;
      OutStream.Free;
    end;
end;

procedure TForm1.decodeClick(Sender: TObject);
var
ii,Size,Size2: integer;
b64decoder: TBase64DecodingStream;
InStream, OutStream: TFileStream;
Arba: array of byte;
FNam,FNam2: string;
IsEnd: boolean;
begin
  SD1.Title:=
  AnsiToUTF8('Декодируем OutFile.bbb Задайте имя результата');

  if not SD1.Execute then exit;
  FNam2:= SD1.FileName;
  OutStream:= TFileStream.Create(FNam2, fmCreate );

  isend:= false;
  FNam:= 'OutFile.bbb';

  InStream := TFileStream.Create(FNam, fmOPenREad);
  Size:= InStream.Size;
  SetLength(arba,Size);
  b64decoder:= TBase64DecodingStream.Create(InStream,bdmMIME);

  ii:= -1;
   memo1.Clear;
    while not IsEnd do
    try
      inc(ii);
      arba[ii]:= b64decoder.ReadByte;
    except
      on e: EStreamError do IsEnd := True;
    end;
  Size2:= ii+1;

  OutStream.Write(arba[0], Size2-1);
  // Почему-то нужно недописывать 1 байт ?

  b64decoder.Free;
  InStream.Free;
  OutStream.Free;
end;

procedure TForm1.QuitClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.b64_encodeClick(Sender: TObject);
var
ii,maxa: integer;
b64encoder: TBase64EncodingStream;
InStream, OutStream: TFileStream;
FNam, InFile: string;
arba: array of byte;
begin
  OD1.Title:=
  AnsiToUTF8('Выберите файл. Результат: OutFile.bbb');

  if not OD1.Execute then exit;
  InFile:= OD1.FileName;
  InStream:= TFileStream.Create(InFile, fmOpenRead);
  maxa:= InStream.Size;
  SetLength(arba,maxa);
  InStream.Read(arba[0], maxa);

  FNam:= 'OutFile.bbb';
  OutStream:= TFileStream.Create(FNam, fmCreate);
  b64encoder:= TBase64EncodingStream.Create(OutStream);

  for ii:=1 to maxa do
    b64encoder.WriteByte(Arba[ii-1]);
  arba:= nil;

  b64encoder.Free;
  OutStream.Free;
  InStream.Free;
end;

procedure TForm1.randfileClick(Sender: TObject);
var OutStream: TFileStream; FSize,ii: integer;
  bufsi, FNam: string;
  rndMax: longInt;
  arabik: array of byte;
 { Создаем файл для тестирования кодирования-декодирования
   Сравнивать исходный и декодированный файл на идентичность
   удобно, например, в Total Commander
 }
begin
  FNam:= 'TestFile.rnd';
  OutStream:= TFileStream.Create(FNam, fmCreate);
{function InputBox(const ACaption, APrompt, ADefault : String) : String;}
  bufsi:= InputBox(
  AnsiToUTF8('Создаем тестовый файл.'),
  AnsiToUTF8('Введите размер файла (байт)'),'512');
  showmessage(AnsiToUTF8('Результат: файл TestFile.rnd'+#13#10+
   '(случайные числа)'));
  FSize:= StrToInt(bufsi);
  SetLength(arabik,FSize);

  rndMax:= 256;
  for ii:= 1 to FSize do
    arabik[ii-1]:= random(rndMax);

  OutStream.Write(arabik[0], FSize);

  arabik:= nil;
  OutStream.Free;
end;

initialization
  {$I unmain.lrs}

end.
Скачать RAR-архив исходников + .exe (MIME_base64_Full.rar - 460 Кб)

Распакуйте архив в папку и откройте projStreams1.lpi - для работы с проектом
Проект должен открыться (если установлен Лазарус).
Или запустите projStreams1.exe (если потребует что-нибудь, сообщите, пожалуйста )
Rambler's Top100
Hosted by uCoz