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

[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;
:افسرده:


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