How to use nested transaction in Delphi dbExpress component with MySQL - mysql

I'm trying to do a nested transaction using dbExpress in Delphi XE3 that is connected to MySQL 5.6.13.
Here is my example code to do a Nested transaction:
...
dbxTransaction := _connection.BeginTransaction(TDBXIsolations.ReadCommitted);
// just to check if nested is suported
supportsNestedBol := dbxTransaction.Connection.DatabaseMetaData.SupportsNestedTransactions;
try
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO test(cod, name) VALUES(:cod, :name)');
_sqlQuery.ParamByName('cod').AsInteger := Test.Cod;
_sqlQuery.ParamByName('name').AsAnsiString := Test.Name;
_sqlQuery.ExecSQL(False);
//calls a nested function that has another transaction
Employee.Save();
_connection.CommitFreeAndNil(dbxTransaction);
Result := True;
except
on Exc:Exception do
begin
_connection.RollBackFreeAndNil(dbxTransaction);
raise Exc;
Result := False;
end;
end;
...
function Employee.Save():Boolean;
begin
...
dbxTransaction02 := _connection.BeginTransaction(TDBXIsolations.ReadCommitted);
try
_sqlQuery.Close;
_sqlQuery.SQL.Clear;
_sqlQuery.SQL.Add('INSERT INTO employee(cod, name) VALUES(:cod, :name)');
_sqlQuery.ParamByName('cod').AsInteger := Employee.Cod;
_sqlQuery.ParamByName('name').AsAnsiString := Employee.Name;
_sqlQuery.ExecSQL(False);
_connection.CommitFreeAndNil(dbxTransaction02);
Result := True;
except
on Exc:Exception do
begin
_connection.RollBackFreeAndNil(dbxTransaction02);
raise Exc;
Result := False;
end;
end;
end;
...
If I put a break point and check the variable supportsNestedBol the value is False.
So, I'm not sure if is the connector "libmysql.dll" that I'm using that not support nested transaction or if is the way that I'm trying to do it.
Some help?

Related

Simple JSON deserialization of records incorrect (Delphi Sydney [10.4.1])

