I have a web service that I have created using Delphi and I want to connect to sql server with it so I have added to the project an ADO Connection and ADOQuery had both of them configured and ready to use, there was only a small problem, there are two units on my project and those objects were added to Unit1 and I am working with my ImplUnit whitch is another unit, and can`t find a way to reference or include one unit inside the other unit.
unit1
{ SOAP WebModule}
unit Unit1;
interface
uses
SysUtils, Classes, HTTPApp, InvokeRegistry, WSDLIntf, TypInfo,
WebServExp, WSDLBind, XMLSchema, WSDLPub, SOAPPasInv, SOAPHTTPPasInv,
SOAPHTTPDisp, WebBrokerSOAP, DB, ADODB;
type
TWebModule1 = class(TWebModule)
HTTPSoapDispatcher1: THTTPSoapDispatcher;
HTTPSoapPascalInvoker1: THTTPSoapPascalInvoker;
WSDLHTMLPublish1: TWSDLHTMLPublish;
ADOConnection1: TADOConnection;
ADODataSet1: TADODataSet;
ADOQuery1: TADOQuery;
procedure WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
WebModule1: TWebModule1;
implementation
{$R *.dfm}
procedure TWebModule1.WebModule1DefaultHandlerAction(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
WSDLHTMLPublish1.ServiceInfo(Sender, Request, Response, Handled);
end;
end.
My unit
unit UTImplementacao;
interface
uses
InvokeRegistry,DB, ADODB;
type
IInterface = interface(IInvokable)
['{EFF30FFA-DA0C-433A-832A-0BA057B55103}']
function ReceiveUser(username : String; password : String) :
Boolean; stdcall;
end;
TImplementacao = class(TInvokableClass, IInterface)
public
function ReceiveUser(username : String; password : String) :
Boolean; stdcall;
end;
implementation
{ TImplementacao }
function TImplementacao.ReceiveUser(username, password: String): Boolean;
var
ADOConnection1: TADOConnection;
ADOQuery1: TADOQuery;
begin
try
ADOConnection1 := TADOConnection.Create(nil);
ADOConnection1.LoginPrompt := False;
ADOConnection1.ConnectionString:= 'Provider=SQLOLEDB.1;Integrated Security=SSPI;' +
'Persist Security Info=False;' +
'User ID=Diego;'+
'Catalog=OnlineShopping;' +
'Data Source=DIEGO-PC\SQLEXPRESS'+
';Use Procedure for Prepare=1;' +
'Auto Translate=True;Packet Size=4096;'+
'Workstation ID=DIEGO-PC;'+
'Use Encryption for Data=False;'+
'Tag with column collation when possible=False;';
ADOConnection1.Connected := True;
ADOQuery1.Connection := ADOConnection1;
ADOQuery1.SQL.Add('select username,upassword from Users '+
'where username = :usernamep and upassword = '+
':upasswordp');
ADOQuery1.Parameters.ParamByName('upasswordp').Value := password;
ADOQuery1.Parameters.ParamByName('usernamep').Value := username;
ADOQuery1.ExecSQL;
Result := True;
finally
ADOQuery1.Free;
if ADOConnection1.Connected then
ADOConnection1.Close;
ADOConnection1.Free;
end;
Result := False;
end;
initialization
InvRegistry.RegisterInvokableClass(TImplementacao);
InvRegistry.RegisterInterface(TypeInfo(IInterface));
end.
please disregard the ADOConnection and ADOQuery that I have added to my unit i got a little desperate ad duplicade the code... Yeah, I know yachs!!!!
#SilverWarrior
If declare Unit1 inside the uses of UTImplementacao will I have access to the componemts below:
type
ADOConnection1: TADOConnection;
ADODataSet1: TADODataSet;
ADOQuery1: TADOQuery;
or should I declare for each one of the types variable inside var clause ?
If you want to access objects declared in Unit1 from other units in your project you need to add Unit1 into interface uses section (the one at top) of those units.
unit ImplUnit;
interface
uses
SysUtils, Classes, ... , Unit1;
...
That is the same way as Delphi automatically adds other units like Sysutils, Classes, etc.
Also I would strongly recomend you change the name of your unit to somethng more meaningfull so that when you will be looking at your code after some time you will quickly know what code does that unit contains and what it is used for.
EDIT: Based on your edit of the question I suspect you want to acces the components from your Unit1 directly by calling:
Unit1.AdoConnection1
That won't work. Why? Becouse the components are declared within the scope of the TWebModule1 class.
So you need to access them like this:
Unit1.WebModule1.AdoConnection1;
NOTE: If Unit1 is added into interface uses section of your UTImplementacao unit you can also directly call:
WebModule1.AdoConnection1
You don't have to prefix every command with Unit1. I have written this in such way to be hopefully more understandable which unit mebers are you accessing. Especially for other people which might be reading this thread and not knowing the structure of your program.
Related
I am trying to add functionality to existing code, by using method resolution clause for various interface properties.
While this works fine, when getting / setting properties in code, this fails when trying to set or get the properties through RTTI.
When using RTTI, the 1st implementing class method is being called.
Here is code which shows the problem:
program TestIntfMethodResolutions;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils,
System.Variants,
System.Classes,
TypInfo,
RTTI{,
uRTTIHelper};
type
ITestInterface = interface
['{61553B5F-574A-4B0F-AB6F-0560E324B463}']
function GetA:integer;
procedure SetA(const AVal:integer);
property A:integer read GetA write SetA;
end;
{$RTTI EXPLICIT METHODS([vcPrivate,vcPublic])}
TTintimpl1 = class(TInterfacedObject,ITestInterface)
private
FA:integer;
function GetA: integer;
procedure SetA(const Value: integer);virtual; // Does not need to be virtual
public
property A:integer read GetA write SetA;
end;
{$RTTI EXPLICIT METHODS([vcPrivate,vcPublic])}
//Explicit RTTI settings causes the Private methods to show up in the method list
TIntimpl2 = class(TTIntimpl1,ITestInterface)
private
procedure MySetA(const Value:integer);virtual;
public
procedure ITestInterface.SetA = MySetA;
end;
TMain = class
private
{ Private declarations }
public
{ Public declarations }
procedure FormCreate;
end;
var
Form5: TMain;
procedure TMain.FormCreate;
var
ctx:TRttiContext;
avalue,bvalue:tvalue;
atype,bastyp:TRttiType;
aproplist:Tarray<TRttiProperty>;
amethlist:Tarray<TRttiMethod>;
isinst:boolean;
aninst:TRttiInstanceType;
anintf:TRttiInterfaceType;
intflist:Tarray<TRttiInterfaceType>;
inst:pointer;
anint:ITestInterface;
aprop:TRttiProperty;
codeptr:pointer;
asetmeth:TRTTIMethod;
begin
ctx:=TRttiContext.Create;
//Faxisloopthr:=TIntimpl2.Create;
anint:=TIntimpl2.Create;
avalue:=anint as TObject;
atype:=ctx.GetType(avalue.TypeInfo);
if atype.IsInstance then
begin
aninst:=atype.AsInstance;
aproplist:=aninst.GetProperties;
amethlist:=aninst.GetMethods;
bvalue:=TValue.FromOrdinal(aproplist[0].PropertyType.Handle,1);
inst:=avalue.AsObject;
aprop:=aproplist[0]; //I could have called aproplist[0].SetValue(...
aprop.SetValue(inst,bvalue);
end;
writeln('RTTI result '+anint.A.ToString); //Should give me 20 but I get 10 everytime
//asetmeth:=aprop.SetterMethod(inst); // returns SetA and not MySetA - need uRTTIhelper unit. https://github.com/RRUZ/blog/tree/master/RTTI
// setpropvalue(inst,aprop.PropInfo,bvalue.AsVariant); // calls SetA and not MySetA
//Manually setting the value calls the correct method
anint.A:=1;
writeln('Direct setting '+anint.A.ToString);
end;
{ T2ndIntf }
{ TTintimpl1 }
function TTintimpl1.GetA: integer;
begin
Result:=FA;
end;
procedure TTintimpl1.SetA(const Value: integer);
var
a:integer;
begin
FA:=Value*10;
writeln('In SetA ',FA);
end;
{ TIntimpl2 }
//Should get called - but the 1st implementing parent gets called
procedure TIntimpl2.MySetA(const Value: integer);
begin
FA:=Value*20;
writeln('In MySetA ',FA);
end;
begin
Form5:=TMain.Create;
try
Form5.FormCreate;
finally
Form5.Free;
readln;
end;
end.
What am I doing wrong ?
Thanks,
IB.
Delphi 10.2 Tokyo Win64
I have a problem while loading procedures from a dll, either when loading it dynamically or statically. When I put procedures from dll to my unit, everything works fine. When I try to do it with dll it gives me
First chance exception at $00526399. Exception class $C0000005 with message 'access violation at 0x00526399: read of address 0x00000390'. Process Project1.exe (21988)
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,Unit2;
type
TForm1 = class(TForm)
ListView1: TListView;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Refresh;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
type
plist = ^element;
element = record
artist,title,genre: string[20];
year,grade: integer;
wsk: plist;
end;
database = file of element;
var
base: database;
first: plist;
handler: HModule;
{$R *.dfm}
procedure TForm1.Refresh();
var
current: plist;
begin
ListView1.Clear;
current:= first;
while current<>nil do
begin
with ListView1.Items.Add do
begin
Caption:=current^.artist;
SubItems.Add(current^.title);
SubItems.Add(current^.genre);
SubItems.Add(IntToStr(current^.year));
SubItems.Add(IntToStr(current^.grade));
end;
current:=current^.wsk;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var Save: procedure;
begin
handler:=LoadLibrary('lib.dll');
try
#Save:=GetProcAddress(handler, PChar(2));
if #Save = nil then raise Exception.Create('Load nie dziala');
Save();
finally
FreeLibrary(handler);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Load: procedure;
begin
handler:=LoadLibrary('lib.dll');
try
#Load:=GetProcAddress(handler, PChar(1));
if #Load = nil then raise Exception.Create('Load nie dziala');
Load();
finally
FreeLibrary(handler);
end;
Refresh();
end;
procedure TForm1.Button1Click(Sender: TObject);
var
el: element;
Add: procedure(el:element);
begin
el.artist:=Edit1.Text;
el.title:=Edit2.Text;
el.genre:=Edit3.Text;
el.year:=StrToInt(Edit4.Text);
el.grade:=StrToInt(Edit5.Text);
handler:=LoadLibrary('lib.dll');
try
#Add:=GetProcAddress(handler, PChar(3));
if #Add = nil then raise Exception.Create('Load nie dziala');
Add(el);
finally
FreeLibrary(handler);
Refresh();
{Form2:=TForm2.Create(Form1);
Form2.ShowModal;
Form2.Free;}
end;
end;
end.
The dll file looks like this:
library lib;
{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }
uses
System.SysUtils,
System.Classes;
{$R *.res}
type plist = ^element;
element = record
artist,title,genre:string[20];
year,grade:integer;
wsk: plist;
end;
database = file of element;
var
first: plist;
base: database;
procedure add(el: element); stdcall;
var current,tmp: plist;
begin
New(current);
current^ := el;
current^.wsk := nil;
if first = nil then
begin
first:=current;
end else
begin
tmp:=first;
while tmp^.wsk<>nil do
begin
tmp:=tmp^.wsk;
end;
tmp^.wsk:=current;
end;
end;
procedure load();stdcall;
var
el: element;
i: integer;
begin
AssignFile(base, 'baza.dat');
if not FileExists('baza.dat') then
begin
Rewrite(base);
end else
begin
Reset(base);
for i := 0 to FileSize(base)-1 do
begin
read(base, el);
add(el);
end;
end;
CloseFile(base);
end;
procedure save();stdcall;
var
current: plist;
el: element;
begin
AssignFile(base, 'baza.dat');
Rewrite(base);
current:=first;
while current<>nil do
begin
el:=current^;
el.wsk:=nil;
write(base, el);
current:= current^.wsk;
end;
end;
exports
add index 1,
load index 2,
save index 3;
begin
end.
It also shows me an error:
Expected ';' but received and identifier 'index' at line 91
But exports are done like I red on web.
The obvious errors are:
You don't perform much error checking. You assume that the calls to LoadLibrary always succeed.
The calling conventions don't match. You use stdcall in the DLL and register in the executable.
The ordinals don't match. In the DLL it is add (1), load (2) and save (3). In the executable you have add (3), load (1) and save (2).
You load and unload the DLL every time you call functions from the DLL. That means that the global variables in the DLL that hold your state are lost each time the DLL is unloaded.
Frankly this code is a real mess. I suggest that you do the following:
Switch to load time linking using the function names rather than ordinals. This means to use the external keyword in the executable. This will greatly simplify your code by removing all those calls to LoadLibrary, GetProcAddress etc. If runtime linking is needed, you can add it later using the delayed keyword.
Stop using global state in the DLL and instead pass information back and forth between modules. Remove all global variables. But make sure you don't pass Delphi objects back and forth.
Use PChar rather than short strings across the module boundary.
Stop using linked lists and dynamic allocation. That's hard to get right. Use TList<T> in the DLL to store the list of elements.
I am absolutely new at calling functions from DLLs (call it bad programming habits, but I never needed to).
I have this C++ dll (CidGen32.dll at https://skydrive.live.com/redir?resid=4FA1892BF2106B62!1066) that is supposed to export a function with the following signature:
extern "C" __declspec(dllexport) int GetCid(const char* pid, char* cid);
What it should do is to get a 13 char string such as '1111111111118' and return a 20 char hash.
I have tried for the last couple of days to call this function in Delphi 6 but to no avail. I have desperately tried I guess 50+ combinations and I got quite close on one occasion but my computer froze and I lost all my effort. Since it was based on luck, I could not redo it anymore.
I am also aiming not to register the DLL, but rather place it in the same folder.
Anyway, the plan was to have something like this:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
function GenerateCID(Prm: string): string;
var
aCID: PAnsiChar;
uCID: AnsiString;
i: integer;
Hbar: Thandle;
GetCID: function (X: PAnsiChar; Y: PAnsiChar): integer; {$IFDEF WIN32} stdcall; {$ENDIF}
begin
ucid := '';
hbar := LoadLibrary('CidGen32.dll');
if Hbar >= 32 then
begin
#GetCID := GetProcAddress(HBar, 'GetCID');
if Assigned(GetCID) then
begin
i := GetCID(pAnsiChar(prm), aCID);
uCID := aCID;
end;
FreeLibrary(HBar);
end
else
begin
//ShowMessage('Error: could not find dll');
end;
result := uCID;
end;
begin
ShowMessage(GenerateCID('1111111111118'));
end;
end.
But it seems I am dead wrong.
You are using the wrong name to import the function. Its name is GetCid but you are trying to import GetCID. Letter case matters when you call GetProcAddress. If that still doesn't result in the GetProcAddress call succeeding, double check the name with which the function is exported using a tool like Dependency Walker.
The function is cdecl so you should declare it like this:
GetCID: function(pid, cid: PAnsiChar): Integer; cdecl;
And the other problem is that you are responsible for allocating the buffer behind cid. You did not do that. Do it like this:
SetLength(uCID, 20);
i := GetCID(pAnsiChar(prm), pAnsiChar(uCID));
And delete the aCID variable. And that >32 error check is wrong, compare against 0.
I have the following code, all the code needs to do is go through a list of vehicles and remove the spaces in each registration but before changing it, it should check to make sure the ammended registration doesn't exist. The following code is what I am using:
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons, Gauges, DB,
DBTables, StrUtils;
type
TfrmMain = class(TForm)
prgTotal: TGauge;
btnStart: TcxButton;
tblVeh: TTable;
tblVehRegNo: TStringField;
procedure btnStartClick(Sender: TObject);
private
procedure OpenTable(pTable: TTable);
procedure CloseTable(pTable: TTable; pPost: Boolean);
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain : TfrmMain;
lvRegLst : TStringList;
lvTblSize : Integer;
lvOrigReg : String;
lvNewReg : String;
lvTest : integer;
implementation
{$R *.dfm}
procedure TfrmMain.btnStartClick(Sender: TObject);
begin
btnStart.Enabled := False;
lvRegLst := TStringList.Create;
// Open Tables
tblVeh.Open;
tblVeh.First;
// Set progress
prgTotal.MinValue := 0;
lvTblSize := tblVeh.RecordCount;
prgTotal.MaxValue := tblVeh.RecordCount;
btnStart.Caption := 'Parsing Registration Numbers...';
// Conversion
while not tblVeh.Eof do
begin
lvRegLst.Add(tblVehRegNo.AsString);
tblVeh.Next;
prgTotal.AddProgress(1);
Application.ProcessMessages;
end;
tblVeh.First;
lvTest := lvRegLst.Count;
prgTotal.Progress := 0;
btnStart.Caption := 'Removing Spaces...';
while not tblVeh.Eof do
begin
lvOrigReg := tblVehRegNo.AsString;
lvNewReg := AnsiReplaceStr(lvOrigReg,' ','');
if lvRegLst.IndexOf(lvNewReg) = -1 then
begin
tblVeh.Edit;
tblVehRegNo.AsString := lvNewReg;
prgTotal.AddProgress(1);
tblVeh.Post;
end;
tblVeh.Next;
prgtotal.AddProgress(1);
Application.ProcessMessages;
end;
// Close Tables
tblVeh.Edit;
tblVeh.Post;
tblVeh.Close;
btnStart.Caption := '&Start Conversion';
btnStart.Enabled := True;
end;
I have stepped through the code and all looks fine and it successfuly changes the registration against the vehicle but when looking at the table afterwards it's not made any changes.
The issue was with the database itself, it turns out 'RegNo' is the only key field so it's the default index. As my conversion was running through it was changing registrations which moved the 'cursor' and skipped over a number of registrations.
I have added another index for the purpose of this conversion but making around 50-60 passes over their data would have eventually sorted out all of the registrations.
Thank you for all of the help.
Delphi XE. Windows 7.
There is a function (please see a code below) or I:=0 that causes an AV error in a big project. There is no the error with the same function in a new project!!! I deleted everything from the big project, and I left only a button and that function. It still causes the error...
A line with the error:
if ISAeroEnabled then // this line is a cause
i:=0; // or this line
I set breakpoints everywhere (I checked the whole function, I set breakpoints on EACH LINE -> no errors in the function), a debugger shows me that the error is in i:=0;
If to delete a function (and leave i:=0;) -> all is ok!
The error message: First chance exception at $747FB727. Exception class EAccessViolation with message 'Access violation at address 004AE5AF in module 'MngProject.exe'. Write of address 0017FFF8'. Process MngProject.exe (4980)
Why does it work in a new project but not in mine?
Here's the whole project: http://www.2shared.com/file/UP22Om4j/Bug.html
The code:
unit MainFormModule;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
mainform:tmainform;
implementation
{$R *.dfm}
function ISAeroEnabled: Boolean;
type
_DwmIsCompositionEnabledFunc = function(IsEnabled: PBoolean): HRESULT; stdcall;
var
Flag : Boolean;
DllHandle : THandle;
OsVersion : TOSVersionInfo;
DwmIsCompositionEnabledFunc: _DwmIsCompositionEnabledFunc;
begin
Result:=False;
ZeroMemory(#OsVersion, SizeOf(OsVersion));
OsVersion.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);
if ((GetVersionEx(OsVersion)) and (OsVersion.dwPlatformId = VER_PLATFORM_WIN32_NT) and (OsVersion.dwMajorVersion >= 6)) then //is Vista or Win7?
begin
DllHandle := LoadLibrary('dwmapi.dll');
if DllHandle <> 0 then
begin
#DwmIsCompositionEnabledFunc := GetProcAddress(DllHandle, 'DwmIsCompositionEnabled');
if (#DwmIsCompositionEnabledFunc <> nil) then
begin
DwmIsCompositionEnabledFunc(#Flag);
Result:=Flag;
end;
end;
FreeLibrary(DllHandle);
end;
end;
procedure Tmainform.Button1Click(Sender: TObject);
var i:integer;
begin
if ISAeroEnabled then // AV is here
i:=0; // Or here
end;
end.
Try changing PBoolean to PBOOL
function(IsEnabled: PBOOL): HRESULT; stdcall;
var
Flag: BOOL;
PBoolean is a pointer to a Pascal Boolean which is 1 byte in size. PBOOL is a pointer to a Windows (C based) BOOL, which is 4 bytes in size. You need to match the size expected by windows.
In general, when translating Windows API calls to Delphi, use the same named data type as the API. Windows.pas has type definitions mapping these to Delphi types, e.g. type BOOL = LongBool;
Also it is usual (but not required) in Delphi to change pointer parameters to var. A var parameter is Pascal syntactic sugar for pass-by-reference which isn't available in C.
function(var IsEnabled: BOOL): HRESULT; stdcall;
....
DwmIsCompositionEnabledFunc(Flag); // no # operator
NOTE: I can't test this, as I only have XP available.