/Gedemin/IBX/IBDatabaseINI.pas

  1{*************************************************************}
  2{                                                             }
  3{       Borland Delphi Visual Component Library               }
  4{       InterBase Express core components                     }
  5{                                                             }
  6{       Copyright (c) 2001 Jeff Overcash                      }
  7{                                                             }
  8{*************************************************************}
  9
 10unit IBDatabaseINI;
 11
 12interface
 13
 14uses
 15  SysUtils, Windows, Classes, IBDatabase;
 16
 17const
 18  PathSeparator = '\'; {do not localize}
 19  NL = #13#10;   {do not localize}
 20  SWrapLine = '<br>' + NL;       {do not localize}
 21
 22type
 23
 24  TIniFilePathOpt = (ipoPathNone, ipoPathToServer, ipoPathRelative);
 25
 26  TIBDatabaseINI = class(TComponent)
 27  private
 28    FDatabaseName: String;
 29    FDatabase: TIBDatabase;
 30    FPassword: String;
 31    FUsername: String;
 32    FFileName: String;
 33    FSQLRole: String;
 34    FAppPath: TIniFilePathOpt;
 35    FSection: String;
 36    FCharacterSet: String;
 37    procedure SetDatabaseName(const Value: String);
 38    procedure SetDatabase(const Value: TIBDatabase);
 39    procedure SetFileName(const Value: String);
 40    procedure SetPassword(const Value: String);
 41    procedure SetUsername(const Value: String);
 42    { Private declarations }
 43    function GetParam(Name: string): string;
 44    procedure AssignParam(Name, Value: string);
 45    procedure DeleteParam(Name: string);
 46    procedure SetSQLRole(const Value: String);
 47    procedure SetSection(const Value: String);
 48    procedure SetCharacterSet(const Value: String);
 49  protected
 50    { Protected declarations }
 51    procedure Loaded; override;
 52    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
 53  public
 54    { Public declarations }
 55    constructor Create(AOwner : Tcomponent); override;
 56    procedure SaveToINI;
 57    procedure ReadFromINI;
 58    procedure WriteToDatabase(ADatabase : TIBDatabase);
 59    procedure ReadFromDatabase;
 60    function IniFileName : string;
 61  published
 62    { Published declarations }
 63    property Database : TIBDatabase read FDatabase write SetDatabase;
 64    property DatabaseName : String read FDatabaseName write SetDatabaseName;
 65    property Username : String read FUsername write SetUsername;
 66    property Password : String read FPassword write SetPassword;
 67    property SQLRole : String read FSQLRole write SetSQLRole;
 68    property CharacterSet : String read FCharacterSet write SetCharacterSet;
 69    property FileName : String read FFileName write SetFileName;
 70    property UseAppPath : TIniFilePathOpt read FAppPath write FAppPath;
 71    property Section : String read FSection write SetSection;
 72  end;
 73
 74  function SlashPath( sPath : string ) : string;
 75  function LocalServerPath( sFile : string = '') : string;
 76
 77implementation
 78
 79uses inifiles;
 80
 81const
 82  SIniDatabase = 'database';
 83  SIniUserName = 'user_name';
 84  SIniPassword = 'password';
 85  SIniSQLRole = 'sql_role';
 86  SIniCharacterSet = 'lc_ctype';
 87
 88function LocalServerPath(sFile: string): string;
 89var
 90  FN: array[0..MAX_PATH- 1] of char;
 91  sPath : shortstring;
 92begin
 93  SetString(sPath, FN, GetModuleFileName(hInstance, FN, SizeOf(FN)));
 94  Result := ExtractFilePath( sPath ) + LowerCase( ExtractFileName( sFile ) );
 95end;
 96
 97function SlashPath( sPath : string ) : string;
 98begin
 99  if ( sPath <> '' ) and ( sPath[ Length( sPath ) ] <> PathSeparator ) then
