{*************************************************************}
{                                                             }
{       Borland Delphi Visual Component Library               }
{       InterBase Express core components                     }
{                                                             }
{       Copyright (c) 1998-2003 Borland Software Corporation  }
{                                                             }
{    Additional code created by Jeff Overcash and John Kaster }
{    used with permission.                                    }
{*************************************************************}


unit Borland.Vcl.IBDatabaseINI;

{$A8,R-}

interface

uses
  SysUtils, Windows, Classes, IBDatabase;

const
  PathSeparator = '\'; {do not localize}
  NL = #13#10;   {do not localize}
  SWrapLine = '<br>' + NL;       {do not localize}

type

  TIniFilePathOpt = (ipoPathNone, ipoPathToServer, ipoPathRelative);

  TIBDatabaseINI = class(TComponent)
  private
    FDatabaseName: String;
    FDatabase: TIBDatabase;
    FPassword: String;
    FUsername: String;
    FFileName: String;
    FSQLRole: String;
    FAppPath: TIniFilePathOpt;
    FSection: String;
    FCharacterSet: String;
    procedure SetDatabaseName(const Value: String);
    procedure SetDatabase(const Value: TIBDatabase);
    procedure SetFileName(const Value: String);
    procedure SetPassword(const Value: String);
    procedure SetUsername(const Value: String);
    { Private declarations }
    function GetParam(Name: string): string;
    procedure AssignParam(Name, Value: string);
    procedure DeleteParam(Name: string);
    procedure SetSQLRole(const Value: String);
    procedure SetSection(const Value: String);
    procedure SetCharacterSet(const Value: String);
  protected
    { Protected declarations }
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    constructor Create(AOwner : Tcomponent); override;
    procedure SaveToINI;
    procedure ReadFromINI;
    procedure WriteToDatabase(ADatabase : TIBDatabase);
    procedure ReadFromDatabase;
    function IniFileName : string;
  published
    { Published declarations }
    property Database : TIBDatabase read FDatabase write SetDatabase;
    property DatabaseName : String read FDatabaseName write SetDatabaseName;
    property Username : String read FUsername write SetUsername;
    property Password : String read FPassword write SetPassword;
    property SQLRole : String read FSQLRole write SetSQLRole;
    property CharacterSet : String read FCharacterSet write SetCharacterSet;
    property FileName : String read FFileName write SetFileName;
    property UseAppPath : TIniFilePathOpt read FAppPath write FAppPath;
    property Section : String read FSection write SetSection;
  end;

  function SlashPath( sPath : string ) : string;
  function LocalServerPath( sFile : string = '') : string;

implementation

uses IniFiles, IBXConst, System.Text, Borland.Vcl.WinUtils;

const
  SIniDatabase = 'database'; {do not localize}
  SIniUserName = 'user_name'; {do not localize}
  SIniPassword = 'password';  {do not localize}
  SIniSQLRole = 'sql_role';  {do not localize}
  SIniCharacterSet = 'lc_ctype';  {do not localize}

function LocalServerPath(sFile: string): string;
var
  FN: System.Text.StringBuilder;
  sPath : string;
begin
  FN := System.Text.StringBuilder.Create(256);
  GetModuleFileName(hInstance, FN, FN.Capacity);
  sPath := FN.ToString;
  Result := ExtractFilePath( sPath ) + LowerCase( ExtractFileName( sFile ) );
end;

function SlashPath( sPath : string ) : string;
begin
  if ( sPath <> '' ) and ( sPath[ Length( sPath ) ] <> PathSeparator ) then
    sPath := sPath + PathSeparator;
  Result := sPath;
end;

{ TIBDatabaseINI }

procedure TIBDatabaseINI.AssignParam(Name, Value: string);
var
  i: Integer;
  found: boolean;
begin
  found := False;
  if FDatabase = nil then
    exit;
  if Trim(Value) <> '' then
  begin
    for i := 0 to FDatabase.Params.Count - 1 do
    begin
      if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
      begin
        FDatabase.Params.Values[FDatabase.Params.Names[i]] := Value;
        found := True;
        break;
      end;
    end;
    if not found then
      FDatabase.Params.Add(Name + '=' + Value);
  end
  else
    DeleteParam(Name);
end;

procedure TIBDatabaseINI.WriteToDatabase(ADatabase: TIBDatabase);
begin
  if Assigned(ADatabase) then
  begin
    if FDatabaseName <> '' then
      ADatabase.DatabaseName := FDatabaseName;
    if FUserName <> '' then
      AssignParam(SIniUserName, FUserName);
    if FPassword <> '' then
      AssignParam(SIniPassword, FPassword);
    if FSQLRole <> '' then
      AssignParam(SIniSQLRole, FSQLRole);
    if FCharacterSet <> '' then
      AssignParam(SIniCharacterSet, FCharacterSet);
  end;
end;

