{ +-------------------------------------------------------------+ }
{ |                                                             | }
{ |   GM-Software                                               | }
{ |   ===========                                               | }
{ |                                                             | }
{ |   Project: All Projects                                     | }
{ |                                                             | }
{ |   Description: ODBC Install API.                            | }
{ |                                                             | }
{ |                                                             | }
{ |   Copyright (C) - 1999 - Gerrit Moeller.                    | }
{ |                                                             | }
{ |   Source code distributed under MIT license.                | }
{ |                                                             | }
{ |   See: https://www.gm-software.de                           | }
{ |                                                             | }
{ +-------------------------------------------------------------+ }

{$INCLUDE GMCompilerSettings.inc}

unit GMOdbcInstallAPI;

interface

uses  {$IFNDEF JEDIAPI}Windows,{$ELSE}JwaWinType,{$ENDIF} 
     GMStrDef, GMOdbcAPI, GMIntf, GMCommon, GMCollections, GMPrsStg;


const

  cStrOdbcINI = 'ODBC.INI';
  cStrOdbcInstINI = 'ODBCINST.INI';
  cStrDefaultINIFile = cStrOdbcINI;


type

  TGMOdbcPersistentData = class(TGMStorageBase, IGMValueStorage)
   protected
    FValueStorage: TGMValueStorageImpl;

    procedure ReadNameList(const ASection, AName: PGMChar; const ANameList: IGMObjArrayCollection);

    function InternalOpenDir(const ADirPath: TGMString; const ACreateIfNotExist: Boolean = False): Boolean; override;
    procedure InternalReadSubDirNames(var ASubDirNames: TGMStringArray); override;
    procedure InternalReadValueNames(var AValueNames: TGMStringArray); override;
    function InternalContainsValue(const AValueName: TGMString): Boolean; override;
    function InternalDeleteValue(const AValueName: TGMString): Boolean; override;
    function InternalDeleteSubDir(const ADirName: TGMString): Boolean; override;

   public
    constructor Create(const ARefLifeTime: Boolean = True); overload; override;
    constructor Create(const AOwner: IUnknown; const AFileName: TGMString = cStrDefaultINIFile; const ARefLifeTime: Boolean = True); reintroduce; overload;
    destructor Destroy; override;

    function ReadString(const ValueName: TGMString; const DefaultValue: TGMString = ''): TGMString; {$IFNDEF FPC_}override;{$ELSE}stdcall;{$ENDIF}
    procedure WriteString(const AValueName, AValue: TGMString); {$IFNDEF FPC_}override;{$ELSE}stdcall;{$ENDIF}

    property FileName: TGMString read GetFileName write SetFileName;
    property ValueStorage: TGMValueStorageImpl read FValueStorage implements IGMValueStorage; 
  end;



{ ---------------------------------- }
{ ---- High Level API Functions ---- }
{ ---------------------------------- }

function SQLInstallODBC(hwndParent: HWnd; lpszInfFile: PGMChar; lpszSrcPath: PGMChar; lpszDrivers: PGMChar): BOOL; stdcall;

function SQLManageDataSources(hwndParent: HWnd): BOOL; stdcall;

function SQLCreateDataSource(hwndParent: HWnd; lpszDSN: PGMChar): BOOL; stdcall;

function SQLGetTranslator(hwndParent: HWnd; lpszName: PGMChar; cbNameMax: Word; pcbNameOut: PWord; lpszPath: PGMChar; cbPathMax: WORD; pcbPathOut: PWord; pvOption: PDWORD): BOOL; stdcall;


{ --------------------------------- }
{ ---- Low Level API Functions ---- }
{ --------------------------------- }

function SQLInstallDriver(lpszInfFile: PGMChar; lpszDriver: PGMChar; lpszPath: PGMChar; cbPathMax: Word; pcbPathOut: PWord): BOOL; stdcall;

function SQLInstallDriverManager(lpszPath: PGMChar; cbPathMax: Word; pcbPathOut: PWord): BOOL; stdcall;

function SQLGetInstalledDrivers(lpszBuf: PGMChar; cbBufMax: Word; pcbBufOut: PWord): BOOL; stdcall;

function SQLGetAvailableDrivers(lpszInfFile: PGMChar; lpszBuf: PGMChar; cbBufMax: Word; pcbBufOut: PWord): BOOL; stdcall;

function SQLConfigDataSource(hwndParent: HWnd; fRequest: Word; lpszDriver: PGMChar; lpszAttributes: PGMChar): BOOL; stdcall;

function SQLRemoveDefaultDataSource: BOOL; stdcall;

function SQLWriteDSNToIni(lpszDSN: PGMChar; lpszDriver: PGMChar): BOOL; stdcall;

function SQLRemoveDSNFromIni(lpszDSN: PGMChar): BOOL; stdcall;

function SQLValidDSN(lpszDSN: PGMChar): BOOL; stdcall;

function SQLWritePrivateProfileString(lpszSection: PGMChar; lpszEntry: PGMChar; lpszString: PGMChar; lpszFilename: PGMChar): BOOL; stdcall;

function SQLGetPrivateProfileString(lpszSection: PGMChar; lpszEntry: PGMChar; lpszDefault: PGMChar; lpszRetBuffer: PGMChar; cbRetBuffer: LongInt; lpszFilename: PGMChar): LongInt; stdcall;

function SQLRemoveDriverManager(lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLInstallTranslator(lpszInfFile: PGMChar; lpszTranslator: PGMChar; lpszPathIn: PGMChar; lpszPathOut: PGMChar; cbPathOutMax: Word; pcbPathOut: PWord; fRequest: Word; lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLRemoveTranslator(lpszTranslator: PGMChar; lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLRemoveDriver(lpszDriver: PGMChar; fRemoveDSN: BOOL; lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLConfigDriver(hwndParent: HWnd; fRequest: Word; lpszDriver: PGMChar; lpszArgs: PGMChar; lpszMsg: PGMChar; cbMsgMax: Word; pcbMsgOut: PWord): BOOL; stdcall;

function SQLInstallerError(iError: Word; pfErrorCode: PDWORD; lpszErrorMsg: PGMChar; cbErrorMsgMax: Word; pcbErrorMsg: PWord): SQLRETURN; stdcall;

function SQLPostInstallerError(dwErrorCode: DWORD; lpszErrMsg: PGMChar): SQLRETURN; stdcall;

function SQLWriteFileDSN(lpszFileName: PGMChar; lpszAppName: PGMChar; lpszKeyName: PGMChar; lpszString: PGMChar): BOOL; stdcall;

function SQLReadFileDSN(lpszFileName: PGMChar; lpszAppName: PGMChar; lpszKeyName: PGMChar; lpszString: PGMChar; cbString: Word; pcbString: PWord): BOOL; stdcall;

function SQLInstallDriverEx(lpszDriver: PGMChar; lpszPathIn: PGMChar; lpszPathOut: PGMChar; cbPathOutMax: Word; pcbPathOut: PWord; fRequest: Word; lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLInstallTranslatorEx(lpszTranslator: PGMChar; lpszPathIn: PGMChar; lpszPathOut: PGMChar; cbPathOutMax: Word; pcbPathOut: PWord; fRequest: Word; lpdwUsageCount: PDWORD): BOOL; stdcall;

function SQLGetConfigMode(pwConfigMode: PWord): BOOL; stdcall;

function SQLSetConfigMode(wConfigMode: Word): BOOL; stdcall;



implementation


resourcestring

  RStrValWriteError = 'Unable to write value, valueName: "%s", value: "%s"';
  //RStrValDelError = 'Value ''%s'' cannot be deleted from key "%s"';
  //RStrKeyDelError = 'Key "%s" cannot be deleted';



const

  ODBCCP32_DLL = 'ODBCCP32.DLL';

//cWin95ProfileStrBufSize = $FFFF; // <- 64 KB
  cWinNTProfileStrBufSize = $40000; // <- 256 KB


var

  vSQLProfileStrBufSize: LongInt = cWinNTProfileStrBufSize;


function SQLInstallODBC;               external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallODBCW'{$ELSE}'SQLInstallODBC'{$ENDIF};
function SQLManageDataSources;         external ODBCCP32_DLL name 'SQLManageDataSources';
function SQLCreateDataSource;          external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLCreateDataSourceW'{$ELSE}'SQLCreateDataSource'{$ENDIF};
function SQLGetTranslator;             external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLGetTranslatorW'{$ELSE}'SQLGetTranslator'{$ENDIF};
function SQLInstallDriver;             external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallDriverW'{$ELSE}'SQLInstallDriver'{$ENDIF};
function SQLInstallDriverManager;      external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallDriverManagerW'{$ELSE}'SQLInstallDriverManager'{$ENDIF};
function SQLGetInstalledDrivers;       external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLGetInstalledDriversW'{$ELSE}'SQLGetInstalledDrivers'{$ENDIF};
function SQLGetAvailableDrivers;       external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLGetAvailableDriversW'{$ELSE}'SQLGetAvailableDrivers'{$ENDIF};
function SQLConfigDataSource;          external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLConfigDataSourceW'{$ELSE}'SQLConfigDataSource'{$ENDIF};
function SQLRemoveDefaultDataSource;   external ODBCCP32_DLL name 'SQLRemoveDefaultDataSource';
function SQLWriteDSNToIni;             external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLWriteDSNToIniW'{$ELSE}'SQLWriteDSNToIni'{$ENDIF};
function SQLRemoveDSNFromIni;          external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLRemoveDSNFromIniW'{$ELSE}'SQLRemoveDSNFromIni'{$ENDIF};
function SQLValidDSN;                  external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLValidDSNW'{$ELSE}'SQLValidDSN'{$ENDIF};
function SQLWritePrivateProfileString; external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLWritePrivateProfileStringW'{$ELSE}'SQLWritePrivateProfileString'{$ENDIF};
function SQLGetPrivateProfileString;   external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLGetPrivateProfileStringW'{$ELSE}'SQLGetPrivateProfileString'{$ENDIF};
function SQLRemoveDriverManager;       external ODBCCP32_DLL name 'SQLRemoveDriverManager';
function SQLInstallTranslator;         external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallTranslatorW'{$ELSE}'SQLInstallTranslator'{$ENDIF};
function SQLRemoveTranslator;          external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLRemoveTranslatorW'{$ELSE}'SQLRemoveTranslator'{$ENDIF};
function SQLRemoveDriver;              external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLRemoveDriverW'{$ELSE}'SQLRemoveDriver'{$ENDIF};
function SQLConfigDriver;              external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLConfigDriverW'{$ELSE}'SQLConfigDriver'{$ENDIF};
function SQLInstallerError;            external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallerErrorW'{$ELSE}'SQLInstallerError'{$ENDIF};
function SQLPostInstallerError;        external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLPostInstallerErrorW'{$ELSE}'SQLPostInstallerError'{$ENDIF};
function SQLWriteFileDSN;              external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLWriteFileDSNW'{$ELSE}'SQLWriteFileDSN'{$ENDIF};
function SQLReadFileDSN;               external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLReadFileDSNW'{$ELSE}'SQLReadFileDSN'{$ENDIF};
function SQLInstallDriverEx;           external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallDriverExW'{$ELSE}'SQLInstallDriverEx'{$ENDIF};
function SQLInstallTranslatorEx;       external ODBCCP32_DLL name {$IFDEF UNICODE}'SQLInstallTranslatorExW'{$ELSE}'SQLInstallTranslatorEx'{$ENDIF};
function SQLGetConfigMode;             external ODBCCP32_DLL name 'SQLGetConfigMode';
function SQLSetConfigMode;             external ODBCCP32_DLL name 'SQLSetConfigMode';



{ ------------------------------- }
{ ---- TGMOdbcPersistentData ---- }
{ ------------------------------- }

constructor TGMOdbcPersistentData.Create(const ARefLifeTime: Boolean);
begin
  inherited Create(ARefLifeTime);
  FValueStorage := TGMValueStorageImpl.Create(Self, ReadString, WriteString, False);
end;

constructor TGMOdbcPersistentData.Create(const AOwner: IUnknown; const AFileName: TGMString; const ARefLifeTime: Boolean);
begin
  inherited Create(AOwner, AFileName, '', cDontUseRootKey, ARefLifeTime);
end;

destructor TGMOdbcPersistentData.Destroy;
begin
  GMFreeAndNil(FValueStorage);
  inherited Destroy;
end;

procedure TGMOdbcPersistentData.ReadNameList(const ASection, AName: PGMChar; const ANameList: IGMObjArrayCollection);
var S: TGMString; P: PGMChar;
begin
  SetLength(S, vSQLProfileStrBufSize);
  SetLength(S, SQLGetPrivateProfileString(ASection, AName, nil, PGMChar(S), Length(S), PGMChar(FileName)));
  if Length(S) > 0 then
   begin
    P := PGMChar(S);          // GMAddStrToArray(P, ANameList);
    while P^ <> #0 do begin ANameList.Add(TGMNameObj.Create(P, False)); Inc(P, GMStrLen(P) + 1); end;
   end;
end;

function TGMOdbcPersistentData.InternalOpenDir(const ADirPath: TGMString; const ACreateIfNotExist: Boolean): Boolean;
begin
  //if ACreateIfNotExist then Result := True else Result := SectionExists(ADirPath);
  Result := True;
end;

procedure TGMOdbcPersistentData.InternalReadSubDirNames(var ASubDirNames: TGMStringArray);
var i, Len: LongInt; DirPath, RestStr, Name: TGMString; SectionList: IGMObjArrayCollection; NameObj: IUnknown;
begin
  DirPath := FCurrentPath;

  SectionList := TGMObjArrayCollection.Create(True, False, True, GMCompareByName, True);
  ReadNameList(nil, nil, SectionList);

  NameObj := TGMNameObj.Create(DirPath);
  for i:=SectionList.IndexOfNearest(NameObj) to SectionList.Count-1 do
   begin
    Name := (SectionList[i] as TGMNameObj).Name;
    Len := GMCommonPrefixLen(DirPath, Name);
    if Len <> Length(DirPath) then break else
     begin
      RestStr := GMReplaceChars(GMStrip(Copy(Name, Len + 1, Length(Name) - Len), cDirSep), '/', '\');
      if (RestStr <> '') and (GMStrLScan(PGMChar(RestStr), '\', Length(RestStr)) = nil) then
       GMAddStrToArray(GMStrip(Copy(Name, Length(DirPath) + 1, Length(Name) - Length(DirPath)), cDirSep), ASubDirNames);
     end;
   end;
end;

procedure TGMOdbcPersistentData.InternalReadValueNames(var AValueNames: TGMStringArray);
var nameList: IGMObjArrayCollection; i: LongInt;
begin
  nameList := TGMObjArrayCollection.Create(True, False, True, GMCompareByName, True);
  ReadNameList(PGMChar(FCurrentPath), nil, nameList);
  for i:=0 to nameList.Count-1 do GMAddStrToArray((nameList[i] as TGMnameObj).Name, AValueNames);
end;

function TGMOdbcPersistentData.InternalContainsValue(const AValueName: TGMString): Boolean;
var nameList: IGMObjArrayCollection; searchName: IGMGetName;
begin
  nameList := TGMObjArrayCollection.Create(True, False, True, GMCompareByName, True);
  ReadNameList(PGMChar(FCurrentPath), nil, nameList);
  searchName := TGMNameObj.Create(AValueName);
  Result := GMCollectionContains(nameList, searchName);
end;

function TGMOdbcPersistentData.InternalDeleteValue(const AValueName: TGMString): Boolean;
begin
  Result := SQLWritePrivateProfileString(PGMChar(FCurrentPath), PGMChar(AValueName), nil, PGMChar(FileName));
end;

function TGMOdbcPersistentData.InternalDeleteSubDir(const ADirName: TGMString): Boolean;
var dirPath: TGMString;
begin
  dirPath := GMAppendStrippedPath(FCurrentPath, ADirName);
  Result := SQLWritePrivateProfileString(PGMChar(dirPath), nil, nil, PGMChar(FileName));
end;

function TGMOdbcPersistentData.ReadString(const ValueName: TGMString; const DefaultValue: TGMString = ''): TGMString;
const cResultSize = 4096;
begin
  SetLength(Result, cResultSize);
  SetLength(Result, SQLGetPrivateProfileString(PGMChar(FCurrentPath), PGMChar(ValueName), PGMChar(DefaultValue), PGMChar(Result), Length(Result), PGMChar(FileName)));
end;

procedure TGMOdbcPersistentData.WriteString(const AValueName, AValue: TGMString);
begin
  if not SQLWritePrivateProfileString(PGMChar(FCurrentPath), PGMChar(AValueName), PGMChar(AValue), PGMChar(FileName)) then
     raise EGMException.ObjError(GMFormat(RStrValWriteError, [AValueName, AValue]), Self, {$I %CurrentRoutine%});
end;


end.