What happened to the JSON deserializer of Delphi Sydney (10.4.1)?
After the migration from Delphi Seattle to Sydney, the standard marshal has problems with the deserialization of simple records.
Here is an example and simplified representation of my problem:
Data structure - Interation 1:
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
end;
JSON representation:
"AnalysisAdditionalData":[0,1,"ExampleString"]
Data structure - Interation x, 5 years later:
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
ExampleData3:String; {03} {since version 2016-01-01}
ExampleData4:String; {04} {since version 2018-01-01}
ExampleData5:String; {05}
end;
JSON representation:
"AnalysisAdditionalData":[0,1,"ExampleString0","ExampleString1","ExampleString2","ExampleString3"]
After interation 1, three string fields have been added.
If I now confront the standard marshal of Delphi Sydney (no custom converter, reverter, etc.) with an old dataset, so concretely with the data "AnalysisAdditionalData":[0,1, "ExampleString"], Sydney throws an EArgumentOutOfBoundsException because the 3 strings are expected - the deserialization fails.
Exit point is in Data.DBXJSONReflect in method TJSONUnMarshal.JSONToTValue - location marked below:
function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue;
rttiType: TRttiType): TValue;
var
tvArray: array of TValue;
Value: string;
I: Integer;
elementType: TRttiType;
Data: TValue;
recField: TRTTIField;
attrRev: TJSONInterceptor;
jsonFieldVal: TJSONValue;
ClassType: TClass;
Instance: Pointer;
begin
// null or nil returns empty
if (JsonValue = nil) or (JsonValue is TJSONNull) then
Exit(TValue.Empty);
// for each JSON value type
if JsonValue is TJSONNumber then
// get data "as is"
Value := TJSONNumber(JsonValue).ToString
else if JsonValue is TJSONString then
Value := TJSONString(JsonValue).Value
else if JsonValue is TJSONTrue then
Exit(True)
else if JsonValue is TJSONFalse then
Exit(False)
else if JsonValue is TJSONObject then
// object...
Exit(CreateObject(TJSONObject(JsonValue)))
else
begin
case rttiType.TypeKind of
TTypeKind.tkDynArray, TTypeKind.tkArray:
begin
// array
SetLength(tvArray, TJSONArray(JsonValue).Count);
if rttiType is TRttiArrayType then
elementType := TRttiArrayType(rttiType).elementType
else
elementType := TRttiDynamicArrayType(rttiType).elementType;
for I := 0 to Length(tvArray) - 1 do
tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
elementType);
Exit(TValue.FromArray(rttiType.Handle, tvArray));
end;
TTypeKind.tkRecord, TTypeKind.tkMRecord:
begin
TValue.Make(nil, rttiType.Handle, Data);
// match the fields with the array elements
I := 0;
for recField in rttiType.GetFields do
begin
Instance := Data.GetReferenceToRawData;
jsonFieldVal := TJSONArray(JsonValue).Items[I]; <<<--- Exception here (EArgumentOutOfBoundsException)
// check for type reverter
ClassType := nil;
if recField.FieldType.IsInstance then
ClassType := recField.FieldType.AsInstance.MetaclassType;
if (ClassType <> nil) then
begin
if HasReverter(ClassType, FIELD_ANY) then
RevertType(recField, Instance,
Reverter(ClassType, FIELD_ANY),
jsonFieldVal)
else
begin
attrRev := FieldTypeReverter(recField.FieldType);
if attrRev = nil then
attrRev := FieldReverter(recField);
if attrRev <> nil then
try
RevertType(recField, Instance, attrRev, jsonFieldVal)
finally
attrRev.Free
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
end
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
Inc(I);
end;
Exit(Data);
end;
end;
end;
// transform value string into TValue based on type info
Exit(StringToTValue(Value, rttiType.Handle));
end;
Of course, this may make sense for people who, for example, only work with Sydney, or at least with Delphi versions above Seattle, or have started with these versions. I, on the other hand, have only recently been able to make the transition from Seattle to Sydney (Update 1).
Delphi Seattle has no problems with the missing record fields. Why should it, when they can be left untouched as default? Absurdly, however, Sydney has no problems with excess data.
Is this a known Delphi Sydney bug? Can we expect a fix? Or can the problem be worked around in some other way, i.e. compiler directive, Data.DBXJSONReflect.TCustomAttribute, etc.? Or, is it possible to write a converter/reverter for records? If so, is there a useful guide or resource that explains how to do this?
I, for my part, have unfortunately not found any useful information in this regard, only many very poorly documented class descriptions.
Addendum: Yes, it looks like it is a Delphi bug, and in my opinion a very dangerous one. Luckily, and I'm just about to deploy a major release, I discovered the bug while testing after porting to Sydney. But that was only by chance, because I had to deal with old datasets. I could have easily overlooked the flaw.
You should check if your projects are also affected. For me, the problem is a neckbreaker right now.
I have just written a very simple test program for the Embarcadero support team. If you want, you can have a look at it and test if your code is also affected.
Below are the instructions and the code:
Create a new project.
Creates two buttons and a memo on the main form.
Assign the two OnClick events for the buttons for load and save accordingly
Runs the program and clicks the save button.
Opens the .TXT in the application directory and delete e.g. the last entry of the record.
Click the load button and an EArgumentOutOfBoundsException is thrown.
unit main;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
FMX.Memo.Types, FMX.StdCtrls, FMX.Controls.Presentation, FMX.ScrollBox,
FMX.Memo;
type
TAnalysisAdditionalData=record {order important for marshaling}
ExampleData0:Real; {00}
ExampleData1:Real; {01}
ExampleData2:String; {02}
ExampleData3:String; {03} {since version 2016-01-01}
ExampleData4:String; {04} {since version 2018-01-01}
ExampleData5:String; {05}
end;
TSHCustomEntity=class(TPersistent)
private
protected
public
GUID:String;
end;
TSHAnalysis=class(TSHCustomEntity)
private
protected
public
AnalysisResult:String;
AnalysisAdditionalData:TAnalysisAdditionalData;
end;
TMainform = class(TForm)
Memo_Output: TMemo;
Button_Save: TButton;
Button_Load: TButton;
procedure Button_SaveClick(Sender: TObject);
procedure Button_LoadClick(Sender: TObject);
private
Analysis:TSHAnalysis;
procedure Marshal(Filename:String);
procedure Unmarshal(Filename:String);
function GetApplicationPath: String;
function GetFilename: String;
protected
procedure AfterConstruction;override;
public
Destructor Destroy;override;
property ApplicationPath:String read GetApplicationPath;
property Filename:String read GetFilename;
end;
var
Mainform: TMainform;
implementation
{$R *.fmx}
uses
DBXJSON,
DBXJSONReflect,
System.JSON;
{ TMainform }
procedure TMainform.AfterConstruction;
begin
inherited;
self.Analysis:=TSHAnalysis.Create;
self.Analysis.GUID:='6ed61388-cdd4-28dd-6efe-24461c4df3cd';
self.Analysis.AnalysisAdditionalData.ExampleData0:=0.5;
self.Analysis.AnalysisAdditionalData.ExampleData1:=0.9;
self.Analysis.AnalysisAdditionalData.ExampleData2:='ExampleString0';
self.Analysis.AnalysisAdditionalData.ExampleData3:='ExampleString1';
self.Analysis.AnalysisAdditionalData.ExampleData4:='ExampleString2';
self.Analysis.AnalysisAdditionalData.ExampleData5:='ExampleString3';
end;
destructor TMainform.Destroy;
begin
self.Analysis.free;
inherited;
end;
function TMainform.GetApplicationPath: String;
begin
RESULT:=IncludeTrailingPathDelimiter(ExtractFilePath(paramStr(0)));
end;
function TMainform.GetFilename: String;
begin
RESULT:=self.ApplicationPath+'6ed61388-cdd4-28dd-6efe-24461c4df3cd.txt';
end;
procedure TMainform.Button_SaveClick(Sender: TObject);
begin
self.Marshal(self.Filename);
end;
procedure TMainform.Button_LoadClick(Sender: TObject);
begin
if Analysis<>NIL then
FreeAndNil(Analysis);
self.Unmarshal(self.Filename);
self.Memo_Output.Text:=
self.Analysis.GUID+#13#10+
FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData0)+#13#10+
FloatToStr(self.Analysis.AnalysisAdditionalData.ExampleData1)+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData2+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData3+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData4+#13#10+
self.Analysis.AnalysisAdditionalData.ExampleData5;
end;
procedure TMainform.Marshal(Filename:String);
var
_Marshal:TJSONMarshal;
_Strings:TStringlist;
_Value:TJSONValue;
begin
_Strings:=TStringlist.Create;
try
_Marshal:=TJSONMarshal.Create;
try
_Value:=_Marshal.Marshal(Analysis);
_Strings.text:=_Value.ToString;
finally
if _Value<>NIL then
_Value.free;
_Marshal.free;
end;
_Strings.SaveToFile(Filename);
finally
_Strings.free;
end;
end;
procedure TMainform.Unmarshal(Filename:String);
var
_Strings:TStrings;
_UnMarshal:TJSONUnMarshal;
_Value:TJSONValue;
begin
if FileExists(Filename) then begin
_Strings:=TStringlist.create;
try
_Strings.LoadFromFile(Filename);
try
_Value:=TJSONObject.ParseJSONValue(_Strings.Text);
_UnMarshal:=TJSONUnMarshal.Create;
try
try
self.Analysis:=_UnMarshal.Unmarshal(_Value) as TSHAnalysis;
except
on e:Exception do
self.Memo_Output.text:=e.Message;
end;
finally
_UnMarshal.free;
end;
finally
if _Value<>NIL then
_Value.free;
end;
finally
_Strings.free;
end;
end;
end;
end.
To solve the problem temporarily, I have the following quick solution for you:
Make a copy of the standard library Data.DBXJSONReflect and name it e.g. Data.TempFix.DBXJSONReflect.
Change all includes/uses in your project accordingly.
After that navigate in Data.TempFix.DBXJSONReflect to line 2993:
jsonFieldVal := TJSONArray(JsonValue).Items[I];
And replace it with the following code:
try
jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
on e:Exception do
if e is EArgumentOutOfRangeException then
continue
else
raise;
end;
After that the whole method should look like this:
function TJSONUnMarshal.JSONToTValue(JsonValue: TJSONValue; rttiType: TRttiType): TValue;
var
tvArray: array of TValue;
Value: string;
I: Integer;
elementType: TRttiType;
Data: TValue;
recField: TRTTIField;
attrRev: TJSONInterceptor;
jsonFieldVal: TJSONValue;
ClassType: TClass;
Instance: Pointer;
begin
// null or nil returns empty
if (JsonValue = nil) or (JsonValue is TJSONNull) then
Exit(TValue.Empty);
// for each JSON value type
if JsonValue is TJSONNumber then
// get data "as is"
Value := TJSONNumber(JsonValue).ToString
else if JsonValue is TJSONString then
Value := TJSONString(JsonValue).Value
else if JsonValue is TJSONTrue then
Exit(True)
else if JsonValue is TJSONFalse then
Exit(False)
else if JsonValue is TJSONObject then
// object...
Exit(CreateObject(TJSONObject(JsonValue)))
else
begin
case rttiType.TypeKind of
TTypeKind.tkDynArray, TTypeKind.tkArray:
begin
// array
SetLength(tvArray, TJSONArray(JsonValue).Count);
if rttiType is TRttiArrayType then
elementType := TRttiArrayType(rttiType).elementType
else
elementType := TRttiDynamicArrayType(rttiType).elementType;
for I := 0 to Length(tvArray) - 1 do
tvArray[I] := JSONToTValue(TJSONArray(JsonValue).Items[I],
elementType);
Exit(TValue.FromArray(rttiType.Handle, tvArray));
end;
TTypeKind.tkRecord, TTypeKind.tkMRecord:
begin
TValue.Make(nil, rttiType.Handle, Data);
// match the fields with the array elements
I := 0;
for recField in rttiType.GetFields do
begin
Instance := Data.GetReferenceToRawData;
try
jsonFieldVal := TJSONArray(JsonValue).Items[I];
except
on e:Exception do
if e is EArgumentOutOfRangeException then
continue
else
raise;
end;
// check for type reverter
ClassType := nil;
if recField.FieldType.IsInstance then
ClassType := recField.FieldType.AsInstance.MetaclassType;
if (ClassType <> nil) then
begin
if HasReverter(ClassType, FIELD_ANY) then
RevertType(recField, Instance,
Reverter(ClassType, FIELD_ANY),
jsonFieldVal)
else
begin
attrRev := FieldTypeReverter(recField.FieldType);
if attrRev = nil then
attrRev := FieldReverter(recField);
if attrRev <> nil then
try
RevertType(recField, Instance, attrRev, jsonFieldVal)
finally
attrRev.Free
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
end
end
else
recField.SetValue(Instance, JSONToTValue(jsonFieldVal,
recField.FieldType));
Inc(I);
end;
Exit(Data);
end;
end;
end;
// transform value string into TValue based on type info
Exit(StringToTValue(Value, rttiType.Handle));
end;

