Is there a better way to create objects in IScriptControl than this?
Result := SC.Eval('new Date()');
I need something like this:
function CreateJSObject(JSClassName: string; Params: PDispParams): OleVariant;
a naive implementation would be
var
S: string;
begin
S := '';
for I := P.cArgs - 1 downto 0 do
begin
if S <> '' then
S := S + ', ';
S := S + ConvertParamToJSSyntax(OleVariant(P.rgvarg[I]));
end;
Result := ScriptControl.Eval('new ' + JSClassName + '(' + S + ');');
end;
Query the IDispachEx interface on the CodeObject property of the MSScriptControl. It is a pointer on the global state of the JScript and it contains all objects added to it. Then do an InvokeEx with a DISPATCH_CONSTRUCT parameter on the object name you want to create. This would be equivalent to calling "new".
This would create an object of the correct type and you would not have to convert them to javascript types. You'll be able to pass native objects to the constructor as well.
I know that this works for constructors defined in script. I'm not sure about Date which is a native property.
This works on JScript and VBScript activescripting host, but some others scripting host does not return anything on CodeObject, so this is not very portable.
To call a subroutine, you need to use the Run method, instead of Eval. See this doc for more info.
You are correct in saying that "constructors are different sort of methods", but in this case you are actually just returning the newly-constructed value, aren't you? And so I would expect to still be able to use Eval().
The following code works for me:
procedure TForm1.Button1Click(Sender: TObject);
var
ScriptControl: Variant;
Value: Variant;
begin
ScriptControl := CreateOleObject('ScriptControl');
ScriptControl.SitehWnd := Handle;
ScriptControl.Language := 'JScript';
Value := ScriptControl.Eval('new Date();');
ShowMessage(VarToStr(Value));
end;
When I click the button, my ShowMessage shows up with "Wed Sep 16 23:37:14 TC+0200 2009".
And so for returning a value from a constructor, you can actually use Eval().
Related
I am building a SQL query builder for a repository. This builder will find all required fields for a query and create the SQL text. For this, I am using the Format() procedure. But, I am having trouble creating in runtime the TVarRec array that I must pass to the Format procedure.
It's easy to build this array using constants like Format('%s, %s', ['AString', 'AnotherString']);`. But how must we do to create it in runtime ?
Here is a simplified version of my approach :
procedure BuildString;
begin
FStrings := TStringList.Create;
FStrings.Add('String 1');
FStrings.Add('String 2');
FStrings.Add('String 3');
FFormatString := '%0:s, %1:s, %2:s';
SetLength(FFormatStringParams, FStrings.Count);
for I := 0 to FStrings.Count - 1 do
begin
aString := FStrings.Strings[I];
FFormatStringParams[I].VString := Addr(aString);
end;
ShowMessage(Format(FFormatString, FFormatStringParams));
end;
But when I run this, I get the error "The format '%0:s, %1:s, %2:s' is invalid or incompatible with the argument'
I understand that I am incorrectly building the TVarRec array that I must pass to the Format procedure. Can anyone help me in this?
Thank you.
You are passing the address of the string variable rather than its value. Furthermore, you are assigning the VString field, which expects a ShortString. You are supplying a native String instead.
Replace
VString := Addr(aString)
with
VUnicodeString := Pointer(aString)
Furthermore, you need to specify the string type by assigning the VType field.
for I := 0 to FStrings.Count - 1 do
begin
aString := FStrings.Strings[I];
FFormatStringParams[I].VType := vtUnicodeString;
FFormatStringParams[I].VUnicodeString := Pointer(aString);
end;
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.
If you like to use a method's pointer as an argument, you need to type the method as function of object like this works good:
type TAcceptor = function(filename:string):boolean of object;
function acceptor(filename:string):boolean;
begin
result := filename <> '';
end;
What if you like to use the pointer of a sub-method? It does not work:
procedure TForm1.Button1Click(Sender:TObject);
function acceptor(filename:string):boolean of object;
begin
result := filename <> '';
end;
begin
end;
The error occour: ; expected but OF found!
Question: Is there any subfunction-pointer? Can i cast it?
I don't see how that this would be possible.
http://docwiki.embarcadero.com/RADStudio/XE6/en/Procedural_Types
If you look under the method pointers section, it specifically says that nested procedures and functions cannot be used:
"Nested procedures and functions (routines declared within other
routines) cannot be used as procedural values, nor can predefined
procedures and functions."
You might be able to work around it using an anonymous method. Something like:
procedure TForm1.Button1Click(Sender:TObject);
begin
DoSomethingWithAcceptor(function(FileName: string): Boolean
begin
Result := FileName <> '';
end);
end;
CAUTION
I know that the following is not universally applicable, but it works for all known Win32 versions of Delphi. As long as you are aware of this, and check its functionality in new versions, it is a viable hack, IMO.
Passing nested functions to methods
In older code, I used this to do some "poor man's anonymous methods":
type
TLocal = packed record
Code: Pointer; // local (nested) function
Frame: Pointer; // outer stack frame for local function
end;
To fill such a local inside a method, I wrote the function Local:
function Local(LocalFunction: Pointer): TLocal;
asm
MOV [EDX].TLocal.Frame,EBP
MOV [EDX].TLocal.Code,EAX
end;
Inside my unit (some kind of generic collection), I wrote a function to call them, passing one parameter (of type TGeneric, in this case, which is not important here, you can also pass a pointer or some such).
// Calls local function using local closure provided, passing
// T as parameter to the local.
function CallLocal(T: TGeneric; const Local: TLocal): TGeneric;
asm
PUSH [EDX].TLocal.Frame
CALL [EDX].TLocal.Code
ADD ESP,4
end;
It was used like this:
function TStdCollection.AsArray: TGenericArray;
var
I: Integer;
A: TGenericArray;
procedure ToArray(E: TGeneric);
begin
Result[I] := E.Traits.Copy(E);
Inc(I);
end;
begin
SetLength(A, Count);
I := 0;
ForEach(Local(#ToArray));
Assert(I = Count);
Result := A;
end;
The code in the nested function makes a copy of the element and stores it in the array. The main procedure then passes the nested function ToArray (together with its stack frame) as parameter to ForEach, which is implemented this way:
function TStdCollection.ForEach(Operation: TLocal): ICollection;
var
Enum: IEnumerator;
Elem: TGeneric;
begin
Enum := GetEnumerator;
Elem := Enum.First;
while Elem <> nil do
begin
CallLocal(Elem, Operation);
Elem := Enum.Next;
end;
Result := Self;
end;
These examples show how to use the Locals. I hope this more or less answers your question.
Note
Note that this code was written in the Delphi 6 timeframe. I know there are better alternatives these days, like generics and anonymous methods. But if compatibility with Delphi 7 is required, the above might be a solution.
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.
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);
....