The FireDAC sample project (demonstrating ArrayDML) c:\Users\Public\Documents\Embarcadero\Studio\19.0\Samples\Object Pascal\Database\FireDAC\Samples\Comp Layer\TFDQuery\ExecSQL\Batch\Batch.dproj compiles with two // W1058 Implicit string cast with potential data loss from string to rawbytestring warnings on the Params[2].AsBlobs assignments indicated with //W 1058:
procedure TfrmBatch.btnExecSQLClick(Sender: TObject);
var
i: Integer;
iTm: LongWord;
begin
qrySelect.Open;
qrySelect.ServerDeleteAll(True);
qrySelect.Close;
with qryBatch do
if cbxBatchExec.Checked then begin
Params.ArraySize := StrToInt(edtArraySize.Text);
iTm := GetTickCount;
for i := 0 to Params.ArraySize - 1 do begin
Params[0].AsIntegers[i] := i;
Params[1].AsStrings[i] := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlobs[i] := 'blob' + IntToStr(i); // W1058
end;
Execute(Params.ArraySize);
iTm := GetTickCount - iTm;
end
else begin
Params.ArraySize := 1;
iTm := GetTickCount;
for i := 0 to StrToInt(edtArraySize.Text) - 1 do begin
Params[0].AsInteger := i;
Params[1].AsString := 'string' + IntToStr(i);
Params[1].Size := 20;
if cbxInsertBlob.Checked then
Params[2].AsBlob := 'blob' + IntToStr(i); // W1058
ExecSQL;
end;
iTm := GetTickCount - iTm;
end;
StatusBar1.SimpleText := 'Time executing is ' + FloatToStr(iTm / 1000.0) + ' sec.';
qrySelect.Open;
end;
What is the correct way to solve this? (Under FireDAC the AsBlobs has changed to TFDByteString = RawByteString under Windows). Both a cast as RawByteString() or a Params[2].Value assignment make the compiler warning go away but I'm unsure it this won't lead to potential problems...
If you decide storing binary BLOB data in a String type variable, you can lose them, and by adding typecast to RawByteString before that parameter value assignment you just say the compiler, that you agree with a potential data loss. There's nothing more than that.
Correct way is storing your BLOB data in RawByteString type variable for such parameter.
Related
I need to limit the number of decimal digits that the user can type as value for a ftFloat field.
var
Dst : TClientDataSet;
Dsc : TDataSource;
Fld : TNumericField;
Edt : TDBEdit;
begin
//dataset
Dst := TClientDataSet.Create(Self);
Dst.FieldDefs.Add('TEST', ftFloat);
Dst.CreateDataSet();
Dst.Active := True;
Fld := Dst.Fields[0] as TNumericField;
Dst.Append();
Fld.AsFloat := 1234.56;
Dst.Post();
//field
Fld.DisplayFormat := '0,.##'; //2 optional decimals, with thousands separator
Fld.EditFormat := '0.##'; //2 optional decimals, withhout thousands separator
//datasource
Dsc := TDataSource.Create(Self);
Dsc.DataSet := Dst;
//control
Edt := TDBEdit.Create(Self);
Edt.DataSource := Dsc;
Edt.DataField := Fld.FieldName;
Edt.Top := 5;
Edt.Left := 5;
Edt.Parent := Self;
end;
In the example, after typing 1234,5678, the TDBEdit control displays 1234,56 but the field's value is 1234,5678.
As suggested in this answer, I've tried using the EditMask property.
Fld.EditMask := '9' + DecimalSeparator + '99;1; ';
Unfortunately this approach introduces several problems:
I can't set a variable number of digits for the integer part (e.g. values like 12, 123... can't be typed)
I can't set negative values (e.g. values like -1, -12 can't be typed)
The decimal separator is always visible when editing.
How can I avoid that the user types more than N digits in the decimal part (Without adding any other kind of limitation)?
Rather than avoiding typing the field extra digits, you can also strip the digits before they are posted to the datasaet.
Strip the "extra" digits on the TDataset.OnBeforePost event, or maybe better using the OnDataChange event of a TDatasource. (Pseudocode,untested)
procedure TSomeClass.OnDataChange(aField:TField)
begin
if Assigned(aField) and (aField.FieldName='TEST') and not aField.IsNull then
aField.AsFloat:=round(aField.AsFloat*100)/100.0;
end;
As I found nothing in standard VCL controls to achieve this, my approach would be to have a TDBEdit descendant that can be assigned desired DecimalPlaces and can then prohibit the user from entering more than configured.
This is independent of the underlying data-type, but for ftFloat it will try to convert the resulting value, eliminating e.g. multiple times decimalseperator.
This uses KeyPress to eliminate unwanted keys that would invalidate the current value, either adding too many decimal places or in case of ftFloat not being convertible by TryStrToFloat.
An example using sample then would be:
//control
Edt := TDecimalPlacesDBEdit.Create(Self);
Edt.DataSource := Dsc;
Edt.DataField := Fld.FieldName;
Edt.Top := 5;
Edt.Left := 5;
Edt.Parent := Self;
Edt.DecimalPlaces := 2;
Here is an implementation approach in a new unit:
unit Unit1;
interface
uses
Vcl.DBCtrls;
type
TDecimalPlacesDBEdit = class(TDBEdit)
private
FDecimalPlaces: Integer;
function IsValidChar(Key: Char): Boolean;
protected
procedure KeyPress(var Key: Char); override;
public
property DecimalPlaces: Integer read FDecimalPlaces write FDecimalPlaces;
end;
implementation
uses
System.SysUtils,
Data.DB,
Winapi.Windows;
{ TDecimalPlacesDBEdit }
function TDecimalPlacesDBEdit.IsValidChar(Key: Char): Boolean;
function IsValidText(const S: string): Boolean;
var
ADecPos, AStartPos: Integer;
V: Double;
begin
Result := False;
ADecPos := Pos(FormatSettings.DecimalSeparator, S);
if ADecPos > 0 then
begin
AStartPos := Pos('E', UpperCase(S));
if AStartPos > ADecPos then
ADecPos := AStartPos - ADecPos - 1
else
ADecPos := Length(S) - ADecPos;
if ADecPos > DecimalPlaces then
Exit;
end;
if Assigned(Field) and (Field.DataType in [ftFloat{, ftSingle, ftExtended}]) then
Result := TryStrToFloat(S, V)
else
Result := True;
end;
var
AEndPos, AStartPos: Integer;
S: string;
begin
Result := DecimalPlaces = 0;
if not Result then
begin
S := Text;
AStartPos := SelStart;
AEndPos := SelStart + SelLength;
// Prepare current Text as if the user typed his key, then check if still valid.
Delete(S, SelStart + 1, AEndPos - AStartPos);
Insert(Key, S, AStartPos + 1);
Result := IsValidText(S);
end;
end;
procedure TDecimalPlacesDBEdit.KeyPress(var Key: Char);
begin
inherited KeyPress(Key);
if (Key >= #32) and not IsValidChar(Key) then
begin
MessageBeep(0);
Key := #0;
end;
end;
end.
I have been playing around with some code to send mail using MAPI in my Delphi XE7 program.
I have managed to get the To, Cc and Bcc working together with fileattachment, but when the mail is send by the client (in this case Outlook 2010) the program crashes and I simply can't figure out where I am am doing something wrong - I might be staring blind on the code.
I have made a small example with the code in a file in my dropbox
dl.dropboxusercontent.com/u/65392149/Mapi_MCVE.ZIP
The MAPI function looks like this
function SendMailMAPI(const aFrom, aTo, aCc, aBcc, aSubject, aBody: string; aMailFiles: TStringList; aReceipt: boolean): boolean;
var
MapiStatus: DWord;
MapiMessage: TMapiMessage;
MapiOrigin: TMapiRecipDesc;
MapiRecipient: array of TMapiRecipDesc;
MapiFiles: PMapiFileDesc;
RecipientsTo: TStringlist;
RecipientsCc: TStringlist;
RecipientsBcc: TStringlist;
RecipientsCount: integer;
FilesCount: Integer;
i: integer;
Filename: string;
begin
MapiStatus := SUCCESS_SUCCESS;
Result := True;
MapiFiles := nil;
FillChar(MapiMessage, Sizeof(TMapiMessage), 0);
if aReceipt then
MapiMessage.flFlags := MAPI_RECEIPT_REQUESTED;
MapiMessage.lpszSubject := PAnsiChar(AnsiString(aSubject));
MapiMessage.lpszNoteText := PAnsiChar(AnsiString(aBody));
FillChar(MapiOrigin, Sizeof(TMapiRecipDesc), 0);
MapiOrigin.lpszName := PAnsiChar(AnsiString(aFrom));
MapiOrigin.lpszAddress := PAnsiChar(AnsiString(aFrom));
MapiMessage.lpOriginator := nil;
FilesCount := aMailFiles.Count;
if FilesCount > 0 then
begin
GetMem(MapiFiles, SizeOf(TMapiFileDesc) * FilesCount);
for i := 0 to FilesCount - 1 do
begin
FileName := aMailfiles[i];
MapiFiles[i].ulReserved := 0;
MapiFiles[i].flFlags := 0;
MapiFiles[i].nPosition := ULONG($FFFFFFFF);
MapiFiles[i].lpszPathName := PAnsiChar(AnsiString(FileName));
MapiFiles[i].lpszFileName := PAnsiChar(AnsiString(ExtractFileName(FileName)));
MapiFiles[i].lpFileType := nil;
end;
MapiMessage.nFileCount := FilesCount;
MapiMessage.lpFiles := #MapiFiles^;
end;
RecipientsCount := 0;
RecipientsTo := TStringlist.Create;
RecipientsCc := TStringlist.Create;
RecipientsBcc := TStringlist.Create;
RecipientsTo.Delimiter := ';';
RecipientsCc.Delimiter := ';';
RecipientsBcc.Delimiter := ';';
try
if aTo <> '' then
begin
RecipientsTo.DelimitedText := aTo;
RecipientsCount := RecipientsCount + RecipientsTo.Count;
end;
if aCc <> '' then
begin
RecipientsCc.DelimitedText := aCc;
RecipientsCount := RecipientsCount + RecipientsCc.Count;
end;
if aBcc <> '' then
begin
RecipientsBcc.DelimitedText := aBcc;
RecipientsCount := RecipientsCount + RecipientsBcc.Count;
end;
FillChar(MapiRecipient, Sizeof(TMapiRecipDesc) * RecipientsCount, 0);
SetLength(MapiRecipient, RecipientsCount);
RecipientsCount := 0;
if RecipientsTo.Count > 0 then
begin
MapiRecipient[RecipientsCount].ulRecipClass := MAPI_TO;
for i := 0 to RecipientsTo.Count - 1 do
begin
MapiRecipient[RecipientsCount].lpszName := PAnsiChar(AnsiString(RecipientsTo[i]));
MapiRecipient[RecipientsCount].lpszAddress := PAnsiChar(AnsiString(RecipientsTo[i]));
Inc(RecipientsCount);
end;
end;
if RecipientsCc.Count > 0 then
begin
MapiRecipient[RecipientsCount].ulRecipClass := MAPI_CC;
for i := 0 to RecipientsCc.Count - 1 do
begin
MapiRecipient[RecipientsCount].lpszName := PAnsiChar(AnsiString(RecipientsCc[i]));
MapiRecipient[RecipientsCount].lpszAddress := PAnsiChar(AnsiString(RecipientsCc[i]));
Inc(RecipientsCount);
end;
end;
if RecipientsBcc.Count > 0 then
begin
MapiRecipient[RecipientsCount].ulRecipClass := MAPI_BCC;
for i := 0 to RecipientsBcc.Count - 1 do
begin
MapiRecipient[RecipientsCount].lpszName := PAnsiChar(AnsiString(RecipientsBcc[i]));
MapiRecipient[RecipientsCount].lpszAddress := PAnsiChar(AnsiString(RecipientsBcc[i]));
Inc(RecipientsCount);
end;
end;
MapiMessage.nRecipCount := RecipientsCount;
MapiMessage.lpRecips:= Pointer(MapiRecipient);
finally
RecipientsTo.Free;
RecipientsCc.Free;
RecipientsBcc.Free;
end;
try
MapiStatus := MapiSendMail(0, Application.MainForm.Handle, MapiMessage, MAPI_LOGON_UI + MAPI_DIALOG, 0);
except
on E:Exception do
ShowMessage('U_Mailing.Mapi.SendMailMAPI: ' + E.Message);
end;
for i := 0 to FilesCount - 1 do
begin
System.AnsiStrings.StrDispose(MapiFiles[i].lpszPathName);
System.AnsiStrings.StrDispose(MapiFiles[i].lpszFileName);
end;
for i := 0 to RecipientsCount - 1 do
begin
System.AnsiStrings.StrDispose(MapiRecipient[i].lpszName);
System.AnsiStrings.StrDispose(MapiRecipient[i].lpszAddress);
end;
case MapiStatus of
MAPI_E_AMBIGUOUS_RECIPIENT:
Showmessage('A recipient matched more than one of the recipient descriptor structures and MAPI_DIALOG was not set. No message was sent.');
MAPI_E_ATTACHMENT_NOT_FOUND:
Showmessage('The specified attachment was not found; no message was sent.');
MAPI_E_ATTACHMENT_OPEN_FAILURE:
Showmessage('The specified attachment could not be opened; no message was sent.');
MAPI_E_BAD_RECIPTYPE:
Showmessage('The type of a recipient was not MAPI_TO, MAPI_CC, or MAPI_BCC. No message was sent.');
MAPI_E_FAILURE:
Showmessage('One or more unspecified errors occurred; no message was sent.');
MAPI_E_INSUFFICIENT_MEMORY:
Showmessage('There was insufficient memory to proceed. No message was sent.');
MAPI_E_LOGIN_FAILURE:
Showmessage('There was no default logon, and the user failed to log on successfully when the logon dialog box was displayed. No message was sent.');
MAPI_E_TEXT_TOO_LARGE:
Showmessage('The text in the message was too large to sent; the message was not sent.');
MAPI_E_TOO_MANY_FILES:
Showmessage('There were too many file attachments; no message was sent.');
MAPI_E_TOO_MANY_RECIPIENTS:
Showmessage('There were too many recipients; no message was sent.');
MAPI_E_UNKNOWN_RECIPIENT:
Showmessage('A recipient did not appear in the address list; no message was sent.');
MAPI_E_USER_ABORT:
Showmessage('The user canceled the process; no message was sent.');
else
Showmessage('MAPISendMail failed with an unknown error code.');
Result := False;
end;
end;
I can see two obvious mistakes. Firstly you use a lot of implicit temporary AnsiString variables whose lifetime is unclear. This happens whenever you do
PAnsiChar(AnsiString(...))
The compiler makes a temporary AnsiString local variable. You are relying on the compiler making enough of them, one for each distinct string.
When you do this inside a loop, the compiler will have one implicit local variable shared between all iterations. That's not enough. You might get away with this because the memory manager doesn't happen to re-use the memory. But your code is still wrong.
I would create a TList<AnsiString> to hold the numerous AnsiString variables. Every time you need to get a PAnsiChar do this:
astr := AnsiString(...);
TempAnsiStrings.Add(astr);
... := PAnsiChar(astr);
where TempAnsiStrings is your list that holds temporary AnsiString objects. Wrap this up in a nested function for ease of use.
function GetPAnsiChar(const str: string): PAnsiChar;
var
astr: AnsiString;
begin
astr := AnsiString(str);
TempAnsiStrings.Add(astr);
Result := PAnsiChar(astr);
end;
Obviously you need to instantiate the list, and destroy it, but I trust you already know how to do that.
Your other problem are the calls to StrDispose. You have to remove them since the compiler is managing lifetime. Call StrDispose to free memory allocated with StrNew or StrAlloc. You don't allocate this way so there is no place for StrDispose.
Rather than using explicit memory allocation for list of files, a dynamic array would be cleaner. This would have the other benefit of avoiding the possibility of leaking that your code currently has due to its missing finally block.
While maintaining some code, I came across this statement:
sActDiln := Format('%.*f',[tdDigits.ndd, Fields[itd].AsFloat * rfc / 100]);
In order to see what was going on, I added a temporary variable (actDiln) of type DOUBLE and altered the code as follows:
actDiln := Fields[itd].AsFloat * rfc / 100;
sActDiln := Format('%.*f',[tdDigits.ndd, actDiln]);
When "Fields[itd].AsString" is 35 and "rfc" is 109, the computed value changed from 38.15 to 38.14999999. When the number of decimal digits was 1, this then changed the computed value from 38.2 to 38.1. And this caused other problems.
I did not anticipate that using this temporary variable would cause such problems. Can anyone explain what is going on here? And what is best practice in the future to avoid this?
This demonstrates the problem:
Uses DB, DBISAMTb;
procedure TForm1.FormShow(Sender: TObject);
var
t : TDBISAMTable;
actDiln, rfc : double;
actDilnE : extended;
sActDiln1, sActDiln2, sActDiln3 : string;
begin
t := TDBISAMTable.Create(Application);
WITH t DO BEGIN
TableName := 'xxx';
DataBaseName := 'Study';
Active := False;
Exclusive := False;
IF Exists THEN DeleteTable;
WITH FieldDefs DO BEGIN
Clear;
Add('fld', ftString, 10, False);
END;
WITH IndexDefs DO BEGIN
Clear;
END;
CreateTable;
Exclusive := True; //<<<<<<<<<<<<<
IndexName := '';
Open;
Append;
FieldByName('fld').AsString := '35';
Post;
rfc := 109;
actDiln := Fields[0].AsFloat * rfc / 100;
sActDiln1 := Format('%.*f',[1, Fields[0].AsFloat * rfc / 100]);
sActDiln2 := Format('%.*f',[1, actDiln]);
actDilnE := Fields[0].AsFloat * rfc / 100;
sActDiln3 := Format('%.*f',[1, actDilnE]);
ShowMessage(sActDiln1 + ' vs ' + sActDiln2 + ' vs ' + sActDiln3);
end;
end;
Inline floating-point calculations are usually of Extended type. Check the behavior when your intermediate variable is Extended too.
I have a function declare like this :
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer; //The "OutValues" is a out parameter.
And I call this function like this:
procedure TForm1.Button6Click(Sender: TObject);
var
v:integer;
s:pchar;
begin
Memo1.Clear;
v := execProc(pchar('PROC_TEST'),pchar('aaa'),s);
showmessage(inttostr(v)); //mark line
Memo1.Lines.Add(strpas(s));
end;
when i delete the mark line(showmessage(inttostr(v))),i will have a correct result display in the Memo1,but if i keep use the showmessage(), the memo1 will dispaly an error string : "Messag" ,Why?
Thanks for any help!
function execProc(ProcName,InValues:PChar;out OutValues:PChar):integer;
var
str: TStrings;
InValue,OutValue: string;
i,j,scount: integer;
begin
Result := -100;
i := 0;
j := 0;
str := TStringList.Create;
try
sCount := ExtractStrings(['|'], [], InValues, str);
with kbmMWClientStoredProc1 do
begin
Close;
Params.Clear;
StoredProcName := StrPas(ProcName);
FieldDefs.Updated := False;
FieldDefs.Update;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptUnknown) or
(Params[i].ParamType = ptInput) or
(Params[i].ParamType = ptInputOutput) then
begin
inc(j);
InValue := str[j-1];
Params[i].Value := InValue;
end;
end;
try
ExecProc;
for i := 0 to Params.Count - 1 do
begin
if (Params[i].ParamType = ptOutput) or
(Params[i].ParamType = ptInputOutput) then
OutValue := OutValue + '|' + Params[i].AsString;
end;
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
Result := 0;
except
on E:Exception do
begin
if E.Message = 'Connection lost.' then Result := -101;//服务器连接失败
if E.Message = 'Authorization failed.' then Result := -102;//身份验证失败
Writelog(E.Message);
end;
end;
end;
finally
str.Free;
end;
end;
The problem is in the design of your interface and the use of PChar.
OutValues := PChar(Copy(OutValue,2,Length(OutValue)-1));
This is implemented by making an implicit, hidden, local string variable which holds the value
Copy(OutValue,2,Length(OutValue)-1)
When the function returns, that string variable is destroyed and so OutValues points at deallocated memory. Sometimes your program appears to work but that's really just down to chance. Any small change can disturb that, as you have observed.
The problem is easy enough to fix. Simply use string parameters rather than PChar. This will make the code easier to read as well as making it work correctly.
function execProc(ProcName, InValues: string; out OutValues: string): integer;
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;