How to fix Access Violation at address in Delphi - oop

I'm new to delphi and am trying to start OOP. However I get an access violation when using public property to set a private field.
type
User = class;
TData = class
private
CurrUser: User;
Connection: TFDConnection;
Query: TFDQuery;
procedure SetUser(newUser: User);
procedure SetConnection(newConn: TFDConnection);
procedure SetQuery(newQry: TFDQuery);
public
property CUser: User read CurrUser write SetUser;
property Conn: TFDConnection read Connection write SetConnection;
property Qry: TFDQuery read Query write SetQuery;
class procedure Login(uID: integer); static;
class procedure Logout(uID: integer); static;
class procedure ExitApp(); static;
end;
implementation
{$R *.fmx}
procedure TData.SetUser(newUser: User);
begin
CurrUser := newUser;
end;
procedure TData.SetConnection(newConn: TFDConnection);
begin
Connection := newConn;
end;
procedure TData.SetQuery(newQry: TFDQuery);
begin
Query := newQry;
end;
I expect to be able to set the Connection using that property however it gives me the access violation with any code that uses the property write:
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
var
TData: frmData.TData;
LoginForm: TLoginForm;
ErrorCount : integer;
implementation
{$R *.fmx}
procedure TLoginForm.ExitAppButtonClick(Sender: TObject);
begin
TData.ExitApp;
end;
procedure TLoginForm.LoginButtonClick(Sender: TObject);
var
companyPath : string;
nurseID : integer;
begin
if(UsernameInput.Text = '') or (PasswordInput.Text = '') or (PincodeInput.Text = '') then
begin
ShowMessage('Please enter your login details.');
Exit;
end;
try
TData.Conn := TFDConnection.Create(nil);
TData.Conn.Params.DriverID := 'MSAcc';
TData.Conn.Params.Database := 'D:\PulseDB\AlfaPersonnel\Pulse.mdb';
TData.Conn.LoginPrompt := False;
TData.Conn.Connected := True;
if(TData.Conn.Connected <> True) then
begin
ShowMessage('Could not connect, try again');
Exit;
end
else //When Connection
begin
TData.Qry := TFDQuery.Create(TData.Conn);
try
TData.Qry.Connection := TData.Conn;
TData.Qry.SQL.Text := 'SELECT * FROM NurseLogin WHERE Username=:uname AND Password=:pword AND PinCode=:pin;';
TData.Qry.Params.ParamByName('uname').AsString := UsernameInput.Text;
TData.Qry.Params.ParamByName('pword').AsString := PasswordInput.Text;
TData.Qry.Params.ParamByName('pin').AsString := PincodeInput.Text;
TData.Qry.Active := True;
if TData.Qry.RecordCount = 0 then ShowMessage('Details not recognised.')
else if TData.Qry.RecordCount = 1 then
begin
if TData.Qry.FieldByName('IsActive').AsBoolean then //If the user is active
begin
try
//Connect to the path
companyPath := TData.Qry.FieldByName('CompanyName').AsString;
TData.Conn.Params.Database := 'D\PulseDB\' + companyPath + '\Pulse.mdb';
TData.Conn.Connected := True;
ShowMessage('Connected to ' + companyPath);
finally
end;
end;
end;
finally
end;
end;
finally
end;
end;

You don't ever create an instance of your TData class. At some point you need to write:
TData := frmData.TData.Create;
Which is how you instantiate an instance. And you need to destroy it when you are finished also. Like this:
TData.Free;
That you did not instantiate an instance is the explanation for your access violation.
Some other issues:
Use the T prefix for types. Your variable should be named Data rather than TData.
Don't use global variables if at all possible.

Related

TADOConnection with SQL Server Thread with Delphi

