Chip 2002 March/Chip_2002-03_cd1.bin/zkuste/delphi/kompon/d5/ADO.ZIP/src/AdoUtils.pas

Pascal/Delphi Source File | 2001-12-23 | 5.6 KB | 181 lines

unit AdoUtils;

interface

uses
  OleCtrls, SysUtils, Classes, Registry, Windows,
  Ado21Int, MsDascInt;

procedure OleEnumExclude(Value: TOleEnum; var EnumSet: TOleEnum);
procedure OleEnumInclude(Value: TOleEnum; var EnumSet: TOleEnum);
function OleEnumInSet(Value, EnumSet: TOleEnum): boolean;
function OleEnumToOrd(OleEnumArray: array of TOleEnum; Value: TOleEnum): Integer;

// this code is created by Copyright Aloha Oi Software
// http://www.alohaoi.com/Software
procedure GetDrivers(Drivers: TStrings);
procedure GetDSNs(DSNs: TStrings; SystemDSN, UserDSN: Boolean);
procedure GetProviderNames(Providers: TStrings);
function ConnectionStringDlg(Previous: String): String;

implementation
//------------------------------------------------------------------------------
function OleEnumInSet(Value, EnumSet: TOleEnum): boolean;
begin
  result:= (EnumSet and Value) = Value;
end;
//------------------------------------------------------------------------------
procedure OleEnumInclude(Value: TOleEnum; var EnumSet: TOleEnum);
begin
  if not OleEnumInSet(Value, EnumSet) then
    EnumSet:= EnumSet or Value;
end;
//------------------------------------------------------------------------------
procedure OleEnumExclude(Value: TOleEnum; var EnumSet: TOleEnum);
begin
  if OleEnumInSet(Value, EnumSet) then
    EnumSet:= EnumSet xor Value;
end;
//------------------------------------------------------------------------------
function OleEnumToOrd(OleEnumArray: array of TOleEnum; Value: TOleEnum): Integer;
begin
  for Result := Low(OleEnumArray) to High(OleEnumArray) do
    if Value = OleEnumArray[Result] then Exit;
  raise Exception.Create('Invalid Enum Value');
end;
//------------------------------------------------------------------------------
{This procedure will return all driver names on the system. This procedure
works directly on the registry rather than through ADO or ODBC.}
procedure GetDrivers(Drivers: TStrings);
var
  i  : Integer;
  Reg: TRegistry;
begin
  Drivers.Clear;
  {Create the registry link.}
  Reg:= TRegistry.Create;
  Reg.RootKey:= HKEY_LOCAL_MACHINE;
  {$IFNDEF OLD_STYLE}
  Reg.Access:= KEY_READ;
  {$ENDIF}
  Reg.OpenKey('\SOFTWARE\ODBC\odbcinst.ini\ODBC Drivers', False);
  Reg.GetValueNames(Drivers);
  i:= 0;
  while i < Drivers.Count do
    if UpperCase(Reg.ReadString(Drivers[i])) = 'INSTALLED' then inc(i)
    else Drivers.Delete(i);
  Reg.Free;
end;
//------------------------------------------------------------------------------
{This procedure will return all DSN names on the system. This procedure
works directly on the registry rather than through ADO or ODBC. Specify
which sets of DSN you want to retrieve - System and/or User. If value
is specified, then no DSNs will be retieved.}
procedure GetDSNs(DSNs: TStrings; SystemDSN, UserDSN: Boolean);
var
  L  : TStrings;
  Reg: TRegistry;
begin
  DSNs.Clear;
  {Create the registry link.}
  Reg:= TRegistry.Create;
  L:= TStringList.Create;
  try
    {$IFNDEF OLD_STYLE}
    Reg.Access:= KEY_READ;
    {$ENDIF}

    {Get the system DSN. These DSN are available to all users.}
    if SystemDSN then
      begin
        Reg.RootKey:= HKEY_LOCAL_MACHINE;
        Reg.OpenKey('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources', False);
        Reg.GetValueNames(L);
        DSNs.AddStrings(L);
        L.Clear;
      end;

    {Get the user DSN. These DSN are available only to the user.}
    if UserDSN then
      begin
        Reg.RootKey:= HKEY_CURRENT_USER;
        Reg.OpenKey('\SOFTWARE\ODBC\odbc.ini\ODBC Data Sources', False);
        Reg.GetValueNames(L);
        DSNs.AddStrings(L);
        L.Clear;
      end;
  finally
    Reg.Free;
    L.Free;
  end;
end;
//------------------------------------------------------------------------------
{This method will return all OLE DB Providers listed in the system. This
method does not require that a connection be established, since it works
directly on the registry rather than through ADO or ODBC.}
procedure GetProviderNames(Providers: TStrings);
var
  i: Integer;
  L: TStringList;
  R: TRegistry;
begin
  Providers.Clear;
  {Open the registry.}
  R:= TRegistry.Create;
  L:= TStringList.Create;
  try
    R.RootKey:= HKEY_CLASSES_ROOT;
    {$IFNDEF OLD_STYLE}
    R.Access:= KEY_READ;
    {$ENDIF}
    if R.OpenKey('\CLSID', False) then
      begin
        R.GetKeyNames(L);
        for i:= 0 to L.Count - 1 do
          if R.OpenKey('\CLSID\' + L[i], False) then
            begin
              if R.KeyExists('OLE DB Provider') then
                Providers.Add(R.ReadString(''));
            end;
      end;
  finally
    R.Free;
    L.Free;
  end;
end;
//------------------------------------------------------------------------------
{This method will return the constructed connection string after presenting
the ADO dialog box. The Previous paramater is used to open the dialog box
on the specified connection string.}
function ConnectionStringDlg(Previous: String): String;
var
  Con: _Connection;
  DL : Datalinks;
  ID : IDispatch;
begin
  {Get the actual dataset.}
  Result:= Previous;
  DL:= CoDatalinks.Create;
  Con:= CoConnection.Create;
  DL.Set_hwnd(0);
  try
    if Previous = '' then
      begin
         Con:= _Connection(DL.PromptNew);
         if Assigned(Con) then Result:= Con.ConnectionString;
      end
    else
      begin
         Con.ConnectionString:= Previous;
         ID:= IDispatch(Con);
         if DL.PromptEdit(ID) then Result:= Con.ConnectionString;
      end;
  finally
     DL:= NIL;
     Con:= NIL;
     ID:= NIL;
  end;
end;

end.