I have Delphi application that connected to SQL server using ADODB component like (TAdoQuery , TADOStoredProcedure , TADOConnection .....)
Now am trying to migrating from ADODB Connection to FireDac in delphi 10.3 Rio ,
but how I can passing Recordset from TFDQuery to TFDStoredProcedure like this :
enter code here
var
Qry: TAdoQuery;
List: TADOStoredProc;
i: Integer;
Item: TCurrencyVal;
begin
Qry := TAdoQuery.Create(nil);
Qry.Connection := Connection;
Qry.SQL.Add('SELECT * FROM Currency WHERE ID=' + IntToStr(ID));
Qry.SQL.Add('SELECT * FROM CurrencyValues WHERE CurrencyID=' + IntToStr(ID));
Qry.Open;
Result := nil;
if Qry.RecordCount = 1 then
begin
Result := TCurrency.Create(AOwner);
TCurrency(Result).ID := ID;
TCurrency(Result).FCode := Qry.FieldByName('Code').AsString;
TCurrency(Result).FName := Qry.FieldByName('Name').AsString;
TCurrency(Result).FDefaultPrice := Qry.FieldByName('DefaultPrice').AsFloat;
TCurrency(Result).FDefaultCurrency := Qry.FieldByName('DefaultCurrency')
.AsBoolean;
TCurrency(Result).FPartName := Qry.FieldByName('PartName').AsString;
TCurrency(Result).FDecimalDigits := Qry.FieldByName('DecimalDigits')
.AsInteger;
TCurrency(Result).FAccountID := Qry.FieldByName('AccountID').AsInteger;
TCurrency(Result).FMajorGender := Qry.FieldByName('MajorGender').AsInteger;;
TCurrency(Result).FPluralMajor := Qry.FieldByName('PluralMajor').AsString;
TCurrency(Result).FMinorGender := Qry.FieldByName('MinorGender').AsInteger;;
TCurrency(Result).FPluralMinor := Qry.FieldByName('PluralMinor').AsString;
TCurrency(Result).FFracsInUnit := Qry.FieldByName('FracsInUnit').AsInteger;;
TCurrency(Result).FCountryName := Qry.FieldByName('CountryName').AsString;
List := TADOStoredProc.Create(Result);
List.Recordset := Qry.NextRecordset(i);
for i := 0 to List.RecordCount - 1 do
begin
List.RecNo := i + 1;
Item := TCurrencyVal.Create(Result);
Item.ID := List.FieldByName('ID').AsInteger;
Item.Date := List.FieldByName('Date').AsDateTime;
Item.SellPrice := List.FieldByName('Value').AsFloat;
TCurrency(Result).AddItem(Item);
end;
List.Close;
List.Free;
end;
Related
I'm using this class (link) from Jens Borrisholt.
This class helps to monitor keyboard events.
but the problem is that all keystrokes is trapped inside my application and no characters appear on other programs!!!
FHook := THookInstance<TLowLevelKeyboardHook>.CreateHook(Self);
FHook.OnPreExecute := procedure(Hook: THook; var HookMsg: THookMessage)
var
LLKeyBoardHook: TLowLevelKeyboardHook;
ScanCode: integer;
begin
LLKeyBoardHook := TLowLevelKeyboardHook(Hook);
ScanCode := LLKeyBoardHook.KeyName.ScanCode;
Caption := 'Got ya! Key [' + LLKeyBoardHook.KeyName.KeyExtName + '] blocked.';
HookMsg.Result := LLKeyBoardHook.ThreadID;
end;
FHook.Active := true;
This works for me!
I set HookMsg.Result := 0; inside FHook.OnPostExecute
FHook := THookInstance<TLowLevelKeyboardHook>.CreateHook(Self);
FHook.OnPreExecute := procedure(Hook: THook; var HookMsg: THookMessage)
var
LLKeyBoardHook: TLowLevelKeyboardHook;
ScanCode: integer;
begin
LLKeyBoardHook := TLowLevelKeyboardHook(Hook);
if LLKeyBoardHook.LowLevelKeyStates.KeyState <> ksKeyDown then
exit;
ScanCode := LLKeyBoardHook.KeyName.ScanCode;
if not(ScanCode in [VK_NUMPAD0 .. VK_NUMPAD9, VK_0 .. VK_9]) then
begin
Caption := 'Got ya! Key [' + LLKeyBoardHook.KeyName.KeyExtName + '] blocked.';
end
else
Caption := '';
end;
FHook.OnPostExecute := procedure(Hook: THook; var HookMsg: THookMessage)
begin
HookMsg.Result := 0;
end;
I'm using TFIBDataSet (Firebird dataset component) and I'm trying to automatically create all fields at runtime, without loading any record into the dataset.
Here is the code of my test:
uses
FIBDatabase, FIBDataSet, Dialogs;
...
var
Db : TFIBDataBase;
Tr : TFIBTransaction;
Dst : TFIBDataSet;
begin
//connection
Db := TFIBDatabase.Create(Self);
Db.ConnectParams.UserName := 'SYSDBA';
Db.ConnectParams.Password := 'masterkey';
Db.DatabaseName := 'localhost:mydatabase.fdb';
Db.SQLDialect := 3;
Db.Connected := True;
//transaction
Tr := TFIBTransaction.Create(Self);
Tr.DefaultDatabase := Db;
Tr.Active := True;
//dataset
Dst := TFIBDataSet.Create(Self);
Dst.Database := Db;
Dst.Transaction := Tr;
Dst.SelectSQL.Text := 'SELECT * FROM rdb$database';
//...
ShowMessage(IntToStr(Dst.FieldCount));
end;
The previous code produces '0' as output..
I've tried using Dst.Open() and it produces '5', but it also executes the SQL query.
I did it by calling FieldDefs.Update and creating the fields from the FieldDefs list.
uses
FIBDatabase, FIBDataSet, Dialogs;
...
var
Db : TFIBDataBase;
Tr : TFIBTransaction;
Dst : TFIBDataSet;
I : integer;
begin
//connection
Db := TFIBDatabase.Create(Self);
Db.ConnectParams.UserName := 'SYSDBA';
Db.ConnectParams.Password := 'masterkey';
Db.DatabaseName := 'localhost:mydatabase.fdb';
Db.SQLDialect := 3;
Db.Connected := True;
//transaction
Tr := TFIBTransaction.Create(Self);
Tr.DefaultDatabase := Db;
Tr.Active := True;
//dataset
Dst := TFIBDataSet.Create(Self);
Dst.Database := Db;
Dst.Transaction := Tr;
Dst.SelectSQL.Text := 'SELECT * FROM rdb$database';
//create fields
Dst.FieldDefs.Update();
for I := 0 to Dst.FieldDefs.Count - 1 do
Dst.FieldDefs[I].CreateField(Dst);
ShowMessage(IntToStr(Dst.FieldCount));
end;
My incoming data is loaded in a TFDMemTable, (the reader). The writer is a TFDQuery.
Incoming data should be inserted if not in the target, otherwise updated. Matches are based on the UUID field.
I am unable to properly define that the UUID field is the key.
Here is a code example - does not work. FBatchMove.Execute fails because cannot it find any key fields.
procedure TSubDB.FindDestRecord(ASender: TObject; var AFound: Boolean);
var
aSrc: TBytes;
begin
SetLength(aSrc, 16);
aSrc := FReader.DataSet.FieldByName('UUID').AsBytes;
AFound := FWriter.DataSet.Locate('UUID', aSrc, []);
end;
function TSubDB.LoadDB(const aFilename: string): boolean;
var
FQry: TFDQuery;
FBatchMove: TFDBatchMove;
FReader: TFDBatchMoveDataSetReader;
FWriter: TFDBatchMoveDataSetWriter;
FMemTable: TFDMemTable;
begin
FQry := TFDQuery.Create(nil);
FQry.Connection := dmFB.myDB;
FQry.FetchOptions.AssignedValues := [evItems];
FQry.FetchOptions.Items := [fiBlobs, fiDetails];
FBatchMove := TFDBatchMove.Create(nil);
FBatchMove.Analyze := [taDelimSep, taHeader, taFields];
FReader := TFDBatchMoveDataSetReader.Create(FBatchMove);
FWriter := TFDBatchMoveDataSetWriter.Create(FBatchMove);
FMemTable := TFDMemTable.Create(nil);
try
FMemTable.LoadFromFile(aFileName, sfBinary);
//Not sure how to make the BatchMove recognize that UUID is the key for OnFindDestRecord
FMemTable.IndexFieldNames := 'UUID';
with FMemTable.Indexes.Add do
begin
Name :='idxUUID';
Fields := 'UUID';
Active := true;
end;
FMemTable.IndexName := 'idxUUID';
FMemTable.IndexesActive := true;
FMemTable.FieldByName('UUID').ProviderFlags := FMemTable.FieldByName('UUID').ProviderFlags + [pfInKey];
FReader.DataSet := FMemTable;
FQry.SQL.Text := 'select * from test';
FWriter.DataSet := FQry;
FBatchMove.OnFindDestRecord := FindDestRecord;
FBatchMove.Mode := dmAppendUpdate;
//None of the above seems to keep the pfInKey in the UUID field's ProviderFlags
FBatchMove.Execute;
FQry.Open;
FQry.Close;
finally
FMemTable.Free;
FWriter.Free;
FReader.Free;
FBatchMove.Free;
FQry.Free;
end;
end;
I would really appreciate a working example of batch move (where the target has data, so the batch move mode is dmAppendUpdate).
The key here is that the writer needs to be a TFDBatchMoveSQLWriter with a TableName set. This way the destination had the primary key defined and it is then used to decide whether to insert or update.
function TSubDB.LoadDB(const aFilename: string): boolean;
var
FQry: TFDQuery;
FBatchMove: TFDBatchMove;
FReader: TFDBatchMoveDataSetReader;
FWriter: TFDBatchMoveSQLWriter;
FMemTable: TFDMemTable;
begin
FQry := TFDQuery.Create(nil);
FQry.Connection := dmFB.myDB;
FQry.FetchOptions.AssignedValues := [evItems];
FQry.FetchOptions.Items := [fiBlobs, fiDetails];
FBatchMove := TFDBatchMove.Create(nil);
FBatchMove.Analyze := [taDelimSep, taHeader, taFields];
FReader := TFDBatchMoveDataSetReader.Create(FBatchMove);
FWriter := TFDBatchMoveSQLWriter.Create(FBatchMove);
FMemTable := TFDMemTable.Create(nil);
try
FMemTable.LoadFromFile(aFileName, sfBinary);
FReader.DataSet := FMemTable;
FQry.SQL.Text := 'select * from test';
FWriter.Connection := dmFB.myDB;
FWriter.TableName := 'test';
FBatchMove.Mode := dmAppendUpdate;
FBatchMove.Execute;
FQry.Open;
FQry.Close;
finally
FMemTable.Free;
FWriter.Free;
FReader.Free;
FBatchMove.Free;
FQry.Free;
end;
end;
I am trying to connect my Delphi application to Informix database using fireDAC. I all the parameters supplied in connection editor. But I have to run PA Server to make it work.
So is it necessary to run the PA Server to connect to Informix db.
I am able to solve it using the following code to connect instead of dragging droping he controls:
procedure TForm1.FormCreate(Sender: TObject);
var
Params: TStringList;
begin
FDManager := TFDManager.Create(self);
FDconnection := TFDConnection.Create(self);
FDQuery := TFDQuery.Create(self);
FDataSOurce := TDataSource.Create(self);
Params := TStringList.create;
Params.Values['User_Name'] := paramstr(3);
Params.Values['Database'] := paramstr(2);
Params.Values['Password'] := paramstr(4);
Params.Values['DriverName'] := 'Informix';
Params.Values['HostName'] := paramstr(1);
Params.Values['RDBMS'] := 'OTHER';
Params.Values['DriverID'] := 'TDBX';
FDManager.AddConnectionDef('BOSSConnection', 'TDBX', Params);
FDConnection.DriverName := 'TDBX';
FDConnection.ConnectionDefName:='BOSSConnection';
FDConnection.Connected := True;
FDQuery.SQL.Add('select first 10 cust_code, bus_name, status from strcustr;');
FDQuery.Connection := FDConnection;
FDataSource.DataSet := FDQuery;
FDQuery.Active := True;
DBGrid1.DataSource := FDataSource;
FDConnection.LoginPrompt := False;
end;
Using Delphi 2010, UniDAC components, Firebird 2.5 SuperServer.
Database character set is ISO_8559_1 (my Windows default).
I am writing a data transfer application to transfer data from an Access database to a Firebird database that has identical table structure. I am using a ADOQuery component to select all rows from source table, and then looping through that recordset, and using UniSQL component with an INSERT statement with parameters, assigning parameter values from the corresponding source dataset field values.
When running the insert command, it throws a 'Malformed string' exception.
I am stuck and need help to resolve the issue.
Code follows:
function TDataTransfer.BeginTransfer(AProgressCallback: TProgressCallback): Boolean;
var
slSQLSelect, slSQLInsert: TStringList;
i, f, z: Integer;
cmdS, cmdI: String;
adods: TADODataSet;
fbcmd: TUniSQL;
fbscript: TUniscript;
q: String;
s : WideString;
begin
FProgressCallback := AProgressCallback;
fbscript := TUniscript.Create(nil);
try
fbscript.Connection := FirebirdConnection;
FirebirdConnection.StartTransaction;
try
fbscript.Delimiter := ';';
fbscript.ExecuteFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Script_0.txt');
FirebirdConnection.CommitRetaining;
slSQLSelect := TStringList.Create;
slSQLInsert := TStringList.Create;
adods := TADODataSet.Create(nil);
fbcmd := TUniSQL.Create(nil);
try
adods.Connection := AccessConnection;
fbcmd.Connection := FirebirdConnection;
slSQLSelect.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Access_Select.txt');
slSQLInsert.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Insert.txt');
z := slSQLSelect.Count - 1;
for i := 0 to z do begin
cmdS := slSQLSelect[i];
cmdI := slSQLInsert[i];
adods.CommandText := cmdS;
fbcmd.SQL.Text := cmdI;
adods.Open;
while not adods.Eof do begin
for f := 0 to adods.FieldCount - 1 do
try
if adods.FieldDefs[f].DataType = ftWideString then begin
s := adods.Fields[f].AsAnsiString ;
q := '"';
// if AnsiStrPos(PAnsiChar(#s), PAnsiChar(q)) <> nil then
// s := StringReplace(s, '"', '""', [rfReplaceAll]);
fbcmd.Params[f].Value := s;
end
else
if adods.FieldDefs[f].DataType = ftWideMemo then
fbcmd.Params[f].SetBlobData(adods.CreateBlobStream(adods.Fields[f], bmRead))
else
fbcmd.Params[f].Value := adods.Fields[f].Value;
except
raise;
end;
try
fbcmd.Execute;
// FirebirdConnection.CommitRetaining;
except
raise;
end;
adods.Next;
end;
adods.Close;
FProgressCallback((i + 1) * 100 div (z + 1), 10);
end;
finally
slSQLSelect.Free;
slSQLInsert.Free;
adods.Free;
fbcmd.Free;
end;
fbscript.ExecuteFile(ExtractFilePath(ParamStr(0)) + 'Firebird_Script_1.txt');
FirebirdConnection.Commit;
Result := True;
except
FirebirdConnection.Rollback;
Result := False;
end;
finally
fbscript.Free;
end;
end;
TIA,
SteveL
If you try to replace s := StringReplace(s, '"', '""', [rfReplaceAll]); with s := StringReplace(s, '''''', '''', [rfReplaceAll]); and uncomment the line;