# signs in ADO locates (Delphi XE5) - delphi

With an TADOQuery.Locate that uses a list of fields and a VarArray of values, if one of the values contains a # sign, we get this exception:
'Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.'
I've traced this down to ADODB which itself seems to be using # signs as delimiters.
Is there a way to escape #-signs so that the query doesn't fail?
* EDIT 1 *
I was wrong. What causes this failure is a string that has a pound sign and a single quote. The code shown below fails with error message noted above.
What really worries us is that when it fails running as an .exe outside the IDE, there's no runtime exception. We only see the exception when we're in the IDE. If our programmers hadn't happened to be using data that triggers this we never would have known that the .Locate returned FALSE because of a runtime error, not because a matching record was not found.
Code:
var
SearchArray: Variant;
begin
SearchArray := VarArrayCreate([0,1], VarVariant);
SearchArray[0] := 'T#more''wo';
SearchArray[1] := 'One';
ADOQuery.Locate('FieldName1;FieldName2', SearchArray, []);

Please see Updates below; I've found a work-around that's at least worth testing.
Even with Sql Server tables, the # shouldn't need to be escaped.
The following code works correctly in D7..XE8
procedure TForm1.Button1Click(Sender: TObject);
begin
AdoQuery1.Locate('country;class', VarArrayOf(['GB', Edit1.Text]), []);
end;
when Edit1.Text contains 'D#E', so I think your problem must lie elsewhere. Try a minimalist project with just that code, after rebooting your machine.
Update: As noted in a comment, there is a problem with .Locate where the expression
passed to GetFilterStr (in ADODB.Pas) contains a # followed by a single quote. To try and
work out a work-around for this, I've transplanted GetFilterStr into my code and have
been experimenting with using it to construct a recordset filter on my AdoQuery, as I noticed
that this is what .Locate does in the statement
FLookupCursor.Filter := LocateFilter;
The code I'm using for this, including my "corrected" version of GetFilterStr, is below.
What I haven't managed to figure out yet is how to avoid getting an exception on
AdoQuery1.Recordset.Filter := S;
when the filter expression yields no records.
(Btw, for convenience, I'm doing this in D7, but using XE8's GetFilterStr, which is why I've had to comment out the reference to ftFixedWideChar)
function GetFilterStr(Field: TField; Value: Variant; Partial: Boolean = False): WideString;
// From XE8 Data.Win.ADODB
var
Operator,
FieldName,
QuoteCh: WideString;
begin
QuoteCh := '';
Operator := '=';
FieldName := Field.FieldName;
if Pos(' ', FieldName) > 0 then
FieldName := WideFormat('[%s]', [FieldName]);
if VarIsNull(Value) or VarIsClear(Value) then
Value := 'Null'
else
case Field.DataType of
ftDate, ftTime, ftDateTime:
QuoteCh := '#';
ftString, ftFixedChar, ftWideString://, ftFixedWideChar:
begin
if Partial and (Value <> '') then
begin
Value := Value + '*';
Operator := ' like '; { Do not localize }
end;
{.$define UseOriginal}
{$ifdef UseOriginal}
if Pos('''', Value) > 0 then
QuoteCh := '#' else
QuoteCh := '''';
{$else}
QuoteCh := '''';
if Pos('''', Value) > 0 then begin
QuoteCh := '';
Value := QuotedStr(Value);
end;
{$endif}
end;
end;
Result := WideFormat('(%s%s%s%s%2:s)', [FieldName, Operator, QuoteCh, VarToWideStr(Value)]);
end;
procedure TForm1.CreateFilterExpr;
var
S : String;
begin
// clear any existing filter
AdoQuery1.Recordset.Filter := adFilterNone;
AdoQuery1.Refresh;
if edFilter.Text = '' then Exit;
S := GetFilterStr(AdoQuery1.FieldByName('Applicant'), edFilter.Text, cbPartialKey.Checked);
// Add the filter expr to Memo1 so we can inspect it
Memo1.Lines.Add(S);
try
AdoQuery1.Recordset.Filter := S;
AdoQuery1.Refresh;
except
end;
end;
procedure TForm1.FilterClick(Sender: TObject);
begin
CreateFilterExpr;
end;
Update 2: Try the following:
Copy Data.Win.ADODB.Pas to your project directory
In it, replace GetFilterExpr by the version above, making sure that UseOriginal
isn't DEFINEd, and that ftFixedWideChar is reinstated in the Case statement.
Build and run your project
In XE8 at any rate, my testbed now correctly Locate()s a field ending with ' or #'
(or containing either of them if loPartialKey is specified. (I can't test in XE4/5
because my XE4 now says it's unlicenced since I upgraded to Win10 last week, thanks EMBA!)
I hestitate to call this a solution or even a work-around as yet, but it is at least worth testing.
I'm not sure whether I'd call the original version of GetFilterExpr bugged, because I'm not sure
what use-case its treatment of values containing quotes was intended to handle.

Related

How can I filter a string field in a dataset with a like clause and an umlaut?

Albeit there is some documentation about dataset filtering, the syntax details are only outlined. In my application I want to filter person names with a dataset filter. Normally this works really fast, but I've stumbled over a minor problem filtering for example a TClientDataset. How can I add a like filter for an umlaut? The expression
[X] LIKE 'Ö%'
(for a given field X) does not work (in contrast to the expression [X] LIKE 'A%'). Is this just a bug or do I need to set a charset / encoding somewhere?
Minimal example:
procedure TForm1.FormCreate(Sender: TObject);
var
LField: TFieldDef;
LCDs: TClientDataSet;
const
SAMPLE_CHAR: string = 'Ö';
begin
LCds := TClientDataSet.Create(Self);
LField := LCds.FieldDefs.AddFieldDef();
LField.DataType := ftString;
LField.Size := 10;
LField.Name := 'X';
LCDs.CreateDataSet;
LCDs.Append;
LCDs.FieldByName('X').AsString := SAMPLE_CHAR;
LCDs.Post;
ShowMessage(LCds.FieldByName('X').AsString);
LCds.Filter := '[X] LIKE ' + QuotedStr(SAMPLE_CHAR + '%');
LCds.Filtered := true;
ShowMessage(LCds.FieldByName('X').AsString);
end;
The first message box shows Ö, whereas the second message box is empty. If you change SAMPLE_CHAR from Ö to A, both message boxes show A.
Use ftWideString data type to create a TWideStringField field instead of ftString, which internally creates a TStringField field. TStringField is for ANSI strings whilst TWideStringField for Unicode ones. Do that, otherwise you lose data.
To access TWideStringField value use AsWideString property. I've made a quick test in D 2009, and when I tried to filter the dataset I got this:
First chance exception at $7594845D. Exception class EAccessViolation
with message 'Access violation at address 4DB1E8D1 in module
'midas.dll'. Read of address 00FC0298'.
Tested code:
procedure TForm1.FormCreate(Sender: TObject);
var
S: string;
FieldDef: TFieldDef;
MemTable: TClientDataSet;
begin
S := 'Ŧĥε qùíçķ ƀřǭŵņ fôx ǰűmpεď ōvêŗ ţħě łáƶÿ ďơǥ';
MemTable := TClientDataSet.Create(nil);
try
FieldDef := MemTable.FieldDefs.AddFieldDef;
FieldDef.DataType := ftWideString;
FieldDef.Size := 255;
FieldDef.Name := 'MyField';
MemTable.CreateDataSet;
MemTable.Append;
MemTable.FieldByName('MyField').AsWideString := S;
MemTable.Post;
ShowMessage(MemTable.FieldByName('MyField').AsWideString); { ← data lost }
MemTable.Filter := '[MyField] LIKE ' + QuotedStr('%' + 'ǰűmpεď' + '%');
MemTable.Filtered := True; { ← access violation }
ShowMessage(MemTable.FieldByName('MyField').AsWideString);
finally
MemTable.Free;
end;
end;
I hope it's not related to your Delphi version, but still, I would prefer using FireDAC if you can. There you would do the same for Unicode strings (your code would change by replacing TClientDataSet by TFDMemTable and adding FireDAC units).

Copy a file to clipboard in Delphi

I am trying to copy a file to the clipboard. All examples in Internet are the same. I am using one from, http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212186.html but it does not work.
I use Rad Studio XE and I pass the complete path. In mode debug, I get some warnings like:
Debug Output:
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
I am not sure is my environment is related: Windows 8.1 64 bits, Rad Studio XE.
When I try to paste the clipboard, nothing happens. Also, seeing the clipboard with a monitor tool, this tool shows me error.
The code is:
procedure TfrmDoc2.CopyFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
end;
end;
UPDATE:
I am sorry, I feel stupid. I used the code that did not work, the original question that somebody asked, in my project, while I used the Remy's code, the correct solution, here in Stackoverflow. I thought that I used the Remy's code in my project. So, now, using the Remy's code, everything works great. Sorry for the mistake.
The forum post you link to contains the code in your question and asks why it doesn't work. Not surprisingly the code doesn't work for you any more than it did for the asker.
The answer that Remy gives is that there is a mismatch between ANSI and Unicode. The code is for ANSI but the compiler is Unicode.
So click on Remy's reply and do what it says: http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212187.html
Essentially you need to adapt the code to account for characters being 2 bytes wide in Unicode Delphi, but I see no real purpose repeating Remy's code here.
However, I'd say that you can do better than this code. The problem with this code is that it mixes every aspect all into one big function that does it all. What's more, the function is a method of a form in your GUI which is really the wrong place for it. There are aspects of the code that you might be able to re-use, but not factored like that.
I'd start with a function that puts an known block of memory into the clipboard.
procedure ClipboardError;
begin
raise Exception.Create('Could not complete clipboard operation.');
// substitute something more specific that Exception in your code
end;
procedure CheckClipboardHandle(Handle: HGLOBAL);
begin
if Handle=0 then begin
ClipboardError;
end;
end;
procedure CheckClipboardPtr(Ptr: Pointer);
begin
if not Assigned(Ptr) then begin
ClipboardError;
end;
end;
procedure PutInClipboard(ClipboardFormat: UINT; Buffer: Pointer; Count: Integer);
var
Handle: HGLOBAL;
Ptr: Pointer;
begin
Clipboard.Open;
Try
Handle := GlobalAlloc(GMEM_MOVEABLE, Count);
Try
CheckClipboardHandle(Handle);
Ptr := GlobalLock(Handle);
CheckClipboardPtr(Ptr);
Move(Buffer^, Ptr^, Count);
GlobalUnlock(Handle);
Clipboard.SetAsHandle(ClipboardFormat, Handle);
Except
GlobalFree(Handle);
raise;
End;
Finally
Clipboard.Close;
End;
end;
We're also going to need to be able to make double-null terminated lists of strings. Like this:
function DoubleNullTerminatedString(const Values: array of string): string;
var
Value: string;
begin
Result := '';
for Value in Values do
Result := Result + Value + #0;
Result := Result + #0;
end;
Perhaps you might add an overload that accepted a TStrings instance.
Now that we have all this we can concentrate on making the structure needed for the CF_HDROP format.
procedure CopyFileNamesToClipboard(const FileNames: array of string);
var
Size: Integer;
FileList: string;
DropFiles: PDropFiles;
begin
FileList := DoubleNullTerminatedString(FileNames);
Size := SizeOf(TDropFiles) + ByteLength(FileList);
DropFiles := AllocMem(Size);
try
DropFiles.pFiles := SizeOf(TDropFiles);
DropFiles.fWide := True;
Move(Pointer(FileList)^, (PByte(DropFiles) + SizeOf(TDropFiles))^,
ByteLength(FileList));
PutInClipboard(CF_HDROP, DropFiles, Size);
finally
FreeMem(DropFiles);
end;
end;
Since you use Delphi XE, strings are Unicode, but you are not taking the size of character into count when you allocate and move memory.
Change the line allocating memory to
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen * SizeOf(Char));
and the line copying memory, to
Move(FileList[1], (PByte(DropFiles) + SizeOf(TDropFiles))^, iLen * SizeOf(Char));
Note the inclusion of *SizeOf(Char) in both lines and change of PChar to PByte on second line.
Then, also set the fWide member of DropFiles to True
DropFiles^.fWide := True;
All of these changes are already in the code from Remy, referred to by David.

Error: Object Was Open - Delphi

I have the following issue, When ever I run this code in the procedure, getting a SQL from my SQL COMPACT DATABASE(sdf), it gives me an error "Object Already Open". How can I fix this. Below is my code for the procedure
Function GetSQL(sName: String; Var App: TApplication): String;
Var
Q: TADOQuery;
Begin
Q := TADOQuery.Create(App);
Q.ConnectionString := GetConnectionStringFromRegistry;
Q.Close;
Q.SQL.Text := 'SELECT * FROM SQLs WHERE Name = :sname';
Q.Parameters.ParamByName('sname').Value := sName;
Try
Q.Open;
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
Q.Close;
End;
Finally
Q.Free;
End;
End;
[This is what the error looks like]
[This is what the code looks like when I press Break]
The only thing I see that could be a problem is that your code leaves the query open if there are no rows returned:
Q.Open;
Try
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
Q.Close; // If Q.RecordCount = 0 above, this line never executes
End;
Finally
Q.Free;
End;
Move the Q.Close inside your finally instead, so it will always be called:
Q.Open;
Try
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
End;
Finally
Q.Close; // This will always run, even if no rows are returned
Q.Free; // or if an exception occurs.
End;
As an aside, you should use parameterized queries instead of concatenating the text, especially if you're running the same query multiple times with the only change being the value of sName. The server is smart enough to cache the compiled query and only replace the parameter value, which means your code executes faster and with less load on the server.
Function GetSQL(sName: String; Var App: TApplication): String;
Var
Q: TADOQuery;
Begin
Q := TADOQuery.Create(App);
Q.ConnectionString := GetConnectionStringFromRegistry;
// I've even tried closing it first
Q.Close;
Q.SQL.Text := 'SELECT Query FROM SQLs WHERE Name = :sname';
Q.ParamByName('sname').AsString := sName;
Try
// Error occurs here
Q.Open;
//Q.Active := True;
If Q.RecordCount >= 1 Then
Begin
Q.First;
Result := Q['Query'];
End;
Finally
Q.Close;
Q.Free;
End;
End;
Thanks to #user582118 for reminding this one...
This is actually a bug in the OleDB provider for SQL CE. If you have nvarchar fields greater than 127 characters in a table and you do a select query on that table, you will receive the DB_E_OBJECTOPEN error.
Original thread : https://stackoverflow.com/a/14222561/800214

Check If TEdit's Text Property Is Null On A Frame

So here is my situation. I have a Form (MainMenu) and a Frame (TestFrame). TestFrame is displayed on a TPanel located on MainMenu. Using this code:
frTestFrame := TfrTestFrame.Create(nil);
frTestFrame.Parent := plMain;
frTestFrame.Align := alClient;
frTestFrame.Visible := true;
TestFrame displays fine with no error. TestFrame has a few TEdit boxes on it. A TButton on MainMenu calls a procedure located in TestFrame to check if the TEdit boxes text property is null.
procedure TfmMainMenu.tbCheckClick(Sender: TObject);
begin
frTestFrame.Check;
end;
This function on TestFrame is supposed to go through all the "TEdit" components and use the function GetErrorData that returns a string if the TEdit's text property is null. That string is added to a TStringList and displayed if any TEdit boxes are null.
function TfrTestFrame.Check: Boolean;
var
ErrorList: TStringList;
ErrorString: string;
I: Integer;
begin
ErrorList := TStringList.Create;
for I := 0 to (frTestFrame.ComponentCount - 1) do
begin
if (frTestFrame.Components[I] is TEdit) then
begin
ErrorString := GetErrorData(frTestFrame.Components[I]);
if (ErrorString <> '') then
begin
ErrorList.Add(ErrorString);
end;
end;
end;
if (ErrorList.Count > 0) then
begin
ShowMessage('Please Add The Following Information: ' + #13#10 + ErrorList.Text);
result := false;
end;
result := true;
end;
function TfrTestFrame.GetErrorData(Sender: TObject): string;
var
Editbox: TEdit;
ErrorString: string;
begin
if (Sender is TEdit) then
begin
Editbox := TEdit(Sender);
if (Editbox.Text <> '') then
begin
Editbox.Color := clWindow;
result := '';
end
else
begin
Editbox.Color := clRed;
ErrorString := Editbox.Hint;
result := ErrorString;
end;
end;
end;
The problem is that when it hits the line "for I := 0 to (frTestFrame.ComponentCount - 1) do
" It blows up and I get the error "Access violation at 0x00458... Read of address 0x000..."
I do not know why this error is happening. I can only assume that maybe the Frame is not getting creating. Any help would be great. Thanks in advance.
According to your question, the line
for I := 0 to (frTestFrame.ComponentCount - 1) do
leads to an access violation at address 0x000..... Now, for a start, why won't you tell us the precise error message with the full details? Hiding the address makes it harder!
Anyway, it looks like the address is going to be a value very close to zero. In any case the only explanation for an access violation there is that frTestFrame is invalid. Most likely it is nil.
I note that the code in question is inside a TfrTestFrame method. So why do you use frTestFrame to refer to the object? You are already inside an instance of the object. Do you have multiple global variables named frTestFrame? Perhaps one in the main form unit and one in the frame unit?
You should stop using global variables for your GUI objects. I know that the IDE leads you that way. Resist the temptation to program that way. Abuse of global variables leads to pain and suffering.
Since the code is inside a TfrTestFrame method you can use Self. In all your TfrTestFrame methods remove all references to frTestFrame. Your loop should be like this:
for I := 0 to ComponentCount - 1 do
and the rest of the methods in that class need similar treatment. Note that you don't need to explicitly write Self and it is idiomatic not to.
Finally, I urge you to learn how to use the debugger. It's a wonderful tool and if you would use it, it would have told you what the problem was. Don't be helpless, let the tools help you.

AdoQuery not working with SHOW: command

and I am tearing my hair out!!
Even something simple like this work:
procedure MyAdoQueryTest();
const MYSQL_CONNECT_STRING='Driver={MySQL ODBC 5.1 Driver};Server=%s;Port=3306;Database=%s;User=%s;Password=%s;Option=3;';
var AdoConnection : TADOConnection;
ADOQuery : TADOQuery;
Param : TParameter;
begin
AdoConnection := TADOConnection.Create(Nil);
AdoConnection.ConnectionString := Format(MYSQL_CONNECT_STRING,['localhost',
'mysql',
'root',
'']);
AdoConnection.LoginPrompt := False;
AdoConnection.Connected := True;
ADOQuery := TADOQuery.Create(Nil);
ADOQuery.Connection := AdoConnection;
ADOQuery.Sql.Clear();
ADOQuery.SQl.Add('SHOW :what_to_show');
Param := ADOQuery.Parameters.ParamByName('what_to_show');
Param.DataType := ftString;
Param.Value := 'databases';
ADOQuery.Prepared := true;
ADOQuery.Active := True;
end;
(btw, do I really need to use the 'Param' variable and 3 statements, or can I just ` ADOQuery.Parameters.ParamByName('what_to_show').Value := 'databases';?)
Anyway, when I run it, I get an exception at ADOQuery.SQl.Add('SHOW :what_to_show'); which says "Arguments are of the wrong type, are out of the acceptable range or are in conflict with one another".
What I am trying to do is to make 2 central functions: one which will accept and execute any SQL statement which will not return any data (such as INSERT INTO) and oen which will (such as SELECT).
I currently have these working with AdoConnection only, but am now trying to use AdoQuery because I want to parametrize my SQL statements to handle strings with quotes in them.
I can has halpz?
The error is here:
ADOQuery.SQl.Add('SHOW :what_to_show');
The :Param can only be used for values, not for dynamic column/keyword/table/database names.
This is because if it worked like that you'd have an SQL-injection risk depending on the contents of your parameter.
In order to fix that you'll have to inject your what_to_show thingy into the SQL-string.
Like so:
var
what_to_show: string;
begin
....
what_to_show:= 'tables';
ADOQuery.SQL.Text:= ('SHOW '+what_to_show);
....
Now it will work.
Warning
Make sure test everything you inject into the SQL to prevent users from being able inject their SQL-code into your queries.
Parameters prevent SQL injection, but because you cannot use them here you need to check them against a list of pre-approved values. e.g. a stringlist holding all the allowed what_to_shows.
Escaping or use of special chars is useless.
Safe injection example code
var
what_to_show: string;
i: integer;
inputapproved: boolean;
begin
....
what_to_show:= lower(trim(someinput));
i:= 0;
inputapproved:= false;
while (i < WhiteList.count) and not(inputapproved) do begin
inputapproved:= ( what_to_show = lower(Whitelist[i]) );
Inc(i);
end; {while}
if inputapproved then ADOQuery.SQL.Text:= ('SHOW '+what_to_show);
....

Resources