VPF::Base64 - Форум программистов

aktuba

Дата 15.2.2007, 09:49 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Люди, помогите найти ошибку.
С сайта принимаю изображение (jpg), кодирую его в base64 следующей функцией:

Код


function StreamToBase64(AStream: TStream): string;
var
  i: Int64;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  if (AStream.Size = 0) or (AStream.Position >= AStream.Size) then Exit;
  a := 0;
  b := 0;
  i := AStream.Position;
  while i < AStream.Size do
    begin
      x := 0;
      AStream.Read(x, 1);
      b := b * 256 + x;
      Inc(a, 8);
      while a >= 6 do
        begin
          Dec(a, 6);
          x := b div (1 shl a);
          b := b mod (1 shl a);
          Result := Result + Codes64[x + 1];
        end;
      if a > 0 then
        begin
          x := b shl (6 - a);
          Result := Result + Codes64[x + 1];
        end;  
      Inc(i);
    end;  
end;

Код брал тут, переделал для stream.

Для возврата в исходный вид использую следующее:

Код


procedure Base64ToStream(S: string; AStream: TStream);
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  if not Assigned(AStream) then Exit;
  a := 0;
  b := 0;
  for i := 1 to Length(s) do
    begin
      x := Pos(s[i], codes64) - 1;
      if x >= 0 then
        begin
          b := b * 64 + x;
          Inc(a, 6);
          if a >= 8 then
            begin
              Dec(a, 8);
              x := b shr a;
              b := b mod (1 shl a);
              x := x mod 256;
              AStream.Write(x, 1);
            end;
        end else Exit;
    end;
end;

Код оттуда же, также переделан.

После этих операция результат отличается от оригинала. Где ошибка? smile

--------------------

Alexeis

Дата 15.2.2007, 11:40 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

aktuba, мне кажется что этот модуль по удобнее будет (из него понадобятся всего 2 процедуры)

Код


unit Base64;

{
  Base64 convert function library
  Delphi Base64 Convert Functions

  Copyright (c) 2004 Zinkevich Viktor

  You can use this module for various
  purposes (comercial as well).
}

interface

uses Windows, Classes, Registry, SysUtils;

type
  TMIMETypes = class(TObject)
  private
    list: TStringList;
  protected

  public
    constructor Create;
    destructor Destroy; override;
    function GetContentType(Ext: string): string;
  published

  end;


procedure ConvertToBase64(inp, outp: TStream);
procedure ConvertFromBase64(inp, outp: TStream);

implementation

procedure ConvertFromBase64(inp, outp: TStream);
var
  int, i, ns: integer;
  buf: array [0..3] of Byte;
  ot: array [0..2] of Byte;
  decode: array [Byte] of Byte;
  code: PChar;
begin
  code:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  for i:=0 to 63 do
    decode[Byte(code[i])] := i;
  inp.Position := 0;
  ns := (inp.Size div 78)*2;        // 76 + 2 (#10#13)
  int := (inp.Size - ns) div 4;
  for i:=0 to int - 2 do
  begin
    inp.ReadBuffer(buf[0],2);
    if (buf[0] = 13) and ((buf[1] = 10)) then
    begin
      inp.ReadBuffer(buf[0],4);
    end
    else
      inp.ReadBuffer(buf[2],2);
    ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
    ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
    ot[2] := ((decode[buf[2]] and 3) shl 6) or (decode[buf[3]] and 63);
    outp.WriteBuffer(ot[0],3);
  end;
  inp.ReadBuffer(buf[0],4);
  if (buf[2] = Byte('=')) and (buf[3] = Byte('=')) then
  begin
    ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
    outp.WriteBuffer(ot[0],1);
  end;
  if (buf[2] <> Byte('=')) and (buf[3] = Byte('=')) then
  begin
    ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
    ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
    outp.WriteBuffer(ot[0],2);
  end;
  if (buf[2] <> Byte('=')) and (buf[3] <> Byte('=')) then
  begin
    ot[0] := (decode[buf[0]] shl 2) or ((decode[buf[1]] shr 4) and 3);
    ot[1] := ((decode[buf[1]] and 15) shl 4) or ((decode[buf[2]] shr 2) and 15);
    ot[2] := ((decode[buf[2]] and 3) shl 6) or (decode[buf[3]] and 63);
    outp.WriteBuffer(ot[0],3);
  end;
end;

