درج عکس در دیتابیس

[gbg]

سلام
وقتی یه جدول رو با دستورات T-sql پر میکنم فیلد عکس رو چطور درج کنم؟

qry1.sql.add(insert into cars (name,type,pic) valeus("BMW",1,nil);

منضورم فیلد pic در گزارش بالا هستش
qry1 رو در زمان رانتایم ساختم

[hassan_reza]

insert into cars (name,type,pic) values('Benz',3, FILE_READ('file.jpg'));

[gbg]

ممنون اگه فایل نباشه چی؟

[samani]

براي اينكار شما محتويات عكس كه به شكل باينري يا Stream هست رو به رشته اي از Hex تبديل كن

function GetBitmapHexString(aBitmap: TBitmap): string;

var

  ms: TStream;

  i: integer;

  b: byte;

begin

  Result := '';

  ms := TMemoryStream.Create;

  try

    aBitmap.SaveToStream(ms);

    ms.Position := 0;

    for i := 1 to ms.Size do

    begin

      ms.Read(b, 1);

      Result := Result + IntToHex(b, 2);

    end;

  finally

    ms.Free;

  end;

  if Result <> '' then

    Result := '0x' + Result;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  HexString: string;

begin

  HexString := GetBitmapHexString(Image1.Picture.Bitmap);

  if HexString = '' then

    HexString := 'NULL';



  qry1.sql.add('insert into cars (name, type, pic) valeus(''BMW'', 1, ' + HexString + ')');

end;

[gbg]

براي اينكار شما محتويات عكس كه به شكل باينري يا Stream هست رو به رشته اي از Hex تبديل كن

function GetBitmapHexString(aBitmap: TBitmap): string;

var

  ms: TStream;

  i: integer;

  b: byte;

begin

  Result := '';

  ms := TMemoryStream.Create;

  try

    aBitmap.SaveToStream(ms);

    ms.Position := 0;

    for i := 1 to ms.Size do

    begin

      ms.Read(b, 1);

      Result := Result + IntToHex(b, 2);

    end;

  finally

    ms.Free;

  end;

  if Result <> '' then

    Result := '0x' + Result;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  HexString: string;

begin

  HexString := GetBitmapHexString(Image1.Picture.Bitmap);

  if HexString = '' then

    HexString := 'NULL';



  qry1.sql.add('insert into cars (name, type, pic) valeus(''BMW'', 1, ' + HexString + ')');

end;

به شدت کنده

[samani]

تو عكسهاي حجيم ممكن تا حدودي كند بشه براي مثال اگه حجم عكس 2 مگابايت باشه خروجي تابع 4 مگابايت رشته است كه ساختن رشته داخل حلقه كند ميشه ولي شما براي حل اين مشكل ميتونيد از getmem و تبديل آن به هگز از shl استفاده كنيد تابع زير براي تبديل استريم به رشته با سرعت بالاست كه فايل 2 مگابايتي رو كمتر از 30 ميلي ثانيه تبديل به رشته هگز ميكنه

function StreamToString(Stream: TStream): String;

var

  Size: Integer;

  p: PChar;

begin

  Size := Stream.Size;

  SetLength(Result, Size * 2);

  GetMem(p, Size);



  Stream.Position := 0;

  Stream.Read(p^, Size);



  BinToHex(p, PChar(@Result[1]), Size);



  FreeMem(p, Size);

end;



function GetBitmapHexString(aBitmap: TBitmap): string;

var

  ms: TStream;

begin

  Result := '';

  ms := TMemoryStream.Create;

  try

    aBitmap.SaveToStream(ms);

    Result := StreamToString(ms);

  finally

    ms.Free;

  end;

  if Result <> '' then

    Result := '0x' + Result;

end;



procedure TForm1.Button1Click(Sender: TObject);

var

  HexString: string;

  sl: TStringList;

  t: Cardinal;

begin

  sl := TStringList.Create;

  try

    t := GetTickCount;

    HexString := GetBitmapHexString(Image1.Picture.Bitmap);

    t := GetTickCount - t;

    if HexString = '' then

      HexString := 'NULL';

    sl.Text := HexString;

    sl.SaveToFile('HexString.txt');

  finally

    sl.Free;

    ShowMessage(IntToStr(t));

  end;

end;

[gbg]

ارور می گیره :FreeMem(p, Size);
و همچنین ms.Free;
خطوط 15 و 28 در پست بالا

[samani]

تو دلفي 7و XE3 تست شده مشكلي نداره
كدي رو كه نوشتي درست چك كن و همينطور FreeMem رو هم چك كن كه از توابع يونت System باشه شايد يونيت ديگري يوز هست كه بعد از System تعريف شده

[gbg]

ذرست شد حجم عکس من دو مگ هست
کوئری که اجرا میشه بعد سه دقیقه رور میگره و تایم اوت میده

[gbg]

insert into cars (name,type,pic) values('Benz',3, FILE_READ('file.jpg'));

این هم تست کردم کار نکرد مگه این تابع وجود نداره

Msg 195, Level 15, State 10, Line 1

'FILE_READ' is not a recognized built-in function name

اسکول 2008

[gbg]

من خودم از این روش استفاده می کنم ولی 2 ثانیه طول میکشه

ms := TMemoryStream.Create;

CBitmap.SaveToStream(ms);

ms.Seek(0,0);

qry1:=TADOQuery.Create(nil);

qry1.Connection:=frmDataModule.conMowjCars;

qry1.sql.add('insert into cars (name,type,pic) valeus('+Carname+','+inttostr(CType)+',:Ppic');

qry1.Parameters[0].Attributes := [paLong];

qry1.Parameters[0].DataType := ftBlob;

qry1.Parameters[0].LoadFromStream(ms,ftBlob);

qry1.ExecSQL;

qry1.Free;

ms.free;

ادیت :
بعضی وقت ها کلا رکورد رو هم ادد نمی کنه و ارور هم نمیگیره