I am working on a project and I need to think about emergency situations.
The main issue is, how to check if the database is connected (circle object = red or green)?
BeforeConnect, AfterDisconnect, they have no good answer.
Inside type:
Create Connection:
procedure TForm1.Button1Click(Sender: TObject);
var
s : String;
begin
ADOConnectionSQL := TADOConnection.Create(nil);
ADOConnectionSQL.LoginPrompt := false;
with ADOSQL do
begin
s := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
ADOConnectionSQL.ConnectionString := s;
end;
ADOConnectionSQL.BeforeConnect := SQLConnected;
ADOConnectionSQL.AfterDisconnect := SQLDisconnected;
end;
Try to connect:
procedure TForm1.Button2Click(Sender: TObject);
var
Thread : TThread;
begin
Thread := TThread.CreateAnonymousThread(
procedure
begin
TThread.Synchronize(TThread.CurrentThread,
procedure
begin
try
ADOConnectionSQL.Connected := True;
ADOConnectionSQL.Open;
except
on E: Exception do
begin
ShowMessage('Exception message = '+E.Message);
end;
end;
ADOQuerySQL := TADOQuery.Create(nil);
end);
end);
Thread.OnTerminate := FinishConnected;
Thread.Start;
end;
Green or Red:
procedure TForm1.SQLConnected(Sender: TObject);
begin
Circle1.Fill.Color := $FF00FF00;
end;
procedure TForm1.SQLDisconnected(Sender: TObject);
begin
Circle1.Fill.Color := $FFFF0000;
end;
FinishConnected:
procedure TForm1.FinishConnected(Sender: TObject);
begin
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage ('Failure to connection');
//Exit;
end;
end;
When the SQL Server is online, I would like to see a green circle. When the connection with server goes downs, the circle should be red.
You are creating and opening the ADO connection in the context of the main UI thread, not in the context of the worker thread. So your worker thread is basically useless. You could have just used TThread.ForceQueue() instead to get the same effect.
ADO uses COM technology internally, so you can't really use it across thread boundaries anyway. If you want to use ADO in a thread, give the thread its own ADO Connection and Query objects. Do all your SQL work in the context of the thread, and synchronize status updates with the main UI thread as needed.
Also, you need to initialize the COM library in the worker thread before it can work with ADO.
Try something more like this instead:
procedure TForm1.Button1Click(Sender: TObject);
var
Thread : TThread;
ConnStr: string;
begin
ConnStr := 'Provider=SQLNCLI11.1;'+
'Persist Security Info=False;'+
'User ID='+Edit1.Text+';'+
'Initial Catalog='+Edit2.Text+';'+
'Data Source='+Edit3.Text+';'+
'Initial File Name="";'+
'Server SPN="";'+
'password="'+Edit4.Text+'"';
Thread := TThread.CreateAnonymousThread(
procedure
var
ADOConnectionSQL: TADOConnection;
ADOQuerySQL: TADOQuery;
begin
CoInitialize(nil);
try
ADOConnectionSQL := TADOConnection.Create(nil);
try
ADOConnectionSQL.LoginPrompt := False;
ADOConnectionSQL.ConnectionString := ConnStr;
ADOConnectionSQL.Open;
TThread.Queue(nil,
procedure
begin
Circle1.Fill.Color := TAlphaColorRec.Green;
end
);
ADOQuerySQL := TADOQuery.Create(nil);
try
ADOQuerySQL.Connection := ADOConnectionSQL;
// use ADOQuerySQL as needed...
finally
ADOQuerySQL.Free;
end;
finally
ADOConnectionSQL.Free;
end;
finally
CoUninitialize;
end;
end);
Thread.OnTerminate := SQLFinished;
Thread.Start;
end;
procedure TForm1.SQLFinished(Sender: TObject);
begin
Circle1.Fill.Color := TAlphaColorRec.Red;
if TThread(Sender).FatalException <> nil then
begin
// something went wrong
ShowMessage('Failure! ' + Exception(TThread(Sender).FatalException).Message);
end;
end;

Is there any way to put text into SQL using Delphi? [duplicate]

