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;
Related
I have an app with a TListView and I want to populate data from JSON inside its Items by using TJSONIterator.Next(). The code I use displays the results I want, except for the first one.
How can I parse these JSON objects correctly, what am I doing wrong?
Data: Data.json
{
"event":"subscribe-status",
"status":"ok",
"success":[
{
"symbol":"EUR/USD",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"USD/JPY",
"exchange":"PHYSICAL CURRENCY",
"mic_code":"PHYSICAL CURRENCY",
"country":"",
"type":"Physical Currency"
},
{
"symbol":"BTC/USD",
"exchange":"Coinbase Pro",
"mic_code":"Coinbase Pro",
"country":"",
"type":"Digital Currency"
},
{
"symbol":"ETH/BTC",
"exchange":"Huobi",
"mic_code":"Huobi",
"country":"",
"type":"Digital Currency"
}
],
"fails":null
}
Code app:
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
LIterator.Recurse;
LIterator.Next;
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
begin
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
oItem.Detail := 'Key:' +LIterator.Key;
end
end;
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
lStringReader.Free;
Memo1.Lines.Text := NObjJSON.ToString;
end;
Add this recurse / next at beginning of your loop to prepare to enter array :
while LIterator.Next do
begin
if LIterator.&Type = TJsonToken.StartArray then
begin
LIterator.Recurse;
LIterator.Next;
end;
You can check this exemple in the doc : https://docwiki.embarcadero.com/CodeExamples/Sydney/en/RTL.JSONIterator
The code below is easier to read :
procedure TFormX.LoadJSON;
const
cValue = 'symbol';
var
LValue: TJSONValue;
LArray: TJSONArray;
i: integer;
oItem: TListViewItem;
begin
LValue := TJSONObject.ParseJSONValue('{json}');
LArray := LValue.FindValue('success') as TJSONArray;
if Assigned(LArray) then
begin
for i := 0 to LArray.Count - 1 do
begin
oItem := ListView1.Items.Add;
oItem.Text := 'Object #' + i.ToString + ' ' + LArray.Items[i].GetValue<string>(cValue);
oItem.Detail := 'Key:' + cValue;
end;
end;
end;
After all, i found the correct solution:*
var
LIterator: TJSONIterator;
LJsonTextReader: TJsonTextReader;
LStringReader: TStreamReader;
NObjJSON: Integer;
begin
LStringReader := TStreamReader.Create('../../Data.json', TEncoding.UTF8, True);
LJsonTextReader := TJsonTextReader.Create(LStringReader);
LIterator := TJSONIterator.Create(LJsonTextReader);
NObjJSON := LIterator.AsInteger;
ListView1.Items.Clear;
ListView1.BeginUpdate;
try
while True do
begin
while LIterator.Next do
begin
if LIterator.&Type in [TJsonToken.StartObject, TJsonToken.StartArray] then
begin
Memo1.Lines.Add(LIterator.Key);
LIterator.Recurse;
end
else if LIterator.Path = 'success['+NObjJSON.ToString+'].symbol' then
begin
Memo1.Lines.Add(LIterator.AsValue.ToString);
oItem := ListView1.Items.Add;
for NObjJSON := 0 to ListView1.ItemCount -1 do
oItem.Text := 'Object #' + NObjJSON.ToString + ' ' + LIterator.AsValue.ToString;
end
end;
if LIterator.InRecurse then
LIterator.Return
else
Break;
end;
finally
ListView1.EndUpdate;
LIterator.Free;
LJsonTextReader.Free;
LStringReader.Free;
end;
end;
NObjJSON is used to count the number of objects inside array and it returns 4.
You can use a simple integer (I) and replace "for NObjJSON := 0 to ListView1.ItemCount -1 do" by for I := 0 to ListView1.ItemCount -1 do but the number of objects will return 0.
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;
(edit This question has received few downvotes. I don't know a reason and still cannot see what's wrong with it. I can edit this if downvoters could comment about what they wish to see better written or lack of valuable info I have not given).
I have Intermec PM4i label printer and Generic text print driver. I am able to print text file script from Notepad or Delphi calls ShellExecute('printto',..) shellapi function.
I found few raw printing examples but none work. How can Delphi app print to Generic_text_driver without shellapi function? This is not GDI printer.canvas capable driver.
I have tried "everything" even legacy PASSTHROUGH printing examples. Only working method is Notepad.exe or shellexecute('printto', 'tempfile.txt',...) which I guess is using Notepad internally. I can see notepad printing dialog flashing on screen. I would like to control this directly from Delphi application.
This printFileToGeneric did not work.
// https://groups.google.com/forum/#!topic/borland.public.delphi.winapi/viHjsTf5EqA
Procedure PrintFileToGeneric(Const sFileName, printerName, docName: string; ejectPage: boolean);
Const
BufSize = 16384;
Var
Count : Integer;
BytesWritten: DWORD;
hPrinter: THandle;
DocInfo: TDocInfo1;
f: file;
Buffer: Pointer;
ch: Char;
Begin
If not WinSpool.OpenPrinter(PChar(printerName), hPrinter, nil) Then
raise Exception.Create('Printer not found');
Try
DocInfo.pDocName := PChar(docName);
DocInfo.pOutputFile := nil;
DocInfo.pDatatype := 'RAW';
If StartDocPrinter(hPrinter, 1, #DocInfo) = 0 Then
Raise Exception.Create('StartDocPrinter failed');
Try
If not StartPagePrinter(hPrinter) Then
Raise Exception.Create('StartPagePrinter failed');
System.Assign(f, sFileName);
Try
Reset(f, 1);
GetMem(Buffer, BufSize);
Try
While not eof(f) Do Begin
Blockread(f, Buffer^, BufSize, Count);
If Count > 0 Then Begin
If not WritePrinter(hPrinter, Buffer, Count, BytesWritten) Then
Raise Exception.Create('WritePrinter failed');
End;
End;
Finally
If ejectPage Then Begin
ch:= #12;
WritePrinter( hPrinter, #ch, 1, BytesWritten );
End;
FreeMem(Buffer, BufSize);
End;
Finally
EndPagePrinter(hPrinter);
System.Closefile( f );
End;
Finally
EndDocPrinter(hPrinter);
End;
Finally
WinSpool.ClosePrinter(hPrinter);
End;
End;
The following prtRaw helper util example did not work.
prtRaw.StartRawPrintJob/StartRawPrintPage/PrintRawData/EndRawPrintPage/EndRawPrintJob
http://www.swissdelphicenter.ch/torry/showcode.php?id=940
The following AssignPrn method did not work.
function testPrintText(params: TStrings): Integer;
var
stemp:String;
idx: Integer;
pOutput: TextFile;
begin
Result:=0;
idx := getPrinterIndexByName( params.Values['printer'] );
if (idx<0) then Raise Exception.Create('Printer not found');
WriteLn('Use printer(text) ' + IntToStr(idx) + ' ' + Printer.Printers[idx] );
Printer.PrinterIndex := idx;
stemp := params.Values['jobname'];
if (stemp='') then stemp:='rawtextprint';
Printer.Title:=stemp;
AssignPrn(pOutput);
ReWrite(pOutput);
stemp := 'INPUT ON'+#10;
stemp := stemp + 'NASC 1252'+#10;
stemp := stemp + 'BF OFF'+#10;
stemp := stemp + 'PP 30,480:FT "Swiss 721 BT",8,0,100'+#10;
stemp := stemp + 'PT "Test text 30,480 position ABC'+#10;
Write(pOutput, stemp);
//Write(pOutput, 'INPUT ON:');
//Write(pOutput, 'NASC 1252:');
//Write(pOutput, 'BF OFF:');
//Write(pOutput, 'PP 30,480:FT "Swiss 721 BT",8,0,100:');
//Write(pOutput, 'PT "Test text 30,480 position ABC":');
//Write(pOutput, 'Text line 3 goes here#13#10');
//Write(pOutput, 'Text line 4 goes here#13#10');
CloseFile(pOutput);
end;
This Printer.Canvas did not print anything, it should have had print something because Notepad is internally using GDI printout. Something is missing here.
function testPrintGDI(params: TStrings): Integer;
var
filename, docName:String;
idx: Integer;
lines: TStrings;
begin
Result:=0;
idx := getPrinterIndexByName( params.Values['printer'] );
if (idx<0) then Raise Exception.Create('Printer not found');
WriteLn('Use printer(gdi) ' + IntToStr(idx) + ' ' + Printer.Printers[idx] );
docName := params.Values['jobname'];
if (docName='') then docName:='rawtextprint';
filename := params.values['input'];
If Not FileExists(filename) then Raise Exception.Create('input file not found');
Printer.PrinterIndex := idx;
Printer.Title := docName;
Printer.BeginDoc;
lines := readTextLines(filename);
try
for idx := 0 to lines.Count-1 do begin
Printer.Canvas.TextOut(10, 10*idx, lines[idx]);
end;
finally
FreeAndNil(lines);
Printer.EndDoc;
end;
end;
Only three methods working are printing from Notepad.exe, Delphi ShellExecute call or open a raw TCP socket to IP:PORT address and write text lines to a socket outputstream.
function testPrintPrintTo(params: TStrings): Integer;
var
filename, printerName:String;
idx: Integer;
exInfo: TShellExecuteInfo;
device,driver,port: array[0..255] of Char;
hDeviceMode: THandle;
timeout:Integer;
//iRet: Cardinal;
begin
Result:=0;
idx := getPrinterIndexByName( params.Values['printer'] );
if (idx<0) then Raise Exception.Create('Printer not found');
WriteLn('Use printer(printto) ' + IntToStr(idx) + ' ' + Printer.Printers[idx] );
filename := params.values['input'];
If Not FileExists(filename) then Raise Exception.Create('input file not found');
filename := uCommon.absoluteFilePath(filename);
Printer.PrinterIndex := idx;
Printer.GetPrinter(device, driver, port, hDeviceMode);
printerName := Format('"%s" "%s" "%s"', [device, driver, port]);
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := 0;
exInfo.lpVerb := 'printto';
exInfo.lpParameters := PChar(printerName);
lpFile := PChar(filename);
lpDirectory := nil;
nShow := SW_HIDE;
end;
WriteLn('printto ' + printerName);
if Not ShellExecuteEx(#exInfo) then begin
Raise Exception.Create('ShellExecuteEx failed');
exit;
end;
try
timeout := 30000;
while WaitForSingleObject(exInfo.hProcess, 50) <> WAIT_OBJECT_0 do begin
Writeln('wait timeout ' + IntToStr(timeout));
dec(timeout, 50);
if (timeout<1) then break;
end;
finally
CloseHandle(exInfo.hProcess);
end;
{iRet:=ShellExecute(0, 'printto',
PChar(filename),
PChar(printerName), //Printer.Printers[idx]),
nil, //PChar(filepath),
SW_HIDE // SW_SHOWNORMAL
);
Writeln('printto return code ' + IntToStr(iRet)); // >32 OK }
end;
you can use this procedure:
where the LabelFile is the full path of the label file,we are using this code and works with generic text driver printer and the printer is set as the default printer.
it works with zebra printer and windows xp operating system.
i hope this will help you.
function PrintLabel(LabelName: String): Boolean;
var
EfsLabel,dummy: TextFile;
ch : Char;
begin
try
try
Result:= False;
AssignFile(EfsLabel,LabelName);
Reset(EfsLabel);
Assignprn(dummy);
ReWrite(Dummy);
While not Eof(EfsLabel) do
begin
Read(EfsLabel, Ch);
Write(dummy, Ch);
end;
Result:= True;
except
Result:=False;
LogMessage('Error Printing Label',[],LOG_ERROR);
end;
finally
CloseFile(EfsLabel);
CloseFile(dummy);
end;
end;
You are able to print to this printer from Notepad. Notepad prints using the standard GDI mechanism. If Notepad can do this then so can you. Use Printer.BeginDoc, Printer.Canvas etc. to print to this printer.
I have a DB grid which is sorted (the user clicked a few radio buttons and checkboxes to influence the display).
I would like to export all of the data (not just what is visible in the grid), sorted identically, to CSV - how do I do so? The data - not the user settings, just to clarify.
Thanks in advance for any help
[Update] I build sqlQuery bit by bit, depending on the user's settings of checkboxes & radio groups, then, when one of them changes, I
ActivityADQuery.SQL.Clear();
ActivityADQuery.SQL.Add(sqlQuery);
ActivityADQuery.Open(sqlQuery);
That is to say that there isn't a hard coded query, it varies and I want to export the current settings.
I don't know enough if I want to export from the grid or the dataset (I am just not a db guy, this is my first DBgrid), but I suspect that I want the grid, because it has a subset of fields of he dataset.
I guess that TJvDBGridCSVExport is a Jedi component(?) I have tried to avoid them so far, great as they sound, because I prefer discreet, stand-alone, components to installing a huge collection. That may not be the cleverest thing to do, but it's how I feel - ymmv (and prolly does)
Another solution, works also with (multi)selected rows:
procedure TReportsForm.ExportToCSV(const aGrid : TDBGrid; const FileName : String);
Var
I, J : Integer;
SavePlace : TBookmark;
Table : TStrings;
HeadTable : String;
LineTable : String;
First : Boolean;
Begin
HeadTable := '';
LineTable := '';
Table := TStringList.Create;
First := True;
Try
For I := 0 To Pred(aGrid.Columns.Count) Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
// Use the text from the grid, in case it has been set programatically
// E.g., we prefer to show "Date/time" than "from_unixtime(activity.time_stamp, "%D %b %Y %l:%i:%S")"
// HeadTable := HeadTable + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ','; // Previous separated wth semi-colon, not comma! (global)
First := False;
End
Else
begin
// HeadTable := HeadTable + ';' + aGrid.Columns[I].FieldName;
HeadTable := HeadTable + ActivityReportStringGrid.Columns[i].Title.Caption + ',';
end;
Delete(HeadTable, Length(HeadTable), 1); // Remove the superfluous trailing comma
Table.Add(HeadTable);
First := True;
// with selection of rows
If aGrid.SelectedRows.Count > 0 Then
Begin
For i := 0 To aGrid.SelectedRows.Count - 1 Do
Begin
aGrid.DataSource.Dataset.GotoBookmark(pointer(aGrid.SelectedRows.Items[i]));
For j := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[J].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[J].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[J].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
First := True;
End;
End
Else
//no selection
Begin
SavePlace := aGrid.DataSource.Dataset.GetBookmark;
aGrid.DataSource.Dataset.First;
Try
While Not aGrid.DataSource.Dataset.Eof Do
Begin
For I := 0 To aGrid.Columns.Count - 1 Do
If aGrid.Columns[I].Visible Then
If First Then
Begin
lineTable := lineTable + aGrid.Fields[I].AsString;
First := False;
End
Else
lineTable := lineTable + ',' + aGrid.Fields[I].AsString;
Delete(LineTable, Length(LineTable), 1); // Remove the superfluous trailing comma
Table.Add(LineTable);
LineTable := '';
aGrid.DataSource.Dataset.Next;
First := True;
End;
aGrid.DataSource.Dataset.GotoBookmark(SavePlace);
Finally
aGrid.DataSource.Dataset.FreeBookmark(SavePlace);
End;
End;
Table.SaveToFile(FileName);
Finally
Table.Free;
End;
End; // ExportToCSV()
You could use a own tiny procedure wich could be adapted to your needs
Procedure Dataset2SeparatedFile(ads: TDataset; const fn: String; const Separator: String = ';');
var
sl: TStringList;
s: String;
i: Integer;
bm: TBookmark;
Procedure ClipIt;
begin
s := Copy(s, 1, Length(s) - Length(Separator));
sl.Add(s);
s := '';
end;
Function FixIt(const s: String): String;
begin
// maybe changed
Result := StringReplace(StringReplace(StringReplace(s, Separator, '', [rfReplaceAll]), #13, '', [rfReplaceAll]), #10, '', [rfReplaceAll]);
// additional changes could be Quoting Strings
end;
begin
sl := TStringList.Create;
try
s := '';
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayLabel) + Separator;
end;
ClipIt;
bm := ads.GetBookmark;
ads.DisableControls;
try
ads.First;
while not ads.Eof do
begin
For i := 0 to ads.FieldCount - 1 do
begin
if ads.Fields[i].Visible then
s := s + FixIt(ads.Fields[i].DisplayText) + Separator;
end;
ClipIt;
ads.Next;
end;
ads.GotoBookmark(bm);
finally
ads.EnableControls;
ads.FreeBookmark(bm);
end;
sl.SaveToFile(fn);
finally
sl.Free;
end;
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;