paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-04 08:19:53 +01:00
Code Issues Packages Projects Releases Wiki Activity

examples: added mssql, thanks to Reinier Olislagers

Browse Source 
git-svn-id: trunk@36494 -
This commit is contained in:
mattias 2012-04-01 07:26:10 +00:00
parent e1e12d6ea1
commit 9365cfa920
8 changed files with 664 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.gitattributes vendored
View File

@ -3962,6 +3962,13 @@ examples/motiongraphics/motiongraphics.ico -text
examples/motiongraphics/motiongraphics.lpi svneol=native#text/plain
examples/motiongraphics/motiongraphics.lpr svneol=native#text/pascal
examples/motiongraphics/motiongraphics.res -text
examples/mssql/README.txt svneol=native#text/plain
examples/mssql/dbform.lfm svneol=native#text/plain
examples/mssql/dbform.pas svneol=native#text/plain
examples/mssql/dbloginform.lfm svneol=native#text/plain
examples/mssql/dbloginform.pas svneol=native#text/plain
examples/mssql/mssqlconnsample.lpi svneol=native#text/plain
examples/mssql/mssqlconnsample.lpr svneol=native#text/plain
examples/multithreading/criticalsectionexample1.lpi svneol=native#text/plain
examples/multithreading/criticalsectionexample1.lpr svneol=native#text/plain
examples/multithreading/criticalsectionunit1.lfm svneol=native#text/plain

21
examples/mssql/README.txt Normal file
View File

@ -0,0 +1,21 @@
Example program for the MS SQL Server and Sybase connectors in Lazarus.
These connectors require the FreeTDS shared library (dblib.dll/.so/.dylib), which at least on Windows requires libiconv2.dll for UTF8 support.
These can be downloaded via www.freetds.org and are provided by a lot of Linux distributions.
The program will ask you for a database type (Sybase or MS SQL Server), username, password, server etc. and then connect.
Then it will query the server for database server information and show the results in a dbgrid.
It demonstrates:
- enabling/disabling connections in code
- getting database data into a dbgrid
- using modal forms
- getting combobox values
- handling database errors
- terminating a program
Works for me on Windows Lazarus/FPC trunk x86.
More databae functionality and techniques are shown in the LazDataDesktop project in the <lazarusdir>\tools\LazDataDesktop directory.
Reinier Olislagers, 31 March 2012

115
examples/mssql/dbform.lfm Normal file
View File

@ -0,0 +1,115 @@
object Form1: TForm1
Left = 238
Height = 314
Top = 145
Width = 456
Caption = 'Form1'
ClientHeight = 314
ClientWidth = 456
OnCreate = FormCreate
LCLVersion = '0.9.31'
object DBGrid1: TDBGrid
Left = 43
Height = 195
Top = 97
Width = 365
Color = clWindow
Columns = <>
DataSource = Datasource1
TabOrder = 0
end
object SQLTransaction1: TSQLTransaction
Active = False
Action = caNone
Database = SybaseConnection1
left = 208
top = 32
end
object SQLQuery1: TSQLQuery
FieldDefs = <
item
Name = 'srvid'
DataType = ftSmallint
Precision = -1
Size = 0
end
item
Name = 'srvstatus'
DataType = ftSmallint
Precision = -1
Size = 0
end
item
Name = 'srvname'
DataType = ftFixedChar
Precision = -1
Size = 60
end
item
Name = 'srvnetname'
DataType = ftFixedChar
Precision = -1
Size = 510
end
item
Name = 'srvclass'
DataType = ftSmallint
Precision = -1
Size = 0
end
item
Name = 'srvsecmech'
DataType = ftFixedChar
Precision = -1
Size = 60
end
item
Name = 'srvcost'
DataType = ftSmallint
Precision = -1
Size = 0
end
item
Name = 'srvstatus2'
DataType = ftBCD
Precision = 10
Size = 0
end
item
Name = 'srvprincipal'
DataType = ftFixedChar
Precision = -1
Size = 510
end>
Database = SybaseConnection1
Transaction = SQLTransaction1
SQL.Strings = (
'select * from sysservers'
)
Params = <>
left = 280
top = 32
end
object Datasource1: TDatasource
DataSet = SQLQuery1
left = 352
top = 32
end
object SybaseConnection1: TSybaseConnection
Connected = False
LoginPrompt = False
KeepConnection = False
Transaction = SQLTransaction1
UserName = 'sa'
LogEvents = []
left = 128
end
object MSSQLConnection1: TMSSQLConnection
Connected = False
LoginPrompt = False
KeepConnection = False
LogEvents = []
left = 128
top = 48
end
end

159
examples/mssql/dbform.pas Normal file
View File

@ -0,0 +1,159 @@
unit dbform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, mssqlconn, db, sqldb, FileUtil, Forms, Controls, Graphics,
Dialogs, DBGrids, dbloginform;
type
{ TForm1 }
TForm1 = class(TForm)
Datasource1: TDatasource;
DBGrid1: TDBGrid;
MSSQLConnection1: TMSSQLConnection;
SQLQuery1: TSQLQuery;
SQLTransaction1: TSQLTransaction;
SybaseConnection1: TSybaseConnection;
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
type
DBType=(MSSQL,SybaseASE);
var
ChosenDB: DBType;
Connection: TSQLConnection;
DBSelected: string;
GoodConnection: boolean;
LoginForm: dbloginform.TLoginForm;
Password: string;
UserCancel: boolean;
begin
// Let user login.
GoodConnection:=false;
UserCancel:=false;
LoginForm:=dbloginform.TLoginForm.Create(Nil);
try
while (GoodConnection=false) and (UserCancel=false) do
begin
if LoginForm.ShowModal=mrOK then
begin
DBSelected:=LoginForm.DatabaseType.Items[LoginForm.DatabaseType.ItemIndex];
// Use the text in the databasetype combobox to see what db the user wants.
// Then we point our Connection to the relevant TSQLConnection descendant.
case UpperCase(DBSelected) of
'MS SQL SERVER':
begin
ChosenDB:=MSSQL;
Connection:=MSSQLConnection1;
end;
'SYBASE ASE':
begin
ChosenDB:=SybaseASE;
Connection:=SybaseConnection1;
end
else
begin
showmessage('Unknown database type '+DBSelected+' chosen. Aborting. Pleae fix the code!');
Application.Terminate;
end;
end;
if LoginForm.OSAuthentication.Checked then
begin
// Use operating system credentials - mssqlconn
// expectes empty username/password then.
Connection.UserName:='';
Connection.Password:='';
end
else
begin
// Use regular username/password
Connection.UserName:=LoginForm.User.Text;
Connection.Password:=LoginForm.Password.Text;
end;
if LoginForm.Port.Text<>'' then
begin
Connection.HostName:=LoginForm.Server.Text+':'+LoginForm.Port.Text;
end
else
begin
// Default/no port. Let the connector sort it out.
Connection.HostName:=LoginForm.Server.Text;
end;
Connection.DatabaseName:=LoginForm.Database.Text;
// Actually, this should work both on MS SQL and Sybase server, so no need to change it:
//SQLQuery1.SQL.Text:='select * from sysservers';
// Everything set up, now connect to database.
// First make sure the other connection is switched off:
if ChosenDB=MSSQL then
begin
SybaseConnection1.Connected:=false;
end
else
begin
MSSQLConnection1.Connected:=false;
end;
SQLTransaction1.DataBase:=Connection;
SQLQuery1.DataBase:=Connection;
try
Connection.Connected:=true;
GoodConnection:=true;
except
on E: Exception do
begin
GoodConnection:=false;
showmessage('Error connecting to database. Technical details: '+E.ClassName+'/'+E.Message);
end;
end;
end
else
begin
showmessage('User cancelled login. Stopping.');
UserCancel:=true; //Tell the loop to release us.
Application.Terminate;
end;
end;
if UserCancel=false then
begin
// Now activate the components "downstream" of the database connection to get the data
// displayed to the user
try
SQLTransaction1.Active:=true;
SQLQuery1.Active:=true;
GoodConnection:=true;
except
on E: Exception do
begin
GoodConnection:=false;
showmessage('Error connecting to database. Technical details: '+E.ClassName+'/'+E.Message);
end;
end;
end;
finally
// Close the form and release memory
LoginForm.Release;
end;
end;
end.

153
examples/mssql/dbloginform.lfm Normal file
View File

