сохранение blob на диск

[eldalex]

кто вобще с блобами работал?
вытягиваю блоб из базы, сохраняю на диск но почему то изображения не получается может ему надо как то указывать что это картинка?

procedure TestMacroProc (MName:string; AParams:TObject);
var 
  FS: TFileStream; 
  ds:Tdataset;
  buffer:Variant;
  buf:TBlobByteData;
  zap:string;
begin
  zap:='select image from dent_teeth_map where map_id=4'; //запрос
  ds:=CreateSQLDataset(zap,true);//получаем запросом датасет
  ds.Open;//открываем
    buffer:=ds.GetBlobFieldData(1,buf); //считываем поле в буфер
    FS:=TFileStream.Create('c:\1.gif', fmCreate); // создаем файл
    with FS do
    try
       Seek(0, soFromBeginning); // перемещаем указатель в начало потока
       WriteBuffer(buf, buffer);// записываем 
       finally
       Free; // закрываем файл, освобождаем память
    end;
  ds.close;
end;

[Stilet]

А он хоть файл наполняет то? Может buffer равен 0?

[eldalex]

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

[eldalex]

нашел в нете такую штуку

type

  PInteger  = ^integer;
  PInt      = ^integer;
  Short     = SmallInt;// 16 bit signed
  UShort    = Word;    // 16 bit unsigned
  Long      = LongInt; // 32 bit signed

  TISC_BlobGetSegment = function(BlobHandle: pointer;
                                 Buffer: PChar;
                                 BufferSize: ushort;
                                  var ResultLength: ushort): Short; cdecl;
  TISC_BlobPutSegment = procedure(BlobHandle: pointer;
                                  Buffer: PChar;
                                  BufferLength: Short); cdecl;
  TBlob = record
    GetSegment         : TISC_BlobGetSegment;
    Handle             : pointer;
    SegmentCount       : Long;
    MaxSegmentLength   : Long;
    TotalSize          : Long;
    PutSegment         : TISC_BlobPutSegment;
  end;

  PBlob = ^TBlob;


function SaveBLOBToFile(var BLOb: TBLOb; FileName: PChar): integer; cdecl; export;
var
  Stream: TFileStream;
  Buffer: PChar;
  EndOfBlob: short;
  MaxBufSize: ushort;
  GotLength: ushort;
begin
  Result:;
  try
    if (Assigned(Blob.Handle)) or (Blob.TotalSize > 0) then // don't do anything is blob = 0
      begin
        // add fmShare... option to fmCreate as needed
        Stream := TFileStream.Create(FileName, fmCreate);
        Stream.Seek(0, soFromBeginning);
        MaxBufSize:=Blob.MaxSegmentLength;
        GetMem(Buffer, MaxBufSize + 1);
        try
          repeat
            GotLength := 0; { !?! }

            with BLOb do
              EndOfBLOb := GetSegment(Handle, Buffer, MaxBufSize, GotLength);
            if (GotLength > 0) then {?}
              Stream.WriteBuffer(Buffer^, GotLength);
          until EndOfBLOb = 0;

        finally
          FreeMem(Buffer, MaxBufSize + 1);
          Result:=Stream.Size; // really result need to be int64. but 2 gb blob files is ok.
          Stream.Free;
        end;
      end;
  except
  end;
end;

вроде должна делать то что надо, тока не пойму как ей мой blob передать...

[eldalex]

все, проблема решена. а ларчик просто открывался...

procedure TestMacroProc (MName:string; AParams:TObject);
var 
  wPrm:TmParams;
  ds:Tdataset;
  zap:string;
  bl:TBLObfield;

begin
  wPrm:=AParams as TmParams;
  if wPrm.Values[1]=1 then zap:='select image from dent_teeth_map where map_id='+wPrm.Values[0]
  else zap:='select template from templates where id=747';
  ds:=CreateSQLDataset(zap,true);
  bl:= ds.fields[0] as tblobfield;
  if wPrm.Values[1]=1 then bl.savetofile('c:\1.gif')
  else bl.savetofile('c:\1.txt');
end;