procedure TIBDatabaseINI.DeleteParam(Name: string);
var
  i: Integer;
begin
  if FDatabase = nil then
    exit;
  for i := 0 to FDatabase.Params.Count - 1 do
  begin
    if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
    begin
      FDatabase.Params.Delete(i);
      break;
    end;
  end;
end;

function TIBDatabaseINI.GetParam(Name: string): string;
var
  i: Integer;
begin
  Result := '';
  if FDatabase = nil then
    exit;
  for i := 0 to FDatabase.Params.Count - 1 do
  begin
    if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
    begin
      Result := FDatabase.Params.Values[FDatabase.Params.Names[i]];
      break;
    end;
  end;
end;

procedure TIBDatabaseINI.Loaded;
begin
  inherited;
  ReadFromINI;
  if Assigned(FDatabase) and ( not ( csDesigning in ComponentState ) ) then
    WriteToDatabase(FDatabase);
end;

procedure TIBDatabaseINI.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if (AComponent = FDatabase) and (Operation = opRemove) then
    FDatabase := nil;
end;

procedure TIBDatabaseINI.ReadFromDatabase;
begin
  if Assigned(FDatabase) then
  begin
    if FDatabase.DatabaseName <> '' then
      FDatabaseName := FDatabase.DatabaseName;
    if GetParam(SIniUserName) <> '' then
      FUserName := GetParam(SIniUserName);
    if GetParam(SIniPassword) <> '' then
      FPassword := GetParam(SIniPassword);
    if GetParam(SIniSQLRole) <> '' then
      FSQLRole := GetParam(SIniSQLRole);
    if GetParam(SIniCharacterSet) <> '' then
      FCharacterSet := GetParam(SIniCharacterSet);
  end;
end;

procedure TIBDatabaseINI.ReadFromINI;
var
  sININame : String;
begin
  sININame := IniFileName;
  if sININame = '' then
    Exit;

 with TIniFile.Create(sININame) do
  try
    {Do it to the setter so the IBDatabase will be updated if assigned }
    if SectionExists(FSection) then
    begin
      FDatabaseName := ReadString(FSection, SIniDatabase, '' );
      FUsername := ReadString(FSection, SIniUserName, '' );
      FPassword := ReadString(FSection, SIniPassword, '' );
      FSQLRole := ReadString(FSection, SIniSQLRole, '' );
      FCharacterSet := ReadString(FSection, SIniCharacterSet, '');
    end;
  finally
    Free;
  end;
end;

procedure TIBDatabaseINI.SaveToINI;
begin
  if FFileName = '' then
    Exit;
  with TIniFile.Create(FFileName) do
  try
    WriteString(FSection, SIniDatabase, FDatabaseName );
    WriteString(FSection, SIniUserName, FUsername );
    WriteString(FSection, SIniPassword, FPassword );
    WriteString(FSection, SIniSQLRole, FSQLRole );
    WriteString(FSection, SIniCharacterSet, FCharacterSet);
  finally
    Free;
  end;
end;

procedure TIBDatabaseINI.SetDatabase(const Value: TIBDatabase);
begin
  if FDatabase <> Value then
    FDatabase := Value;
end;

procedure TIBDatabaseINI.SetDatabaseName(const Value: String);
begin
  if FDatabaseName <> Value then
    FDatabaseName := Value;
end;

procedure TIBDatabaseINI.SetFileName(const Value: String);
begin
  if FFileName <> Value then
  begin
    FFileName := Value;
    ReadFromINI;
  end;
end;

procedure TIBDatabaseINI.SetPassword(const Value: String);
begin
  if FPassword <> Value then
    FPassword := Value;
end;

procedure TIBDatabaseINI.SetSQLRole(const Value: String);
begin
  if FSQLRole <> Value then
    FSQLRole := Value;
end;

procedure TIBDatabaseINI.SetUsername(const Value: String);
begin
  if FUsername <> Value then
    FUsername := Value;
end;

constructor TIBDatabaseINI.Create(AOwner: Tcomponent);
begin
  inherited;
  FSection := SIBDatabaseINISection;
  FAppPath := ipoPathToServer;
end;

procedure TIBDatabaseINI.SetSection(const Value: String);
begin
  if Value = '' then
    raise Exception.Create(SIBDatabaseINISectionEmpty);
  FSection := Value;
end;

function TIBDatabaseINI.IniFileName: string;
begin
  if FFileName = '' then
    Result := ''
  else
  begin
    if FAppPath = ipoPathToServer then
      Result := LocalServerPath(FFileName)
    else
      if FAppPath = ipoPathRelative then
        Result := SlashPath(LocalServerPath) + FFileName
      else
        Result := FFileName;
  end;
end;

procedure TIBDatabaseINI.SetCharacterSet(const Value: String);
begin
  if FCharacterSet <> Value then
    FCharacterSet := Value;
end;

end.