Delphi FDQuery to Json

I'm trying to convert the result of my Sqlite query into a Json,
to use the same procedures I use with remote binding to Sql Server by php.
The code works, but do you think it's a better solution?
Anyone there do that?
function TLogin.RetornaRegistros(query:String): String;
var
FDQuery : TFDQuery;
field_name,nomeDaColuna,valorDaColuna : String;
I: Integer;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FDQuery.First;
result := '[';
while (not FDQuery.EOF) do
begin
result := result+'{';
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
nomeDaColuna := FDQuery.FieldDefs[I].Name;
valorDaColuna := FDQuery.FieldByName(nomeDaColuna).AsString;
result := result+'"'+nomeDaColuna+'":"'+valorDaColuna+'",';
end;
Delete(result, Length(Result), 1);
result := result+'},';
FDQuery.Next;
end;
FDQuery.Refresh;
Delete(result, Length(Result), 1);
result := result+']';
finally
FDQuery.Free;
end;
end;
That is not a good approach. I really suggest consider at least three options:
Use the power of System.JSON unit.
Uses {...} System.JSON;
Var
FDQuery : TFDQuery;
field_name,Columnname,ColumnValue : String;
I: Integer;
LJSONObject:TJsonObject;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FdQuery.BeginBatch;//Don't update external references until EndBatch;
FDQuery.First;
LJSONObject:= TJSONObject.Create;
while (not FDQuery.EOF) do
begin
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
ColumnName := FDQuery.FieldDefs[I].Name;
ColumnValue := FDQuery.FieldByName(ColumnName).AsString;
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(ColumnValue)));
FDQuery.Next;
end;
//FDQuery.Refresh; that's wrong
FdQuery.EndBatch;
finally
FDQuery.Free;
Showmessage(LJSonObject.ToString);
end;
end;
https://www.youtube.com/watch?v=MLoeLpII9IE&t=715s
Second approach, use FDMemTable.SaveToStream;
The same works for FDMemTable.SaveToFile;
Put a TFDMemTable on Datamodule (Or form, as well).
fMStream:TMemoryStream;
Begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
//fdMemTable1.Data:=fdQuery.Data; {note *2}
fdMemTable1.CloneCursor(FdQuery,true,true);{note *3}
fMStream:=TMemoryStream.Create;
FdMemTable1.SaveToStream(fMStream,sfJson);
finally
FDQuery.Free;
FdMemTable.Close;
end;
Now you can Read the JSON content
For example, following answer Converting TMemoryStream to 'String' in Delphi 2009
function MemoryStreamToString(M: TMemoryStream): string;
begin
SetString(Result, PChar(M.Memory), M.Size div SizeOf(Char));
end;
and you have the json as String
The BatchMove suggeted by #VictoriaMarotoSilva
You can use BatchMove components, which provides an interface to move data between datasets, but it works better for backup and importation when you want to save data in drive, XML or json format. I didn't find examples yet, using data moving in memory; if somebody else has an example, please comment.
Notes
Using FdMemTable, don't forget drag TFDStanStorageJSONLink component for datamodule
method .Data just works for FiredacDatasets (Datasets with prefix FD).
To assign data for memTable in old Datasets use method .Copydata instead.
Sorry guys, I change .Data to .CloneCursor to share the same Memory Space with both datasets.
I just modified my first answer below to comport different type of field to convert number, date and boolean in appropriate json format.
I comment the Types I didn't test.
Look
Uses {...} System.JSON;
Var
FDQuery : TFDQuery;
field_name, Columnname, ColumnValue : String;
I: Integer;
LJSONObject:TJsonObject;
begin
FDQuery := TFDQuery.Create(nil);
try
FDQuery.Connection := FDConnection1;
FDQuery.SQL.Text := query;
FDQuery.Active := True;
FdQuery.BeginBatch;//Don't update external references until EndBatch;
FDQuery.First;
LJSONObject:= TJSONObject.Create;
while (not FDQuery.EOF) do
begin
for I := 0 to FDQuery.FieldDefs.Count-1 do
begin
ColumnName := FDQuery.FieldDefs[I].Name;
Case FDQuery.FieldDefs[I].Datatype of
ftBoolean:
IF FDQuery.FieldDefs[I].Value=True then LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONTrue.Create)) else
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONFalse.Create));
ftInteger,ftFloat{,ftSmallint,ftWord,ftCurrency} :
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONNumber.Create(FDQuery.FieldDefs[I].value)));
ftDate,ftDatetime,ftTime:
LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(FDQuery.FieldDefs[I].AsString)));
//or TJSONString.Create(formatDateTime('dd/mm/yyyy',FDQuery.FieldDefs[I].Value));
else LJSONObject.AddPair(TJSONPair.Create(TJSONString.Create( ColumnName),TJSONString.Create(FDQuery.FieldDefs[I].AsString)));
End;
FDQuery.Next;
end;
FdQuery.EndBatch;
finally
FDQuery.Free;
Showmessage(LJSonObject.ToString);
end;
end;
More about dataset.DataType http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/DB_TFieldType.html
More about JSONTypes https://community.embarcadero.com/blogs/entry/json-types-for-server-methods-in-datasnap-2010-4
Consider using TFDBatchMove component. It's for direct transferring of data between two databases with additional mappings support. As a source and target can be a text, dataset or an SQL query to any of the FireDAC's supported database engines.
The Delphi MVC Framework contains a powerful mapper to map json to objects and datasets to objects. The Mapper is a sub project. It's independent code that can also be used in other kind of projects. It is open-source!
Advantage is that boolean values for example, are converted to TJSONBool type and not a string. I suggest take a look at the samples.
https://github.com/danieleteti/delphimvcframework/tree/master/samples/objectsmapperssamples
Probably not the best solution, and you can modify this to how you would like the JSON to be formatted... here is a quick sample solution:
function GetDataSetAsJSON(DataSet: TDataSet): TJSONObject;
var
f: TField;
o: TJSOnObject;
a: TJSONArray;
begin
a := TJSONArray.Create;
DataSet.Active := True;
DataSet.First;
while not DataSet.EOF do begin
o := TJSOnObject.Create;
for f in DataSet.Fields do
o.AddPair(f.FieldName, VarToStr(f.Value));
a.AddElement(o);
DataSet.Next;
end;
DataSet.Active := False;
Result := TJSONObject.Create;
Result.AddPair(DataSet.Name, a);
end;