Using Delphi 2010
Can anyone tell me what I am doing wrong here with my code. The comments show the errors that I receive with the particular methods that I tried to pass parameters to my ADOQuery
procedure CreateAdminLogin(const APasswd: string);
var
qry: TADOQuery;
//P1, P2: TParameter;
begin
qry := TADOQuery.Create(nil);
try
qry.Connection := frmDataModule.conMain;
qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)';
//Syntax error in INTO statement
qry.Parameters.ParamByName('u').Value:= 'Admin';
qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd);
//invalid variant operation
{qry.Parameters.ParamByName('u').Value.AsString:= 'Admin';
qry.Parameters.ParamByName('p').Value.AsString:= GetMd5(APasswd);}
//invalid variant operation
{P1:= qry.Parameters.ParamByName('u');
P1.Value.asString:= 'Admin';
P2:= qry.Parameters.ParamByName('p');
P2.Value.asString:= GetMd5(APasswd);}
qry.Prepared := True;
qry.ExecSQL;
finally
qry.Free;
end;
end;
NOTE: GetMD5 is declared as follows
function GetMd5(const Value: String): string;
var
hash: MessageDigest_5.IMD5;
fingerprint: string;
begin
hash := MessageDigest_5.GetMd5();
hash.Update(Value);
fingerprint := hash.AsString();
Result := fingerprint;
end;
Thankx
This works fine for me, using the DBDemos.MDB file that shipped with Delphi (C:\Users\Public\Documents\RAD Studio\9.0\Samples\Data\dbdemos.mdb by the default installation)
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('INSERT INTO Country (Name, Capital, Continent, Area, Population)');
ADOQuery1.SQL.Add('VALUES (:Name, :Capital, :Continent, :Area, :Population)');
ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace';
ADOQuery1.Parameters.ParamByName('Capital').Value := 'Pitsville';
ADOQuery1.Parameters.ParamByName('Continent').Value := 'Floating';
ADOQuery1.Parameters.ParamByName('Area').Value := 1234;
ADOQuery1.Parameters.ParamByName('Population').Value := 56;
ADOQuery1.ExecSQL;
ADOQuery1.Close;
// Open it to read the data back
ADOQuery1.SQL.Text := 'SELECT * FROM Country WHERE Name = :Name';
ADOQuery1.Parameters.ParamByName('Name').Value := 'SomePlace';
ADOQuery1.Open;
ShowMessage(ADOQuery1.FieldByName('Name').AsString);
For using like extra thing to know:
Datasource SQL like this
select * from Table where Phone like :param
DataModule.findQuery.Parameters.ParamByName('param').Value:= '%%'+yourEdit.Text + '%%';
You should create parameters first:
procedure CreateAdminLogin(const APasswd: string);
var
qry: TADOQuery;
begin
qry := TADOQuery.Create(nil);
try
// this part is missed in your code
with qry.Parameters.AddParameter do
begin
Name := 'u';
DataType := ftString;
end;
with qry.Parameters.AddParameter do
begin
Name := 'p';
DataType := ftString;
end;
qry.Connection := frmDataModule.conMain;
qry.SQL.Text := 'INSERT INTO Users (User_Id, Password) VALUES (:u, :p)';
// Now it will be ok!
qry.Parameters.ParamByName('u').Value:= 'Admin';
qry.Parameters.ParamByName('p').Value:= GetMd5(APasswd);
qry.Prepared := True;
qry.ExecSQL;
finally
qry.Free;
end;
end;

Implement an interface with class wide operations in Ada 95