procedure ConvertToBase64(inp, outp: TStream);
var
  rem, int, i: integer;
  buf: array [0..2] of Byte;
  ot: array [0..3] of Char;
  endl : PChar;
  code: PChar;
begin
  code:='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
  inp.Position := 0;
  endl := #13#10;
  rem := inp.Size mod 3;
  int := inp.Size div 3;
  for i:=0 to int - 1 do
  begin
    inp.ReadBuffer(buf[0],3);
    ot[0] := code[((buf[0] and 254) shr 2)];
    ot[1] := code[(((buf[0] and 3) shl 4) or ((buf[1] and 240) shr 4))];
    ot[2] := code[(((buf[1] and 15) shl 2) or ((buf[2] and 192) shr 6))];
    ot[3] := code[(buf[2] and 63)];
    outp.WriteBuffer(ot[0],4);
    // 76 / 4 = 19
    if (i <> 0) and (((i+1) mod 19) = 0) then
      outp.WriteBuffer(endl^,2);
  end;
  inp.ReadBuffer(buf[0],rem);
  if rem = 1 then
  begin
    ot[0] := code[((buf[0] and 254) shr 2)];
    ot[1] := code[(((buf[0] and 3) shl 4))];
    ot[2] := '=';
    ot[3] := '=';
  end;
  if rem = 2 then
  begin
    ot[0] := code[((buf[0] and 254) shr 2)];
    ot[1] := code[(((buf[0] and 3) shl 4) or ((buf[1] and 240) shr 4))];
    ot[2] := code[(((buf[1] and 15) shl 2))];
    ot[3] := '=';
  end;
  if rem <> 0 then
    outp.WriteBuffer(ot[0],4);

end;

{ TMIMETypes }

constructor TMIMETypes.Create;
var
  reg: TRegistry;
  st: TStringList;
  i: Integer;
  ex: string;
begin
  list := TStringList.Create;
  st := TStringList.Create;
  reg := TRegistry.Create;
  reg.RootKey := HKEY_CLASSES_ROOT;
  reg.OpenKeyReadOnly('\MIME\Database\Content Type');
  reg.GetKeyNames(st);
  reg.CloseKey;
  for i:=0 to st.Count-1 do
  begin
    if reg.OpenKeyReadOnly('\MIME\Database\Content Type\'+st.Strings[i]) then
    begin
      ex := AnsiLowerCase(reg.ReadString('Extension'));
      list.Values[ex] := st.Strings[i];
      reg.CloseKey;
    end;
  end;
  reg.CloseKey;
  st.Free;
end;

destructor TMIMETypes.Destroy;
begin
  list.Free;
  inherited;
end;

function TMIMETypes.GetContentType(Ext: string): string;
begin
  Result := list.Values[AnsiLowerCase(Ext)];
end;

end.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

aktuba

Дата 15.2.2007, 12:03 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Alexeis, практически такая же беда smile

. Правда, если с моим кодом различия начинались на 2-3 символе, то с твоим гдето на 30-м...

Оригинал изображения

Результат кодирования/декодирования

Вторая картинка не открывается, т.к. декодирована (или закодирована) не верно. smile

Сравнить можно любым HEX-редактором...

--------------------

Alexeis

Дата 15.2.2007, 12:32 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

aktuba, не знаю не знаю, я вот попробовал модуль товарища Zinkevich Viktor и у меня после кодировки-декодировки 100% совпадение.

Добавлено @ 12:39
Создавал я 2 обычных TFileStream один один в режиме чиения, другой в режиме создания файла и получился такой результат:
Исходный
Readme.txt

Кодированный
Readme1.txt

Декодированный

Readme2.txt

Присоединённый файл ( Кол-во скачиваний: 29 )

base64_2007.02.15_11.37.rar 8,58 Kb

--------------------

aktuba

Дата 15.2.2007, 23:52 (ссылка)

(нет голосов)

Загрузка ...

Смышленный

Профиль
Группа: Завсегдатай
Сообщений: 1915
Регистрация: 24.4.2006
Где: Планета Земля

Репутация: 16
Всего: 38

Alexeis, спасибо, '+' за очень полезный код. Кстати, не мешает этот код в FAQ занести.

P.S.: столкнулся с такой проблемой: при добавлении строки в XML все переносы строк меняются с #13#10 на #10. Из-за этого и получилась проблема у меня, т.к. для текстов это не критично, а для изображений критично...

Это сообщение отредактировал(а) aktuba - 16.2.2007, 03:47

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »