INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Component Writing

How do I make a component to interact with a database table? by djjd47130
Posted: 2 Jan 11 (Edited 27 May 11)

(Updated with new properties and better description)

The component below demonstrates the basics of how to wrap a component around a database table, creating a generic control over the table's contents. Type TCustomUsers has all the necessary functionality to interact with the data in a User table, without the end user having to know how to access the database. One property specifies the Connection String to the database. Each field in the database is mapped to a corresponding property in the component. Standard user properties such as Database ID, User Name, First Name, Last Name, Nick Name, Password, Etc. are linked through the properties in the options (TUserTableOptions). Therefore, it can be customized to interact with any database.

Note: Change the properties in 'Options' for TCustomUsers Component according to your user table in your database. Set the ConnectionString to your database. When you want to retrieve data from the component, call the procedure 'TCustomUsers.Refresh'.

Delphi 7 Unit: UserWrap

Types: TCustomUsers, TCustomUser, TUserTableOptions
Component: TCustomUsers

CODE

// for automatic syntax highlighting see FAQ102-6487: How to include syntax highlighting in code examples.
unit UserWrap;

interface

uses
  Variants, Classes, DB, ADODB, SysUtils, Controls, Graphics, Forms, Windows;

type
  TCustomUsers = class;
  TCustomUser = class;
  TUserTableOptions = class;

  //Represents User Table Options
  TUserTableOptions = class(TPersistent)
  private
    fUserTable: String;       //Database Table where User Data is Stored   
    fIDField: String;         //ID Field
    fUserNameField: String;   //User Name Field  
    fPasswordField: String;   //Password Field
    fFirstNameField: String;  //First Name Field
    fMiddleNameField: String; //Middle Name Field
    fLastNameField: String;   //Last Name Field
    fNickNameField: String;   //Nick Name Field
  published
    property UserTable: String read fUserTable write fUserTable;     
    property IDField: String read fIDField write fIDField;
    property UserNameField: String read fUserNameField write fUserNameField;  
    property PasswordField: String read fPasswordField write fPasswordField;
    property FirstNameField: String read fFirstNameField write fFirstNameField;
    property MiddleNameField: String read fMiddleNameField write fMiddleNameField;
    property LastNameField: String read fLastNameField write fLastNameField;
    property NickNameField: String read fNickNameField write fNickNameField;
  end;

  //Represents an individual user
  TCustomUser = class(TObject)
  private
    fConnectionString: String;
    fID: Integer;
    fUserName: String;
    fPassword: String;
    fFirstName: String;
    fMiddleName: String;
    fLastName: String;
    fNickName: String;
    fOwner: TCustomUsers;

    function GetOptions: TUserTableOptions;

    function GetID: Integer;
    function GetUserName: String;
    function GetFirstName: String;
    function GetLastName: String;
    procedure SetUserName(Value: String);
    procedure SetFirstName(Value: String);
    procedure SetLastName(Value: String);

    function GetMiddleName: String;
    function GetNickName: String;
    function GetPassword: String;
    procedure SetMiddleName(Value: String);
    procedure SetNickName(Value: String);
    procedure SetPassword(Value: String);

    function ReadString(Field: String): String;
    function ReadInteger(Field: String): Integer;
    function SaveString(Field: String; Value: String): Bool;
    function SaveInteger(Field: String; Value: Integer): Bool;
  public
    constructor Create(AOwner: TCustomUsers);
    destructor Destroy; override;
  published
    property ConnectionString: String read fConnectionString write fConnectionString;
    property ID: Integer read GetID;  //No setting function because ID shall remain the same
    property UserName: String read GetUserName write SetUserName;
    property Password: String read GetPassword write SetPassword;
    property FirstName: String read GetFirstName write SetFirstName;
    property MiddleName: String read GetMiddleName write SetMiddleName;
    property LastName: String read GetLastName write SetLastName;
    property NickName: String read GetNickName write SetNickName;
    property Options: TUserTableOptions read GetOptions;
  end;

  //Represents a set of users (TCustomUser)
  TCustomUsers = class(TComponent)
  private
    fUserList: TStringList;
    fConnectionString: String;
    fOptions: TUserTableOptions;

    function GetUser(Index: Integer): TCustomUser;
    procedure SetConnectionString(Value: String);
    function GetCount: Integer;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Refresh;
    property Count: Integer read GetCount;
    property Users[Index: Integer]: TCustomUser read GetUser;
  published
    property ConnectionString: String read fConnectionString write SetConnectionString;
    property Options: TUserTableOptions read fOptions write fOptions;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('JD Custom', [TCustomUsers]);
end;



function TCustomUser.GetID: Integer;      
begin
  Self.fID:= Self.ReadInteger(Options.IDField);
  Result:= Self.fID;
end;

function TCustomUser.GetUserName: String;    
begin
  Self.fUserName:= Self.ReadString(Options.UserNameField);
  Result:= Self.fUserName;
end;

function TCustomUser.GetFirstName: String;
begin
  Self.fFirstName:= Self.ReadString(Options.FirstNameField);
  Result:= Self.fFirstName;
end;

function TCustomUser.GetLastName: String;
begin
  Self.fLastName:= Self.ReadString(Options.LastNameField);
  Result:= Self.fLastName;
end;

function TCustomUser.GetMiddleName: String;
begin
  Self.fMiddleName:= Self.ReadString(Options.MiddleNameField);
  Result:= Self.fMiddleName;
end;

function TCustomUser.GetNickName: String;
begin
  Self.fNickName:= Self.ReadString(Options.NickNameField);
  Result:= Self.fNickName;
end;

function TCustomUser.GetPassword: String;
begin
  Self.fPassword:= Self.ReadString(Options.PasswordField);
  Result:= Self.fPassword;
end;

procedure TCustomUser.SetMiddleName(Value: String);
begin
  if Self.SaveString(Options.MiddleNameField, Value) then
    Self.fMiddleName:= Value;
end;

procedure TCustomUser.SetNickName(Value: String);
begin
  if Self.SaveString(Options.NickNameField, Value) then
    Self.fNickName:= Value;
end;

procedure TCustomUser.SetPassword(Value: String);
begin
  if Self.SaveString(Options.PasswordField, Value) then
    Self.fPassword:= Value;
end;

procedure TCustomUser.SetUserName(Value: String);
begin
  if Self.SaveString(Options.UserNameField, Value) then
    Self.fUserName:= Value;
end;

procedure TCustomUser.SetFirstName(Value: String);
begin
  if Self.SaveString(Options.FirstNameField, Value) then
    Self.fFirstName:= Value;
end;

procedure TCustomUser.SetLastName(Value: String);
begin
  if Self.SaveString(Options.LastNameField, Value) then
    Self.fLastName:= Value;
end;

constructor TCustomUser.Create(AOwner: TCustomUsers);
begin
  Self.fOwner:= AOwner;
end;

destructor TCustomUser.Destroy;
begin

  inherited Destroy;
end;

function TCustomUser.ReadString(Field: String): String;
var
  Q: TADOQuery;
begin
  Result:= '';
  Q:= TADOQuery.Create(nil);
  try
    Q.ConnectionString:= Self.fConnectionString;
    Q.SQL.Text:= 'select '+Field+' from ['+Options.UserTable+'] where ['+
      Options.IDField+'] = '+IntToStr(Self.fID);
    Q.Open;
      if not Q.IsEmpty then begin
        Q.First;
        Result:= Q.FieldByName(Field).AsString;
      end;
    Q.Close;
  finally
    if assigned(Q) then begin
      if Q.Active then Q.Close;
      Q.Free;
    end;
  end;
end;

function TCustomUser.ReadInteger(Field: String): Integer;
var
  Q: TADOQuery;
begin
  Result:= 0;
  Q:= TADOQuery.Create(nil);
  try
    Q.ConnectionString:= Self.fConnectionString;
    Q.SQL.Text:= 'select '+Field+' from ['+Options.UserTable+'] where ['+
      Options.IDField+'] = '+IntToStr(Self.fID);
    Q.Open;
      if not Q.IsEmpty then begin
        Q.First;
        Result:= Q.FieldByName(Field).AsInteger;
      end;
    Q.Close;
  finally
    if assigned(Q) then begin
      if Q.Active then Q.Close;
      Q.Free;
    end;
  end;
end;

function TCustomUser.SaveString(Field: String; Value: String): Bool;
var
  Q: TADOQuery;
begin
  Result:= False;
  Q:= TADOQuery.Create(nil);
  try
    Q.ConnectionString:= Self.fConnectionString;
    Q.SQL.Text:= 'select '+Field+' from ['+Options.UserTable+'] where ['+
      Options.IDField+'] = '+IntToStr(Self.fID);
    Q.Open;
      if not Q.IsEmpty then begin
        Q.First;
        try
          Q.Edit;
            Q[Field]:= Value;
          Q.Post;
          Result:= True;
        except
          on e: exception do begin
            Result:= False;
          end;
        end;
      end;
    Q.Close;
  finally
    if assigned(Q) then begin
      if Q.Active then Q.Close;
      Q.Free;
    end;
  end;
end;