@ -0,0 +1,153 @@
object LoginForm: TLoginForm
Left = 371
Height = 335
Top = 215
Width = 542
Caption = 'LoginForm'
ClientHeight = 335
ClientWidth = 542
LCLVersion = '0.9.31'
object User: TEdit
Left = 116
Height = 23
Hint = 'Username needed to log in to the database'
Top = 72
Width = 80
TabOrder = 0
Text = 'sa'
end
object Server: TEdit
Left = 116
Height = 23
Hint = 'Database serverr/machine'
Top = 136
Width = 80
TabOrder = 1
Text = '127.0.0.1'
end
object Port: TEdit
Left = 116
Height = 23
Hint = 'If connecting using TCP/IP: the port of the server where the database listens'
Top = 168
Width = 80
TabOrder = 2
Text = '1433'
end
object Database: TEdit
Left = 116
Height = 23
Hint = 'Name of the database, if required/useful'
Top = 200
Width = 80
TabOrder = 3
Text = 'master'
end
object UserLabel: TLabel
Left = 32
Height = 16
Top = 72
Width = 24
Caption = 'User'
ParentColor = False
end
object PasswordLabel: TLabel
Left = 32
Height = 16
Top = 104
Width = 51
Caption = 'Password'
ParentColor = False
end
object Label3: TLabel
Left = 32
Height = 16
Top = 136
Width = 33
Caption = 'Server'
ParentColor = False
end
object Label4: TLabel
Left = 32
Height = 16
Top = 168
Width = 23
Caption = 'Port'
ParentColor = False
end
object Label5: TLabel
Left = 32
Height = 16
Top = 200
Width = 49
Caption = 'Database'
ParentColor = False
end
object OKButton: TButton
Left = 440
Height = 25
Top = 272
Width = 75
Caption = '&OK'
ModalResult = 1
TabOrder = 6
end
object CancelButton: TButton
Left = 344
Height = 25
Top = 272
Width = 75
Caption = '&Cancel'
ModalResult = 2
TabOrder = 5
end
object LocalMachine: TButton
Left = 212
Height = 25
Top = 136
Width = 112
Caption = 'Local machine'
OnClick = LocalMachineClick
TabOrder = 4
end
object DatabaseType: TComboBox
Left = 116
Height = 23
Hint = 'Type of server you want to connect to'
Top = 28
Width = 124
ItemHeight = 15
ItemIndex = 0
Items.Strings = (
'MS SQL Server'
'Sybase ASE'
)
TabOrder = 7
Text = 'MS SQL Server'
end
object Label6: TLabel
Left = 32
Height = 16
Top = 28
Width = 27
Caption = 'Type'
ParentColor = False
end
object Password: TEdit
Left = 116
Height = 23
Hint = 'Password that matches username'
Top = 104
Width = 80
TabOrder = 8
end
object OSAuthentication: TCheckBox
Left = 224
Height = 19
Top = 72
Width = 117
Caption = 'OS authentication'
OnChange = OSAuthenticationChange
TabOrder = 9
end
end

75
examples/mssql/dbloginform.pas Normal file
View File

@ -0,0 +1,75 @@
unit dbloginform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
type
{ TLoginForm }
TLoginForm = class(TForm)
OSAuthentication: TCheckBox;
DatabaseType: TComboBox;
Label6: TLabel;
LocalMachine: TButton;
OKButton: TButton;
CancelButton: TButton;
User: TEdit;
Server: TEdit;
Port: TEdit;
Database: TEdit;
UserLabel: TLabel;
PasswordLabel: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Password: TEdit;
procedure LocalMachineClick(Sender: TObject);
procedure OSAuthenticationChange(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
LoginForm: TLoginForm;
implementation
{$R *.lfm}
{ TLoginForm }
procedure TLoginForm.LocalMachineClick(Sender: TObject);
begin
Server.Text:='127.0.0.1';
end;
procedure TLoginForm.OSAuthenticationChange(Sender: TObject);
begin
if OSAuthentication.Checked then
begin
// Switch from username/password to OS authentication.
User.Enabled:=false;
UserLabel.Enabled:=false;
Password.Enabled:=false;
PasswordLabel.Enabled:=false;
end
else
begin
// Switch other way round
User.Enabled:=true;
UserLabel.Enabled:=true;
Password.Enabled:=true;
PasswordLabel.Enabled:=true;
end;
end;
end.

108
examples/mssql/mssqlconnsample.lpi Normal file
View File

@ -0,0 +1,108 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="MSSQLConn"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="SQLDBLaz"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="mssqlconnsample.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="mssqlconnsample"/>
</Unit0>
<Unit1>
<Filename Value="dbform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="dbform"/>
</Unit1>
<Unit2>
<Filename Value="dbloginform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="LoginForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="dbloginform"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="mssqlconnsample"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<MsgFileName Value=""/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

26
examples/mssql/mssqlconnsample.lpr Normal file
View File

@ -0,0 +1,26 @@
program mssqlconnsample;
{
Demonstrates connecting to a Sybase ASE or MS SQL Server database.
Allows user to specify username/password, server, port and db in separate form.
See readme.txt for details on required drivers.
}
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, dbform, dbloginform
{ you can add units after this };
begin
Application.Title:='MSSQLConn';
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.