Delphi: Return database names from MySQL using Metadata

I want to know if there is a way to return database names from MySQL using Delphi object TSQLConnection, I know that there is some methods that return table names or field names:
TSQLConnection.getTableNames, TSQLConnection.GetFieldNames
but I can't find a way to get the databases on a specific server.
There s a method called OpenSchema in the TADOconnection object: TADOconnection.Openschema, that can return database names but in the TSQLConnection the method -protected not public- can't return database names.
P.S. I don't want to execute a query like 'show databases' or 'select * from information_schema.schemata'.
any body can help, thanks.
I tried this code and it worked, not sure if it will work for all MySQL, MariaDB versions and all Delphi versions but for me it workes, I am using delphi 6 and MySQL 4.0.25:
function GetMySQLDatabaseNames(AUserName, APassword, AHostName, APort: string; var
AErrorMessage: String): TStrings;
var SQLConnection: TSQLConnection;
ObjectCursor: ISQLCursor;
Status: SQLResult;
Counter: Integer;
Precision: Smallint;
Value: Pointer;
IsBlank: LongBool;
begin
Result:= TStringList.Create;
SQLConnection:= TSQLConnection.Create(nil);
with SQLConnection do
begin
ConnectionName:='dbnames';
DriverName := 'mysql';
Params.Clear;
Params.Values['User_Name'] := AUserName;
Params.Values['Password'] := APassword;
Params.Values['HostName'] := AHostName;
Params.Values['Database'] := 'mysql';
Params.Values['Port'] := APort;
LibraryName :='dbexpmda.dll';
VendorLib := 'not used';
GetDriverFunc :='getSQLDriverMySQLDirect';
LoginPrompt :=False;
try
Connected := True;
Status:= MetaData.getObjectList(eObjTypeDatabase, ObjectCursor);
while Status = SQL_SUCCESS do
begin
Status:= ObjectCursor.getColumnPrecision(4, Precision);
if Status = SQL_SUCCESS then
begin
Value:= AllocMem(Precision);
Status:= ObjectCursor.getString(4, Value, IsBlank);
if Status = SQL_SUCCESS then
if not IsBlank then
Result.Add(PChar(Value));
end;
Status:= ObjectCursor.Next;
end;
Connected := False;
Free;
except
on E: Exception do
begin
AErrorMessage:= AErrorMessage + E.Message+ sLineBreak;
end;
end;
end;
end;
With a query component you can get a list of databases with the following query:
SHOW DATABASES;
I have been looking for this answer for a longer time. Hopefully it will help others.

