neoturk: ...Get rid of the annoying sql wait cursor ?...
{
Simply place this one line of code in the OnCreate event of
the form that is showing the annoying SQL Wait cursor...
}
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crSQLWait] := Screen.Cursors[crHourGlass];
// or whatever cursor you would like to replace the SQL hourglass with
end;
Delphi - .....................................
neoturk: ...Get rid of the annoying sql wait cursor ?...
{
Simply place this one line of code in the OnCreate event of
the form that is showing the annoying SQL Wait cursor...
}
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crSQLWait] := Screen.Cursors[crHourGlass];
// or whatever cursor you would like to replace the SQL hourglass with
end;
Delphi - .....................................
neoturk: ...Stop the dbgrid control from auto-appending a new entry ?...
{How to stop the dbgrid control from auto-appending a new entry when you move
down after the last record in a table.
It creates a new blank line / record in the table. Can this be stopped?}
{A: Add to your TTables's "BeforeInsert" event the following line:}
procedure TForm1.Tbable1BeforeInsert(DataSet: TDataSet);
begin
Abort; {<<---this line}
end;
{A: It traps the down key and checks for end-of-file.}
procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_DOWN) then
begin
TTable1.DisableControls;
TTable1Next;
if TTable1.EOF then
Key := 0
else
TTable1.Prior;
TTable1.EnableControls;
end;
end;
Delphi - .....................................
neoturk: ...Stop the dbgrid control from auto-appending a new entry ?...
{How to stop the dbgrid control from auto-appending a new entry when you move
down after the last record in a table.
It creates a new blank line / record in the table. Can this be stopped?}
{A: Add to your TTables's "BeforeInsert" event the following line:}
procedure TForm1.Tbable1BeforeInsert(DataSet: TDataSet);
begin
Abort; {<<---this line}
end;
{A: It traps the down key and checks for end-of-file.}
procedure TForm8.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key = VK_DOWN) then
begin
TTable1.DisableControls;
TTable1Next;
if TTable1.EOF then
Key := 0
else
TTable1.Prior;
TTable1.EnableControls;
end;
end;
Delphi - .....................................
neoturk: ...Convert a ado recordset to xml and the reverse way ?...
unit ADOXMLUnit;
interface
uses
Classes, ADOInt;
function RecordsetToXML(const Recordset: _Recordset): string;
function RecordsetFromXML(const XML: string): _Recordset;
implementation
uses
ComObj;
{
Example:
...
Memo1.Lines.Text:=RecordsetToXML(ADOQuery1.Recordset);
...
}
function RecordsetToXML(const Recordset: _Recordset): string;
var
RS: Variant;
Stream: TStringStream;
begin
Result := '';
if Recordset = nil then Exit;
Stream := TStringStream.Create('');
try
RS := CreateOleObject('ADODB.Recordset');
RS := Recordset;
RS.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistXML);
Stream.Position := 0;
Result := Stream.DataString;
finally
Stream.Free;
end;
end;
{
Example:
...
ADOQuery1.Recordset:=RecordsetFromXML(Memo1.Lines.Text);
...
}
function RecordsetFromXML(const XML: string): _Recordset;
var
RS: Variant;
Stream: TStringStream;
begin
Result := nil;
if XML = '' then Exit;
try
Stream := TStringStream.Create(XML);
Stream.Position := 0;
RS := CreateOleObject('ADODB.Recordset');
RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
Result := IUnknown(RS) as _Recordset;
finally
Stream.Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Convert a ado recordset to xml and the reverse way ?...
unit ADOXMLUnit;
interface
uses
Classes, ADOInt;
function RecordsetToXML(const Recordset: _Recordset): string;
function RecordsetFromXML(const XML: string): _Recordset;
implementation
uses
ComObj;
{
Example:
...
Memo1.Lines.Text:=RecordsetToXML(ADOQuery1.Recordset);
...
}
function RecordsetToXML(const Recordset: _Recordset): string;
var
RS: Variant;
Stream: TStringStream;
begin
Result := '';
if Recordset = nil then Exit;
Stream := TStringStream.Create('');
try
RS := CreateOleObject('ADODB.Recordset');
RS := Recordset;
RS.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistXML);
Stream.Position := 0;
Result := Stream.DataString;
finally
Stream.Free;
end;
end;
{
Example:
...
ADOQuery1.Recordset:=RecordsetFromXML(Memo1.Lines.Text);
...
}
function RecordsetFromXML(const XML: string): _Recordset;
var
RS: Variant;
Stream: TStringStream;
begin
Result := nil;
if XML = '' then Exit;
try
Stream := TStringStream.Create(XML);
Stream.Position := 0;
RS := CreateOleObject('ADODB.Recordset');
RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
Result := IUnknown(RS) as _Recordset;
finally
Stream.Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Locate on a non-indexed field in a ttable ?...
{The following function can be added to your to your unit and called as follows:}
Locate(Table1, Table1LName, 'Beman');
{Table1 is your table component, Table1LName is TField you've add with the fields
editor (double click on the table component) and 'Beman' is the name you want to find.}
{Locate will find SValue in a non-indexed table}
function Locate(const oTable: TTable; const oField: TField;
const sValue: string): Boolean;
var
bmPos: TBookMark;
bFound: Boolean;
begin
Locate := False;
bFound := False;
if not oTable.Active then Exit;
if oTable.FieldDefs.IndexOf(oField.FieldName) < 0 then Exit;
bmPos := oTable.GetBookMark;
with oTable do
begin
DisableControls;
First;
while not EOF do
if oField.AsString = sValue then
begin
Locate := True;
bFound := True;
Break;
end
else
Next;
end;
if (not bFound) then
oTable.GotoBookMark(bmPos);
oTable.FreeBookMark(bmPos);
oTable.EnableControls;
end;
Delphi - .....................................
neoturk: ...Locate on a non-indexed field in a ttable ?...
{The following function can be added to your to your unit and called as follows:}
Locate(Table1, Table1LName, 'Beman');
{Table1 is your table component, Table1LName is TField you've add with the fields
editor (double click on the table component) and 'Beman' is the name you want to find.}
{Locate will find SValue in a non-indexed table}
function Locate(const oTable: TTable; const oField: TField;
const sValue: string): Boolean;
var
bmPos: TBookMark;
bFound: Boolean;
begin
Locate := False;
bFound := False;
if not oTable.Active then Exit;
if oTable.FieldDefs.IndexOf(oField.FieldName) < 0 then Exit;
bmPos := oTable.GetBookMark;
with oTable do
begin
DisableControls;
First;
while not EOF do
if oField.AsString = sValue then
begin
Locate := True;
bFound := True;
Break;
end
else
Next;
end;
if (not bFound) then
oTable.GotoBookMark(bmPos);
oTable.FreeBookMark(bmPos);
oTable.EnableControls;
end;
Delphi - .....................................
neoturk: ...Create a database at run-time with zeos ?...
{
This unit creates a database on a Interbase-Server at run-time.
The IBConsole is no longer needed.
You can execute an SQL script to create tables.
Try it out!
}
{
Diese Unit erstellt eine Datenbank auf einem Interbase - Server zur Laufzeit des Programms.
Es wird nicht mehr die IBConsole gebraucht.
Dazu kann man im Memo noch ein SQL - Skript ablaufen lassen zum erstellen der Tabellen.
Probiert es einfach aus.
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ZTransact, ZIbSqlTr, DB, ZQuery, ZIbSqlQuery,
ZConnect, ZIbSqlCon;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
ZIbSqlQuery1: TZIbSqlQuery;
ZIbSqlTransact1: TZIbSqlTransact;
ZIbSqlDatabase1: TZIbSqlDatabase;
Button3: TButton;
procedure Button1Click(Sender: TObject); // Caption/ Beschriftung : Create Database
procedure Button2Click(Sender: TObject); // Caption/ Beschriftung : SQL-Anweisung
procedure Button3Click(Sender: TObject); // Caption/ Beschriftung : Drop Database
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Creating the database
// Hier wird durch drücken des Buttons die Datenbank erstellt
//---------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>';// Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlDatabase1.CreateDatabase('');
end;
// Execute the SQL-Script in the memo
// Hier wird durch drücken des Buttons das SQL-Skript im Memo ausgeführt
//----------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlQuery1.SQL.Clear;
ZIbSqlQuery1.SQL.AddStrings(memo1.Lines);
ZIbSqlQuery1.ExecSQL;
end;
// Deleted the database
// Hier wird durch drücken des Buttons die Datenbank komplette gelöscht
//---------------------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlDatabase1.DropDatabase;
end;
end.
Delphi - .....................................
neoturk: ...Create a database at run-time with zeos ?...
{
This unit creates a database on a Interbase-Server at run-time.
The IBConsole is no longer needed.
You can execute an SQL script to create tables.
Try it out!
}
{
Diese Unit erstellt eine Datenbank auf einem Interbase - Server zur Laufzeit des Programms.
Es wird nicht mehr die IBConsole gebraucht.
Dazu kann man im Memo noch ein SQL - Skript ablaufen lassen zum erstellen der Tabellen.
Probiert es einfach aus.
}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ZTransact, ZIbSqlTr, DB, ZQuery, ZIbSqlQuery,
ZConnect, ZIbSqlCon;
type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
ZIbSqlQuery1: TZIbSqlQuery;
ZIbSqlTransact1: TZIbSqlTransact;
ZIbSqlDatabase1: TZIbSqlDatabase;
Button3: TButton;
procedure Button1Click(Sender: TObject); // Caption/ Beschriftung : Create Database
procedure Button2Click(Sender: TObject); // Caption/ Beschriftung : SQL-Anweisung
procedure Button3Click(Sender: TObject); // Caption/ Beschriftung : Drop Database
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Creating the database
// Hier wird durch drücken des Buttons die Datenbank erstellt
//---------------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>';// Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlDatabase1.CreateDatabase('');
end;
// Execute the SQL-Script in the memo
// Hier wird durch drücken des Buttons das SQL-Skript im Memo ausgeführt
//----------------------------------------------------------------------
procedure TForm1.Button2Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlQuery1.SQL.Clear;
ZIbSqlQuery1.SQL.AddStrings(memo1.Lines);
ZIbSqlQuery1.ExecSQL;
end;
// Deleted the database
// Hier wird durch drücken des Buttons die Datenbank komplette gelöscht
//---------------------------------------------------------------------
procedure TForm1.Button3Click(Sender: TObject);
begin
ZIbSqlDatabase1.Database := '<<Pfad zu Datenbank>>'; // Path to Database
ZIbSqlDatabase1.Host := 'testserver';
ZIbSqlDatabase1.Password := 'masterkey';
ZIbSqlDatabase1.Login := 'SYSDBA';
ZIbSqlDatabase1.DropDatabase;
end;
end.
Delphi - .....................................
neoturk: ...Read a blobstream with tadoquery from an accessdb ?...
function GetBlobStream(Query: TADOQuery): TMemoryStream;
begin
result := TMemoryStream.Create;
// You must connect to AccessDB first.
// See: Query.Connection, TADOConection or Query.ConnectString
// Send SQL command
Query.Active := False;
Query.SQL.Clear;
// data is my row and email the table
Query.SQL.Append('SELECT data FROM email WHERE id=1');
Query.Active := True;
Result.LoadFromStream(Query.CreateBlobStream(Query.FieldByName('Data'), bmRead));
end;
Delphi - .....................................
neoturk: ...Read a blobstream with tadoquery from an accessdb ?...
function GetBlobStream(Query: TADOQuery): TMemoryStream;
begin
result := TMemoryStream.Create;
// You must connect to AccessDB first.
// See: Query.Connection, TADOConection or Query.ConnectString
// Send SQL command
Query.Active := False;
Query.SQL.Clear;
// data is my row and email the table
Query.SQL.Append('SELECT data FROM email WHERE id=1');
Query.Active := True;
Result.LoadFromStream(Query.CreateBlobStream(Query.FieldByName('Data'), bmRead));
end;
Delphi - .....................................
neoturk: ...Borland datasnap vs microsof ado net ?...
Borland DataSnap vs Microsof ADO.NET
====================================
Delphi 7 and .NET Framework 1.1
A comparison between the tools provided by these two technologies for
building data aware applications.
Data access technologies:
=========================
Everybody knows that Borland DataSnap provides four data access technologies.
While ADO.NET is a data access technology, it provides four embedded data access technologies.
Third party companies provide data access technologies for both.
*** Borland DataSnap ***
- Borland Database Engine (BDE)
- dbExpress (DBX)
- InterBase Express (IBX)
- Activex Data Objects (ADO)
- Third party
*** Microsoft ADO.NET ***
- SQL for MS SQL Server
- OleDb
- ODBC
- Oracle
- Third party
Provide/Resolve
===============
Both uses a provide/resolve mechanism. You first provide data to a
component which holds data in memory in a disconnected fashion.
Changes to this data are hold in memory too.
Then you apply this changes to the underlying database.
So what you need is...
Components to establish a connection:
-------------------------------------
This components let you establish a connection with a
database and manage transactions.
*** Borland DataSnap ***
- Session and Database
- SQLConnection
- IBDatabase and IBTransaction
- ADOConnection
- Third party
*** Microsoft ADO.NET ***
- SQLConnection
- OleDbConnection
- ODBCConnection
- OracleConnection
- Third party
Borland DataSnap connection components have many similarities
between them but they all are different. All Microsoft ADO.NET
connection components implements the same interface.
Components to obtain data:
--------------------------
This components let you obtain a data set form a database
through one of the connection components.
*** Borland DataSnap ***
- Table, Query, StoredProc
- SQLTable, SQLQuery, SQLStoredProc, SQLDataSet
- IBTable, IBQuery, IBStoredProc, IBDataSet
- ADOTable, ADOQuery, ADOStoredProc, ADODataSet
- Third party
*** Microsoft ADO.NET ***
- SQLCommand, SQLDataReader
- OleDbCommand, OleDbDataReader
- ODBCCommand, OleDbDataReader
- OracleCommand, OracleDataReader
- Third party
Borland DataSnap components used to obtain data have many similarities between
them but they all are different. All Microsoft ADO.NET components used to obtain
data implements the same interface.
While some of the Borland DataSnap components used to obtain data let you obtain
a read-write, bi-directional data sets, all Microsoft components used to obtain
data provide read-only, forward-only data sets.
Components to provide data and resolve changes:
-----------------------------------------------
This components do two main things: provide data and resolve changes.
While Borland DataSnap component can perform it in a connected and disconnected fashion,
Microsoft ADO.NET component can perform it only in a disconnected fashion.
*** Borland DataSnap ***
- DataSetProvider
Provide:
- Connect it to a DataSet and it provides data to a ClientDataSet.
The DataSet must implements IProviderSupport interface.
- If the connected DataSet is a master DataSet it recognize the
master/detail relationship and provide data treating master record
and its detail records as a unit.
Resolve:
- It generates SQL statements on the fly using information form the
connected DataSet, even if you use JOINs.
- It treats master and details as a unit and generates transactions
for updating master and details in the same transaction and updates
data in the correct order (for inserts, first master and then details;
for deletes, first details and then master).
- It lets you configure how SQL statement should be generated.
- It manages concurrency.
*** Microsoft ADO.NET ***
- DataAdapter
Provide:
- You use a DataAdapter to fill a DataSet with records.
It could use embedded Command components or it could be connected
to your Command components.
- DataAdapter does not recognize master/detail relationships.
You need to use one DataAdapter for each table.
Resolve:
- It generates SQL statements on the fly using information from the SELECT statement,
but only for single tables.
- You must use one DataAdapter for each table so it updates only one table.
- It does not let you configure how SQL statement should be generated.
- It manages concurrency.
Components to hold data and changes in memory:
----------------------------------------------
This components hold data and changes to that data in memory.
Both can save its data to a file on disk and resolve updates later.
*** Borland DataSnap ***
- ClientDataSet
- It is aware of the DataSetProvider so they work together to apply
updates and reconcile update errors.
- Details are an extra field of the master. If you modify details
you also modify the master.
- It provides functionality to obtain details and BLOBs on demand.
*** Microsoft ADO.NET ***
- DataSet
- It doesn't aware of the DataAdapter so they don't work synchronized
and it doesn't know about update errors.
- Has a collection of tables and relations between this tables.
If you modify details you don't modify the master.
- It doesn't provide functionality to obtain details and BLOBs on demand.
Conclusions
===========
Borland DataSnap is a mature technology while Microsoft ADO.NET is an emerging,
new technology with an excellent starting point. You can accomplish the same task
with both technologies but you need to code a lot more with Microsoft ADO.NET.
With DataSetProvider and ClientDataSet from Borland DataSnap you get more than
with DataAdapter and DataSet from Microsoft ADO.NET.
Delphi - .....................................
neoturk: ...Borland datasnap vs microsof ado net ?...
Borland DataSnap vs Microsof ADO.NET
====================================
Delphi 7 and .NET Framework 1.1
A comparison between the tools provided by these two technologies for
building data aware applications.
Data access technologies:
=========================
Everybody knows that Borland DataSnap provides four data access technologies.
While ADO.NET is a data access technology, it provides four embedded data access technologies.
Third party companies provide data access technologies for both.
*** Borland DataSnap ***
- Borland Database Engine (BDE)
- dbExpress (DBX)
- InterBase Express (IBX)
- Activex Data Objects (ADO)
- Third party
*** Microsoft ADO.NET ***
- SQL for MS SQL Server
- OleDb
- ODBC
- Oracle
- Third party
Provide/Resolve
===============
Both uses a provide/resolve mechanism. You first provide data to a
component which holds data in memory in a disconnected fashion.
Changes to this data are hold in memory too.
Then you apply this changes to the underlying database.
So what you need is...
Components to establish a connection:
-------------------------------------
This components let you establish a connection with a
database and manage transactions.
*** Borland DataSnap ***
- Session and Database
- SQLConnection
- IBDatabase and IBTransaction
- ADOConnection
- Third party
*** Microsoft ADO.NET ***
- SQLConnection
- OleDbConnection
- ODBCConnection
- OracleConnection
- Third party
Borland DataSnap connection components have many similarities
between them but they all are different. All Microsoft ADO.NET
connection components implements the same interface.
Components to obtain data:
--------------------------
This components let you obtain a data set form a database
through one of the connection components.
*** Borland DataSnap ***
- Table, Query, StoredProc
- SQLTable, SQLQuery, SQLStoredProc, SQLDataSet
- IBTable, IBQuery, IBStoredProc, IBDataSet
- ADOTable, ADOQuery, ADOStoredProc, ADODataSet
- Third party
*** Microsoft ADO.NET ***
- SQLCommand, SQLDataReader
- OleDbCommand, OleDbDataReader
- ODBCCommand, OleDbDataReader
- OracleCommand, OracleDataReader
- Third party
Borland DataSnap components used to obtain data have many similarities between
them but they all are different. All Microsoft ADO.NET components used to obtain
data implements the same interface.
While some of the Borland DataSnap components used to obtain data let you obtain
a read-write, bi-directional data sets, all Microsoft components used to obtain
data provide read-only, forward-only data sets.
Components to provide data and resolve changes:
-----------------------------------------------
This components do two main things: provide data and resolve changes.
While Borland DataSnap component can perform it in a connected and disconnected fashion,
Microsoft ADO.NET component can perform it only in a disconnected fashion.
*** Borland DataSnap ***
- DataSetProvider
Provide:
- Connect it to a DataSet and it provides data to a ClientDataSet.
The DataSet must implements IProviderSupport interface.
- If the connected DataSet is a master DataSet it recognize the
master/detail relationship and provide data treating master record
and its detail records as a unit.
Resolve:
- It generates SQL statements on the fly using information form the
connected DataSet, even if you use JOINs.
- It treats master and details as a unit and generates transactions
for updating master and details in the same transaction and updates
data in the correct order (for inserts, first master and then details;
for deletes, first details and then master).
- It lets you configure how SQL statement should be generated.
- It manages concurrency.
*** Microsoft ADO.NET ***
- DataAdapter
Provide:
- You use a DataAdapter to fill a DataSet with records.
It could use embedded Command components or it could be connected
to your Command components.
- DataAdapter does not recognize master/detail relationships.
You need to use one DataAdapter for each table.
Resolve:
- It generates SQL statements on the fly using information from the SELECT statement,
but only for single tables.
- You must use one DataAdapter for each table so it updates only one table.
- It does not let you configure how SQL statement should be generated.
- It manages concurrency.
Components to hold data and changes in memory:
----------------------------------------------
This components hold data and changes to that data in memory.
Both can save its data to a file on disk and resolve updates later.
*** Borland DataSnap ***
- ClientDataSet
- It is aware of the DataSetProvider so they work together to apply
updates and reconcile update errors.
- Details are an extra field of the master. If you modify details
you also modify the master.
- It provides functionality to obtain details and BLOBs on demand.
*** Microsoft ADO.NET ***
- DataSet
- It doesn't aware of the DataAdapter so they don't work synchronized
and it doesn't know about update errors.
- Has a collection of tables and relations between this tables.
If you modify details you don't modify the master.
- It doesn't provide functionality to obtain details and BLOBs on demand.
Conclusions
===========
Borland DataSnap is a mature technology while Microsoft ADO.NET is an emerging,
new technology with an excellent starting point. You can accomplish the same task
with both technologies but you need to code a lot more with Microsoft ADO.NET.
With DataSetProvider and ClientDataSet from Borland DataSnap you get more than
with DataAdapter and DataSet from Microsoft ADO.NET.
Delphi - .....................................
neoturk: ...Create database on local ms sql server 2000 ?...
procedure CreateDatabase(WindowsSecurity: Boolean; Username, Password: String);
var
ConnectionString: String;
CommandText: String;
begin
if WindowsSecurity then
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Integrated Security=SSPI;' +
'Persist Security Info=False;' +
'Initial Catalog=master'
else
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Password=' + Password + ';' +
'Persist Security Info=True;' +
'User ID=' + Username + ';' +
'Initial Catalog=master';
try
try
ADOConnection.ConnectionString := ConnectionString;
ADOConnection.LoginPrompt := False;
ADOConnection.Connected := True;
CommandText := 'CREATE DATABASE test ON ' +
'( NAME = test_dat, ' +
'FILENAME = ''c:program filesmicrosoft sql servermssqldatatest.mdf'', ' +
'SIZE = 4, ' +
'MAXSIZE = 10, ' +
'FILEGROWTH = 1 )';
ADOCommand.CommandText := CommandText;
ADOCommand.Connection := ADOConnection;
ADOCommand.Execute;
MessageDlg('Database succesfully created.', mtInformation, [mbOK], 0);
except
on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
end;
finally
ADOConnection.Connected := False;
ADOCommand.Connection := nil;
end;
end;
Delphi - .....................................
neoturk: ...Create database on local ms sql server 2000 ?...
procedure CreateDatabase(WindowsSecurity: Boolean; Username, Password: String);
var
ConnectionString: String;
CommandText: String;
begin
if WindowsSecurity then
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Integrated Security=SSPI;' +
'Persist Security Info=False;' +
'Initial Catalog=master'
else
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Password=' + Password + ';' +
'Persist Security Info=True;' +
'User ID=' + Username + ';' +
'Initial Catalog=master';
try
try
ADOConnection.ConnectionString := ConnectionString;
ADOConnection.LoginPrompt := False;
ADOConnection.Connected := True;
CommandText := 'CREATE DATABASE test ON ' +
'( NAME = test_dat, ' +
'FILENAME = ''c:program filesmicrosoft sql servermssqldatatest.mdf'', ' +
'SIZE = 4, ' +
'MAXSIZE = 10, ' +
'FILEGROWTH = 1 )';
ADOCommand.CommandText := CommandText;
ADOCommand.Connection := ADOConnection;
ADOCommand.Execute;
MessageDlg('Database succesfully created.', mtInformation, [mbOK], 0);
except
on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
end;
finally
ADOConnection.Connected := False;
ADOCommand.Connection := nil;
end;
end;
Delphi - .....................................
neoturk: ...Compact and repair an access database ?...
{
Here is a function I have made to compact and repair an access database.
Exclusive access to the DB is required!!
}
uses
ComObj;
function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLEObject('JRO.JetEngine');
try
V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB,
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
DeleteFile(DB);
RenameFile(DB+'x',DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;
Delphi - .....................................
neoturk: ...Compact and repair an access database ?...
{
Here is a function I have made to compact and repair an access database.
Exclusive access to the DB is required!!
}
uses
ComObj;
function CompactAndRepair(DB: string): Boolean; {DB = Path to Access Database}
var
v: OLEvariant;
begin
Result := True;
try
v := CreateOLEObject('JRO.JetEngine');
try
V.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB,
'Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+DB+'x;Jet OLEDB:Engine Type=5');
DeleteFile(DB);
RenameFile(DB+'x',DB);
finally
V := Unassigned;
end;
except
Result := False;
end;
end;
Delphi - .....................................
neoturk: ...Create tables on ms sql server 2000 ?...
procedure TLocal.CreateTables(WindowsSecurity: Boolean; Username, Password: String);
var
ConnectionString: String;
begin
if WindowsSecurity then
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Integrated Security=SSPI;' +
'Persist Security Info=False;' +
'Initial Catalog=test'
else
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Password=' + Password + ';' +
'Persist Security Info=True;' +
'User ID=' + Username + ';' +
'Initial Catalog=test';
try
try
ADOConnection.ConnectionString := ConnectionString;
ADOConnection.LoginPrompt := False;
ADOConnection.Connected := True;
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Klijent(');
Add('JMBG char(13) not null,');
Add('Ime char(30) not null,');
Add('Adresa char(30) not null,');
Add('Telefon char(15) not null,');
Add('Primanja numeric(6,2) not null,');
Add('primary key (JMBG))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Kredit(');
Add('Sifra numeric not null,');
Add('Tip char(15) unique not null,');
Add('Kamata numeric not null,');
Add('primary key (Sifra))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Operator(');
Add('JMBG char(13) unique not null,');
Add('Ime char(30) not null,');
Add('Sifra char(30) not null,');
Add('Adresa char(30) not null,');
Add('Telefon char(15) not null,');
Add('Prioritet smallint not null check (Prioritet>0),');
Add('primary key (JMBG))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Kreditiranja (');
Add('Sifra numeric not null,');
Add('Sifra_kredita numeric not null,');
Add('Datum datetime,');
Add('Iznos_kredita numeric(10,2) check (Iznos_kredita>0),');
Add('Broj_rata numeric,');
Add('JMBG_klijenta char(13),');
Add('JMBG_operatora char(13),');
Add('primary key(Sifra),');
Add('foreign key(Sifra_kredita) references Kredit(Sifra) on delete cascade on update cascade,');
Add('foreign key(JMBG_klijenta) references Klijent(JMBG) on delete cascade on update cascade,');
Add('foreign key(JMBG_operatora) references Operator(JMBG) on delete cascade on update cascade)');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Rata (');
Add('Broj_rate numeric not null,');
Add('Broj_sifre numeric not null,');
Add('Datum datetime,');
Add('Iznos_rate numeric(10,2) check (Iznos_rate>0),');
Add('primary key (Broj_rate),');
Add('foreign key (Broj_sifre) references Kreditiranja(Sifra) on delete cascade on update cascade)');
end;
ADOQuery.ExecSQL;
MessageDlg('Tabele su uspjesno kreirane.', mtInformation, [mbOK], 0);
except
on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
end;
finally
ADOConnection.Connected := False;
end;
end;
Delphi - .....................................
neoturk: ...Create tables on ms sql server 2000 ?...
procedure TLocal.CreateTables(WindowsSecurity: Boolean; Username, Password: String);
var
ConnectionString: String;
begin
if WindowsSecurity then
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Integrated Security=SSPI;' +
'Persist Security Info=False;' +
'Initial Catalog=test'
else
ConnectionString := 'Provider=SQLOLEDB.1;' +
'Password=' + Password + ';' +
'Persist Security Info=True;' +
'User ID=' + Username + ';' +
'Initial Catalog=test';
try
try
ADOConnection.ConnectionString := ConnectionString;
ADOConnection.LoginPrompt := False;
ADOConnection.Connected := True;
ADOQuery.Connection := ADOConnection;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Klijent(');
Add('JMBG char(13) not null,');
Add('Ime char(30) not null,');
Add('Adresa char(30) not null,');
Add('Telefon char(15) not null,');
Add('Primanja numeric(6,2) not null,');
Add('primary key (JMBG))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Kredit(');
Add('Sifra numeric not null,');
Add('Tip char(15) unique not null,');
Add('Kamata numeric not null,');
Add('primary key (Sifra))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Operator(');
Add('JMBG char(13) unique not null,');
Add('Ime char(30) not null,');
Add('Sifra char(30) not null,');
Add('Adresa char(30) not null,');
Add('Telefon char(15) not null,');
Add('Prioritet smallint not null check (Prioritet>0),');
Add('primary key (JMBG))');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Kreditiranja (');
Add('Sifra numeric not null,');
Add('Sifra_kredita numeric not null,');
Add('Datum datetime,');
Add('Iznos_kredita numeric(10,2) check (Iznos_kredita>0),');
Add('Broj_rata numeric,');
Add('JMBG_klijenta char(13),');
Add('JMBG_operatora char(13),');
Add('primary key(Sifra),');
Add('foreign key(Sifra_kredita) references Kredit(Sifra) on delete cascade on update cascade,');
Add('foreign key(JMBG_klijenta) references Klijent(JMBG) on delete cascade on update cascade,');
Add('foreign key(JMBG_operatora) references Operator(JMBG) on delete cascade on update cascade)');
end;
ADOQuery.ExecSQL;
ADOQuery.SQL.Clear;
with ADOQuery.SQL do
begin
Add('create table Rata (');
Add('Broj_rate numeric not null,');
Add('Broj_sifre numeric not null,');
Add('Datum datetime,');
Add('Iznos_rate numeric(10,2) check (Iznos_rate>0),');
Add('primary key (Broj_rate),');
Add('foreign key (Broj_sifre) references Kreditiranja(Sifra) on delete cascade on update cascade)');
end;
ADOQuery.ExecSQL;
MessageDlg('Tabele su uspjesno kreirane.', mtInformation, [mbOK], 0);
except
on E: Exception do MessageDlg(E.Message, mtWarning, [mbOK], 0);
end;
finally
ADOConnection.Connected := False;
end;
end;
Delphi - .....................................
neoturk: ...Recover the id of the last inserted row in a table [ado] ?...
// Insert a new Record...
var
LastID: Integer;
// Query: TADOQuery;
// oder
// Query: TQuery;
begin
Query.Active := False;
Query.SQL.Clear;
Query.SQL.Append('INSERT INTO Table (Spalte) VALUES (Value)');
Query.ExecSQL;
LastID := GetLastID(Query);
end;
// get the ID of the last inserted row
function GetLastID(var Query: TADOQuery {or TQuery}): Integer;
begin
result := -1;
try
Query.SQL.clear;
Query.SQL.Add('SELECT @@IDENTITY');
Query.Active := True;
Query.First;
result := Query.Fields.Fields[0].AsInteger;
finally
Query.Active := False;
Query.SQL.clear;
end;
end;
Delphi - .....................................
neoturk: ...Recover the id of the last inserted row in a table [ado] ?...
// Insert a new Record...
var
LastID: Integer;
// Query: TADOQuery;
// oder
// Query: TQuery;
begin
Query.Active := False;
Query.SQL.Clear;
Query.SQL.Append('INSERT INTO Table (Spalte) VALUES (Value)');
Query.ExecSQL;
LastID := GetLastID(Query);
end;
// get the ID of the last inserted row
function GetLastID(var Query: TADOQuery {or TQuery}): Integer;
begin
result := -1;
try
Query.SQL.clear;
Query.SQL.Add('SELECT @@IDENTITY');
Query.Active := True;
Query.First;
result := Query.Fields.Fields[0].AsInteger;
finally
Query.Active := False;
Query.SQL.clear;
end;
end;
Delphi - .....................................
neoturk: ...Use ado to connect to an access database and write a blobstream value ?...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ADODB, DB, DBTables, ComObj;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
procedure ShowEOleException(AExc: EOleException; Query: String);
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Query: TADOQuery;
ms: TMemoryStream;
ConnectStr: String;
begin
ms := TMemoryStream.Create;
ms.LoadFromFile('d:a.txt');
Query := TADOQuery.Create(nil);
// You must connect to AccessDB first.
// See: Query.Connection, TADOConection or Query.ConnectionString
//my function to connect to DB
ConnectStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + // provider for Access2000
'Data Source=C:db1.mdb;' + // databasefile
'Mode=ReadWrite|Share Deny None;' + // set to ReadWrite
'Persist Security Info=False';
if not ConnectToADODB(Query, ConnectStr) then
ShowMessage('Connecting to DB failed.');
// data is my row and email the table
UpdateBlob(Query.Connection, 'blobfieldname', 'Tabelle1', 'id=1', ms);
ms.Free;
// disconnect from DB
Query.Connection.Close;
Query.Free;
end;
function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
begin
Query.Connection := TADOConnection.Create(nil);
Query.Connection.LoginPrompt := True;
Query.Connection.ConnectionString := ConnectStr;
Query.Connection.Open;
result := Query.Connection.Connected;
end;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
var
BlobField: TBlobField;
Table: TADOTable;
begin
result := True;
try
ms.Seek(0, soFromBeginning);
Table := TADOTable.Create(nil);
Table.Connection := Connection;
Table.TableName := Tabelle;
Table.Filtered := False;
// Set Filter like SQL-Command '... WHERE id=1'
Table.Filter := Where;
Table.Filtered := True;
Table.Open;
Table.First;
if not Table.FieldByName(Spalte).IsBlob then
Raise EOleException.Create('The field ' + Spalte + ' is not a blob-field.', S_FALSE, 'ITSQL.UpdateBlob', '', 0);
BlobField := TBlobField(Table.FieldByName(Spalte));
Table.Edit;
BlobField.LoadFromStream(ms);
Table.Post;
Table.Free;
except
on E: EOleException do
begin
ShowEOleException(E, 'UPDATE BLOB FROM: SELECT ' + Spalte + ' FROM ' + Tabelle + ' WHERE ' + Where);
result := False;
end;
end;
end;
procedure ShowEOleException(AExc: EOleException; Query: String);
var
ErrShowFrm: TForm;
Memo: TMemo;
begin
ErrShowFrm := TForm.Create(nil);
ErrShowFrm.Position := poScreenCenter;
ErrShowFrm.Width := 640;
ErrShowFrm.Height := 480;
Memo := TMemo.Create(ErrShowFrm);
Memo.Parent := ErrShowFrm;
Memo.Align := alClient;
Memo.Lines.Clear;
Memo.Lines.Add('Message: ' + AExc.Message);
Memo.Lines.Add(' Source: ' + AExc.Source);
Memo.Lines.Add(' ClassName: ' + AExc.ClassName);
Memo.Lines.Add(' Error Code: ' + IntToStr(AExc.ErrorCode));
Memo.Lines.Add(' Query: ' + Query);
ErrShowFrm.ShowModal;
Memo.Free;
ErrShowFrm.Free;
end;
end.
Delphi - .....................................
neoturk: ...Use ado to connect to an access database and write a blobstream value ?...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ADODB, DB, DBTables, ComObj;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
procedure ShowEOleException(AExc: EOleException; Query: String);
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
Query: TADOQuery;
ms: TMemoryStream;
ConnectStr: String;
begin
ms := TMemoryStream.Create;
ms.LoadFromFile('d:a.txt');
Query := TADOQuery.Create(nil);
// You must connect to AccessDB first.
// See: Query.Connection, TADOConection or Query.ConnectionString
//my function to connect to DB
ConnectStr := 'Provider=Microsoft.Jet.OLEDB.4.0;' + // provider for Access2000
'Data Source=C:db1.mdb;' + // databasefile
'Mode=ReadWrite|Share Deny None;' + // set to ReadWrite
'Persist Security Info=False';
if not ConnectToADODB(Query, ConnectStr) then
ShowMessage('Connecting to DB failed.');
// data is my row and email the table
UpdateBlob(Query.Connection, 'blobfieldname', 'Tabelle1', 'id=1', ms);
ms.Free;
// disconnect from DB
Query.Connection.Close;
Query.Free;
end;
function ConnectToADODB(var Query: TADOQuery; ConnectStr: String): Boolean; Overload;
begin
Query.Connection := TADOConnection.Create(nil);
Query.Connection.LoginPrompt := True;
Query.Connection.ConnectionString := ConnectStr;
Query.Connection.Open;
result := Query.Connection.Connected;
end;
function UpdateBlob(Connection: TADOConnection; Spalte: String; Tabelle: String; Where: String; var ms: TMemoryStream): Boolean;
var
BlobField: TBlobField;
Table: TADOTable;
begin
result := True;
try
ms.Seek(0, soFromBeginning);
Table := TADOTable.Create(nil);
Table.Connection := Connection;
Table.TableName := Tabelle;
Table.Filtered := False;
// Set Filter like SQL-Command '... WHERE id=1'
Table.Filter := Where;
Table.Filtered := True;
Table.Open;
Table.First;
if not Table.FieldByName(Spalte).IsBlob then
Raise EOleException.Create('The field ' + Spalte + ' is not a blob-field.', S_FALSE, 'ITSQL.UpdateBlob', '', 0);
BlobField := TBlobField(Table.FieldByName(Spalte));
Table.Edit;
BlobField.LoadFromStream(ms);
Table.Post;
Table.Free;
except
on E: EOleException do
begin
ShowEOleException(E, 'UPDATE BLOB FROM: SELECT ' + Spalte + ' FROM ' + Tabelle + ' WHERE ' + Where);
result := False;
end;
end;
end;
procedure ShowEOleException(AExc: EOleException; Query: String);
var
ErrShowFrm: TForm;
Memo: TMemo;
begin
ErrShowFrm := TForm.Create(nil);
ErrShowFrm.Position := poScreenCenter;
ErrShowFrm.Width := 640;
ErrShowFrm.Height := 480;
Memo := TMemo.Create(ErrShowFrm);
Memo.Parent := ErrShowFrm;
Memo.Align := alClient;
Memo.Lines.Clear;
Memo.Lines.Add('Message: ' + AExc.Message);
Memo.Lines.Add(' Source: ' + AExc.Source);
Memo.Lines.Add(' ClassName: ' + AExc.ClassName);
Memo.Lines.Add(' Error Code: ' + IntToStr(AExc.ErrorCode));
Memo.Lines.Add(' Query: ' + Query);
ErrShowFrm.ShowModal;
Memo.Free;
ErrShowFrm.Free;
end;
end.
Delphi - .....................................
neoturk: ...Edit an inplace tmemo inside a tdbgrid ?...
(*
A common problem when working with DBGrid is, that this component can't display TMemo fields,
multiline columns, Graphics...
There are a few good freeware components around to solve this problem.
The best one is definitly "DBGRIDPLUS", which comes with full sources.
However, this component does not allow to edit the text in memo fields.
The delphi fans out there who bought a delphi version that comes with the VCL sources can
fix this problem:
Open dbgrids.pas and make the following changes:
(To have memo editing in your app you must just add the modifyed version of dbgrids.pas to your uses clause)
*)
function TCustomDBGrid.GetEditLimit: Integer;
begin
Result := 0;
if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString, ftMemo]) then <-- Add
Result := SelectedField.Size;
end;
function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
Result := '';
if FDatalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
Result := Field.AsString; <-- Change this.
FEditText := Result;
end;
(*
Just compare theese edited functions with the original ones, and you will know what to change.
To get multiline cell support (not in memo fields!) for DBGridPlus, send me an email and i can send you the changed DBGridPlus.pas file.
*)
Delphi - .....................................
neoturk: ...Edit an inplace tmemo inside a tdbgrid ?...
(*
A common problem when working with DBGrid is, that this component can't display TMemo fields,
multiline columns, Graphics...
There are a few good freeware components around to solve this problem.
The best one is definitly "DBGRIDPLUS", which comes with full sources.
However, this component does not allow to edit the text in memo fields.
The delphi fans out there who bought a delphi version that comes with the VCL sources can
fix this problem:
Open dbgrids.pas and make the following changes:
(To have memo editing in your app you must just add the modifyed version of dbgrids.pas to your uses clause)
*)
function TCustomDBGrid.GetEditLimit: Integer;
begin
Result := 0;
if Assigned(SelectedField) and (SelectedField.DataType in [ftString, ftWideString, ftMemo]) then <-- Add
Result := SelectedField.Size;
end;
function TCustomDBGrid.GetEditText(ACol, ARow: Longint): string;
begin
Result := '';
if FDatalink.Active then
with Columns[RawToDataColumn(ACol)] do
if Assigned(Field) then
Result := Field.AsString; <-- Change this.
FEditText := Result;
end;
(*
Just compare theese edited functions with the original ones, and you will know what to change.
To get multiline cell support (not in memo fields!) for DBGridPlus, send me an email and i can send you the changed DBGridPlus.pas file.
*)
Delphi - .....................................
neoturk: ...Multi select rows in a dbgrid using shift [select as in the ie] ?...
property BM1: TBookmark read FBM1 Write SetBM1;
property BM2: TBookmark read FBM2 Write SetBM2;
procedure Markieren(Sender: TObject);
function Shiftgedr: Boolean;
procedure TForm1.Markieren(Sender: TObject);
var
Richtung: string;
TempBM: TBookmark;
begin
with (Sender as TDBGRID).DataSource.Dataset do
begin
if (BOF and EOF) then
Exit;
DisableControls;
try
try
GotoBookmark(BM1);
case DBGrid1.DataSource.DataSet.CompareBookmarks(BM1, BM2) of
-1: Richtung := 'Unten';
1: Richtung := 'Oben';
0: Richtung := 'Gleich';
end;
TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
while DBGrid1.DataSource.DataSet.CompareBookmarks(BM2, TempBM) <> 0 do
begin
DBGrid1.SelectedRows.CurrentRowSelected := True;
if Richtung = 'Unten' then
Next
else
Prior;
TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
end;
finally
FreeBookmark(tempbm);
end;
finally
EnableControls;
end;
end;
end;
function TForm1.Shiftgedr: Boolean;
var
State: TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[VK_SHIFT] and 128) <> 0);
end;
//Im "OnMouseUP" des Grids folgenden Code einbauen
begin
if not Shiftgedr then
Merke1 := nil;
if Merke1 = nil then
Merke1 := DBGrid1.DataSource.DataSet.GetBookmark
else
Merke2 := DBGrid1.DataSource.DataSet.GetBookmark;
if (Merke1 <> nil) and (Merke2 <> nil) then
begin
if Shiftgedr then
begin
Markieren(Sender);
end;
end;
end;
Delphi - .....................................
neoturk: ...Multi select rows in a dbgrid using shift [select as in the ie] ?...
property BM1: TBookmark read FBM1 Write SetBM1;
property BM2: TBookmark read FBM2 Write SetBM2;
procedure Markieren(Sender: TObject);
function Shiftgedr: Boolean;
procedure TForm1.Markieren(Sender: TObject);
var
Richtung: string;
TempBM: TBookmark;
begin
with (Sender as TDBGRID).DataSource.Dataset do
begin
if (BOF and EOF) then
Exit;
DisableControls;
try
try
GotoBookmark(BM1);
case DBGrid1.DataSource.DataSet.CompareBookmarks(BM1, BM2) of
-1: Richtung := 'Unten';
1: Richtung := 'Oben';
0: Richtung := 'Gleich';
end;
TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
while DBGrid1.DataSource.DataSet.CompareBookmarks(BM2, TempBM) <> 0 do
begin
DBGrid1.SelectedRows.CurrentRowSelected := True;
if Richtung = 'Unten' then
Next
else
Prior;
TempBM := DBGrid1.DataSource.DataSet.GetBookmark;
end;
finally
FreeBookmark(tempbm);
end;
finally
EnableControls;
end;
end;
end;
function TForm1.Shiftgedr: Boolean;
var
State: TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[VK_SHIFT] and 128) <> 0);
end;
//Im "OnMouseUP" des Grids folgenden Code einbauen
begin
if not Shiftgedr then
Merke1 := nil;
if Merke1 = nil then
Merke1 := DBGrid1.DataSource.DataSet.GetBookmark
else
Merke2 := DBGrid1.DataSource.DataSet.GetBookmark;
if (Merke1 <> nil) and (Merke2 <> nil) then
begin
if Shiftgedr then
begin
Markieren(Sender);
end;
end;
end;
Delphi - .....................................
neoturk: ...Load a jpeg file into a blob field using sql ?...
procedure TForm1.Button1Click(Sender: TObject);
var
ms: TMemoryStream;
begin
if OpenPictureDialog1.Execute then
begin
ms := TMemoryStream.Create;
try
ms.LoadFromFile(OpenPictureDialog1.FileName);
with Query1 do
begin
with SQL do
begin
Clear;
Add('INSERT INTO "ImageTbl.db" (ImageFld)');
Add('VALUES (:param0 )');
end;
Query1.ParamByName('param0').SetBlobData(ms.Memory, ms.Size);
ExecSQL;
end;
finally
ms.Free;
end;
end;
end;
Delphi - .....................................
neoturk: ...Load a jpeg file into a blob field using sql ?...
procedure TForm1.Button1Click(Sender: TObject);
var
ms: TMemoryStream;
begin
if OpenPictureDialog1.Execute then
begin
ms := TMemoryStream.Create;
try
ms.LoadFromFile(OpenPictureDialog1.FileName);
with Query1 do
begin
with SQL do
begin
Clear;
Add('INSERT INTO "ImageTbl.db" (ImageFld)');
Add('VALUES (:param0 )');
end;
Query1.ParamByName('param0').SetBlobData(ms.Memory, ms.Size);
ExecSQL;
end;
finally
ms.Free;
end;
end;
end;
Delphi - .....................................
neoturk: ...Convert a query into a table ?...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;
type
TForm1 = class(TForm)
Button1: TButton;
Query1: TQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
InitQuery: TQuery;
InitTable: TTable;
InitBatch: TBatchMove;
begin
InitQuery := TQuery.Create(Application);
with InitQuery do
begin
DatabaseName := 'DBDEMOS';
Close;
SQL.Clear;
SQL.Add('SELECT * ');
SQL.Add('FROM customer.db');
SQL.Add('WHERE Country="US"');
SQL.SaveToFile('mgrInit.sql');
try
Open;
try // Send the SQL result to c:tempINIT.DB
InitTable := TTable.Create(Application);
with InitTable do
begin
DatabaseName := 'c:temp';
TableName := 'INIT';
end;
InitBatch := TBatchMove.Create(Application);
with InitBatch do
begin
Destination := InitTable;
Source := InitQuery;
Mode := batCopy;
Execute;
end;
finally
InitTable.Free;
InitBatch.Free;
end;
except
Free;
Abort;
end;
Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Convert a query into a table ?...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms,
Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;
type
TForm1 = class(TForm)
Button1: TButton;
Query1: TQuery;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
InitQuery: TQuery;
InitTable: TTable;
InitBatch: TBatchMove;
begin
InitQuery := TQuery.Create(Application);
with InitQuery do
begin
DatabaseName := 'DBDEMOS';
Close;
SQL.Clear;
SQL.Add('SELECT * ');
SQL.Add('FROM customer.db');
SQL.Add('WHERE Country="US"');
SQL.SaveToFile('mgrInit.sql');
try
Open;
try // Send the SQL result to c:tempINIT.DB
InitTable := TTable.Create(Application);
with InitTable do
begin
DatabaseName := 'c:temp';
TableName := 'INIT';
end;
InitBatch := TBatchMove.Create(Application);
with InitBatch do
begin
Destination := InitTable;
Source := InitQuery;
Mode := batCopy;
Execute;
end;
finally
InitTable.Free;
InitBatch.Free;
end;
except
Free;
Abort;
end;
Free;
end;
end;
end.
Delphi - .....................................
neoturk: ...Create tables detial-master in sql server 2000 with code ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Create Table MasterTable ' +
'(FieldName Primary Key);';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Create Table Detailtable ' +
'(Fieldname Primary Key Refrenced Mastertable(Fieldname));';
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Create tables detial-master in sql server 2000 with code ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Create Table MasterTable ' +
'(FieldName Primary Key);';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Create Table Detailtable ' +
'(Fieldname Primary Key Refrenced Mastertable(Fieldname));';
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Get list of tables in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_Tables');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Get list of tables in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_Tables');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Get list of database in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_DATABASES');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Get list of database in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_DATABASES');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Get list of active users in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_WHO');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Get list of active users in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOQuery1.SQL.Add('Exec SP_WHO');
ADOQuery1.Active := True;
end;
Delphi - .....................................
neoturk: ...Delete a user from adatabase in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_DropUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Delete a user from adatabase in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_DropUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Add a user into a database in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Add a user into a database in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Use DataBaseName';
ADOCommand1.Execute;
ADOCommand1.CommandText := 'Exec SP_AddUser ' + QuotedStr('Username');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Delete a user's login in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Exec SP_DropLogin ' + QuotedStr('UserName');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Delete a user's login in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOCommand1.CommandText := 'Exec SP_DropLogin ' + QuotedStr('UserName');
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Connect to sql server 2000 ?...
begin
ADOConnection1.ConnectionString := 'Server=Hostname;DataBase=DatabaseName';
ADOConnection1.Open('UserName', 'Password');
ADOConnection1.Connected := True;
end;
Delphi - .....................................
neoturk: ...Connect to sql server 2000 ?...
begin
ADOConnection1.ConnectionString := 'Server=Hostname;DataBase=DatabaseName';
ADOConnection1.Open('UserName', 'Password');
ADOConnection1.Connected := True;
end;
Delphi - .....................................
neoturk: ...Add a user's login in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.Connected := True;
ADOCommand1.CommandText := 'Exec SP_AddLogin ' + QuotedStr('UserName') +
',' + QuotedStr('Password') + ',' + QuotedStr('Database Name') + ',' +
QuotedStr('English') + ';';
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Add a user's login in sql server 2000 ?...
procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.Connected := True;
ADOCommand1.CommandText := 'Exec SP_AddLogin ' + QuotedStr('UserName') +
',' + QuotedStr('Password') + ',' + QuotedStr('Database Name') + ',' +
QuotedStr('English') + ';';
ADOCommand1.Execute;
end;
Delphi - .....................................
neoturk: ...Adapt datetime values for sql-server or access formats ?...
{---------------------------------------------------------------------
Dieser Tip ist als Verbesserung zum ursprünglichen Artikel
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
gedacht.
Die folgende Funktionen wandeln einen DateTime Wert
(unabhängig vom eingestelltem Datumsformat) in einen
für den SQL-Server verständlichen String um.
----------------------------------------------------------------------
Please also take a look at the initial tip:
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
the following functions converts a datatime value
(independant of the dateformat) to a string that
is readably by the SQL Server
---------------------------------------------------------------------}
function DateTimeToSQLServerDateTimeString(Value: TDateTime): string;
begin
Result := '{ ts' + QuotedStr(FormatDateTime('yyyy-mm-dd hh":"nn":"ss.z', Value)) + ' }';
end;
function DateTimeToSQLServerDateString(Value: TDateTime): string;
begin
Result := '{ d' + QuotedStr(FormatDateTime('yyyy-mm-dd', Value)) + ' }';
end;
function DateTimeToSQLServerTimeString(Value: TDateTime): string;
begin
Result := '{ t' + QuotedStr(FormatDateTime('hh":"nn":"ss.z', Value)) + ' }';
end;
{
dito für die Jet-Engine (Access-Datenbank)
also for the Jet-Engine (Access database)
}
function DateTimeToAccessDateTimeString(Value: TDateTime): string;
function FloatToStrEx(const Value: Extended; const DecSep: Char): string;
var
OldSep: Char;
begin
OldSep := DecimalSeparator;
try
DecimalSeparator := DecSep;
Result := FloatToStr(Value);
finally
DecimalSeparator := OldSep;
end;
end;
begin
// Da Access (Jet-Engine) ein Datum als Double speichert...
// because Access (Jet-Engine) stores a date as a double...
Result := FloatToStrEx(Value, '.');
end;
Delphi - .....................................
neoturk: ...Adapt datetime values for sql-server or access formats ?...
{---------------------------------------------------------------------
Dieser Tip ist als Verbesserung zum ursprünglichen Artikel
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
gedacht.
Die folgende Funktionen wandeln einen DateTime Wert
(unabhängig vom eingestelltem Datumsformat) in einen
für den SQL-Server verständlichen String um.
----------------------------------------------------------------------
Please also take a look at the initial tip:
http://www.swissdelphicenter.ch/de/showcode.php?id=1423
the following functions converts a datatime value
(independant of the dateformat) to a string that
is readably by the SQL Server
---------------------------------------------------------------------}
function DateTimeToSQLServerDateTimeString(Value: TDateTime): string;
begin
Result := '{ ts' + QuotedStr(FormatDateTime('yyyy-mm-dd hh":"nn":"ss.z', Value)) + ' }';
end;
function DateTimeToSQLServerDateString(Value: TDateTime): string;
begin
Result := '{ d' + QuotedStr(FormatDateTime('yyyy-mm-dd', Value)) + ' }';
end;
function DateTimeToSQLServerTimeString(Value: TDateTime): string;
begin
Result := '{ t' + QuotedStr(FormatDateTime('hh":"nn":"ss.z', Value)) + ' }';
end;
{
dito für die Jet-Engine (Access-Datenbank)
also for the Jet-Engine (Access database)
}
function DateTimeToAccessDateTimeString(Value: TDateTime): string;
function FloatToStrEx(const Value: Extended; const DecSep: Char): string;
var
OldSep: Char;
begin
OldSep := DecimalSeparator;
try
DecimalSeparator := DecSep;
Result := FloatToStr(Value);
finally
DecimalSeparator := OldSep;
end;
end;
begin
// Da Access (Jet-Engine) ein Datum als Double speichert...
// because Access (Jet-Engine) stores a date as a double...
Result := FloatToStrEx(Value, '.');
end;
Delphi - .....................................
neoturk: ...Talk to a msaccess database thru dot net ?...
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A working Delphi for Dot Net example that talks to an MSAccess
database and displays one result. This code should properly
demonstrate the use of Dot Net Components to retreive Data from
MS Access. Other examples I've seen are Internet based and do not
function correctly.
Any Comments to : Andychap@hotmail.com
Please put DOT NET in the subject so I can
Junk filter.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
//--------------------------------------------------------------------
// Main program refers to the unit below. Make sure of the
// program paths!!!!!
//--------------------------------------------------------------------
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// Simple Access Database demonstration
//
// Written by Andy Chapman (AndyChap@hotmail.com)
// Copyright (C) ACMIS Software , 2003
//
// For all you Delphi lovers here's a complete example of reading
// an MSAccess database useing Dot Net notation. Most of the examples
// found on the net refered to internet and IIS applications but this
// one runs as a true dot net implementation. With thanks to all the
// articles posted on the net... you know who you are.
//
// Program DBTest uses Newform2 as its inclusion. This form is where
// all the work is done. Please pass comment to the EMail address above
// and mark in the Subject Line DOT NET or my mail filter will kill it
//
// Regards : Andrew Chapman
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
program DBTest;
uses
System.Windows.Forms,
Newform2 in 'c:tempnetNewform2.pas' {Form1};
begin
Mainform := TForm1.Create;
Application.Run(Mainform);
end.
//--------------------------------------------------------------------
// Unit refered to by the main program. Make sure your database
// path is set correctly
//--------------------------------------------------------------------
unit NewForm2;
interface
uses
{ Just like the old uses clause in a delphi program. The SYSTEM namespace refers to windows
type controls and not specifically the delphi ones. To draw a delphi button call on the
BORLAND.VCL name spaces... see below }
System.Reflection,
System.Drawing,
System.Drawing.Text,
System.ComponentModel,
System.Windows.Forms,
System.Data.OleDB,
System.Data,
System.Data.Common,
System.Runtime.InteropServices;
type
TForm1 = class(Form)
private
buttonload: system.windows.forms.button; // a button
Components: system.componentmodel.container; // a component store
datagrid1: system.windows.forms.datagrid; // not used in this implementation
public
constructor Create; // which I will inherite and amend
procedure InitializeComponents; // easy way to centralise component creation
procedure Button1_Click(Sender: TObject; E: EventArgs); // on click event
end;
var
MainForm: TForm1; // as ever a main delphi form
implementation
constructor TForm1.Create;
begin
inherited Create; // normal create stuff then set up all the required components
InitializeComponents; // sets up components
end;
procedure TForm1.InitializeComponents;
var
MyControls: array[0..2] of control; // container class for main form
begin
Self.ClientSize := system.Drawing.Size.Create(600,413); // client window on screen
Self.Components := System.ComponentModel.Container.Create();
// container class for the other bits
Self.buttonload := system.windows.forms.button.Create(); // make a button
Self.buttonload.add_click(button1_click); // set its on click event
Self.buttonload.Size := system.drawing.Size.Create(112,32); // size up the button
Self.buttonload.location := system.drawing.point.Create(480,352); // where on screen ?
Self.buttonload.Text := 'Read the database';
// text on the button - 'caption' in real delphi
Self.datagrid1 := system.windows.forms.datagrid.Create(); // draw a datagrid - not used
Self.datagrid1.Size := system.drawing.Size.Create(584,336);
Self.datagrid1.location := system.drawing.point.Create(8,8);
MyControls[0] := Self.buttonload; // add button to container class
MyControls[1] := Self.datagrid1; // add grid to container class
Self.Controls.AddRange(MyControls);
// basically add them to the form, form is now parent
end;
procedure TForm1.Button1_Click(Sender: TObject; E: EventArgs);
var
dbConnection: oleDBConnection;
dbCommand: OleDBCommand;
dbReader: OleDBDataReader;
dbDataAdapter: OleDBDataAdapter;
dbDataset: Dataset;
temp, temp1: string;
int1: Integer;
begin
temp := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb'; // connection string
temp1 := 'Select * from Shawbury'; // SQL code to fire
(* Fount that I had to use an explicit string to make the connection , The exapmple code
was'nt very clear on this - it works so hopefully it's the right solution *)
dbConnection := System.Data.OleDB.OleDbConnection.Create(temp); // make a DB Connection
dbConnection.Open(); // open a DB Conection
dbCommand := System.Data.OleDB.OleDbCommand.Create(temp1, dbConnection);
// execute the SQL
dbReader := dbCommand.ExecuteReader(); // and store in a datareader
int1 := dbReader.GetOrdinal('subcol1');
// I have a coloum in the Database called subcol1
while dbReader.read() do // keep reading all records
begin
// gives you a warm feeling to see the last record on the button
// - now I'm sure its read the file
buttonload.Text := dbreader.GetValue(int1).tostring;
end;
end;
end.
Delphi - .....................................
neoturk: ...Talk to a msaccess database thru dot net ?...
{+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A working Delphi for Dot Net example that talks to an MSAccess
database and displays one result. This code should properly
demonstrate the use of Dot Net Components to retreive Data from
MS Access. Other examples I've seen are Internet based and do not
function correctly.
Any Comments to : Andychap@hotmail.com
Please put DOT NET in the subject so I can
Junk filter.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
//--------------------------------------------------------------------
// Main program refers to the unit below. Make sure of the
// program paths!!!!!
//--------------------------------------------------------------------
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
// Simple Access Database demonstration
//
// Written by Andy Chapman (AndyChap@hotmail.com)
// Copyright (C) ACMIS Software , 2003
//
// For all you Delphi lovers here's a complete example of reading
// an MSAccess database useing Dot Net notation. Most of the examples
// found on the net refered to internet and IIS applications but this
// one runs as a true dot net implementation. With thanks to all the
// articles posted on the net... you know who you are.
//
// Program DBTest uses Newform2 as its inclusion. This form is where
// all the work is done. Please pass comment to the EMail address above
// and mark in the Subject Line DOT NET or my mail filter will kill it
//
// Regards : Andrew Chapman
//++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
program DBTest;
uses
System.Windows.Forms,
Newform2 in 'c:tempnetNewform2.pas' {Form1};
begin
Mainform := TForm1.Create;
Application.Run(Mainform);
end.
//--------------------------------------------------------------------
// Unit refered to by the main program. Make sure your database
// path is set correctly
//--------------------------------------------------------------------
unit NewForm2;
interface
uses
{ Just like the old uses clause in a delphi program. The SYSTEM namespace refers to windows
type controls and not specifically the delphi ones. To draw a delphi button call on the
BORLAND.VCL name spaces... see below }
System.Reflection,
System.Drawing,
System.Drawing.Text,
System.ComponentModel,
System.Windows.Forms,
System.Data.OleDB,
System.Data,
System.Data.Common,
System.Runtime.InteropServices;
type
TForm1 = class(Form)
private
buttonload: system.windows.forms.button; // a button
Components: system.componentmodel.container; // a component store
datagrid1: system.windows.forms.datagrid; // not used in this implementation
public
constructor Create; // which I will inherite and amend
procedure InitializeComponents; // easy way to centralise component creation
procedure Button1_Click(Sender: TObject; E: EventArgs); // on click event
end;
var
MainForm: TForm1; // as ever a main delphi form
implementation
constructor TForm1.Create;
begin
inherited Create; // normal create stuff then set up all the required components
InitializeComponents; // sets up components
end;
procedure TForm1.InitializeComponents;
var
MyControls: array[0..2] of control; // container class for main form
begin
Self.ClientSize := system.Drawing.Size.Create(600,413); // client window on screen
Self.Components := System.ComponentModel.Container.Create();
// container class for the other bits
Self.buttonload := system.windows.forms.button.Create(); // make a button
Self.buttonload.add_click(button1_click); // set its on click event
Self.buttonload.Size := system.drawing.Size.Create(112,32); // size up the button
Self.buttonload.location := system.drawing.point.Create(480,352); // where on screen ?
Self.buttonload.Text := 'Read the database';
// text on the button - 'caption' in real delphi
Self.datagrid1 := system.windows.forms.datagrid.Create(); // draw a datagrid - not used
Self.datagrid1.Size := system.drawing.Size.Create(584,336);
Self.datagrid1.location := system.drawing.point.Create(8,8);
MyControls[0] := Self.buttonload; // add button to container class
MyControls[1] := Self.datagrid1; // add grid to container class
Self.Controls.AddRange(MyControls);
// basically add them to the form, form is now parent
end;
procedure TForm1.Button1_Click(Sender: TObject; E: EventArgs);
var
dbConnection: oleDBConnection;
dbCommand: OleDBCommand;
dbReader: OleDBDataReader;
dbDataAdapter: OleDBDataAdapter;
dbDataset: Dataset;
temp, temp1: string;
int1: Integer;
begin
temp := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=db1.mdb'; // connection string
temp1 := 'Select * from Shawbury'; // SQL code to fire
(* Fount that I had to use an explicit string to make the connection , The exapmple code
was'nt very clear on this - it works so hopefully it's the right solution *)
dbConnection := System.Data.OleDB.OleDbConnection.Create(temp); // make a DB Connection
dbConnection.Open(); // open a DB Conection
dbCommand := System.Data.OleDB.OleDbCommand.Create(temp1, dbConnection);
// execute the SQL
dbReader := dbCommand.ExecuteReader(); // and store in a datareader
int1 := dbReader.GetOrdinal('subcol1');
// I have a coloum in the Database called subcol1
while dbReader.read() do // keep reading all records
begin
// gives you a warm feeling to see the last record on the button
// - now I'm sure its read the file
buttonload.Text := dbreader.GetValue(int1).tostring;
end;
end;
end.
Delphi - .....................................
neoturk: ...Scroll within a dbgrid ?...
- Here is tip how to scroll DBGrid -}
//...
private
OldGridProc: TWndMethod;
procedure GridWindowProc(var Message: TMessage);
//...
procedure TForm1.FormCreate(Sender: TObject);
begin
OldGridProc := DBGrid1.WindowProc;
DBGrid1.WindowProc := GridWindowProc;
end;
procedure TForm1.GridWindowProc(var Message: TMessage);
var
Pos: SmallInt;
begin
OldGridProc(Message);
if Message.Msg = WM_VSCROLL then //or WM_HSCROLL
begin
Pos := Message.WParamHi; //Scrollbox position
Table1.RecNo := Pos;
end;
end;
Delphi - .....................................
neoturk: ...Scroll within a dbgrid ?...
- Here is tip how to scroll DBGrid -}
//...
private
OldGridProc: TWndMethod;
procedure GridWindowProc(var Message: TMessage);
//...
procedure TForm1.FormCreate(Sender: TObject);
begin
OldGridProc := DBGrid1.WindowProc;
DBGrid1.WindowProc := GridWindowProc;
end;
procedure TForm1.GridWindowProc(var Message: TMessage);
var
Pos: SmallInt;
begin
OldGridProc(Message);
if Message.Msg = WM_VSCROLL then //or WM_HSCROLL
begin
Pos := Message.WParamHi; //Scrollbox position
Table1.RecNo := Pos;
end;
end;
Delphi - .....................................
neoturk: ...Autosize a dbgrid-column to fit its contents ?...
Thanks to Thomas Stutz' tip on this site!}
{ A dbgrid is awkward since it has no cells,}
{ you have to step through the table using next;}
{ This procedure is however slow }
procedure SetGridColumnWidths(Grid: Tdbgrid);
const
DEFBORDER = 10;
var
temp, n: Integer;
lmax: array [0..30] of Integer;
begin
with Grid do
begin
Canvas.Font := Font;
for n := 0 to Columns.Count - 1 do
//if columns[n].visible then
lmax[n] := Canvas.TextWidth(Fields[n].FieldName) + DEFBORDER;
grid.DataSource.DataSet.First;
while not grid.DataSource.DataSet.EOF do
begin
for n := 0 to Columns.Count - 1 do
begin
//if columns[n].visible then begin
temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;
if temp > lmax[n] then lmax[n] := temp;
//end; { if }
end; {for}
grid.DataSource.DataSet.Next;
end; { while }
grid.DataSource.DataSet.First;
for n := 0 to Columns.Count - 1 do
if lmax[n] > 0 then
Columns[n].Width := lmax[n];
end; { With }
end; {SetGridColumnWidths }
procedure TForm1.Button1Click(Sender: TObject);
begin
SetGridColumnWidths(dbgrid3);
end;
Delphi - .....................................
neoturk: ...Autosize a dbgrid-column to fit its contents ?...
Thanks to Thomas Stutz' tip on this site!}
{ A dbgrid is awkward since it has no cells,}
{ you have to step through the table using next;}
{ This procedure is however slow }
procedure SetGridColumnWidths(Grid: Tdbgrid);
const
DEFBORDER = 10;
var
temp, n: Integer;
lmax: array [0..30] of Integer;
begin
with Grid do
begin
Canvas.Font := Font;
for n := 0 to Columns.Count - 1 do
//if columns[n].visible then
lmax[n] := Canvas.TextWidth(Fields[n].FieldName) + DEFBORDER;
grid.DataSource.DataSet.First;
while not grid.DataSource.DataSet.EOF do
begin
for n := 0 to Columns.Count - 1 do
begin
//if columns[n].visible then begin
temp := Canvas.TextWidth(trim(Columns[n].Field.DisplayText)) + DEFBORDER;
if temp > lmax[n] then lmax[n] := temp;
//end; { if }
end; {for}
grid.DataSource.DataSet.Next;
end; { while }
grid.DataSource.DataSet.First;
for n := 0 to Columns.Count - 1 do
if lmax[n] > 0 then
Columns[n].Width := lmax[n];
end; { With }
end; {SetGridColumnWidths }
procedure TForm1.Button1Click(Sender: TObject);
begin
SetGridColumnWidths(dbgrid3);
end;
Delphi - .....................................
neoturk: ...Make a html and txt report component ?...
unit LittleReport;
interface
uses Windows, Messages, SysUtils, Classes, DB, Graphics;
const
FAuthor = 'Simone Di Cicco';
FVersion = '1.0';
type
TLittleReport = class(TComponent)
protected
FDataSet: TDataSet;
FWidth: Integer;
FTitle: string;
FAfterHTML: TStringList;
FPreHTML: TStringList;
procedure GetDBFieldData(StringList: TStringList; FieldName: string);
function GetDataRowsTXT: string;
function GetDataRowsHTML: string;
private
ColumnsCont: array of TStringList;
FieldNames: TStringList;
HTMLTable: TStringList;
TXTFile: TStringList;
IncRowTXT: Integer;
IncRowHTML: Integer;
published
property DataSet: TDataSet read FDataSet write FDataSet;
property HTMLTableWidth: Integer read FWidth write FWidth default 100;
property HTMLPageTitle: string read FTitle write FTitle;
property BeforeReportHTML: TStringList read FPreHTML write FPreHTML;
property AfterReportHTML: TStringList read FAfterHTML write FAfterHTML;
public
constructor Create(AOwner: TComponent); override;
// destructor Destroy; override;
procedure CreateReportHTML(Location: TFileName);
procedure CreateReportTXT(Location: TFileName);
end;
procedure Register;
implementation
{ TLittleReport }
procedure Register;
begin
RegisterComponents('Simone Di Cicco', [TLittleReport]);
end;
constructor TLittleReport.Create(AOwner: TComponent);
begin
inherited;
FPreHTML := TStringList.Create;
FPreHTML.Clear;
FAfterHTML := TStringList.Create;
FAfterHTML.Clear;
FieldNames := TStringList.Create;
FieldNames.Clear;
HTMLTable := TStringList.Create;
HTMLTable.Clear;
TXTFile := TStringList.Create;
TXTFile.Clear;
end;
procedure TLittleReport.GetDBFieldData(StringList: TStringList;
FieldName: string);
begin
StringList.Clear;
with FDataSet do
begin
Open;
DisableControls;
try
while not EOF do
begin
StringList.Add(FieldByName(FieldName).AsString);
Next;
end;
finally
EnableControls;
Close;
end;
end;
end;
procedure TLittleReport.CreateReportHTML(Location: TFileName);
var
Counter, ColCount, RowCont: Integer;
BHTMLPRE, BContPRE, BHTMLAF, BContAF: Integer;
NameCont, FieldCont: Integer;
FieldTitle: string;
begin
NameCont := 0;
FieldCont := 0;
RowCont := 0;
BHTMLPRE := 0;
BContPRE := 0;
BHTMLAF := 0;
BContAF := 0;
IncRowHTML := 0;
FDataSet.Open;
FieldNames.Clear;
FDataSet.GetFieldNames(FieldNames);
ColCount := FDataSet.Fields.Count;
SetLength(ColumnsCont, ColCount);
HTMLTable.Clear;
Counter := 0;
repeat
ColumnsCont[Counter] := TStringList.Create;
GetDBFieldData(ColumnsCont[Counter], FieldNames.Strings[Counter]);
Inc(Counter, 1);
until Counter = ColCount;
RowCont := ColumnsCont[0].Count;
BHTMLPRE := FPreHTML.Count;
if BHTMLPRE >= 1 then
begin
repeat
HTMLTable.Add(FPreHTML.Strings[BContPRE]);
Inc(BContPRE, 1);
until BContPRE = BHTMLPRE;
end;
if FTitle = '' then HTMLTable.Add('<title>' + Location + '</title>')
else
HTMLTable.Add('<title>' + FTitle + '</title>');
HTMLTable.Add('<Table Width="' + IntToStr(FWidth) + '%">');
NameCont := FieldNames.Count;
repeat
FieldTitle := FieldTitle + '</TD><TD></TD><TD><B>' +
FieldNames.Strings[FieldCont] + '</B></TD><TD></TD><TD>';
Inc(FieldCont, 1);
until NameCont = FieldCont;
FieldTitle := '<TR><TD>' + FieldTitle + '</TD></TR>';
HTMLTable.Add(FieldTitle);
repeat
HTMLTable.Add(GetDataRowsHTML);
Inc(IncRowHTML, 1);
until IncRowHTML = RowCont;
HTMLTable.Add('</table>');
BHTMLAF := FAfterHTML.Count;
if BHTMLAF >= 1 then
begin
repeat
HTMLTable.Add(FAfterHTML.Strings[BContAF]);
Inc(BContAF, 1);
until BContAF = BHTMLAF;
end;
HTMLTable.SaveToFile(Location);
end;
procedure TLittleReport.CreateReportTXT(Location: TFileName);
var
CounterRep, ColCount, RowCont: Integer;
NameCont, FieldCont: Integer;
FieldTitle: string;
begin
NameCont := 0;
FieldCont := 0;
RowCont := 0;
IncRowTXT := 0;
FDataSet.Open;
FieldNames.Clear;
FDataSet.GetFieldNames(FieldNames);
ColCount := FDataSet.Fields.Count;
SetLength(ColumnsCont, ColCount);
TXTFile.Clear;
CounterRep := 0;
repeat
ColumnsCont[CounterRep] := TStringList.Create;
GetDBFieldData(ColumnsCont[CounterRep], FieldNames.Strings[CounterRep]);
Inc(CounterRep, 1);
until CounterRep = ColCount;
RowCont := ColumnsCont[0].Count;
NameCont := FieldNames.Count;
repeat
FieldTitle := FieldTitle + '| ' + FieldNames.Strings[FieldCont];
Inc(FieldCont, 1);
until NameCont = FieldCont;
FieldTitle := FieldTitle + '|';
TXTFile.Add(FieldTitle);
TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');
TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');
repeat
TXTFile.Add(GetDataRowsTXT);
TXTFile.Add('"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""');
Inc(IncRowTXT, 1);
until IncRowTXT = RowCont;
TXTFile.SaveToFile(Location);
end;
function TLittleReport.GetDataRowsTXT: string;
var
CounterRow, ColArray: Integer;
ReportRow: string;
begin
CounterRow := 0;
ColArray := Length(ColumnsCont);
repeat
ReportRow := ReportRow + '| ' + ColumnsCont[CounterRow].Strings[IncRowTXT] + ' |';
Inc(CounterRow, 1);
until CounterRow = ColArray;
Result := ReportRow;
end;
function TLittleReport.GetDataRowsHTML: string;
var
CounterRow, ColArray: Integer;
ReportRow: string;
begin
CounterRow := 0;
ColArray := Length(ColumnsCont);
repeat
ReportRow := ReportRow + '</TD><TD></TD><TD>' +
ColumnsCont[CounterRow].Strings[IncRowHTML] + '</TD><TD></TD><TD>';
Inc(CounterRow, 1);
until CounterRow = ColArray;
ReportRow := '<TR><TD>' + ReportRow + '</TD></TR>';
Result := ReportRow;
end;
end.
