FireDAC Image BLOB as FDStoredProc parameter [duplicate] - delphi

I want to store images in a database using sql but cant seem to get it to work:
qry.SQL.Clear;
qry.Sql.Add('update tbl set pic = :blobVal where id = :idVal');
qry.Parameters.ParamByName('idVal')._?:=1;
.Parameters has no .asinteger like .Param has but .Param isn't compatible with a TADOquery - to workaround I tried:
a_TParameter:=qry.Parameters.CreateParameter('blobval',ftBlob,pdinput,SizeOf(TBlobField),Null);
a_TParam.Assign(a_TParameter);
a_TParam.asblob:=a_Tblob;
qry.ExecSql;
This also doesnt work:
qry.SQL.Clear;
qry.Sql.Add('update tbl set pic = :blobVal where id = 1')
qry.Parameters.ParamByName('blobVal').LoadFromStream(img as a_TFileStream,ftGraphic);//ftblob
//or
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg',ftgrafic);//ftblob
qry.ExecSql;

Should be something like:
qry.Parameters.Clear;
qry.Parameters.AddParameter.Name := 'blobVal';
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg', ftBlob);
// or load from stream:
// qry.Parameters.ParamByName('blobVal').LoadFromStream(MyStream, ftBlob);
qry.Parameters.AddParameter.Name := 'idVal';
qry.Parameters.ParamByName('idVal').Value := 1;
qry.SQL.Text := 'update tbl set pic = :blobVal where id = :idVal';
qry.ExecSQL;
To read the BLOB back from the DB:
qry.SQL.Text := 'select id, pic from tbl where id = 1';
qry.Open;
TBlobField(qry.FieldByName('pic')).SaveToFile('c:\sample_2.jpg');

I'm using Lazarus, not Delphi, but I guess its usually the same syntax. If so, here's a slight improvement on kobiks suggestion:
Parameters are added automatically if the SQL.Text is assigned before trying to assign values to the parameters. Like this:
qry.Parameters.Clear;
qry.SQL.Text := 'update tbl set pic = :blobVal where id = :idVal';
qry.Parameters.ParamByName('blobVal').LoadFromFile('c:\sample.jpg', ftBlob);
qry.Parameters.ParamByName('idVal').Value := 1;
qry.ExecSQL;