function TCustomUser.SaveInteger(Field: String; Value: Integer): Bool;
var
  Q: TADOQuery;
begin
  Result:= False;
  Q:= TADOQuery.Create(nil);
  try
    Q.ConnectionString:= Self.fConnectionString;
    Q.SQL.Text:= 'select '+Field+' from ['+Options.UserTable+'] where ['+
      Options.IDField+'] = '+IntToStr(Self.fID);
    Q.Open;
      if not Q.IsEmpty then begin
        Q.First;
        try
          Q.Edit;
            Q[Field]:= Value;
          Q.Post;
          Result:= True;
        except
          on e: exception do begin
            Result:= False;
          end;
        end;
      end;
    Q.Close;
  finally
    if assigned(Q) then begin
      if Q.Active then Q.Close;
      Q.Free;
    end;
  end;
end;

function TCustomUser.GetOptions: TUserTableOptions;
begin
  Result:= Self.fOwner.Options;
end;






function TCustomUsers.GetUser(Index: Integer): TCustomUser;    
begin
  if (Index >= 0) and (Index < fUserList.Count) then
    Result:= TCustomUser(Self.fUserList.Objects[Index])
  else begin
    Result:= nil;
    Raise Exception.Create('UserList Index Out Of Bounds ('+IntToStr(Index)+')');
  end;
end;

constructor TCustomUsers.Create(AOwner: TComponent);    
begin
  inherited Create(AOwner);
  Self.fUserList:= TStringList.Create;
  Self.fOptions:= TUserTableOptions.Create;
    //Set Defaults
    fOptions.UserTable:= 'Users';
    fOptions.IDField:= 'ID';
    fOptions.UserNameField:= 'Login';
    fOptions.FirstNameField:= 'FName';
    fOptions.LastNameField:= 'LName';
end;

destructor TCustomUsers.Destroy;
var
  X: Integer;
begin
  for X:= 0 to fUserList.Count - 1 do
    fUserList.Objects[X].Free;
  fUserList.Free;
  if assigned(Self.fOptions) then Self.fOptions.Free;
  inherited Destroy;
end;

procedure TCustomUsers.Refresh;
var
  X: Integer;
  U: TCustomUser;
  Q: TADOQuery;
begin
  for X:= 0 to Self.fUserList.Count - 1 do
    Self.fUserList.Objects[X].Free;
  Self.fUserList.Clear;
  Q:= TADOQuery.Create(nil);
  try
    Q.ConnectionString:= Self.fConnectionString;
    Q.SQL.Text:= 'Select ['+ Options.IDField +'] from ['+ Options.UserTable +']';
    Q.Open;
      if not Q.IsEmpty then begin
        Q.First;
        While Not Q.Eof do begin
          U:= TCustomUser.Create(Self);
            U.fID:= Q.FieldByName(Options.IDField).AsInteger;
            U.fConnectionString:= Self.fConnectionString;
          Self.fUserList.AddObject(IntToStr(U.ID), U);
          Q.Next;
        end;
      end;
    Q.Close;
  finally
    if assigned(Q) then begin
      if Q.Active then Q.Close;
      Q.Free;
    end;
  end;
end;

procedure TCustomUsers.SetConnectionString(Value: String);
var
  X: Integer;
  U: TCustomUser;
begin
  Self.fConnectionString:= Value;
  for X:= 0 to Self.fUserList.Count - 1 do begin
    U:= TCustomUser(fUserList.Objects[X]);
    U.ConnectionString:= Value;
  end;
end;

function TCustomUsers.GetCount: Integer;
begin
  Result:= Self.fUserList.Count;
end;


end.

Implementation of TCustomUsers

Delphi 7 Unit: uMain
Form: Form1
Controls: ListBox1: TListBox, CustomUsers1: TCustomUsers
Methods: Form1.FormCreate

CODE

// for automatic syntax highlighting see FAQ102-6487: How to include syntax highlighting in code examples.

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, UserWrap, StdCtrls;

type
  TForm1 = class(TForm)
    CustomUsers1: TCustomUsers;
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  X: Integer;
  U: TCustomUser;
  Str: String;
begin
  CustomUsers1.Refresh;
  ListBox1.Clear;
  for X:= 0 to CustomUsers1.Count - 1 do begin
    U:= CustomUsers1.Users[X];
    Str:= U.UserName + ' - ' + U.FirstName + ' ' + U.MiddleName + ' ' + U.LastName;
    Str:= Str + ' | '+ U.NickName;
    ListBox1.Items.Append(Str);
  end;
end;

end.
 
 

Back to Embarcadero: Delphi FAQ Index
Back to Embarcadero: Delphi Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close