I try to build REST Web Server based on mORMot framework (Delphi) and have issue with getting data from remote DB.
Server.dpr
const
CONN_STR =
'DRIVER=SQL Server Native Client 10.0;UID=user;PWD=pass;server=server;'
+ 'Trusted_Connection=No;MARS_Connection=yes';
var
Model: TSQLModel;
RESTServer: TSQLRestServerDB;
Application: TwoStreamgateApplication;
HTTPServer: TSQLHttpServer;
ODBCConnProp: TSQLDBConnectionPropertiesThreadSafe;
begin
SQLite3Log.Family.Level := LOG_VERBOSE;
SQLite3Log.Family.PerThreadLog := ptIdentifiedInOnFile;
ODBCConnProp := TODBCConnectionProperties.Create('', CONN_STR, 'wo', 'wo');
try
ODBCConnProp.ThreadingMode := tmMainConnection;
Model := CreateModel;
VirtualTableExternalRegisterAll(Model, ODBCConnProp);
try
RESTServer := TSQLRestServerDB.Create(Model, ':memory:');
try
RESTServer.DB.Synchronous := smNormal;
RESTServer.DB.LockingMode := lmExclusive;
RESTServer.CreateMissingTables;
Application := TwoStreamgateApplication.Create;
try
Application.Start(RESTServer);
HTTPServer := TSQLHttpServer.Create('8092', [RESTServer]
{$IFNDEF ONLYUSEHTTPSOCKET}, '+', useHttpApiRegisteringURI{$ENDIF});
try
HTTPServer.RootRedirectToURI('api/default');
RESTServer.RootRedirectGet := 'api/default';
writeln('"MVC WOStreamgate Server" launched on port 8092 using ',
HTTPServer.HttpServer.ClassName);
writeln(#10'You can check http://localhost:8092/api/info for information');
writeln('or point to http://localhost:8092 to access the web app.');
writeln(#10'Press [Enter] to close the server.'#10);
readln;
writeln('HTTP server shutdown...');
finally
HTTPServer.Free;
end;
finally
Application.Free;
end;
finally
RESTServer.Free;
end;
finally
Model.Free;
end;
finally
ODBCConnProp.Free;
end;
Model is described below in ServerModel.pas unit
type
TSQLBaseData = class(TSQLRecord)
private
FName: RawUTF8;
FDetailURL: RawUTF8;
FLogoURL: RawUTF8;
FDescription: RawUTF8;
published
property Name: RawUTF8 read FName write FName;
property Description: RawUTF8 read FDescription write FDescription;
property LogoURL: RawUTF8 read FLogoURL write FLogoURL;
property DetailURL: RawUTF8 read FDetailURL write FDetailURL;
end;
TSQLStation = class(TSQLBaseData)
end;
function CreateModel: TSQLModel;
implementation
function CreateModel: TSQLModel;
begin
result := TSQLModel.Create(
[TSQLStation],
'api');
end;
View model in ServerViewModel.pas unit
TServerApplication = class(TMVCApplication, IServerApplication)
public
procedure Start(aServer: TSQLRestServer); reintroduce;
procedure StationView(ID: TID; out Station: TSQLStation);
end;
implementation
procedure TServerApplication.Start(aServer: TSQLRestServer);
begin
inherited Start(aServer,TypeInfo(IServerApplication));
fMainRunner := TMVCRunOnRestServer.Create(Self).
SetCache('Default',cacheRootIfNoSession,15);
aServer.Cache.SetCache(TSQLStation);
end;
procedure TServerApplication.StationView(ID: TID; out Station: TSQLStation);
begin
RestModel.Retrieve(ID, Station);
end;
and now once I type http://localhost:8092/api/station/10 in browser, I get response
{ "errorCode":404, "errorText":"Not Found" }
in case I type http://localhost:8092/api/stationview/10 in browser I get rendered page, but without info about station=10 or any other.
Where did I make a mistake? I want simply get JSON-response to my request
UPDATE:
Another info that can help. Once I try the query
procedure TestQuery();
var
SQLDBConnection: TODBCConnection;
Q: TQuery;
begin
SQLDBConnection := TODBCConnection.Create(ODBCConnProp);
Q := TQuery.Create(SQLDBConnection);
try
Q.SQL.Clear; // optional
Q.SQL.Add('select * from dbo.Station');
Q.Open;
...
I catch an error:
Project Server.exe raised exception class EODBCException with message 'TODBCStatement - TODBCLib
error: [HY106] [Microsoft][SQL Server Native Client 10.0]Fetch type
out of range (0) '.
Solution is very simple - need to add:
Database=myDataBase;
to
CONN_STR = 'DRIVER=SQL Server Native Client 10.0;UID=user;PWD=pass;server=server;'
+ 'Trusted_Connection=No;MARS_Connection=yes';Database=myDataBase;
Thanks Arnaud for great framework!!!
Related
I am trying to update two different SQL tables in the same loop using parameterized queries in Delphi XE8. I also want to wrap the whole thing in a transaction, so that if anything in the loop fails, neither table gets updated.
I don't really know what I'm doing, would appreciate some help.
The code below is a simplified version of what I'm trying to achieve, and my best guess as to how to go about it. But I'm not really sure of it at all, particularly the use of two datasets connected to the 'SQL connection' component.
SQL_transaction.TransactionID :=1;
SQL_transaction.IsolationLevel:=xilREADCOMMITTED;
SQL_connection.BeginTransaction;
Try
{ Create connections }
SQL_dataset1 :=TSQLDataSet.Create(nil);
SQL_dataset1.SQLConnection:=SQL_connection;
SQL_dataset2 :=TSQLDataSet.Create(nil);
SQL_dataset2.SQLConnection:=SQL_connection;
{ Create queries }
SQL_dataset1.CommandType:=ctQuery;
SQL_dataset1.CommandText:={ some parameterized query updating table A }
SQL_dataset2.CommandType:=ctQuery;
SQL_dataset2.CommandText:={ some parameterized query updating table B }
{ Populate parameters and execute }
For I:=0 to whatever do
begin
SQL_dataset1.ParamByName('Table A Field 1').AsString:='Value';
SQL_dataset1.ExecSQL;
SQL_dataset2.ParamByName('Table B Field 1').AsString:='Value';
SQL_dataset2.ExecSQL;
end;
SQL_connection.Commit(SQL_transaction);
except
SQL_connection.Rollback(SQL_transaction);
end;
I am using Delphi XE8, and the database can be either SQL server or SQLite.
The logic of your transaction handling is correct (except the missing exception re-raise mentioned by #whosrdaddy). What is wrong are missing try..finally blocks for your dataset instances. Except that you should stop using TSQLConnection deprecated methods that are using the TTransactinDesc record (always check the compiler warnings when you're building your app.). And you can also switch to TSQLQuery component. Try something like this instead:
var
I: Integer;
Query1: TSQLQuery;
Query2: TSQLQuery;
Connection: TSQLConnection;
Transaction: TDBXTransaction;
begin
...
Query1 := TSQLQuery.Create(nil);
try
Query1.SQLConnection := Connection;
Query1.SQL.Text := '...';
Query2 := TSQLQuery.Create(nil);
try
Query2.SQLConnection := Connection;
Query2.SQL.Text := '...';
Transaction := Connection.BeginTransaction;
try
// fill params here and execute the commands
for I := 0 to 42 to
begin
Query1.ExecSQL;
Query2.ExecSQL;
end;
// commit if everything went right
Connection.CommitFreeAndNil(Transaction);
except
// rollback at failure, and re-raise the exception
Connection.RollbackFreeAndNil(Transaction);
raise;
end;
finally
Query2.Free;
end;
finally
Query1.Free;
end;
end;
I prefer try finally over try except
here's how to make it work in a try finally block
var
a_Error: boolean;
begin
a_Error := True;//set in error state...
SQL_dataset1 := nil;
SQL_dataset2 := nil;
SQL_transaction.TransactionID :=1;
SQL_transaction.IsolationLevel:=xilREADCOMMITTED;
SQL_connection.BeginTransaction;
Try
{ Create connections }
SQL_dataset1 :=TSQLDataSet.Create(nil);
SQL_dataset1.SQLConnection:=SQL_connection;
SQL_dataset2 :=TSQLDataSet.Create(nil);
SQL_dataset2.SQLConnection:=SQL_connection;
{ Create queries }
SQL_dataset1.CommandType:=ctQuery;
SQL_dataset1.CommandText:={ some parameterized query updating table A }
SQL_dataset2.CommandType:=ctQuery;
SQL_dataset2.CommandText:={ some parameterized query updating table B }
{ Populate parameters and execute }
For I:=0 to whatever do
begin
SQL_dataset1.ParamByName('Table A Field 1').AsString:='Value';
SQL_dataset1.ExecSQL;
SQL_dataset2.ParamByName('Table B Field 1').AsString:='Value';
SQL_dataset2.ExecSQL;
end;
a_Error := False;//if you don't get here you had a problem
finally
if a_Error then
SQL_connection.Rollback(SQL_transaction)
else
SQL_connection.Commit(SQL_transaction);
SQL_dataset1.Free;
SQL_dataset2.Free;
end;
end;
I added some code on how Try Finally works with init objects to nil
TMyObject = class(TObject)
Name: string;
end;
procedure TForm11.Button1Click(Sender: TObject);
var
a_MyObject1, a_MyObject2: TMyObject;
begin
a_MyObject1 := nil;
a_MyObject2 := nil;
try
a_MyObject1 := TMyObject.Create;
a_MyObject1.Name := 'Object1';
if Sender = Button1 then
raise exception.Create('Object 2 not created');
ShowMessage('We will not see this');
a_MyObject2 := TMyObject.Create;
a_MyObject2.Name := 'Object2';
finally
a_MyObject2.Free;
ShowMessage('We will see this even though we called a_MyObject2.free on a nil object');
a_MyObject1.Free;
end;
end;
I need my program to log a user in from a database. This entails a diver number (like a username) and a password which is already in the database. Unfortunately, I don't know SQL right now and would rather use a technique similar to the one I've done here. I get an error message in run time that says: adotblDiversInfo: Cannot perform this operation on a closed dataset. Thank you so much for your help in advance (:
This is my code:
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
sPassword, sKnownPassword : String;
bFlagDiverNumber, bFlagPassword, Result : Boolean;
begin
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
with frmDM do
adotblDiversInfo.Filtered := False;
frmDM.adotblDiversInfo.Filter := 'Diver Number' + IntToStr(iDiverNumber);
frmDM.adotblDiversInfo.Filtered := True;
if frmDM.adotblDiversInfo.RecordCount = 0 then
ShowMessage(IntToStr(iDiverNumber) + ' cannot be found')
else
begin
sKnownPassword := frmDM.adotblDiversInfo['Password'];
if sKnownPassword = sPassword then
ShowMessage('Login successful')
else
ShowMessage('Incorrect password. Please try again');
end;
end;
The error you're getting is because you've forgotten to open the dataset before attempting to access it. Use frmDM.adoTblDiversInfo.Open; or frmDM.adoTblDiversInfo.Active := True; to do so before trying to use the table.
Your code could be much simpler (and faster) if you change it somewhat. Instead of filtering the entire dataset, simply see if you can Locate the proper record.
procedure TfrmHomeScreen.btnLogInClick(Sender: TObject);
var
iDiverNumber : Integer;
begin
if not frmDM.adoTblDiversInfo.Active then
frmDM.adoTblDiversInfo.Open;
iDiverNumber := StrToInt(ledDiverNumber.Text);
sPassword := ledPassword.Text;
if frmDM.adoTblDiversInfo.Locate('Diver Number', iDiverNumber, []) the
begin
if frmDM.adoTblDiversInfo['Password'] = ledPassword.Text then
ShowMessage('Login successful')
else
ShowMessage('Invalid password. Please try again.');
end
else
ShowMessage(ledDiverNumber.Text);
end;
I am relatively new to FireDAC. I want to be able to call a stored procedure "on the fly", dynamically. So far I have the following:
function TForm21.ExecuteStoredProc(aSPName: string; aParams: TADParams): Boolean;
var
LSP: TADStoredProc;
i: Integer;
begin
LSP := TADStoredProc.Create(nil);
try
LSP.Connection := ADConnection1;
LSP.StoredProcName := aSPName;
LSP.Prepare;
for i := 0 to aParams.Count - 1 do
begin
LSP.Params[i].Value := aParams[i].Value;
end;
LSP.ExecProc;
finally
LSP.Free;
end;
Result := True;
end;
I call it with
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TADParams;
begin
LParams := TADParams.Create;
LParams.Add.Value := 612;
LParams.Add.Value := '2008';
ExecuteStoredProc('HDMTEST.dbo.spARCHIVE_HISTORY_DATA', LParams);
end;
However, the stored procedure fails to execute. That is, the code runs fine, no error message is shown, but the stored procedure doesn't run.
Further info -- it runs fine if I drop a component and set up the params in code.
Anyone have any idea what I am missing?
Seeing as this q has been left unanswered for a while, I thought I'd try to get the code working without using the clues from the comments and found it not quite as easy as I'd imagined.
I immediately got stuck with the SP params. I found this
http://docwiki.embarcadero.com/RADStudio/XE5/en/TFDQuery,_TFDStoredProc_and_TFDUpdateSQL_Questions
which says
"If you have difficulties with manual definition of parameters,
populate the Params collection automatically and check how the
parameters are defined. Then compare that to your code. "
but I couldn't find a way of "automatically" populating the Params. I asked on the EMBA
FireDac newsgroup and the FD author, Dimitry Arefiev, kindly explained that
you can do that by checking that the FetchOptions include fiMeta, and then clearing and setting the FDStoredProc's StoredProcName.
Using a StoredProc in the pubs demo database on my SqlServer defined as follows:
create procedure test(#ANumber int, #AName varchar(20))
as
begin
select
#ANumber * 2 as "Number",
#AName + #AName as "Name"
end
I changed a couple of sections of the OP's code like this
[...]
LSP.Params.Clear;
LSP.StoredProcName := '';
LSP.FetchOptions.Items := LSP.FetchOptions.Items + [fiMeta];
LSP.StoredProcName := aSPName;
LSP.Prepare;
Assert(LSP.ParamCount > 0);
for i := 0 to aParams.Count - 1 do
begin
LSP.Params.ParamByName(aParams[i].Name).Value := aParams[i].Value;
end;
[...]
procedure TForm21.Button1Click(Sender: TObject);
var
LParams: TFDParams;
Param : TFDParam;
begin
LParams := TFDParams.Create;
Param := LParams.Add;
Param.Name := '#ANumber';
Param.Value := 612;
Param := LParams.Add;
Param.Name := '#AName';
Param.Value := '2008';
ExecuteStoredProc('test', LParams);
end;
and it worked fine.
The OP mentions in the q he'd first had the problem that the SP failed to execute
but that he'd found that it worked if he "[dropped] a component and set up the params in code" so I thought I'd include here a console application where of course necessarily everything is done in code. This wasn't difficult, but the time it took me to get the Uses clause right is my main reason for posting this as an answer, for future reference. W/o the correct uses, you get errors complaining about various class factories being missing.
Console app (created and tested in XE6):
program ConsoleStoredProcProject3;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, FireDac.DApt, FireDAC.Stan.Def, FireDAC.Stan.ASync,
FireDAC.Stan.Param, FireDAC.Stan.Option, FireDAC.Comp.Client,
FireDAC.Phys.MSSQL, VCL.ClipBrd;
procedure TestSP;
var
Connection : TFDConnection;
StoredProc : TFDStoredProc;
Param : TFDParam;
begin
Connection := TFDConnection.Create(Nil);
Connection.DriverName := 'MSSQL';
Connection.Params.Values['Server'] := // your server name'';
Connection.Params.Values['Database'] := 'pubs';
Connection.Params.Values['user_name'] := 'user'; // adjust to suit
Connection.Params.Values['password'] := 'password'; // ditto
Connection.LoginPrompt := False;
Connection.Connected := True;
StoredProc := TFDStoredProc.Create(Nil);
StoredProc.Connection := Connection;
StoredProc.FetchOptions.Items := StoredProc.FetchOptions.Items + [fiMeta];
StoredProc.StoredProcName := 'test';
StoredProc.Prepare;
Param := StoredProc.Params.ParamByName('#ANumber');
Param.Value := 333;
Param := StoredProc.Params.ParamByName('#AName');
Param.Value := 'A';
StoredProc.Active := True;
WriteLn(StoredProc.FieldByName('Number').AsInteger);
WriteLn(StoredProc.FieldByName('Name').AsString);
ReadLn;
end;
begin
try
TestSP;
except
on E: Exception do
Clipboard.AsText := E.Message;
end;
end.
I'm having trouble inserting Unicode into a SQL Server database using Delphi ZeosLib and Delphi 7, and then reading the inserted value. I've created a simple test program that first inserts and then queries the inserted value.
The test table schema:
CREATE TABLE [dbo].[incominglog](
[message] [nvarchar](500) NULL
) ON [PRIMARY]
I've upload the simple test program source (ZeosLib source included) - click here to download. I've also included ntwdblib.dll but you can use your own.
The test program also requires TNT component which can be downloaded from here
Using the test program, the Unicode characters that I have inserted appear as question marks on retrieval - I'm not certain whether the problem lies with the insert code or the query code.
I've also tried encoding the data into utf-8 before inserting and then decoding the data after retrieving from utf-8 - please search "//inserted as utf8" in the test program source. I'm able to view the Unicode after it has been decoded, so this method works. However, for my actual application, I can't encode as UTF-8 as SQL Server doesn't support UTF-8 completely - some characters can't be stored. See my previous question here.
Will appreciate any pointers. :)
Meanwhile, here's the source for the Test program:
unit Unit1;
interface
uses
ZConnection, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ZAbstractRODataset, ZAbstractDataset, ZAbstractTable, ZDataset,
StdCtrls, TntStdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
TntMemo1: TTntMemo;
Button2: TButton;
TntEdit1: TTntEdit;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
FZConnection: TZConnection;
FZQuery: TZQuery;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
tntmemo1.Lines.Clear;
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
FZQuery.SQL.Text := 'SELECT * from incominglog';
FZQuery.ExecSQL;
FZQuery.Open;
FZQuery.First;
while not FZQuery.EOF do
begin
tntmemo1.Lines.add(FZQuery.FieldByName('message').AsString);
// tntmemo1.Lines.add(utf8decode(FZQuery.FieldByName('message').AsString)); //inserted as utf8
FZQuery.Next;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
sqlstring, data:widestring;
begin
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
data:= tntedit1.Text;
// data:= utf8encode(tntedit1.Text); //inserted as utf8
sqlstring:= 'INSERT INTO INCOMINGLOG ([MESSAGE]) VALUES(N''' + data + ''')';
FZQuery.SQL.Text := sqlstring;
FZQuery.ExecSQL;
end;
end.
I have not tested your example, but I'm able to save and retrieve from database Unicode characters without problem on SQL Server with Delphi 7 VCL/CLX and zeoslib.
I think in your case it will be enough changing your save procedure like this :
procedure TForm1.Button2Click(Sender: TObject);
var
sqlstring : widestring;
data : UTF8String;
begin
FZConnection := TZConnection.Create(Owner);
FZConnection.LoginPrompt := False;
FZQuery := TZQuery.Create(Owner);
FZQuery.Connection := FZConnection;
FZConnection.Protocol := 'mssql';
FZConnection.Database := 'replace-with-your-db';
FZConnection.HostName := 'localhost';
FZConnection.User := 'sa';
FZConnection.Password := 'replace-with-your-password';
FZConnection.Connect;
data:= UTF8String( utf8encode(tntedit1.Text) );
sqlstring:= 'INSERT INTO INCOMINGLOG ([MESSAGE]) VALUES(:DATA)';
FZQuery.SQL.Text := sqlstring;
FZQuery.ParamByName('DATA').AsString := data;
FZQuery.ExecSQL;
end;
The point is changing your data string variable in UTF8String type, and use parameters pass the data string to the query ...
To be honest I use it with a ZTable and Post command, but it should be the same with a ZQuery like yours ...
I am thinking about adding ODBC database connectivity to an application.
The user will at runtime configure and select their database odbc connection.
Are there any components that will give me the required series of dialogs ?
Allowing the user to select the data source type, select drivers, browse already
defined ODBC connections etc.
Cheers
Sam
You can try this, if you are using ADO components.
Option 1
Uses
OleDB,
ComObj,
ActiveX;
function Edit_ADO_ODBC_ConnectionString(ParentHandle: THandle; InitialString: WideString;out NewString: string): Boolean;
var
DataInit : IDataInitialize;
DBPrompt : IDBPromptInitialize;
DataSource: IUnknown;
InitStr : PWideChar;
begin
Result := False;
DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize;
if InitialString <> '' then
DataInit.GetDataSource(nil, CLSCTX_INPROC_SERVER, PWideChar(InitialString),IUnknown, DataSource);
DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize;
{
DBPROMPTOPTIONS_WIZARDSHEET = $1;
DBPROMPTOPTIONS_PROPERTYSHEET = $2;
DBPROMPTOPTIONS_BROWSEONLY = $8;
DBPROMPTOPTIONS_DISABLE_PROVIDER_SELECTION = $10;
}
if Succeeded(DBPrompt.PromptDataSource(nil, ParentHandle,DBPROMPTOPTIONS_PROPERTYSHEET, 0, nil, nil, IUnknown, DataSource)) then
begin
InitStr := nil;
DataInit.GetInitializationString(DataSource, True, InitStr);
NewString := InitStr;
Result := True;
end;
end;
Result:=Edit_ADO_ODBC_ConnectionString(0,OldConnectionString,NewString);
Option 2
Uses
ADODB;
PromptDataSource(Self.Handle, InitialString);
Option 3
Uses
ADODB,
AdoConEd;
procedure TMainForm.Button2Click(Sender: TObject);
Var
ADOConnection1 : TADOConnection;
begin
ADOConnection1:=TADOConnection.Create(Self);
EditConnectionString(ADOConnection1);
end;
You must Select "Microsoft OLE DB Provider for ODBC Drivers"
Bye.
PromptDataSource Function from the ADODB unit. Two parameters are
required:
the calling form's handle
a connection string . If you want no default connection string
just pass an empty string as:
var sConn : WideString;
begin
sConn := PromptDataSource(Form1.Handle, '');
end;