Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Общие вопросы > В png из base64


Автор: creas0ft 24.8.2006, 00:59
Имеем строку такого вида 
Код

tmpimg = iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=


на php такое с картинку грузиться так - 
Код

imagecreatefromstring(base64_decode(tmpimg))


Как такое сотворить в Delphi...

Компонет отсюда стянул - http://pngdelphi.sourceforge.net
А умных мыслей и нет (((

Автор: Alexeis 24.8.2006, 10:07
Довольно просто нужно скачать и установит любой компонент типа TPNGImage, поддерживающий загрузку из потока.
Код

var
  mem : TMemoryStream;
  png :  TPNGImage;
  s : AnsiString;
begin
  tmpimg := 'iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=';

  mem := TMemoryStream.create;
  mem.writeBuffer(tmpimg[1], length(tmpimg));
  png :=  TPNGImage.create({что потребует конструктор});
  png.loadfromstream(mem);
  mem.free;

Автор: creas0ft 24.8.2006, 10:51
или я совсем отупел или что...
при присваивании tmpimg типа  AnsiString; 
компилируется с ошибкой - String literals may have at most 255 elements

Автор: Kesh 24.8.2006, 10:53
А ты такой страшный текст не из BLOB поля берешь?

Автор: creas0ft 24.8.2006, 10:54
нет. руками присваивание...
ща дам код
Код

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  mem : TMemoryStream;
  PNG: TPNGObject;
  tmpimage :  AnsiString;
begin
  tmpimage := 'iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=';
  mem := TMemoryStream.create;
  mem.writeBuffer(tmpimage[1], length(tmpimage));
  PNG := TPNGObject.Create;
  png.loadfromstream(mem);
  image1.Canvas.Draw(0, 0, PNG);
  mem.free;
end;

Автор: creas0ft 24.8.2006, 11:20
 tmpimage := 'iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp';
  tmpimage := tmpimage+'16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=';

разделил так...
но появилось следующее - the file being readed is not valid @Portable Network Graphics

надо из base64 конвертировать...

Автор: Alexeis 24.8.2006, 11:47
creas0ft, base64, это что разновидность Unicode кодировки?

Добавлено @ 11:57 
На torry.net нашел пример перекодирования base64
в нормальную строку.
Код

const
  Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';

function Encode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  a := 0;
  b := 0;
  for i := 1 to Length(s) do
  begin
    x := Ord(s[i]);
    b := b * 256 + x;
    a := a + 8;
    while a >= 6 do
    begin
      a := a - 6;
      x := b div (1 shl a);
      b := b mod (1 shl a);
      Result := Result + Codes64[x + 1];
    end;
  end;
  if a > 0 then
  begin
    x := b shl (6 - a);
    Result := Result + Codes64[x + 1];
  end;
end;

function Decode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  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;
      a := a + 6;
      if a >= 8 then
      begin
        a := a - 8;
        x := b shr a;
        b := b mod (1 shl a);
        x := x mod 256;
        Result := Result + chr(x);
      end;
    end
    else
      Exit;
  end;
end;

Автор: creas0ft 24.8.2006, 12:02
это сжатый формат - я так понимаю

Автор: Alexeis 24.8.2006, 12:12
Да как я понял символ занимает 6 бит. С помощью Decode64, должны получить нормальное ANSI представление строки

Автор: creas0ft 24.8.2006, 12:43
а еще на инвалид хеадер ругается...
вообщем что то не так...
помогите плз

Автор: Alexeis 24.8.2006, 12:57
Цитата(creas0ft @  24.8.2006,  12:43 Найти цитируемый пост)
а еще на инвалид хеадер ругается...

Может есть опигинал файла, чтоб можно было проверить результат декодировки?

Автор: creas0ft 24.8.2006, 13:03
нету...
это кусок из php кода - который нормальное вставляет в картинку.
imagecreatefromstring(base64_decode(tmpimg))

Автор: Alexeis 24.8.2006, 13:17
ну а нельзя выполнить этот php код и вызвать функцию типа savetofile?
Или апач не установлен?

Автор: creas0ft 24.8.2006, 13:21
так дело не в этом...
мне надо с таким образом управляться...

base64_decode вся загвоздка я так понимаю в этой функции base64_decode
http://www.usurt.ru:8100/php/function.base64-decode.html вот описание ее.
Как бы такое в delphi сделать

Автор: Alexeis 24.8.2006, 13:36
creas0ft, я же дал код функции base64-decode, это не просто самопальный код, он взят с сайта Torry.net. Просто надо все отладить. 
Кстати я забыл кое что сделать.
перед
Код

png.loadfromstream(mem);

необходимо установить указатель потока в начало.
Код

mem.position := 0;


как видишь без отладки трудно написать сразу рабочий код, потому и нужны данные картинки, чтоб проверить каждый шаг последовательно, что и как выполняется.

Автор: creas0ft 24.8.2006, 13:41
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
Uses PngImage;
{$R *.dfm}

const
  Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/';
function Encode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  a := 0;
  b := 0;
  for i := 1 to Length(s) do
  begin
    x := Ord(s[i]);
    b := b * 256 + x;
    a := a + 8;
    while a >= 6 do
    begin
      a := a - 6;
      x := b div (1 shl a);
      b := b mod (1 shl a);
      Result := Result + Codes64[x + 1];
    end;
  end;
  if a > 0 then
  begin
    x := b shl (6 - a);
    Result := Result + Codes64[x + 1];
  end;
end;
function Decode64(S: string): string;
var
  i: Integer;
  a: Integer;
  x: Integer;
  b: Integer;
begin
  Result := '';
  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;
      a := a + 6;
      if a >= 8 then
      begin
        a := a - 8;
        x := b shr a;
        b := b mod (1 shl a);
        x := x mod 256;
        Result := Result + chr(x);
      end;
    end
    else
      Exit;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  mem : TMemoryStream;
  PNG: TPNGObject;
  tmpimage :  AnsiString;
begin
  tmpimage := Decode64('iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp');
  tmpimage := tmpimage+Decode64('16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=');
  mem := TMemoryStream.create;
  mem.writeBuffer(tmpimage[1], length(tmpimage));
  PNG := TPNGObject.Create;
  mem.position := 0;
  png.loadfromstream(mem);
  image1.Canvas.Draw(0, 0, PNG);
  mem.free;
end;

end.



все такая же ошибка....

на php при раскодировке строка начинается так - ‰PNG  

Автор: creas0ft 24.8.2006, 14:24
я так понимаю это uue кодирование 
как такое раскодировать в Delphi

Добавлено @ 14:29 
Код

type TAByte = array [0..maxInt-1] of byte;
type TPAByte = ^TAByte;

function Decode(data:string) : string; overload;
var i1,i2,len : integer;
pi, po : TPAByte;
ch1 : char;
c1 : dword;
begin
len:=length(data);
if (len > 0) and (len mod 4 = 0) then begin
len := len shr 2;
SetLength(result, len * 3);
pi := pointer(data);
po := pointer(result);
for i1 := 1 to len do begin
c1 := 0;
i2 := 0;
while true do begin
ch1 := char(pi^[i2]);
case ch1 of
'A'..'Z' : c1 := c1 or (dword(ch1) - byte('A') );
'a'..'z' : c1 := c1 or (dword(ch1) - byte('a') + 26);
'0'..'9' : c1 := c1 or (dword(ch1) - byte('0') + 52);
'+' : c1 := c1 or 62;
'/' : c1 := c1 or 63;
else begin
if i2 = 3 then begin
po^[0] := c1 shr 16; 
po^[1] := byte(c1 shr 8);
SetLength(result, Length(result) - 1);
end else begin
po^[0] := c1 shr 10;
SetLength(result, Length(result) - 2);
end;
exit;
end;
end;
if i2 = 3 then
break;
inc(i2);
c1 := c1 shl 6;
end;
po^[0] := c1 shr 16;
po^[1] := byte(c1 shr 8);
po^[2] := byte(c1);
inc(dword(pi), 4);
inc(dword(po), 3);
end;
end else
result := '';
end;

вот это правильно раскодирует.
Все всем спасибо

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)