I wrote this as an answer to this q,
Delphi save packed record as blob in a sql database
which is currently flagged as a duplicate, possibly incorrectly because the technique
used by the OP as described in comments appears to be correct. So, the cause of the problem may lie elsewhere.
If the Duplicate flag gets removed, I'll re-post this answer there.
The following code works fine for me against a Sql Server table defined as shown below.
The data from Rec1 is saved into the table and correctly read back into Rec2.
(* MS Sql Server DDL
CREATE TABLE [blobs] (
[id] [int] NOT NULL ,
[blob] [image] NULL ,
CONSTRAINT [PK_blobs] PRIMARY KEY CLUSTERED
(
[id]
) ON [PRIMARY]
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
GO
*)
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
qBlobInsert: TADOQuery;
qBlobRead: TADOQuery;
Button1: TButton;
procedure Button1Click(Sender: TObject);
[...]
type
TMyRecord = packed record
FontName: string[30];
FontSize: word;
FontColor: integer;
FontStyle: word;
Attachement: string[255];
URL: string[255];
end;
const
scInsert = 'insert into blobs(id, blob) values(:id, :blob)';
scSelect = 'select * from blobs where id = %d';
procedure TForm1.Button1Click(Sender: TObject);
begin
TestInsert;
end;
procedure TForm1.TestInsert;
var
Rec1,
Rec2 : TMyRecord;
MS : TMemoryStream;
begin
FillChar(Rec1, SizeOf(Rec1), #0);
FillChar(Rec2, SizeOf(Rec2), #0);
Rec1.FontName := 'AName';
Rec1.URL := 'AUrl';
MS := TMemoryStream.Create;
try
// Save Rec1 using an INSERT statement
MS.Write(Rec1, SizeOf(Rec1));
MS.Seek(0, soFromBeginning);
qBlobInsert.Parameters[0].Value := 1;
qBlobInsert.Parameters[1].LoadFromStream(MS, ftBlob);
qBlobInsert.SQL.Text := scInsert;
qBlobInsert.ExecSQL;
// Read saved data back into Rec2
qBlobRead.SQL.Text := Format(scSelect, [1]);
qBlobRead.Open;
MS.Clear;
TBlobField(qBlobRead.FieldByName('blob')).SaveToStream(MS);
MS.Seek(0, soFromBeginning);
MS.Read(Rec2, MS.Size - 1);
Caption := Rec2.FontName + ':' + Rec2.URL;
finally
MS.Free;
end;
end;
Extract from DFM
object qBlobInsert: TADOQuery
Connection = ADOConnection1
Parameters = <
item
Name = 'id'
DataType = ftInteger
Value = Null
end
item
Name = 'blob'
DataType = ftBlob
Value = Null
end>
Left = 56
Top = 32
end

Related

generate a number increases with a specific format ex 'PRT-00000'

I want to create auto numbering to my access database in delphi
example :
I have a database with part names , i want to create an auto id that counts number of these records and generates a name with number as this 'PRT-00000' and increase it with one each time i add a record and keeps this format of five digits , like this 'PRT-00001'
help me please and thanks a lot .
sorry for my poor english
Let's assume your Access table is named 'Parts' and has an AutoNumber
field named 'ID' and a Short Text field named 'PartNumber'. One way of generating the
PartNumber value would be to get Access to calculate it for you, but since you have asked about Delphi, I'm going to explain a way to do it in Delphi.
Please start a new, very simple project with just the following items on the main form:
A TAdoConnection configured to connect to your database;
A TAdoQuery configured to use the TAdoConnection with its SQL.Text property set
to 'select * from Parts'
A TDataSource and TDBGrid configured to display the contents of the TAdoQuery.
A TButton
Then, add the following code to the form's unit:
procedure TForm2.Button1Click(Sender: TObject);
begin
NewPart;
end;
procedure TForm2.NewPart;
const
sSelect = 'select * from Parts';
sPrefix = 'PRT-';
iDigits = 5;
var
PartNumber : String;
ID : Integer;
begin
qryParts.Insert;
try
// First, set the new record's PartNumber field to a temporary value
qryParts.FieldByName('PartNumber').AsString := 'xxxx';
// save the record so that we can then read the ID value Access has allocated to the record
qryParts.Post;
// read the ID value
ID := qryParts.FieldByName('ID').AsInteger;
// next, construct the desired value for the PartNumber field based on the ID
PartNumber := qryParts.FieldByName('ID').AsString;
// left-pad the PartNumber with zeroes
while Length(PartNumber) < iDigits do
PartNumber := '0' + PartNumber;
// pre-pend the PRT- prefix
PartNumber := sPrefix + PartNumber;
// put qryParts into its dsEdit state
qryParts.Edit;
qryParts.FieldByName('PartNumber').AsString := PartNumber;
finally
// post the record back to the Parts table
qryParts.Post;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
qryParts.Open;
end;
Update I've managed to get the new Part's autonumber ID in advance of the new Part being posted to the db. To use this, add the NewAutoNumber function and modify the NewPart method as shown below.
function TForm2.NewAutoNumber(ATable, AColumn: String): Integer;
var
vCat : OleVariant;
vTable : OleVariant;
vColumn : OleVariant;
begin
vCat := CreateOleObject('ADOX.Catalog');
vCat.ActiveConnection := AdoConnection1.ConnectionString;
vTable := vCat.Tables[ATable];
vColumn := vTable.Columns[AColumn];
Result := vColumn.Properties['Seed'].Value;
end;
procedure TForm2.NewPart;
const
sSelect = 'select * from Parts';
sPrefix = 'PRT-';
iDigits = 5;
var
PrvSql : String;
PartNumber : String;
ID : Integer;
begin
ID := NewAutoNumber('Parts', 'ID');
try
qryParts.Insert;
qryParts.FieldByName('PartNumber').AsString := 'xxxx';
qryParts.Post;
if not qryParts.Locate('ID', ID, []) then begin
raise exception.CreateFmt('Failed to create new Parts record with ID = %d', [ID]);
end;
PartNumber := qryParts.FieldByName('ID').AsString;
while Length(PartNumber) < iDigits do
PartNumber := '0' + PartNumber;
PartNumber := sPrefix + PartNumber;
qryParts.Edit;
qryParts.FieldByName('PartNumber').AsString := PartNumber;
finally
qryParts.Post;
end;
end;
Update #2 As an alternative to getting the ID value for a newly-added Parts record using
either of the methods above, it can be obtained by using the 'select ##identity' method. The simplest
way to do this is to add another TAdoQuery, qryAutoNumber to the form and to add this function to
get the AutoNumber value:
function TForm2.NewAutoNumberFromIdentity : Integer;
begin
if qryAutoNumber.Active then
qryAutoNumber.Close;
qryAutoNumber.SQL.Text := 'select ##identity';
qryAutoNumber.Open;
Result := qryAutoNumber.Fields[0].AsInteger;
end;
Note that to obtain the correct ID value, this function should be called immediately after calling qryParts.Post. However, I have included this
only for completeness but as far as I can see, it is largely pointless
because once the new Parts record has been posted, the ID AutoNumber value
can be read directly from the ID field of qryParts.

Convert datatype ftFloat to ftBCD

How can I convert a fieldtype from ftFloat to ftBCD;
I tried
for i := 0 to FDataSet.FieldCount - 1 do begin
if FDataSet.Fields.Fields[i].DataType = ftFloat then begin
FDataSet.Fields.Fields[i].DataType := ftBCD;
end;
end;
But I get the error
[DCC Error] E2129 Cannot assign to a read-only property
Is there a way I can convert all dataset field that ftFloat to ftBCD ?
DataType is readonly Property of the Tfield created for a DataType.
This is done from Fielddefs using DefaultFieldClasses: array[TFieldType] of TFieldClass from DB.
If you need to change the DataType you will have to Free the Field and create anotherone fittinig your needs.
Below is shown an exmaple how this could be done.
type
TMyFieldInfo = Record
FieldName: String;
Size: Integer;
DataType: TFieldType;
FieldKind: TFieldKind;
end;
type
TFA= Array of TMyFieldInfo;
Procedure GetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
begin
SetLength(FA, DS.FieldCount);
for I := 0 to DS.FieldCount - 1 do
begin
FA[I].FieldName := DS.Fields[I].FieldName;
FA[I].DataType := DS.Fields[I].DataType;
FA[I].Size := DS.Fields[I].Size;
FA[I].FieldKind := fkdata;
end;
end;
Procedure SetFields(DS:Tdataset;var FA:TFA);
var
I: Integer;
F:TField;
begin
DS.Fields.Clear;
for I := Low(FA) to High(FA) do
begin
F := DefaultFieldClasses[FA[I].DataType].Create(DS);
With F do
begin
FieldName := FA[I].FieldName;
FieldKind := FA[I].FieldKind;
Size := FA[I].Size;
DataSet := DS;
end;
end;
end;
procedure TForm6.Button1Click(Sender: TObject);
var
L_FA: TFA;
I:Integer;
begin
MyDS.Open; // open to get the Fielddefs.
GetFields(MyDS,L_FA);
MyDS.Close; // close to be able to change the fields
for I := Low(L_FA) to High(L_FA) do
begin
if L_FA[i].DataType = ftFloat then
L_FA[i].DataType := ftBCD;
end;
SetFields(MyDS,L_FA);
MyDS.Open;
end;
Here is another way:
First, you need to dump the table into a file like this
ADOQuery.SaveToFile('C:\1.xml');
then find your field description in it, let's say it will be like this:
<s:datatype dt:type='float' dt:maxLength='8' rs:fixedlength='true' rs:maybenull='true'/>
and replace it with the other type description, like this:
<s:datatype dt:type='number' rs:dbtype='currency' dt:maxLength='25' rs:precision='25' rs:fixedlength='true' rs:maybenull='true'/>
now you need to load this file back, like this:
ADOQuery.LoadFromFile('C:\1.xml');
NO! Once you creates a Datafield you can not change it! It is because assigning a Filedtype is much more than just changeing an enum type property. Each field type is a specific class:
TintegerField etc...
So you can not change the FieldType for the same reason the can not make an TList in to a string
Excatly what are you trying to to ?
Jens Borrisholt

Problems returning cursor from stored procedure as ClientDataset

This question directly relates to my Previous Question.
I have a need to create a TClientDataSet on a client from an Oracle 11g cursor contained in a package. I am using Delphi XE2 and DBExpress to connect to the DB and DataSnap to send the data back to the client.
When I configure the TSQLStoredProc to the TClientDataset at design time I can return the cursor as a TClientDataset with no problem and get expected results.
When I try to execute the Stored Procedure at runtime it returns an empty TClientDataset.
Is it possible to configure and execute an Oracle 11g Stored Procedure using TSQLStoredProc at runtime?
DataSnap Server
Design time Data Module code [View as Text]
object StrProc1: TSQLStoredProc
SchemaName = 'xxxx'
MaxBlobSize = -1
Params = <
item
DataType = ftWideString
Precision = 2000
Name = 'ABBR'
ParamType = ptInput
Value = 'ZZZTOP'
end
item
DataType = ftCursor
Precision = 8000
Name = 'RES'
ParamType = ptOutput
Size = 8000
end>
PackageName = 'KP_DATASNAPTEST'
SQLConnection = SQLConnection1
StoredProcName = 'GETFAXDATA'
Left = 408
Top = 72
end
object DataSetProvider1: TDataSetProvider
DataSet = StrProc1
Left = 408
Top = 120
end
object ClientDataSet1: TClientDataSet
Aggregates = <>
Params = <>
ProviderName = 'DataSetProvider1'
Left = 408
Top = 176
end
function to execute Design Time config
function TKPSnapMethods.getCDS_Data3: OLEVariant;
begin
self.ClientDataSet1.Open;
result:= self.ClientDataSet1.Data;
self.SQLConnection1.Close;
end;
function to execute Runtime configuration This is the code that returns an empty ClientDataSet. The objective is to connect the pieces, set the value of the parameter, open the CDS and return the CDS.Data
function TKPSnapMethods.getCDS_Data2(schema: String): OleVariant;
var
cds: TClientDataSet;
dsp: TDataSetProvider;
strProc: TSQLStoredProc;
ProcParams: TList;
begin
strProc := TSQLStoredProc.Create(self);
try
strProc.SQLConnection:= SQLCon;//<--A TSQLConnection
dsp := TDataSetProvider.Create(self);
try
dsp.DataSet := strProc;
cds := TClientDataSet.Create(self);
try
cds.DisableStringTrim := True;
cds.ReadOnly := True;
cds.SetProvider(dsp);
ProcParams:= TList.Create;
try
//Load Stored Procedure Parameters
SQLCon.GetProcedureParams('GETFAXDATA','KP_DATASNAPTEST',Schema,ProcParams);
LoadParamListItems(StrProc.Params,ProcParams);
strProc.ParamByName('ABBR').AsString := 'ZZZTOP';//<--Assign Parms
strProc.MaxBlobSize := -1;
strProc.SchemaName:= Schema;
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
cds.Open;
Result := cds.Data;
finally
FreeProcParams(ProcParams);
end;
finally
FreeAndNil(cds);
end;
finally
FreeAndNil(dsp);
end;
finally
FreeAndNil(strProc);
self.SQLCon.Close;
end;
end;
Client Code this is just a test form that creates a connection to the DataSnap Server executes the ServerMethods and displays the results in a string grid.
procedure TForm1.Button1Click(Sender: TObject);
var
proxy:TKpSnapMethodsClient;
cds :TClientDataSet;
field: TField;
r,c:integer;
begin
r:=0;
c:=0;
SQLConTCPSERV.Connected := True; //TSQLConnection
proxy:= TKPSnapMethodsClient.Create(SQLConTCPSERV.DBXConnection,false);
cds:= TClientDataSet.Create(nil);
try
//cds.Data:= proxy.getCDS_Data2('TESTTH');//<--Runtime function
cds.Data:= proxy.getCDS_Data3; //<--Design time function
if cds <> nil then
begin
cds.Open;
cds.First;
//String grid to display CDS contents.
strGrid1.ColCount:= cds.FieldCount; //returns correct #
strGrid1.RowCount:= cds.RecordCount;
while not cds.Eof do //<--runtime wont make it past here
begin
for field in cds.fields do //loop fields
begin
strgrid1.Cells[c,r]:= field.Text; //display results.
c:=c+1;
end;
c:=0;
r:=r+1;
cds.Next;
end;
end
else showmessage('DataSet is NIL');
finally
cds.Free;
proxy.Free;
SQLConTCPSERV.Connected := False;
end;
end;
Once agian I must confess I am new to the Delphi language. I have searched google, code.google, the Embarcadero Developer Network and DBExpress documentation all to no avail.
I just don't understand why there would be a difference between design time and runtime.
I've resolved the issue. the problem is in the order of assigning values to the TSQLStoredProc component.
when calling this code:
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
the parameters are cleared. Below is the code to set the StoredProcName found in Data.SqlExpr
procedure TSQLStoredProc.SetStoredProcName(Value: UnicodeString);
begin
//if FStoredProcName <> Value then
//begin
FStoredProcName := Value;
SetCommandText(Value);
if Assigned(FProcParams) then // free output params if any
FreeProcParams(FProcParams);
//end;
end;
As you can see if FProcParams are assigned then FreeProcParams is call which frees the params. Because I was setting the StroredProcName after I was assigning the param values the code was executing with cleared params and returning an empty cursor.
the order that produces correct results at runtime [from getCDS_Data2] is as follows:
strProc.SchemaName:= Schema;
SQLCon.GetProcedureParams('GETFAXDATA','KP_DATASNAPTEST',Schema,ProcParams);
LoadParamListItems(StrProc.Params,ProcParams);
strproc.PackageName:='KP_DATASNAPTEST';
strProc.StoredProcName:= 'GETFAXDATA';
strProc.MaxBlobSize := -1;
strProc.ParamCheck:=true;
strProc.ParamByName('ABBR').AsString := 'ZZZTOP';
cds.Open;

How do I use ADO Parameters at run time in Delphi 2006?

I have been banging my head against the desk with this. I have a simple table with 2 columns, like so:
CREATE TABLE [dbo].[MiscInitializers](
[PKey] [int] IDENTITY(1,1) NOT NULL,
[Value] [text] NULL,
CONSTRAINT [PK_MiscInitializers] PRIMARY KEY CLUSTERED
(
[PKey] ASC
)WITH (PAD_INDEX = OFF, STATISTICS_NORECOMPUTE = OFF, IGNORE_DUP_KEY = OFF, ALLOW_ROW_LOCKS = ON, ALLOW_PAGE_LOCKS = ON) ON [PRIMARY]
) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY]
I am trying to update a row with a procedure like this:
function TdmSQL.SetInitializer(Value: string; var Key: string): boolean;
const
UpdateCmd =
'update MiscInitializers set Value = :theValue where PKey = :theKey';
InsertCmd = 'insert into MiscInitializers (Value) values (:Param1)';
var
tmp: integer;
rsTmp: TADODataSet;
foo: TParameter;
sTmp: string;
begin
Result := false;
adoGenericCommand.CommandText := '';
adoGenericCommand.Parameters.Clear;
if Key <> '' then
begin
// attempt update
if not TryStrToInt(Key, tmp) then
exit;
adoGenericCommand.CommandText := UpdateCmd;
adoGenericCommand.Prepared := true;
adoGenericCommand.Parameters.Refresh;
// some debug stuff
sTmp := Format('Num Params: %d', [adoGenericCommand.Parameters.Count]);
ShowMessageBox(sTmp);
for tmp := 0 to adoGenericCommand.Parameters.Count - 1 do
begin
sTmp := Format('Param %d: Name %s',
[tmp, adoGenericCommand.Parameters.Items[tmp].Name]);
ShowMessageBox(sTmp);
end;
// end debug stuff
foo := adoGenericCommand.Parameters.ParamByName('theValue');
foo.Value.AsString := Value;
foo := adoGenericCommand.Parameters.ParamByName('theKey');
foo.Value := Key;
rsTmp.Recordset := adoGenericCommand.Execute;
Result := rsTmp.RecordCount = 1;
exit;
// etc
What I see happening (with those debug messagebox calls) is that the update command gets 2 parameters, but their names are Param1 and Param2, not theValue and theKey.
Is there a way to set up the parameters at runtime so the ParamByName calls will work with the names I actually want, rather than the Param*N* that I'm getting?
You can use ParseSQL to generate the Parameters
const
UpdateCmd = 'update MiscInitializers set Value = :theValue where PKey = :theKey';
var
ds: TADODataSet;
I: Integer;
begin
ds := TADODataSet.Create(nil);
try
ds.CommandText := UpdateCmd;
ds.Parameters.ParseSQL(ds.CommandText, True);
for I := 0 to ds.Parameters.Count - 1 do
ShowMessage(ds.Parameters.Items[I].name);
finally
ds.Free;
end;
end;
Don't call Refresh on the 'Parameters' after you assign the 'CommandText'. When you call 'Refresh', the VCL turns to the provider for parameter information, and if the returned information does not contain parameter names then the VCL makes up them on the fly.

how to map names in Delphi4

I have an Delphi 4 application, that extracts data from XLS 2003 sheets (filled Forms ) and inserts into SQL2005 DB .
i have a group of fields in XSL and SQL2005 called.In the Delphi code it is correspondingly called 133, 167 etc.The words around "smrBgm133GallonsGross, .." i.e "smrBgm" and "GrossGallons" are concatinated accordingly in the Delphi files.
SQL/XLS Delphi
smrBgm133GallonsGross... 133
smrBgm167GallonsGross ... 167
For the above I added a new field called in XSL/SQL called smrBgm167GallonsGrossDA
But the PROBLEM is in the Delphi it should be NAMED AS 229, NOT as 'smrBgm167GallonsGrossDA' (as per some biz rules;coz the Delphi appl, processes both EDI/XLS and EDI accepts 229)Hence getting an error while inserting and updating data via the EXCEL sheets ."saying 229 not found in DB".
(Excel sheets it is named as 'smrBgm167GallonsGrossDA' where as in Delphi it is named as '229').
How to tell the Delphi application....
"if it is " smrBgm167GallonsGrossDA" then consider it as "229"?????????????
Not entirely sure what you need, I can't make head nor tail from what you specificly are asking but perhaps this gets you on the right path.
function ExtractNumber(const Value: string): Integer;
begin
if Value = 'smrBgm167GallonsGrossDA' then
Result := 229
else
Result := YourNormalFunctionToExtractTheNumber(Value);
end;
if copy(fieldname, Length(fieldname) - 2, 2) = 'DA' then
begin
delphiField = 229
end
???
You can create a lookup table. Which can be used to lookup the name.
For example:
const
cSize = 2;
cNames : array[0..cSize-1] of string = (
'Name1', 'Name2'
);
CNumbers : array[0..cSize-1] of Integer = (
99, 123
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cNames[i] = AName then begin
Result := cNumbers[i];
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;
Note you can also use one array of records:
type
TLookupRec = record
name : string;
number : Integer;
end;
const
cSize = 2;
cLookup : array[0..cSize-1] of TLookupRec = (
( name : 'Name1'; number : 99; ),
( name : 'Name2'; number : 123; )
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cLookUp[i].name = AName then begin
Result := cLookUp[i].number;
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;

Resources