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

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> В png из base64 
V
    Опции темы
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   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

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

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

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

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


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

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


 




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


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

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