Ver Mensaje Individual
  #39  
Antiguo 03-08-2012
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Reputación: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
A ver, creo que ya está un poco más claro, aunque sigue bastante oscuro .

Parece ser que siempre sí, la culpa es de SQLite, pero componentes como ZEOS saben cómo arreglar las cosas mientras que los componentes nativos de Lázarus no, o al menos todavía no encuentro como.

El problema con SQLite (y es que apenas hago mis pininos con este gestor) no es tanto que añada encabezados a un blob o que lo guarde en una forma no estándar. El problema es que SQLite usa los caracteres #0 (NULL) como separador de columnas de manera que no puede guardar bytes cero en un campo BLOB. Tal parece entonces que sustituye los ceros por un caracter de porcentaje %. Se supone que esto ya no es así en la versión 3 pero es con la que he estado haciendo pruebas y así es como guarda las imágenes.

No he instalado los componentes ZEOS en Lázarus (no pude ) pero examinando el código fuente, me encontré esto:

Código Delphi [-]
function DecodeString(Value: string): string;
var
  SrcLength, DestLength: Integer;
  SrcBuffer, DestBuffer: PChar;
begin
  SrcLength := Length(Value);
  SrcBuffer := PChar(Value);
  SetLength(Result, SrcLength);
  DestLength := 0;
  DestBuffer := PChar(Result);

  while SrcLength > 0 do
  begin
    if SrcBuffer^ = '%' then
    begin
      Inc(SrcBuffer);
      if SrcBuffer^ <> '0' then
        DestBuffer^ := SrcBuffer^
      else DestBuffer^ := #0;
      Inc(SrcBuffer);
      Dec(SrcLength, 2);
    end
    else
    begin
      DestBuffer^ := SrcBuffer^;
      Inc(SrcBuffer);
      Dec(SrcLength);
    end;
    Inc(DestBuffer);
    Inc(DestLength);
  end;
  SetLength(Result, DestLength);
end;

Esta función la usa en el método GetBlob de la clase TZSQLiteResultSet:

Código Delphi [-]
function TZSQLiteResultSet.GetBlob(ColumnIndex: Integer): IZBlob;
var
  Stream: TStream;
begin
{$IFNDEF DISABLE_CHECKING}
  CheckBlobColumn(ColumnIndex);
{$ENDIF}
  Stream := nil;
  try
    if not IsNull(ColumnIndex) then
    begin
      if TZAbstractResultSetMetadata(Metadata).GetColumnType(ColumnIndex)
        <> stBinaryStream then
        Stream := TStringStream.Create(GetString(ColumnIndex))
      else Stream := TStringStream.Create(DecodeString(GetString(ColumnIndex)));
      Result := TZAbstractBlob.CreateWithStream(Stream)
    end else
      Result := TZAbstractBlob.CreateWithStream(nil);
  finally
    if Assigned(Stream) then
      Stream.Free;
  end;
end;

Con un aplicación delphi abrí el archivo guardado desde el BlobField, le pase la función anterior y vacié la cadena nuevamente en un archivo y voilà, la imagen ya era la correcta.

La función compila sin problemas en Lázarus, pero no he podido usarla porque la clase TStringStream no es compatible con la de delphi así que todavía no encuentro cómo usarla para almacenar el blob, convertirlo y vaciarlo en un TBitmap.

Seguiremos informando...

// Saludos
Responder Con Cita