If I was using C# I could use the .net framework's SqlDataSourceEnumerator to discover and show a user a list of SQL Server instances on the network.
How can I do that in Delphi?
You can use the NetServerEnum function , filtering by the SV_TYPE_SQLSERVER value in the servertype param, another option is use the SQLOLEDB Enumerator ADO object.
To enumerate all available Microsoft SQL Servers, you can follow this excellent tutorial:
Enumerating available SQL Servers. Retrieving databases on a SQL Server
Included in Zarko's tutorial, there's a link to download the full source code (direct download) which can be useful to quickly test it and check if it fits your needs.
Edit Zarko Gajic's main routine is:
procedure ListAvailableSQLServers(Names : TStrings);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
function PtCreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(
CLASS_Recordset,
nil,
CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER,
IUnknown,
Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
begin
SourcesRecordset := PtCreateADOObject(CLASS_Recordset) as _Recordset;
RSCon := SourcesRecordset as ADORecordsetConstruction;
SourcesRowset := CreateComObject(ProgIDToClassID('SQLOLEDB Enumerator')) as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(nil, IRowset, 0, nil, IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(nil) do
try
Recordset := SourcesRecordset;
SourcesName := FieldByName('SOURCES_NAME'); { do not localize }
SourcesType := FieldByName('SOURCES_TYPE'); { do not localize }
Names.BeginUpdate;
try
while not EOF do
begin
if (SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE) and (SourcesName.AsString <> '') then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;
I don't know what I can add without lamering what Zarko's explained.
I use this code:
uses ActiveX,
ComObj,
OleDB,
DB,
ADOInt,
ADODB;
procedure ListAvailableSQLServers(Names: TStringList);
var
RSCon: ADORecordsetConstruction;
Rowset: IRowset;
SourcesRowset: ISourcesRowset;
SourcesRecordset: _Recordset;
SourcesName, SourcesType: TField;
function PtCreateADOObject(const ClassID: TGUID): IUnknown;
var
Status: HResult;
FPUControlWord: Word;
begin
asm
FNSTCW FPUControlWord
end;
Status := CoCreateInstance(
CLASS_Recordset,
nil,
CLSCTX_INPROC_SERVER or
CLSCTX_LOCAL_SERVER,
IUnknown,
Result);
asm
FNCLEX
FLDCW FPUControlWord
end;
OleCheck(Status);
end;
begin
SourcesRecordset :=
PtCreateADOObject(CLASS_Recordset)
as _Recordset;
RSCon :=
SourcesRecordset
as ADORecordsetConstruction;
SourcesRowset :=
CreateComObject(ProgIDToClassID('SQLOLEDB Enumerator'))
as ISourcesRowset;
OleCheck(SourcesRowset.GetSourcesRowset(
nil,
IRowset, 0,
nil,
IUnknown(Rowset)));
RSCon.Rowset := RowSet;
with TADODataSet.Create(nil) do
try
Recordset := SourcesRecordset;
SourcesName := FieldByName('SOURCES_NAME');
SourcesType := FieldByName('SOURCES_TYPE');
Names.BeginUpdate;
Names.Clear;
try
while not EOF do
begin
if (SourcesType.AsInteger = DBSOURCETYPE_DATASOURCE) and
(SourcesName.AsString <> '') then
Names.Add(SourcesName.AsString);
Next;
end;
finally
Names.EndUpdate;
end;
finally
Free;
end;
end;
procedure GetServer();
var
oItems: TStringList;
begin
oItems:= TStringList.Create;
try
ListAvailableSQLServers(oItems);
// To something with oItems
ShowMessage(oItems.Text);
finally
oItems.Free;
end;
end;
Related
Am trying to store my TTreeView inside SQL Server database table by using the next procedure:
procedure Save;
var
BlobField :TBlobField;
Query:TADOQuery;
Stream:TStream;
begin
Stream := TMemoryStream.Create;
Query := TADOQuery.Create(Self);
Query.SQL.Add('Select * From MyTable') ;
Query.Active := True;
Query.First;
Query.Edit;
BlobField := Query.FieldByName('MyTableField') as TBlobField;
Stream := Query.CreateBlobStream(BlobField, bmWrite);
TreeView1.SaveToStream(Stream);
Query.Refresh;
Query.Free;
Stream.Free;
end;
But every time I am getting the error: DataSet is not in edit or insert mode.
I'm using Delphi 10.1, Win 10, SQL server 2019.
Change Query.Refresh; to Query.Post;
Also, you need to Free the blob stream to finalize writing to the blob field before you then Post to commit the new data into the DB.
Also, you are leaking an unused TMemoryStream object.
Try this:
procedure Save;
var
BlobField: TField;
Query: TADOQuery;
Stream: TStream;
begin
Query := TADOQuery.Create(nil);
try
Query.SQL.Text := 'Select TOP(1) * From MyTable';
Query.Open;
try
Query.First;
Query.Edit;
try
BlobField := Query.FieldByName('MyTableField');
Stream := Query.CreateBlobStream(BlobField, bmWrite);
try
TreeView1.SaveToStream(Stream);
finally
Stream.Free;
end;
Query.Post;
except
Query.Cancel;
raise;
end;
finally
Query.Close;
end;
finally
Query.Free;
end;
end;
I've got an sql database from a customer. In the sql database is a table, called "documents". The documents are stored as blobs (have a look at the screenshot).
I want to restore the documents via Delphi (FileStream?). Do you have any ideas how to do that?
Regards,
Dennis Friedrich
function SaveFieldBlobToFile(FQuery: TDataSet): boolean;
var MyStream : TMemoryStream;
begin
Result:= false;
MyStream:= TMemoryStream.Create;
try
(FQuery.Fieldbyname('MODELE') as TBlobField).SaveToStream(MyStream);
if (MyStream<>nil) and (MyStream.Size > 0) then
begin
MyStream.Position := 0;
MyStream.SaveToFile('C:\Temp\tempMyFile.zip');
Result:= true;
end
else Result:= false;
finally
MyStream.Free;
end;
end;
function LoadFileToBlob(FQuery: TDataSet): boolean;
var MyStream : TMemoryStream;
begin
Result:= false;
MyStream := TMemoryStream.Create;
try
MyStream.LoadFromFile('C:\Temp\tempMyFile.zip');
MyStream.Position := 0;
TryEdit(FQuery);
(FQuery.FieldByName('MODELE') As TBlobField).LoadFromStream(MyStream);
TryPost(FQuery);
Result := True;
finally
MyStream.Free;
end;
end;
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 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 ...