How to convert bitmap images stored in a MySQL table to JPEG format?

I have a MySQL table that stores bitmap images and I want to convert them to JPEG format to the same table. Can anyone help me to find a solution ?
I need this to reduce the size of the table...
When you'd use ADO to access your MySQL database, it might look like this (it's untested). This code assumes you have the table you want to work with named as YourTable and the BLOB field you want to convert the images from as ImageField. Note you have to specify the connection string to your DB in the ConnectionString property of the ADOConnection object:
uses
DB, ADODB, JPEG;
procedure ConvertImage(BlobField: TBlobField);
var
BMPImage: TBitmap;
JPEGImage: TJPEGImage;
MemoryStream: TMemoryStream;
begin
MemoryStream := TMemoryStream.Create;
try
BlobField.SaveToStream(MemoryStream);
BMPImage := TBitmap.Create;
try
MemoryStream.Position := 0;
BMPImage.LoadFromStream(MemoryStream);
JPEGImage := TJPEGImage.Create;
try
JPEGImage.Assign(BMPImage);
MemoryStream.Position := 0;
JPEGImage.SaveToStream(MemoryStream);
finally
JPEGImage.Free;
end;
finally
BMPImage.Free;
end;
MemoryStream.Position := 0;
BlobField.LoadFromStream(MemoryStream);
finally
MemoryStream.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ADOTable: TADOTable;
ADOConnection: TADOConnection;
begin
ADOConnection := TADOConnection.Create(nil);
try
ADOConnection.LoginPrompt := False;
// here you have to specify the connection string to your database
// according to your connection parameters
ADOConnection.ConnectionString := '<enter your connection string here>';
ADOConnection.Open;
if ADOConnection.Connected then
begin
ADOTable := TADOTable.Create(nil);
try
ADOTable.Connection := ADOConnection;
ADOTable.TableName := 'YourTable';
ADOTable.Filter := 'ImageField IS NOT NULL';
ADOTable.Filtered := True;
ADOTable.CursorType := ctOpenForwardOnly;
ADOTable.Open;
ADOTable.First;
while not ADOTable.Eof do
begin
ADOTable.Edit;
ConvertImage(TBlobField(ADOTable.FieldByName('ImageField')));
ADOTable.Post;
ADOTable.Next;
end;
finally
ADOTable.Free;
end;
end;
finally
ADOConnection.Free;
end;
end;

