Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> В png из base64 
V
    Опции темы
creas0ft
Дата 24.8.2006, 00:59 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
Имеем строку такого вида 
Код

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


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

imagecreatefromstring(base64_decode(tmpimg))


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

Компонет отсюда стянул - http://pngdelphi.sourceforge.net
А умных мыслей и нет (((
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 10:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Довольно просто нужно скачать и установит любой компонент типа 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;



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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 10:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
или я совсем отупел или что...
при присваивании tmpimg типа  AnsiString; 
компилируется с ошибкой - String literals may have at most 255 elements
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Kesh
Дата 24.8.2006, 10:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Эксперт
Сообщений: 2488
Регистрация: 31.7.2002
Где: Германия, Saarbrü cken

Репутация: 4
Всего: 54
А ты такой страшный текст не из BLOB поля берешь?


--------------------
user posted image
PM MAIL WWW ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 10:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
нет. руками присваивание...
ща дам код
Код

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;

--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
creas0ft
Дата 24.8.2006, 11:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
 tmpimage := 'iVBORw0KGgoAAAANSUhEUgAAACgAAAAoCAAAAACpleexAAAAFXRFWHRDcmVhdGlvbiBUaW1lAAfTBQ4QHwfqWOdfAAAAB3RJTUUH0wUOEDIrLasyIwAAAAlwSFlzAAALEgAACxIB0t1+/AAAAL5JREFUeNrl1C0OwkAQBWCWQIJEVPQIFT0GAlHBMRBIBKIHqahAIDlERY9R0UOs3ORh5qVLunmp5GfUZvczbzKzDqtltV7ofgtueHCp';
  tmpimage := tmpimage+'16h33xBGwn0KYqoTO/J868Csaj418e0cPujOkLDfmTsECcfcXOGhoC/NZQMUDBUDd5DwxiAtJGzprpCw48xVQcIhM1d6KOgLc/kIBcORgXtIeGGQOyRs6Oq0g7P92YbkRE7bRZhcwhh+6nLF5f7yx30B8Z7FgxzMWtEAAAAASUVORK5CYII=';

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

надо из base64 конвертировать...
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 11:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
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;



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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 12:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
это сжатый формат - я так понимаю
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 12:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
Да как я понял символ занимает 6 бит. С помощью Decode64, должны получить нормальное ANSI представление строки


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 12:43 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
а еще на инвалид хеадер ругается...
вообщем что то не так...
помогите плз
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 12:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

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

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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 13:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
нету...
это кусок из php кода - который нормальное вставляет в картинку.
imagecreatefromstring(base64_decode(tmpimg))
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 13:17 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
ну а нельзя выполнить этот php код и вызвать функцию типа savetofile?
Или апач не установлен?


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 13:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
так дело не в этом...
мне надо с таким образом управляться...

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

Это сообщение отредактировал(а) creas0ft - 24.8.2006, 13:24
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Alexeis
Дата 24.8.2006, 13:36 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

Репутация: 109
Всего: 459
creas0ft, я же дал код функции base64-decode, это не просто самопальный код, он взят с сайта Torry.net. Просто надо все отладить. 
Кстати я забыл кое что сделать.
перед
Код

png.loadfromstream(mem);

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

mem.position := 0;


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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
creas0ft
Дата 24.8.2006, 13:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
Код

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

Присоединённый файл ( Кол-во скачиваний: 7 )
Присоединённый файл  error.gif 4,17 Kb
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
creas0ft
Дата 24.8.2006, 14:24 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 117
Регистрация: 5.8.2006
Где: Саранск

Репутация: нет
Всего: 2
я так понимаю это 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;

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

Это сообщение отредактировал(а) creas0ft - 24.8.2006, 15:29
--------------------
Форум программистов уклонистов в сторону сео-шмео
PM MAIL WWW ICQ   Вверх
Страницы: (2) [Все] 1 2 
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1217 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.