Summary: How do you access the original TWebRequest object in a Delphi Soap Server Application ?
My web service publishes a service ITest with a method CallMe:
ITest = interface(IInvokable)
['{AA226176-FFAD-488F-8768-99E706450F31}']
function CallMe: string; stdcall;
end;
...
initialization
InvRegistry.RegisterInterface(TypeInfo(ITest));
This interface is implemented in a class:
TTest = class(TInvokableClass, ITest)
public
function CallMe: string; stdcall;
end;
...
initialization
InvRegistry.RegisterInvokableClass(TTest, TestFactory);
How do I access the original TWebRequest object inside of the implementation of this method ? E.g. If I want to check what cookies were set, or read other properties on the request:
function TTest.CallMe: string;
begin
// how to access TWebRequest object
...
end;
uses
System.SysUtils,
Web.HTTPApp,
Soap.WebBrokerSOAP;
function TTest.CallMe: string;
var
WebDispatcher: IWebDispatcherAccess;
begin
Result := '';
if Supports(GetSOAPWebModule, IWebDispatcherAccess, WebDispatcher) then
Result := Format('You are calling me from: %s', [WebDispatcher.Request.RemoteIP]);
end;
Related
I really like Delphi Mocks, but it seems to have a problem with class helpers. I have a class helper that extends TRESTResponse and want to test the functions I added. Unfortunately, this does not work. I have created the following simple reproduction:
MyClass = class
function MyFunc1: Integer; virtual;
end;
MyClassHelper = class helper for MyClass
function MyFunc2: Integer; virtual;
end;
var
LMock: TMock<MyClass>;
begin
LMock := TMock<MyClass>.Create;
LMock.Setup.WillReturn(2).When.MyFunc1;
LMock.Setup.WillReturn(2).When.MyFunc2;
Assert(LMock.Instance.MyFunc1 <> 1);
Assert(LMock.Instance.MyFunc2 <> 1);
end;
function MyClass.MyFunc1: Integer;
begin
Result := 1;
end;
function MyClassHelper.MyFunc2: Integer;
begin
Result := 1;
end;
Mocking MyFunc1 works as expected, but MyFunc2 cannot be mocked. The second LMock.Setup.WillReturn-line raises an exception [MyClass] already defines Will Return When for method [MyFunc1]. If you remove the mocking setup for MyFunc1 then no exception is raised, but MyFunc2 is not mocked.
Any suggestions how to solve this? Or is it not possible to mock class helpers with Delphi Mocks?
How to provide data for Unit Tests in Delphi DUnit) ? For example, in PHP, you can do something like this:
public function URLProvider() {
return [
["https://helloacm.com"],
["https://codingforspeed.com"]
];
}
/**
* #dataProvider URLProvider
*/
public function test_url($url) {
$data = file_get_contents("$this->API?url=$url");
$result = json_decode($data, true);
$this->assertEquals(true, $result['result']);
$this->assertEquals(200, $result['code']);
}
With Spring4D DUnit extensions you can write something like that (look into the release/1.2 branch in the Tests\Source folder for the unit Spring.Testing).
program Tests;
uses
Spring.Testing,
TestInsight.DUnit;
type
TUrlTests = class(TTestCase)
public
class function UrlProvider: TArray<string>; static;
published
[TestCaseSource('UrlProvider')]
procedure TestUrl(const url: string);
end;
{ TUrlTests }
procedure TUrlTests.TestUrl(const url: string);
begin
// do whatever
end;
class function TUrlTests.UrlProvider: TArray<string>;
begin
Result := ['https://helloacm.com', 'https://codingforspeed.com'];
end;
begin
TUrlTests.Register;
RunRegisteredTests;
end.
You can either pass the name to the method within the same Testcase class or specify another class - the method itself must be a public static class function. The extension then will create different test cases for each parameter being passed. You can check the Unittests of Spring4D for other use cases.
In DUnit every single test case has to be a procedure without parameters. So there can't exist a mechanism for injecting arguments via custom attributes to test methods like you are doing it PHPUnit.
You should take a look at DUnitX instead where you can define tests like this:
[TestCase('https://helloacm.com')]
[TestCase('https://codingforspeed.com']
procedure TestUrl(const Url: String);
I am using Delphi XE7 and want to test my program with the unit test provided by DUnit. My code is:
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
with Form1 do
Edit3.Text := IntToStr(StrToInt(Edit1.Text) + StrToInt(Edit2.Text));
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Form1.Edit1.Text := '5';
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Edit2.Text := '4';
end;
end.
So i created a unit test with some test cases for the code:
unit TestUnit1;
interface
uses
TestFramework, System.SysUtils, Vcl.Graphics, Vcl.StdCtrls, Winapi.Windows,
System.Variants, System.Classes, Vcl.Dialogs, Vcl.Controls, Vcl.Forms,
Winapi.Messages, Unit1;
type
TestTForm1 = class(TTestCase)
strict private
FForm1: TForm1;
public
procedure SetUp; override;
procedure TearDown; override;
published
procedure TestButton1Click;
procedure TestFormActivate;
procedure TestFormCreate;
end;
implementation
procedure TestTForm1.SetUp;
begin
FForm1 := TForm1.Create;
end;
procedure TestTForm1.TearDown;
begin
FForm1.Free;
FForm1 := nil;
end;
procedure TestTForm1.TestButton1Click;
var
Sender: TObject;
begin
FForm1.Button1Click(Sender);
CheckEquals(StrToInt(Form1.Edit1.Text)+StrToInt(Form1.Edit2.Text),StrToInt(Form1.Edit3.Text));
end;
procedure TestTForm1.TestFormActivate;
var
Sender: TObject;
begin
FForm1.FormActivate(Sender);
CheckEquals(5, StrToInt(Form1.Edit1.Text));
end;
procedure TestTForm1.TestFormCreate;
var
Sender: TObject;
begin
FForm1.FormCreate(Sender);
CheckEquals(4, StrToInt(Form1.Edit2.Text));
end;
initialization
RegisterTest(TestTForm1.Suite);
end.
My problem now is that when I want to start the unit test I get an error e2035 Not enough actual parameters at "FForm1 := TForm1.Create;"
What I already know is that the error means that parameters are missing, but I have no idea what parameters i can add so that the code will work. Anyone know any help?
Such errors are readily resolved by reading the documentation. The documentation for this constructor can be found here: http://docwiki.embarcadero.com/Libraries/en/Vcl.Forms.TCustomForm.Create
constructor Create(AOwner: TComponent); override;
So you need to supply the owner. Like this:
FForm1 := TForm1.Create(nil);
There's no need to supply an owner, I presume, because you are managing the lifetime of the form.
We have two classes which are important:
uSitz, uGUI.
unit uSitz;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, stdctrls;
type txyTogglebox=class(TTogglebox)
private
x:integer;
y:integer;
public
constructor create(xi,yi:integer;TheOwner:tobject);
end;
implementation
constructor txytogglebox.create(xi,yi:integer;TheOwner:tobject);
begin
x:=xi;
y:=yi;
end;
end.
It inherits the class TToggleBox!
So then we have the uGUI:
unit uGUI;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, usaal, usitz, stdctrls;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
i,j:integer;
saal:tsaal;
xytoggles: array of array of txytogglebox;
implementation
{$R *.lfm}
{ TForm1 }
procedure toggleboxclick(Sender:TObject);
begin
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
setlength(xytoggles, 10, 10);
saal.create(10,10);
for i:=0 to 10 do
begin
for j:=0 to 10 do
begin
xytoggles[i,j].create(i,j,form1);
xytoggles[i,j].parent:=form1;
xytoggles[i,j].Visible:=true;
xytoggles[i,j].top:=i*10;
xytoggles[i,j].left:=j*10;
xytoggles[i,j].width:=10;
xytoggles[i,j].height:=10;
xytoggles[i,j].onclick:=#toggleboxclick;
end;
end;
end;
end.
So the compiler says that we have an error #: ugui.pas(64,29) Error: Incompatible types: got "<address of procedure(TObject);Register>" expected "<procedure variable type of procedure(TObject) of object;Register> ".
If i change the procedure "toggleboxclick" to TForm1.toggleboxclick i will get a new error: nullpointer-exception (sigserv or something like this) # "xytoggles[i,j].parent:=form1;". How i can solve this problem.
At last: Sry for my english ;)
If i change the procedure "toggleboxclick" to TForm1.toggleboxclick
That is the correct way to do it
i will get a new error: nullpointer-exception (sigserv or something like this) # "xytoggles[i,j].parent:=form1;". How i can solve this problem.
You cannot use object.create. You need to use object := TClass.create. I.e.: In your case:
saal := tsaal.create(10, 10);
xytoggles[i,j] := txyTogglebox.create(i,j,form1);
It is also bad style to have global variables like i,j,saal, xytoggles. Better make i,j local variables; and saal, xytoggles class fields
EDIT: Dumb question, already fixed. Form1 was nil because I didn't assign it a new TForm1, I forgot Delphi doesn't do that for you like C++.
I have a Delphi DLL that I want to use for the GUI of my C++ program, so just for starters, I created a form, and have a function that will show the form which is exported so that C++ can call it. However, the program crashes when it calls the function. Here is my code. (I am using Delphi 2010)
The delphi part:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Tabs, ComCtrls;
type
TForm1 = class(TForm)
TabControl1: TTabControl;
TabSet1: TTabSet;
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function ShowForm(i: Integer) : Integer; export; cdecl;
exports
ShowForm name 'ShowForm';
implementation
{$R *.dfm}
function ShowForm(i: Integer) : Integer; export; cdecl;
begin
Form1.Show();
Result := 3; // random value, doesn't mean anything
end;
end.
And here is the C++ code:
HMODULE h = LoadLibrary("delphidll.dll");
if (!h) {
printf("Failed LoadLibrary (GetLastError: %i)\n", GetLastError());
return 0;
}
FARPROC p = GetProcAddress(h, "ShowForm");
if (p)
printf("Found it # %p\n", p);
else
printf("Didn't find it\n");
((int(__cdecl *)(int))p)(34);
system("PAUSE");
return 0;
The program prints "Found it # " and then crashes. If I comment out Form1.Show() in the Delphi DLL, it doesn't crash, and the function returns 3 (tested by printf). Am I missing some initialization or something? Thanks.
The reason it crases is that the var Form1: TForm1; is not initialized.
The reason that the var Form1: TForm1; is not initialized, is most likely because you put the unit Main into a DLL project, but it originally came from a Delphi VCL project where you had Form1 on the auto-creation list.
The auto-creation list means that the Delphi .dpr will initialize the form.
Now you need to manually create the form, so you need to export these 3 new routines from your DLL, and have the C++ DLL call them:
function CreateForm() : Integer; export; cdecl;
begin
try
Application.CreateForm(TForm1, Form1);
Result := 0;
except
Result := -1;
end;
end;
function DestroyForm() : Integer; export; cdecl;
begin
try
if Assigned(Form1) then
begin
FreeAndNil(Form1);
Application.ProcessMessages();
end;
Result := 0;
except
Result := -1;
end;
end;
function DestroyApplication() : Integer; export; cdecl;
begin
try
FreeAndNil(Application);
Result := 0;
except
Result := -1;
end;
end;
In addition, you should put a try...except block around the implementation of your ShowForm function implementation, as exceptions and other language dependent run-time features should not cross DLL boundaries.
You probably should do similar things for releasing other potentially allocated pieces of dynamic memory too.
--jeroen