Using parameters with ADO Query (mysql/MyConnector)

Today I downloaded and installed MyConnector so I can use Mysql with ADO, everything installed, OK!, I can make connection with ODBC and do a connection from my delphi environment.
when I build my Query at runetime, I get an error saying :
Project Project1.exe raised exception class EOleException with message 'Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another'. Process stopped. Use Step or Run to continue.
function TForm1.CreateSQL : TADOQuery;
begin
result := TADOQuery.create(self);
with Result do
begin
Connection := MainConnection;
CursorLocation := clUseServer;
CursorType := ctStatic;
CacheSize := 50;
AutoCalcFields := true;
ParamCheck := true;
Prepared := true;
end;
end;
procedure TForm1.login();
begin
with CreateSQL do
try
with SQL do
begin
add('SELECT ');
add(' * ');
add('FROM ');
add(' LisenswebUsers ');
add('WHERE ');
add(' UserName = :MyUsername '); // debugger exception here
add('AND ');
add(' UserPassword = :MyPassword '); // debugger exception here
with Parameters do
begin
ParamByName('MyUsername').value := txtLogin.text;
ParamByName('MyPassword').value := strmd5(txtPassword.text);
end;
Open;
if Recordcount <> 1 then
begin
lblLoggedinAs.Text := format('Du er logget inn som: %s (%s)',[FieldByName('Username').AsString,FieldByName('UserEmailaddress').AsString]);
MainPageControl.ActivePageIndex := 1;
end else
begin
txtPassword.Text := '';
txtPassword.SetFocus;
end;
end;
finally
free;
end;
end;
The strangest thing is that this works if I turn off debugging in delphi.
I would try adding SQL.BeginUpdate/SQL.EndUpdate around the Adds, otherwise the SQL text will be parsed every time you call "Add".
This is generally a good idea, as ADOQuery.SQL is a TStringList that has an OnChange event that sets the CommandText. SetCommandText text then end up calling TADOCommand.AssignCommandText which does a fair amount of work parsing params, and setting CommandObject.CommandText. Sometimes drivers will fail with partial SQL statements, but this stuff looks OK.
I had a similar problem many years ago - that's why I learnt about this stuff!
procedure TForm1.login();
var
Qry : TADOQuery;
begin
Qry := CreateSQL;
try
Qry.SQL.BeginUpdate;
Qry.SQL.Add('SELECT');
Qry.SQL.Add(' *');
Qry.SQL.Add('FROM');
Qry.SQL.Add(' LisenswebUsers');
Qry.SQL.Add('WHERE UserName = :MyUsername '); // debugger exception here
Qry.SQL.Add(' AND UserPassword = :MyPassword '); // debugger exception here
Qry.SQL.EndUpdate;
Qry.Parameters.ParamByName('MyUsername').value := txtLogin.text;
Qry.Parameters.ParamByName('MyPassword').value := strmd5(txtPassword.text);
Qry.Open;
if Qry.Recordcount <> 1 then
begin
lblLoggedinAs.Text := format('Du er logget inn som: %s (%s)',[FieldByName('Username').AsString,FieldByName('UserEmailaddress').AsString]);
MainPageControl.ActivePageIndex := 1;
end
else
begin
txtPassword.Text := '';
txtPassword.SetFocus;
end;
finally
Qry.Free;
end;
end;
BTW, the nested withs are really ugly (let the holy war begin)
I will sometimes use with, but would never nest three levels! If you are, at least reduce the scope of with SQL so it ends before with Parameters.
Try setting an explicit datatype :
CreateSql.Parameters.ParamByName('MyUserName').DataType := ftString;
In my case, defining the parameters and assigning the query string before assigning the connection corrected the problem. The query executes successfully in both cases, but the TADOQuery component internally raises (and subsequently swallows) the EOleException noted in OP if the connection is assigned before the parameterized query.
//LADOQuery.Connection := LADOConnection; // Exception # LADOQuery.Text:=...
Param := LADOQuery.Parameters.AddParameter;
Param.Name := 'rid';
Param.DataType := ftFixedChar;
Param := LADOQuery.Parameters.AddParameter;
Param.Name := 'qd';
Param.DataType := ftLongWord;
LADOQuery.SQL.Clear;
LADOQuery.SQL.Text:='SELECT Val FROM table WHERE v1=:rid AND v2=:qd';
LADOQuery.Connection := LADOConnection; // OK!
I'm open to explanations as to why this is the case - nothing in the documentation seems to suggest a need for this order of operations.
The exception is raised in ADODB.pas in TADOCommand.AssignCommandText here
try
// Retrieve additional parameter info from the server if supported
Parameters.InternalRefresh;
where this branch is only followed if the TADOQuery is attached to a live connection. InternalRefresh performs :
if OLEDBParameters.GetParameterInfo(ParamCount,
PDBPARAMINFO(ParamInfo),
#NamesBuffer) = S_OK then
for I := 0 to ParamCount - 1 do
with ParamInfo[I] do
begin
// When no default name, fabricate one like ADO does
if pwszName = nil then
Name := 'Param' + IntToStr(I+1) else // Do not localize
Name := pwszName;
// ADO maps DBTYPE_BYTES to adVarBinary
if wType = DBTYPE_BYTES then wType := adVarBinary;
// ADO maps DBTYPE_STR to adVarChar
if wType = DBTYPE_STR then wType := adVarChar;
// ADO maps DBTYPE_WSTR to adVarWChar
if wType = DBTYPE_WSTR then wType := adVarWChar;
Direction := dwFlags and $F;
// Verify that the Direction is initialized
if Direction = adParamUnknown then Direction := adParamInput;
Parameter := Command.CommandObject.CreateParameter(Name, wType, Direction, ulParamSize, EmptyParam);
Parameter.Precision := bPrecision;
Parameter.NumericScale := ParamInfo[I].bScale;
// EOleException raised here vvvvvvvvv
Parameter.Attributes := dwFlags and $FFFFFFF0; //Mask out Input/Output flags
AddParameter.FParameter := Parameter;
end;
The problem definitely seems to be at the OLE level, probably because the MySQL ODBC driver does not support returning this information (or returns invalid information). The exception is raised behind the _Parameter interface when setting
Parameter.Attributes := dwFlags and $FFFFFFF0;
using what seem to be invalid values (dwFlags = 320 -> bits set above DBPARAMFLAGSENUM defined length) returned from GetParameterInfo. Exception handling for flow control seems the only option given that the interface does not provide any mechanism to check values before setting them (and triggering exceptions).
Update :
It turns out there is an open QC about this : http://qc.embarcadero.com/wc/qcmain.aspx?d=107267
BeginUpdate/EndUpdate pair is not adequate. Use AddParameter to add parameters explicity before assigning sql command. Like:
var
Qry : TADOQuery;
begin
Qry := CreateSQL;
try
with Qry.Parameters.AddParameter do
begin
Name := 'MyUsername';
DataType := ftString;
end;
with Qry.Parameters.AddParameter do
begin
Name := 'MyPassword';
DataType := ftString;
end;
Qry.SQL.BeginUpdate;
Qry.SQL.Add('SELECT');
Qry.SQL.Add(' *');
Qry.SQL.Add('FROM');
Qry.SQL.Add(' LisenswebUsers');
Qry.SQL.Add('WHERE UserName = :MyUsername '); // debugger exception here
Qry.SQL.Add(' AND UserPassword = :MyPassword '); // debugger exception here
Qry.SQL.EndUpdate;
...