100    sPath := sPath + PathSeparator;
101  Result := sPath;
102end;
103
104{ TIBDatabaseINI }
105
106procedure TIBDatabaseINI.AssignParam(Name, Value: string);
107var
108  i: Integer;
109  found: boolean;
110begin
111  found := False;
112  if FDatabase = nil then
113    exit;
114  if Trim(Value) <> '' then
115  begin
116    for i := 0 to FDatabase.Params.Count - 1 do
117    begin
118      if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
119      begin
120        FDatabase.Params.Values[FDatabase.Params.Names[i]] := Value;
121        found := True;
122        break;
123      end;
124    end;
125    if not found then
126      FDatabase.Params.Add(Name + '=' + Value);
127  end
128  else
129    DeleteParam(Name);
130end;
131
132procedure TIBDatabaseINI.WriteToDatabase(ADatabase: TIBDatabase);
133begin
134  if Assigned(ADatabase) then
135  begin
136    if FDatabaseName <> '' then
137      ADatabase.DatabaseName := FDatabaseName;
138    if FUserName <> '' then
139      AssignParam(SIniUserName, FUserName);
140    if FPassword <> '' then
141      AssignParam(SIniPassword, FPassword);
142    if FSQLRole <> '' then
143      AssignParam(SIniSQLRole, FSQLRole);
144    if FCharacterSet <> '' then
145      AssignParam(SIniCharacterSet, FCharacterSet);
146  end;
147end;
148
149procedure TIBDatabaseINI.DeleteParam(Name: string);
150var
151  i: Integer;
152begin
153  if FDatabase = nil then
154    exit;
155  for i := 0 to FDatabase.Params.Count - 1 do
156  begin
157    if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
158    begin
159      FDatabase.Params.Delete(i);
160      break;
161    end;
162  end;
163end;
164
165function TIBDatabaseINI.GetParam(Name: string): string;
166var
167  i: Integer;
168begin
169  Result := '';
170  if FDatabase = nil then
171    exit;
172  for i := 0 to FDatabase.Params.Count - 1 do
173  begin
174    if (Pos(Name, LowerCase(FDatabase.Params.Names[i])) = 1) then {mbcs ok}
175    begin
176      Result := FDatabase.Params.Values[FDatabase.Params.Names[i]];
177      break;
178    end;
179  end;
180end;
181
182procedure TIBDatabaseINI.Loaded;
183begin
184  inherited;
185  ReadFromINI;
186  if Assigned(FDatabase) and ( not ( csDesigning in ComponentState ) ) then
187    WriteToDatabase(FDatabase);
188end;
189
190procedure TIBDatabaseINI.Notification(AComponent: TComponent;
191  Operation: TOperation);
192begin
193  inherited;
194  if (AComponent = FDatabase) and (Operation = opRemove) then
195    FDatabase := nil;
196end;
197
198procedure TIBDatabaseINI.ReadFromDatabase;
199begin
200  if Assigned(FDatabase) then
201  begin
202    if FDatabase.DatabaseName <> '' then
203      FDatabaseName := FDatabase.DatabaseName;
204    if GetParam(SIniUserName) <> '' then
205      FUserName := GetParam(SIniUserName);
206    if GetParam(SIniPassword) <> '' then
207      FPassword := GetParam(SIniPassword);
208    if GetParam(SIniSQLRole) <> '' then
209      FSQLRole := GetParam(SIniSQLRole);
210    if GetParam(SIniCharacterSet) <> '' then
211      FCharacterSet := GetParam(SIniCharacterSet);
212  end;
213end;
214
215procedure TIBDatabaseINI.ReadFromINI;
216var
217  sININame : String;
218begin
219  sININame := IniFileName;
220  if sININame = '' then
221    Exit;
222
223 with TIniFile.Create(sININame) do
224  try
225    {Do it to the setter so the IBDatabase will be updated if assigned }
226    if SectionExists(FSection) then
227    begin
228      FDatabaseName := ReadString(FSection, SIniDatabase, '' );
229      FUsername := ReadString(FSection, SIniUserName, '' );
230      FPassword := ReadString(FSection, SIniPassword, '' );
231      FSQLRole := ReadString(FSection, SIniSQLRole, '' );
232      FCharacterSet := ReadString(FSection, SIniCharacterSet, '');
233    end;
234  finally
235    Free;
236  end;
237end;
238
239procedure TIBDatabaseINI.SaveToINI;
240begin
241  if FFileName = '' then
242    Exit;
243  with TIniFile.Create(FFileName) do
244  try
245    WriteString(FSection, SIniDatabase, FDatabaseName );
246    WriteString(FSection, SIniUserName, FUsername );
247    WriteString(FSection, SIniPassword, FPassword );
248    WriteString(FSection, SIniSQLRole, FSQLRole );
249    WriteString(FSection, SIniCharacterSet, FCharacterSet);
250  finally
251    Free;
252  end;
253end;
254
255procedure TIBDatabaseINI.SetDatabase(const Value: TIBDatabase);
256begin
257  if FDatabase <> Value then
258    FDatabase := Value;
259end;
260
261procedure TIBDatabaseINI.SetDatabaseName(const Value: String);
262begin
263  if FDatabaseName <> Value then
264    FDatabaseName := Value;
265end;
266
267procedure TIBDatabaseINI.SetFileName(const Value: String);
268begin
269  if FFileName <> Value then
270  begin
271    FFileName := Value;
272    ReadFromINI;
273  end;
274end;
275
276procedure TIBDatabaseINI.SetPassword(const Value: String);
277begin
278  if FPassword <> Value then
279    FPassword := Value;
280end;
281
282procedure TIBDatabaseINI.SetSQLRole(const Value: String);
283begin
284  if FSQLRole <> Value then
285    FSQLRole := Value;
286end;
287
288procedure TIBDatabaseINI.SetUsername(const Value: String);
289begin
290  if FUsername <> Value then
291    FUsername := Value;
292end;
293
294constructor TIBDatabaseINI.Create(AOwner: Tcomponent);
295begin
296  inherited;
297  FSection := 'Database Settings';
298  FAppPath := ipoPathToServer;
299end;
300
301procedure TIBDatabaseINI.SetSection(const Value: String);
302begin
303  if Value = '' then
304    raise Exception.Create('Section name can not be empty');
305  FSection := Value;
306end;
307
308function TIBDatabaseINI.IniFileName: string;
309begin
310  if FFileName = '' then
311    Result := ''
312  else
313  begin
314    if FAppPath = ipoPathToServer then
315      Result := LocalServerPath(FFileName)
316    else
317      if FAppPath = ipoPathRelative then
318        Result := SlashPath(LocalServerPath) + FFileName
319      else
320        Result := FFileName;
321  end;
322end;
323
324procedure TIBDatabaseINI.SetCharacterSet(const Value: String);
325begin
326  if FCharacterSet <> Value then
327    FCharacterSet := Value;
328end;
329
330end.