I'm creating a program with Ada 95 and I have a problem. Specifically, I'm trying to implement a class which executes functors given as parameters.
The behavior I want to achieve is:
Declare an interface IF with a procedure Execute.
Derive from IF with a class C and implement Execute.
Create a class D which has a field that is an array of IF. Since IF cannot be instantiated, I use an array of access IF.
Instantiate an object of class D giving it several instances of C as parameters.
Call Execute on every instance of C contained in the array of D.
I've been able to implement the above and compile it, but when I execute it I obtain the error accessibility check failed when trying to assign an object of class C to a component of the array in D.
I know that the error I obtain is because the assignment I'm doing can lead to a danging pointer error according to the Ada policies, so my question is what is the proper way to implement this in Ada 95?
The source code is below. The error is raised in the file elevators.adb, in the procedure Add_Event_Handler, I have commented the statement that causes it.
Functors.ads
package Functors is
type IFunctor is abstract tagged null record;
procedure Execute(Self : in out IFunctor) is abstract;
end Functors;
Elevators.ads
with Functors; use Functors;
package Elevators is
NOT_A_FLOOR : constant := -1;
MAX_EVENT_HANDLERS : constant := 255;
type Floor is new Integer range NOT_A_FLOOR .. 4;
type Elevator is private;
subtype Event_Handler is IFunctor'Class; --'
type Event_Handler_Index is new Integer range 0 .. MAX_EVENT_HANDLERS;
type Event_Handers is array(Event_Handler_Index) of access Event_Handler;
function Create_Elevator return Elevator;
procedure Add_Stop_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Moving_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Called_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Add_Button_Pressed_Handler(Self : in out Elevator; Handler : access Event_Handler);
procedure Run_Simulation(Self : in out Elevator);
private
type Elevator is
record
Current_Floor : Floor := 0;
Is_Moving : Boolean := False;
Next_Floor : Floor := NOT_A_FLOOR;
Stop : Event_Handers := (others => null);
Moving : Event_Handers := (others => null);
Called : Event_Handers := (others => null);
Button_Pressed : Event_Handers := (others => null);
end record;
procedure On_Stop(Self : in out Elevator);
procedure On_Moving(Self : in out Elevator);
procedure On_Called(Self : in out Elevator);
procedure On_Button_Pressed(Self : in out Elevator);
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler);
procedure Exec_All_Events(Self : in out Elevator; EH : in Event_Handers);
end Elevators;
Elevators.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Elevators is
function Create_Elevator return Elevator is
elev : Elevator;
begin
return elev;
end;
procedure Add_Stop_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Stop, Handler);
end;
procedure Add_Moving_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Moving, Handler);
end;
procedure Add_Called_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Called, Handler);
end;
procedure Add_Button_Pressed_Handler(self : in out Elevator; Handler : access Event_Handler) is
begin
Add_Event_Handler(self.Button_Pressed, Handler);
end;
procedure Run_Simulation(self : in out Elevator) is
begin
Put_Line("Floor: " & Floor'Image(self.Current_Floor)); --'
self.Next_Floor := 3;
On_Called(self);
On_Moving(self);
On_Stop(self);
end;
procedure On_Stop(self : in out Elevator) is
begin
self.Current_Floor := self.Next_Floor;
self.Is_Moving := False;
self.Next_Floor := NOT_A_FLOOR;
Put_Line("Stopped. Current floor = " & Floor'Image(self.Current_Floor)); --'
Exec_All_Events(self, self.Stop);
end;
procedure On_Moving(self : in out Elevator) is
begin
self.Is_Moving := True;
self.Current_Floor := NOT_A_FLOOR;
Put_Line("Moving to floor " & Floor'Image(self.Next_Floor)); --'
Exec_All_Events(self, self.Moving);
end;
procedure On_Called(self : in out Elevator) is
begin
Put_Line("Calling button pressed (" & Floor'Image(self.Next_Floor) & ")..."); --'
Exec_All_Events(self, self.Moving);
end;
procedure On_Button_Pressed(self : in out Elevator) is
begin
null;
end;
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if Self(I) = null then
Self(I) := Handler; -- ======> The error is raised here <======
exit;
end if;
I := I + 1;
end loop;
end;
procedure Exec_All_Events(self : in out Elevator; EH : in Event_Handers) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if EH(I) /= null then
EH(I).Execute;
end if;
I := I + 1;
end loop;
end;
end Elevators;
main.adb
with Ada.Text_IO; use Ada.Text_IO;
with Functors; use Functors;
with Elevators; use Elevators;
procedure Main is
type My_Functor is new IFunctor with
record
I : Integer := 0;
end record;
overriding
procedure Execute(Self : in out My_Functor) is
begin
Put_Line("Executing functor, I is " & Integer'Image(Self.I)); --'
Self.I := Self.I + 1;
end;
Generic_Functor : aliased My_Functor;
Elev : Elevator := Create_Elevator;
begin
Add_Stop_Handler(elev, Generic_Functor'Access); --'
Add_Moving_Handler(elev, Generic_Functor'Access); --'
Add_Called_Handler(elev, Generic_Functor'Access); --'
Run_Simulation(Elev);
end;
EDIT
I have done the following changes in order to fix the mentioned runtime error, but I still obtain the accessibility check failed.
elevators.ads
...
type Event_Handler_Generic_Ptr is access all Event_Handler;
type Event_Handers is array(Event_Handler_Index) of Event_Handler_Generic_Ptr;
...
elevators.adb
procedure Add_Event_Handler(Self : out Event_Handers; Handler : access Event_Handler) is
I : Event_Handler_Index := Event_Handler_Index'First; --'
begin
while I < Event_Handler_Index'Last loop --'
if Self(I) = null then
-- Notice the casting here
Self(I) := Event_Handler_Generic_Ptr(Handler); -- ======> The error is raised here <======
exit;
end if;
I := I + 1;
end loop;
end;
Since you store a pointer generated with 'Access in Event_Handlers, you must declare it with access all, so that it is a general access type:
type Event_Handers is array(Event_Handler_Index) of access all Event_Handler;
If you miss all, it is a pool-specific access type. See Ada 95 RM, 3.10 Access Types, (8) and (10). pool-specific access types may only hold pointers to objects allocated in a storage pool, which your object is not.

Inno Setup ADO Connection for run sql query provides error

I managed [code] section of my installer in order to run a simple sql script (a select against an existing db/table).
Compiles fine, retrieve correctly sql machine and instance using the right password but whenever running the installer, at a moment the setup aborts providing message "Microsoft OLE DB Provider for SQL Server: Could not find store procedure 'ÿƥS'.
Of course none of those characters were defined in the sql script (SELECT ##SERVERNAME AS SERVERNAME, DB_NAME() AS [DB_NAME], CURRENT_USER AS [CURRENT_USER]).
Here is the [Code] section:
[Code]
const
//some constants definition
var
//some var definition
var
Page: TWizardPage;
// Used to generate error code by sql script errors
procedure ExitProcess(exitCode:integer);
external 'ExitProcess#kernel32.dll stdcall';
// enable/disable child text boxes & functions when text has been entered into Server textbox. Makes no sense to populate child items unless a value exists for server.
Procedure ServerOnChange (Sender: TObject);
begin
//code there
end;
// enable/disable user/pass text boxes depending on selected auth type. A user/pass is only required for SQL Auth
procedure AuthOnChange (Sender: TObject);
begin
//code there
end;
// Enable next button once a database name has been entered.
Procedure DatabaseOnChange (Sender: TObject);
//code there
end;
// Retrieve a list of databases accessible on the server with the credentials specified.
// This list is shown in the database dropdown list
procedure RetrieveDatabaseList(Sender: TObject);
var
ADOCommand: Variant;
ADORecordset: Variant;
ADOConnection: Variant;
begin
lstDatabase.Items.Clear;
try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' DB List;'
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
try
// create the ADO command object
ADOCommand := CreateOleObject('ADODB.Command');
// assign the currently opened connection to ADO command object
ADOCommand.ActiveConnection := ADOConnection;
// assign text of a command to be issued against a provider
ADOCommand.CommandText := 'SELECT name FROM master.dbo.sysdatabases WHERE HAS_DBACCESS(name) = 1 ORDER BY name';
// this property setting means, that you're going to execute the
// CommandText text command; it does the same, like if you would
// use only adCmdText flag in the Execute statement
ADOCommand.CommandType := adCmdText;
// this will execute the command and return dataset
ADORecordset := ADOCommand.Execute;
// get values from a dataset using 0 based indexed field access;
// notice, that you can't directly concatenate constant strings
// with Variant data values
while not ADORecordset.eof do
begin
lstDatabase.Items.Add(ADORecordset.Fields(0));
ADORecordset.MoveNext;
end ;
finally
ADOConnection.Close;
end;
except
MsgBox(GetExceptionMessage, mbError, MB_OK);
end;
end;
// Execute files specified in [files] section (hardcoded) against the user defined server.database
procedure DeploySQL();
var
Myscript: AnsiString;
ADOCommand: Variant;
ADOConnection: Variant;
begin
// extract script
ExtractTemporaryFile('script.sql');
try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Initial Catalog=' + lstDatabase.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' Execute SQL;' ;
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
try
// create the ADO command object
ADOCommand := CreateOleObject('ADODB.Command');
// assign the currently opened connection to ADO command object
ADOCommand.ActiveConnection := ADOConnection;
// load a script from file into variable.
if(LoadStringFromFile(ExpandConstant('{app}\script.sql'), Myscript)) then
begin
// assign text of a command to be issued against a provider. Append all 3 because one of the install assembly strings will always be empty.
ADOCommand.CommandText := Myscript;
// this will execute the script; the adCmdText flag here means
// you're going to execute the CommandText text command, while
// the adExecuteNoRecords flag ensures no data row will be get
// from a provider, what should improve performance
ADOCommand.Execute(NULL, NULL, adCmdText or adExecuteNoRecords);
end
else
begin
MsgBox('Installation files missing.', mbError, MB_OK);
ExitProcess(7);
end ;
finally
ADOConnection.Close;
end;
except
MsgBox(GetExceptionMessage, mbError, MB_OK);
ExitProcess(5);
end;
end;
{ CustomForm_NextkButtonClick }
// try to connect to supplied db. Dont need to catch errors/close conn on error because a failed connection is never opened.
function CustomForm_NextButtonClick(Page: TWizardPage): Boolean;
var
ADOConnection: Variant;
begin
//try
// create the ADO connection object
ADOConnection := CreateOleObject('ADODB.Connection');
// build a connection string; for more information, search for ADO
// connection string on the Internet
ADOConnection.ConnectionString :=
'Provider=SQLOLEDB;' + // provider
'Data Source=' + txtServer.Text + ';' + // server name
'Initial Catalog=' + lstDatabase.Text + ';' + // server name
'Application Name=' + '{#SetupSetting("AppName")}' + ' Execute SQL;' ;
if chkWindowsAuth.Checked then
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'Integrated Security=SSPI;' // Windows Auth
else
ADOConnection.ConnectionString := ADOConnection.ConnectionString +
'User Id=' + txtUsername.Text + ';' + // user name
'Password=' + txtPassword.Text + ';'; // password
// open the connection by the assigned ConnectionString
ADOConnection.Open;
Result := True;
end;
{ CustomForm_CreatePage }
function CustomForm_CreatePage(PreviousPageId: Integer): Integer;
begin
Page := CreateCustomPage(
PreviousPageId,
ExpandConstant('{cm:CustomForm_Caption}'),
ExpandConstant('{cm:CustomForm_Description}')
);
{ lblServer }
lblServer := TLabel.Create(Page);
with lblServer do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblServer_Caption0}');
Left := ScaleX(24);
Top := ScaleY(32);
Width := ScaleX(68);
Height := ScaleY(13);
Enabled := True;
end;
{ txtServer }
txtServer := TEdit.Create(Page);
with txtServer do
begin
Parent := Page.Surface;
Left := ScaleX(112);
Top := ScaleY(32);
Width := ScaleX(273);
Height := ScaleY(21);
TabOrder := 1;
Enabled := True;
OnChange := #ServerOnChange;
end;
{ lblAuthType }
lblAuthType := TLabel.Create(Page);
with lblAuthType do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblAuthType_Caption0}');
Left := ScaleX(24);
Top := ScaleY(72);
Width := ScaleX(87);
Height := ScaleY(13);
Enabled := False;
end;
{ chkWindowsAuth }
chkWindowsAuth := TRadioButton.Create(Page);
with chkWindowsAuth do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_chkWindowsAuth_Caption0}');
Left := ScaleX(32);
Top := ScaleY(88);
Width := ScaleX(177);
Height := ScaleY(17);
Checked := True;
TabOrder := 2;
TabStop := True;
OnClick := #AuthOnChange;
Enabled := False;
end;
{ chkSQLAuth }
chkSQLAuth := TRadioButton.Create(Page);
with chkSQLAuth do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_chkSQLAuth_Caption0}');
Left := ScaleX(32);
Top := ScaleY(108);
Width := ScaleX(185);
Height := ScaleY(17);
TabOrder := 3;
OnClick := #AuthOnChange;
Enabled := False;
end;
{ lblUser }
lblUser := TLabel.Create(Page);
with lblUser do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblUser_Caption0}');
Left := ScaleX(56);
Top := ScaleY(128);
Width := ScaleX(58);
Height := ScaleY(13);
Enabled := False;
end;
{ lblPassword }
lblPassword := TLabel.Create(Page);
with lblPassword do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblPassword_Caption0}');
Left := ScaleX(56);
Top := ScaleY(152);
Width := ScaleX(53);
Height := ScaleY(13);
Enabled := False;
end;
{ txtUsername }
txtUsername := TEdit.Create(Page);
with txtUsername do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(128);
Width := ScaleX(241);
Height := ScaleY(21);
Enabled := False;
TabOrder := 4;
end;
{ txtPassword }
txtPassword := TPasswordEdit.Create(Page);
with txtPassword do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(152);
Width := ScaleX(241);
Height := ScaleY(21);
Enabled := False;
TabOrder := 5;
end;
{ lblDatabase }
lblDatabase := TLabel.Create(Page);
with lblDatabase do
begin
Parent := Page.Surface;
Caption := ExpandConstant('{cm:CustomForm_lblDatabase_Caption0}');
Left := ScaleX(56);
Top := ScaleY(192);
Width := ScaleX(53);
Height := ScaleY(13);
Enabled := False;
end;
{ lstDatabase }
lstDatabase := TComboBox.Create(Page);
with lstDatabase do
begin
Parent := Page.Surface;
Left := ScaleX(120);
Top := ScaleY(192);
Width := ScaleX(145);
Height := ScaleY(21);
Enabled := False;
TabOrder := 6;
OnDropDown:= #RetrieveDatabaseList;
OnChange:= #DatabaseOnChange;
end;
with Page do
begin
OnNextButtonClick := #CustomForm_NextButtonClick;
end;
Result := Page.ID;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
// set initial status of next button. Should be disabled when page is first loaded, but should be enabled if user clicked back.
if CurPageID = Page.ID then
WizardForm.NextButton.Enabled := bIsNextEnabled;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
// The preinstall step seems like the best time to do the actual install. The problem is that this is not a traditional install. Nothing is copied to the users' pc
if CurStep = ssInstall then
DeploySQL;
end;
procedure InitializeWizard();
begin
bIsNextEnabled := False;
CustomForm_CreatePage(wpLicense);
end;
Any idea?
thanks
I got the solution!
Problem occurs in the if(LoadStringFromFile(ExpandConstant('{app}\script.sql'), Myscript)) statement because the sql file was not ANSI coded.
Everything gone fine by changing the coding.
thanks everybody!

Using Firedac to run SQL stored procedure

I'm trying to figure out how to run a stored procedure using firedac
unit DataLayer.OilCommanderConnection;
interface
uses
FireDAC.Phys.FB,
Generics.Collections,
Model.Sample,
Model.Batch,
FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error,
FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool,
FireDAC.Stan.Async, FireDAC.Phys, FireDAC.Phys.MySQL, Data.DB,
FireDAC.Comp.Client, FireDAC.Phys.MSSQL,
FireDAC.DApt,
FireDAC.Comp.UI
;
type
TOilCommanderConnection = class
strict private
public
Connection : TFDConnection;
function GetSampleTypesForBatch(Batch : TBatch) : Boolean;
function Connect:Boolean;
constructor Create;
destructor Destroy; override;
end;
implementation
uses
SysUtils
;
function TOilCommanderConnection.Connect:Boolean;
var
OK : Boolean;
begin
OK := true;
Connection := TFDConnection.Create(nil);
try
Connection.Params.LoadFromFile('MSSQL.ini');
finally
Result := OK;
end;
end;
function TOilCommanderConnection.GetSampleTypesForBatch(Batch : TBatch) : Boolean;
var
StoredProc : TFDStoredProc;
begin
Connect;
StoredProc := TFDStoredProc.Create(nil);
try
StoredProc.Connection := Connection;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items - [fiMeta];
with StoredProc.Params do
begin
Clear;
with Add do
begin
Name := 'BatchNo';
ParamType := ptInput;
DataType := ftString;
Size := 6;
end;
end;
StoredProc.StoredProcName := 'GetSampleTypesForBatch';
StoredProc.Prepare;
StoredProc.Params[0].Value := Batch.RackNo;
StoredProc.ExecProc;
while not StoredProc.Eof do
begin
//StoredProc.FieldByName('').AsS
StoredProc.Next;
end;
finally
FreeAndNil(StoredProc);
end;
Result := true;
end;
constructor TOilCommanderConnection.Create;
begin
inherited;
Connection := TFDConnection.Create(nil);
end;
destructor TOilCommanderConnection.Destroy;
begin
if Assigned(Connection) then FreeAndNil(Connection);
inherited;
end;
end.
I get an error message a the first occurrence of the line
StoredProc.Prepare;
Here is the message
--------------------------- Debugger Exception Notification
Project RefractiveIndexTests.exe raised exception class Exception with message 'Object factory for class
{3E9B315B-F456-4175-A864-B2573C4A2201} is missing. To register it, you
can drop component [TFDGUIxWaitCursor] into your project'.
I've called the function using
OilCommanderConnection.GetSampleTypesForBatch(batch);
from a test project.
the tutorial I read didn't explain what to do about this situation.
I've tried adding TFDGUIxWaitCursor into my project as the error message suggests but this has not made any difference. I wonder if this problem is related to me keeping the Database connection logic in a separate unit to my Main Form. I would like to be able to separate my user interface from my Data Layer.
Depending on the type of your application, include one of the following units into any one "uses" clause:
FireDAC.VCLUI.Wait - for VCL applications;
FireDAC.FMXUI.Wait - for FireMonkey applications;
FireDAC.ConsoleUI.Wait - for console / non-visual applications.