CLSID_SQLOLEDB : TGUID = '{0C7FF16C-38E3-11d0-97AB-00C04FC2AD98}';

var FDataInitialize : IDataInitializeSC;
...
OleCheck(CoCreateInstance(CLSID_MSDAINITIALIZE, nil, CLSCTX_INPROC_SERVER, IID_IDataInitialize,
      FDataInitialize));

var 
  Unknown : IUnknown;
  FDbINitialize : IDbInitialize;
...
  FDataInitialize.GetDataSource(nil, CLSCTX_INPROC_SERVER,
      PWideChar(FConnectionString), IID_IDBInitialize,  Unknown);
  FDbInitialize := Unknown as IDBInitialize;

// On ouvre la connexion sur la source de donnée.
OleDbCheck(FDbInitialize.Initialize);

// Il ne reste plus qu'à créer une session par défaut.
FSession := nil;
OleDbCheck((FDbInitialize as IDBCreateSession).CreateSession(nil, IID_IOpenRowset, FSession));

procedure TOleDbConnection.DoConnect;
var
  Unknown : IUnknown;
  FDataInitialize : IDataInitializeSC;
begin
  // Tout d'abord, la chaîne de connexion doit avoir été définie
  if FConnectionString = ''
  then raise EOleDbException.Create('La chaîne de connexion n''est pas définie !');

  SQLLogger.Trace(EVENT_SQL_INFO, 'Ouverture de la connexion : ' +
    FConnectionString, TRACE_LEVEL_INFORMATION);
  try
    // Enfin, on a besoin d'un accès à IMAlloc pour gérer certaines allocation
    // de mémoire.
    OleCheck(CoGetMalloc(1, FMAlloc));

    // L'initialisation de la connexion est faite indirectement,
    // par l'intermédiaire du service OLEDB gérant les chaînes de connexion.
    // On commence donc par se connecter à ce service, en instanciant un
    // objet CLSID_MSDAINITIALIZE.
    OleCheck(CoCreateInstance(CLSID_MSDAINITIALIZE, nil, CLSCTX_INPROC_SERVER, IID_IDataInitialize,
      FDataInitialize));

    // Dans un deuxième temps, on crée l'objet DataSource oledb à partir
    // de la chaîne de connexion. L'objet ainsi créé est déjà initialisé.
    // Il ne restera plus qu'à ouvrir la connexion.
    Unknown := nil;
    FDataInitialize.GetDataSource(nil, CLSCTX_INPROC_SERVER,
      PWideChar(FConnectionString), IID_IDBInitialize,  Unknown);
    FDbInitialize := Unknown as IDBInitialize;

    FDataInitialize := nil; // On n'a plus besoin d'accéder au service !
    // On ouvre la connexion sur la source de donnée.
    OleDbCheck(FDbInitialize.Initialize);

    // Il ne reste plus qu'à créer une session par défaut.
    FSession := nil;
    OleDbCheck((FDbInitialize as IDBCreateSession).CreateSession(nil, IID_IOpenRowset, FSession));

    // On essaie d'obtenir l'interface ITransactionLocal pour la gestion des
    // transaction. Cependant, il se peut que le provider OLEDB ne gère pas les
    // transaction et n'implémente pas l'interface ITransactionLocal.
    if FSession.QueryInterface(IID_ITransactionLocal, unknown) = S_OK
    then FTransaction := unknown as ITransactionLocal
    else FTransaction := nil;

    // La connexion a été effectuée.
    SQLLogger.TraceConnect;
  except
    on e:exception do
    begin
      // En cas d'erreur à la connexion, on trace l'exception.
      SQLLogger.TraceException(e);

      // Puis on nettoie les interfaces.
      FSession := nil; // La connexion a échoué.
      FDbInitialize := nil;
      FDataInitialize := nil;

      // On redéclenche l'exception.
      raise;
    end;
  end;
end;

// Est appelée par TCustomConnection pour fermer la connexion.
procedure TCustomOleDbConnection.DoDisconnect;
begin
  SQLLogger.Trace(EVENT_SQL_INFO, 'Fermeture de la connexion : ' +
    FConnectionString, TRACE_LEVEL_INFORMATION);
  try
    FTransaction := nil;

    // Il faut commencer par libérer l'objet Session.
    FSession := nil;

    // On ferme la connexion à la source de données.
    OleDbCheck(FDbInitialize.Uninitialize);

    // Puis il ne reste plus qu'à libérer les interfaces.
    FDbInitialize := nil;

    // Enfin, on trace la déconnexion.
    SQLLogger.TraceDisconnect;
  except
    on e:exception do
    begin
      // En cas d'erreur à la connexion, on trace l'exception.
      SQLLogger.TraceException(e);

      raise; // Et on redéclenche l'exception.
    end;
  end;
end;

// Indique si la connexion est ouverte.
function TCustomOleDbConnection.GetConnected: Boolean;
begin
  result := Assigned(FSession);
end;

// Affiche la boîte de dialogue permettant de construire la chaîne de connexion.
// La méthode renvoie la chaîne de connexion ainsi construite si l'utilisateur
// valide la sélection.
// Autrement, la méthode retourne une chaîne vide.
// <ParenthWnd> peut être utilisé pour indiquer le Handle de la fenêtre parente
// de la boîte de dialogue.
class function TOleDbConnection.PromptConnexionString(
  OldConnexionString : widestring ='';
  ParenthWnd : cardinal = 0) : widestring;
var
  DBPromptInitialize : IDBPromptInitialize;
  DBInitialize : IUnknown;
  DataInitialize : IDataInitialize;
  hResult : integer;
  CntStr : PWideChar;
begin
  // On instancie les services OLEDB.
  OleCheck(CoCreateInstance(CLSID_DATALINKS, nil, CLSCTX_INPROC_SERVER,
    IID_IDBPromptInitialize, DBPromptInitialize));
  OleCheck(CoCreateInstance(CLSID_MSDAINITIALIZE, nil, CLSCTX_INPROC_SERVER,
    IID_IDataInitialize, DataInitialize));

  if OldConnexionString<>''
  then begin
    // Si une chaine de connexion a été fournie, on va l'utiliser pour initialiser
    // la boîte de dialogue.
    // Pour celà, on crée l'objet à partir de la chaîne de connexion fournie.
    DBInitialize := nil;
    DataInitialize.GetDataSource(nil, CLSCTX_INPROC_SERVER,
      PWideChar(OldConnexionString), IID_IDBInitialize,  DBInitialize);
  end
  else DBInitialize := nil;

  // Puis on appelle le dialogue prédéfini.
  // Si une chaîne de connexion initiale a été fournie, elle a permis d'initialiser
  // DBInitialize. PromptDataSource va alors s'en servir pour préinitialiser
  // la boîte de dialogue.
  hResult := DBPromptInitialize.PromptDataSource(nil,
      ParenthWnd, // Handle de la fenêtre parent
      DBPROMPTOPTIONS_PROPERTYSHEET, // Paramétrage de la connexion
      0,  // Pas de filtre sur les providers autorisés.
      nil, // Pas de filtre sur les providers autorisés.
      nil, // Pas de filtre sur les providers autorisés.
      IID_IDBInitialize, // IID de l'interface à retourner.
      DBInitialize); // Interface de retour.

  case hResult of
  S_OK: // L'utilisateur a validé la sélection
    begin
      // On appelle GetInitializationString pour connaitre la chaîne de connexion
      OleCheck(DataInitialize.GetInitializationString(DBInitialize, true,
        CntStr));
      result := cntStr;
    end;
  DB_E_CANCELED: // L'utilisateur a annulé la boîte de dialogue.
      result := '';
  else OleCheck(hResult);
  end;
end;

procedure TCustomOleDbConnection.OleDbCheck(hResult : integer);
var
  ErrInfo : IErrorInfo;
  ErrorInfo2 : IErrorInfo;
  Errors : IErrorRecords;
  nbError : cardinal;
  i : integer;
  Description : WideString;
  ErrMsg : widestring;
  ProcedureName : widestring;
  msg : string;

  unknown : IUnknown;
  SQLServerErrorInfo : ISQLServerErrorInfo;
  SQLServerError : PSSERRORINFO;
  SQLServerErrorMessage : PWideChar;
begin
  ErrMsg := '';
  // Premièrement, on regarde si des informations sont disponibles sur l'erreur en cours.
  GetErrorInfo(0, ErrInfo);

  if Assigned(ErrInfo) // On a réussit à obtenir des informations.
  then begin
    // OLEDB étend la gestion des exceptions COM de façon à retourner une liste d'exceptions
    // (la liste des exceptions à l'origine de l'erreur) au lieu d'une seule et unique erreur.
    // Si on veut connaitre la cause de l'erreur, il faut lire la liste complète.
    Errors := ErrInfo as IErrorRecords;

    // Maintenant, il ne reste plus qu'à parcourir la liste des erreurs.
    Errors.GetRecordCount(nbError);
    for i := 0 to nbError-1 do
    begin
      // Si on travaille avec SQL Server, on peut obtenir des informations plus complètes sur
      // les erreurs avec l'interface ISQLServerErrorInfo. On commence donc par rechercher si
      // ces informations sont disponibles. Si le provider OLEDB n'est pas un provider SQL Server,
      // l'interface ISQLServerErrorInfo ne sera pas disponible.
      unknown := nil;
      Errors.GetCustomErrorObject(i, IID_ISQLServerErrorInfo, unknown);
      if Assigned(unknown)
      then begin
        SQLServerErrorInfo := unknown as ISQLServerErrorInfo;
        SQLServerError := nil;
        SQLServerErrorMessage := nil;
        if SQLServerErrorInfo.GetErrorInfo(SQLServerError, SQLServerErrorMessage) = S_OK
        then begin
          if Assigned(SQLServerError)
          then begin
            try
              // A présent, on construit le message d'erreur à partir des informations :
              // Le champ bClass indique le niveau de gravité de l'erreur. Les valeurs
              // inférieures à 10 indiquent qu'il s'agit d'un simple message d'information.
              // Les valeurs supérieures à 10 désignent les erreurs.
              if SQLServerError.bClass <= 10 // Il s'agit d'un message d'information
              then begin
                // On ajoute le message à la liste des messages d'information.
                InfoMessages.Add(SQLServerError.pwszMessage);
              end
              else begin
                // Il s'agit d'une erreur. On met en forme le message d'erreur dans msg.
                msg := 'MSG-' + IntToStr(SQLServerError.lNative) + ', '; // Numéro de l'erreur

                // Traitement du nom de la procédure stockée à l'origine de l'erreur
                ProcedureName := SQLServerError.pwszProcedure;
                if ProcedureName<>''
                then msg := ProcedureName + ', ';

                // Ajout du numéro de ligne de l'erreur
                msg := msg + 'Line ' + IntToStr(SQLServerError.wLineNumber) + ', ';

                // Enfin, on termine avec le message de l'erreur.
                msg := msg + SQLServerError.pwszMessage;

                // Il s'agit d'une erreur. On l'ajoute au message complet des erreurs.
                ErrMsg := ErrMsg + msg + #13#10;
              end;
            finally
              if Assigned(SQLServerError)
              then FMAlloc.Free(SQLServerError);
              if Assigned(SQLServerErrorMessage)
              then FMAlloc.Free(SQLServerErrorMessage);
            end;
          end;
        end;
      end
      else begin
        // Il ne s'agit pas d'une erreur SQLServer, on traite l'erreur de façon classique.
        // On commence par lire l'erreur n°i dans ErrorInfo2
        OleCheck(Errors.GetErrorInfo(i, GetSystemDefaultLCID,  ErrorInfo2));
        OleCheck(ErrorInfo2.GetDescription(Description));

        ErrMsg := ErrMsg + Description + #13#10;
      end;
    end;
  end;

  // Enfin, il ne reste plus qu'à déclencher l'exception en cas d'erreur.
  // Normalement, s'il y a eu une erreur, hResult doit contenir un code
  // d'erreur et ErrMsg la description de l'erreur.
  if (ErrMsg<>'') or (not Succeeded(hResult))
  then begin
    if ErrMsg<>''
    then raise EOleDbException.Create(ErrMsg) // On déclenche une erreur spécifique OLEDB
    else raise EOleSysError.Create('', hResult, 0); // On déclenche une erreur système OLE
  end;
end;

type
  // L'interface IErrorRecords fait parti de OLEDB. Cependant l'unité OleDb.pas ne la déclare
  // pas. On doit donc la déclarer nous-même.
  IErrorRecords = interface(IUnknown)
  ['{0c733a67-2a1c-11ce-ade5-00aa0044773d}']

    function AddErrorRecord(pErrorInfo : PErrorInfo;
                            dwLookupID : cardinal;
                            pdispparams : pointer;
                            punkCustomError : IUnknown;
                            dwDynamicErrorID : cardinal) : HResult; stdcall;
    function GetBasicErrorInfo(ulRecordNum : cardinal;
                            pErrorInfo : PErrorInfo) : HResult; stdcall;
    function GetCustomErrorObject(ulRecordNum : cardinal;
                                  const riid : TGUID;
                                  var ppObject : IUnknown) : HResult; stdcall;
    function GetErrorInfo(ulRecordNum : cardinal;
                          lcid : cardinal;
                           var ppErrorInfo : IErrorInfo) : HResult; stdcall;

    function GetErrorParameters(ulRecordNum : cardinal;
                                pdispparams : pointer) : HResult; stdcall;

    function GetRecordCount(var pcRecords : cardinal) : HResult; stdcall;
  end;

  ISQLServerErrorInfo = interface(IUnknown)
  ['{5CF4CA12-EF21-11d0-97E7-00C04FC2AD98}']
    function GetErrorInfo(out ppErrorInfo : PSSERRORINFO;
                          out Error : PWideChar) : Hresult; stdcall;
  end;

  // Enregistrement relatif à une erreur SQL Server
  PSSERRORINFO = ^SSERRORINFO;
  SSERRORINFO = packed record
    pwszMessage : PWideChar;
    pwszServer : PWideChar;
    pwszProcedure : PWideChar;
    lNative : cardinal;
    bState : byte;
    bClass : byte;
    wLineNumber : word;
  end;

OleDbCheck((FSession as IDBCreateCommand).CreateCommand(nil,
   IID_ICommandText, unknown));

cmd := unknown as ICommandText;
cmd.SetCommandText(DBGUID_DEFAULT, PWideChar(SQL));

OleDbCheck(cmd.Execute(nil, IID_NULL, DbParams, nil, nil));

// Il n'y a pas de paramètres 
DbParams.pData := nil;
DbParams.cParamSets := 0;
DbParams.HACCESSOR := 0;

const
  IID_NULL: TGUID = '{00000000-0000-0000-0000-000000000000}';

// Execute une commande SQL qui ne retourne pas de données.
// C'est la méthode la plus simple pour exécuter une requête SQL.
procedure TOleDbConnection.ExecSQL(const SQL: widestring; Params : TParams);
var t0 : int64;
    cmd : ICommandText;
    unknown : IUnknown;
    OleDbParams : TOleDbParams;
begin
  // Premièrement, on trace le début de la requête.
  SQLLogger.TraceSQLBegin(SQL, t0);
  try
    try
      CheckConnected; // On s'assure que la connexion est ouverte.

      InfoMessages.Clear; // On réinitialise la liste des messages d'information

      // Tout d'abord, il faut créer un objet Command pour exécuter la requête.
      OleDbCheck((FSession as IDBCreateCommand).CreateCommand(nil, IID_ICommandText, unknown));

      // Ensuite on initialise la requête SQL.
      cmd := unknown as ICommandText;
      cmd.SetCommandText(DBGUID_DEFAULT, PWideChar(SQL));

      OleDbParams := TOleDbParams.Create(Params, cmd, self);
      try
        // Enfin on exécute la commande, sans attendre de résultats.
        OleDbCheck(cmd.Execute(nil, IID_NULL, OleDbParams.Parameters, nil, nil));

        // On met à jour la valeur des paramètres de sorti
        OleDbParams.UpdateParams(Params);
      finally
        OleDbParams.Free;
      end;

    except
      on e:exception do
      begin
        // En cas d'erreur, on trace l'exception.
        SQLLogger.TraceException(e);
        raise; // Et on redéclenche l'erreur.
      end;
    end;
  finally
    SQLLogger.TraceSQLEnd(SQL, t0); // Pour finir, on logue la fin de la requête
  end;
end;

// Execute une requête SQL qui renvoie des données.
// La fonction retourne un DataSet déconnecté, initialisé avec le jeu de données obtenu
function TOleDbConnection.OpenSQL(const SQL: widestring;
  Params: TParams; FetchSize : cardinal): TDataSet;
var
  t0 : int64;
  ds : TOleDbDataSet;
  RowSet : IRowSet;
  unknown : IUnknown;
  cmd : ICommandText;
  OleDbParams : TOleDbParams;

begin
  ds := nil;
  // Premièrement, on trace le début de la requête.
  SQLLogger.TraceSQLBegin(SQL, t0);
  try
    try
      CheckConnected; // On s'assure que la connexion est ouverte.

      InfoMessages.Clear;

      // Il faut créer un objet Command pour exécuter la requête
      OleDbCheck((FSession as IDBCreateCommand).CreateCommand(nil, IID_ICommandText, unknown));

      // On initialise la requête SQL.
      cmd := unknown as ICommandText;
      cmd.SetCommandText(DBGUID_DEFAULT, PWideChar(SQL));
      unknown := nil;

      // Si la requête est paramétrée, il faut initialiser les valeurs des paramètres. C'est le rôle
      // de la classe TOleDbParams. Si elle n'attend pas de paramètre, TOleDbParams définit un jeu
      // de paramètres vide.
      OleDbParams := TOleDbParams.Create(Params, Cmd, self);
      try
        OleDbCheck(cmd.Execute(nil, IID_IRowset, OleDbParams.Parameters, nil, @unknown));
        if Assigned(unknown)
        then begin
          RowSet := unknown as IRowSet;
          unknown := nil;

          // La source de données vient de rendre la main. On peut lire les données.
          ds := TOleDbDataSet(CreateDataSet); // On instancie le DataSet qui sera retourné.
          ds.LoadFromRowSet(RowSet, self, FetchSize); // Lecture des données.
          RowSet := nil;
        end
        else ds := nil;

        // Après l'exécution de la requête on met à jour les valeurs des paramètres de sorti.
        OleDbParams.UpdateParams(Params);
      finally
        OleDbParams.Free;
      end;

    except
      on e:exception do
      begin
        SQLLogger.TraceException(e);
        if Assigned(ds)
        then ds.Free;
        raise;
      end;
    end;
  finally
    // Pour finir, on trace la fin de la requête
    if Assigned(ds)
    then SQLLogger.TraceSQLEnd(SQL + ', ' + IntToStr(ds.RecordCount) + ' Lignes', t0)
    else SQLLogger.TraceSQLEnd(SQL, t0, Params);
  end;
  result := ds;
end;

// Exécution de la requête sur la source de données.
OleDbCheck(cmd.Execute(nil, IID_IRowset, DbParams, nil, @unknown));
RowSet := unknown as IRowSet;

// La source de données vient de rendre la main. On peut lire les données.
ds := TOleDbDataSet(CreateDataSet); // On instancie le DataSet qui sera retourné.
ds.LoadFromRowSet(unknown as IRowSet, self); // Lecture des données.

// Charge les données retournées par RowSet dans le Dataset.
// Le dataset est complètement initialisé : Les champs sont créés, le dataset
// est ouvert et chargé avec les données.
procedure TOleDbDataSet.LoadFromRowSet(RowSet: IRowSet; Cnt : TOleDbConnection; FetchSize : cardinal);
var t0 : int64;
begin
  SQLLogger.TraceBegin(EVENT_SQL_START, '  Debut Fetch', t0);
  try
    Close; // On s'assure que le Dataset est fermé.
    FPageSize := FetchSize;
    Describe(RowSet as IColumnsInfo, cnt); // Il faut définir les champs en fonction du rowset.

    if FetchSize<>0              // On initialise le FetchSize qui nous a été fournit
    then FPageSize := FetchSize
    else begin                   // Sinon, on essaie de calculer une valeur adaptée.
      FPageSize := 8192 div RecordSize;
      if FPageSize < 1
      then FPageSize := 1;
    end;

    SQLLogger.Trace(EVENT_SQL_INFO, Format('  RecordSize=%d, PageSize=%d', [RecordSize, FPageSize]),
      TRACE_LEVEL_VERBOSE);

    Open; // On doit ouvrir le dataset pour pouvoir charger les données.
    FetchAll(RowSet, cnt); // Charge les données du rowset dans le dataset.
    First; // On se positionne au début du DataSet.
  finally
    SQLLogger.TraceEnd(EVENT_SQL_END, '  Fin Fetch', t0);
  end;
end;

var
  nbColumns : cardinal;
  ColumnsInfo : PDBColumnInfo;
  infos : PWideChar;
...
  // On appelle GetColumnInfo pour obtenir un tableau décrivant la liste des colonnes présentes.
  OleDbCheck((RowSet as IColumnsInfo).GetColumnInfo(nbColumns, ColumnsInfo, Infos));

procedure TCustomOleDbDataSet.Describe(RowSet: IColumnsInfo; Cnt : TCustomOleDbConnection);
var
  nbColumns : cardinal;
  ColumnsInfo : PDBColumnInfo;
  infos : PWideChar;
  Column : PDBColumnInfo;

  columnName : widestring;
  DataType : TFieldType;
  DataSize : cardinal;
  i : integer;
  n : integer;
  IsNullable : boolean;
begin
  // On appelle GetColumnInfo pour obtenir un tableau décrivant la liste des colonnes présentes.
  Cnt.OleDbCheck(RowSet.GetColumnInfo(nbColumns, ColumnsInfo, Infos));
  try
    FieldDefs.BeginUpdate;
    Column := ColumnsInfo; // Pointe sur la description de la colonne en cours
    try
      FieldDefs.Clear;
      for i := 0 to nbColumns-1 do
      begin
        DataSize := 0;
        // Si la colonne n'a pas été nommée, on lui attribue un nom automatique
        // sous la forme colX avec X indiquant le numéro de la colonne (à partir 1)
        if Assigned(Column.pwszName)
        then columnName := Column.pwszName
        else columnName := 'col' + IntToStr(i+1);

        if Trim(columnName) = ''
        then columnName := 'col' + IntToStr(i+1);

        // Ensuite il faut vérifier si le nom n'existe pas déjà et renommer les
        // colonnes automatiquement en cas de besoin.
        if FieldDefs.IndexOf(columnName)<>-1
        then begin
          n := 1;
          columnName := columnName + '_';
          while FieldDefs.IndexOf(columnName + IntToStr(n))<>-1 do
          begin
            inc(n);
          end;
          columnName := columnName + IntToStr(n);
        end;

        // A présent, on peut commencer à créer les champs.
        case Column.wType of
        DBTYPE_I1, DBTYPE_UI1, DBTYPE_I2: // Entier court signé
          DataType := ftSmallint;
        DBTYPE_UI2: // Entier court non signé
          DataType := ftWord;
        DBTYPE_UI4, DBTYPE_I4: // Entier, signé ou non signé
          DataType := ftInteger;
        DBTYPE_CY:  // Type currency.
          DataType := ftBCD;
        DBTYPE_DATE, DBTYPE_DBDATE, DBTYPE_DBTIME: // Dates
          DataType := ftDateTime;
        DBTYPE_DBTIMESTAMP: // DateTime précis.
          DataType := ftTimeStamp;
        DBTYPE_BOOL:  // Booléen
          DataType := ftBoolean;
        DBTYPE_R4, DBTYPE_R8, DBTYPE_DECIMAL, DBTYPE_NUMERIC: // Nombre décimal
          DataType := ftFloat;
        DBTYPE_I8, DBTYPE_UI8:  // Entier long
          DataType := ftLargeint;
        DBTYPE_GUID:    // GUID
          begin
            DataType := ftGuid;
            DataSize := 38;
          end;
        DBTYPE_BYTES, DBTYPE_UDT: // Binaire
          DataType := ftBlob;
        DBTYPE_STR: // Chaîne de caractères
          begin
            // Si la longueur du champ dépasse une certaine longueur, on en fait un memo.
            if Column.ulColumnSize<COLUMN_MAXSIZE
            then begin
              DataType := ftString;
              DataSize := Column.ulColumnSize;
            end
            else DataType := ftMemo;
          end;
        DBTYPE_WSTR: // Chaîne de caractères unicode UTF-16.
          begin
            // Si la longueur du champ dépasse une certaine longueur, on en fait un memo unicode.
            if Column.ulColumnSize <COLUMN_MAXSIZE
            then begin
              DataType := ftWideString;
              DataSize := Column.ulColumnSize;
            end
            else DataType := ftWideMemo;
          end;
        else begin
          raise EOleDbException.Create(
            Format('Le type (%d) de la colonne %s n''est pas supporté !',
                   [Column.wType, columnName]));
        end;
        end;

        IsNullable := (ColumnsInfo.dwFlags and DBCOLUMNFLAGS_MAYBENULL) <>0;
        try
          TFieldDef.Create(FieldDefs,
                       columnName,
                       DataType,
                       DataSize,
                       not IsNullable,
                       FieldDefs.Count);
        except
          on e : EDatabaseError do
          begin
            raise EOleDbException.CreateFmt('Erreur lors de la création du champ %s : %s',
                    [columnName, e.Message]);
          end;
        end;
        // On peut passer à la colonne suivante :
        integer(Column) := integer(Column) + sizeof(DBCOLUMNINFO);
      end;
    finally
      FieldDefs.EndUpdate;
    end;

    CalcRecordSize; // calcule le buffer de stockage des lignes
  finally
    Cnt.FMAlloc.Free(ColumnsInfo);
    Cnt.FMAlloc.Free(Infos);
  end;
end;

  OleDbCheck((RowSet as IAccessor).CreateAccessor(
      DBACCESSOR_ROWDATA + DBACCESSOR_OPTIMIZED,
      FieldDefs.Count,
      @Bindings[0],
      RecordSize,
      Accessor,
      nil));

procedure TCustomOleDbDataSet.InitializeBindings;
var
  i : integer;
  FieldDef : TFieldDef;
  Binding : PDBBinding;
begin
  SetLength(Bindings, FieldDefs.Count);

  for i := 0 to FieldDefs.Count-1 do
  begin
    FieldDef := FieldDefs[i];
    Binding := @Bindings[i];

    Binding.iOrdinal := i+1;
    Binding.pTypeInfo := nil;
    Binding.obValue := FFieldInfo[i].Offset+8;  // Offset de la parti données du champ
    Binding.obLength := FFieldInfo[i].Offset+4; // Offset de la parti longueur du champ
    Binding.obStatus  := FFieldInfo[i].Offset; // offset de la parti status du champ
    Binding.cbMaxLen := FFieldInfo[i].Size; // taille de la zone données en octets.
    Binding.dwPart := DBPART_VALUE or DBPART_LENGTH or DBPART_STATUS; // Les trois champs sont définis
    Binding.pObject   := nil;
    Binding.pBindExt  := nil;
    Binding.dwFlags   := 0;
    Binding.eParamIO  := DBPARAMIO_NOTPARAM; // Il ne s'agit pas d'un paramètre
    Binding.dwMemOwner:= DBMEMOWNER_CLIENTOWNED; // Le client est propriétaire de la mémoire.
    Binding.bPrecision:= 0;            
    Binding.bScale    := 0;
    Binding.wType     := DBTYPE_STR;

    case FieldDef.DataType of
      ftString, ftFixedChar:          // Chaîne de caractères
         Binding.wType := DBTYPE_STR;
      ftSmallint :                    // Entier court signé
         Binding.wType := DBTYPE_I2;
      ftWord:                         // Entier court non signé
         Binding.wType := DBTYPE_UI2;
      ftAutoInc, ftInteger:           // Entier signé
        Binding.wType := DBTYPE_I4;
      ftBoolean:                      // Booléen
        Binding.wType := DBTYPE_BOOL;
      ftFloat:                        // Nombre flottant sur 64 bits
        Binding.wType := DBTYPE_R8;
      ftCurrency:                     // Nombre flottant sur 64 bits
        Binding.wType := DBTYPE_R8;
      ftBCD:                          // Nombre décimal en virgule fixe (currency)
        Binding.wType := DBTYPE_CY;
      ftDate, ftTime, ftDateTime :    // Date de type TDateTime
        Binding.wType := DBTYPE_DATE;
      ftTimeStamp:                    // Date de type TTimeStamp
        Binding.wType := DBTYPE_DBTIMESTAMP;
      ftLargeint:                     // entier long 64 bits
        Binding.wType := DBTYPE_I8;
      ftWideString, ftFixedWideChar:  // Chaîne de caractères UNICODE
        Binding.wType := DBTYPE_WSTR;
      ftMemo:                         // Le champ est un pointeur sur une chaine de caractères.
        Binding.wType := DBTYPE_STR + DBTYPE_BYREF;
      ftBlob:                         // Le champ est un pointeur sur un tableau binaire
        Binding.wType := DBTYPE_BYTES + DBTYPE_BYREF;
      ftWideMemo:                     // Le champ est un pointeur sur une chaine de caractères unicode.
        Binding.wType := DBTYPE_WSTR + DBTYPE_BYREF;
      ftGUID:                         // Les GUID sont stockés en chaîne de caractères
        Binding.wType := DBTYPE_STR;
      else raise EOleDbException.Createfmt('Le type du champ %s n''est pas supporté !', [FieldDef.Name]);
    end;
  end;
end;

// Dans un premier temps, il faut demander au provider de récupérer les lignes depuis le serveur.
// Elles restent stockées dans des buffers internes au provider.
FetchResult := RowSet.GetNextRows(DB_NULL_HCHAPTER,
                  0, // On lit les lignes depuis la dernière lecture
                  FPageSize, // On lit autant de ligne que dans une page du dataset.
                  nbRow, // Nombre de lignes réellement lues.
                  RowHandle);
Cnt.OleDbCheck(FetchResult);

Cnt.OleDbCheck(RowSet.GetData(RowHandle[i], Accessor, Data));

RowSet.ReleaseRows(nbRow, RowHandle, nil, nil, nil);

// Charge les données retournée par IRowSet à l'intérieur du dataset ds.
procedure TOleDbDataSet.FetchAll(RowSet: IRowSet; Cnt : TOleDbConnection);
var
  Accessor : HACCESSOR;
  nbRow : cardinal;
  RowHandle : PUintArray;
  FetchResult : hResult;
  i,j : integer;
  FPosition : cardinal;
  Data : Pointer;
  FIeldData : PFieldData;
  FieldOffset : cardinal;
  ptrBlob : pointer;
begin
  // Premièrement, il faut configurer le binding par rapport à la structure des lignes du dataset.
  InitializeBindings;

  // Ensuite, on crée un accesseur basé sur ce binding.
  Cnt.OleDbCheck((RowSet as IAccessor).CreateAccessor(
      DBACCESSOR_ROWDATA + DBACCESSOR_OPTIMIZED,
      FieldDefs.Count,
      @Bindings[0],
      RecordSize,
      Accessor,
      nil));

  try
    // A présent, il ne reste plus qu'à lire les lignes.
    nbRow := 0;

    // Les lignes vont être lues par blocs de FPageSize lignes.
    // Il faut commencer par allouer un tableau qui contiendra les handles de ces lignes.
    GetMem(RowHandle, FPageSize*sizeof(integer));
    try
      repeat
        // Dans un premier temps, il faut demander au provider de récupérer les lignes depuis le serveur.
        // Elles restent stockées dans des buffers internes au provider.
        FetchResult := RowSet.GetNextRows(DB_NULL_HCHAPTER,
                           0, // On lit les lignes depuis la dernière lecture
                           FPageSize, // On lit autant de ligne que dans une page du dataset.
                           nbRow, // Nombre de lignes réellement lues.
                           RowHandle);
        Cnt.OleDbCheck(FetchResult);

        // Les lignes ont été lues on peut demander au provider d'alimenter notre dataset avec les
        // résultats de cette lecture.
        for i := 0 to nbRow-1 do
        begin
          // On calcul le pointeur sur la ligne, dans les pages de stockage de TMemoryDataSet.
          Data := GetNewline(FPosition);

          // Ensuite on demande à OLEDB de remplir la ligne pointée avec les données, en respectant
          // le binding définit dans l'accesseur.
          Cnt.OleDbCheck(RowSet.GetData(RowHandle[i], Accessor, Data));

          // Une fois les données retournées par le provider, il reste à convertir
          // les LOB pour les stocker dans des TMemoryBlobStream.
          for j := 0 to FBlobFields.Count -1 do
          begin
            // On commence par obtenir le pointeur sur les données du champ
            FieldOffset := FFieldInfo[cardinal(FBlobFields[j])-1].Offset;
            FieldData := GetPFieldData(Data, FieldOffset);
            ptrBlob := pointer(FieldData^.Data);

            // On recopie les données du Blob à l'intérieur du DataSet.
            LoadBlobField(Data, cardinal(FBlobFields[j]), ptrBlob);

            // Enfin il ne faut pas oublier de libérer la mémoire allouée par le provider
            // OLEDB pour stocker le BLOB. Cette mémoire n'a été allouée que si le champ
            // ne vaut pas NULL.            
            if FieldData.NullStatus = DBSTATUS_S_OK
            then cnt.FMAlloc.Free(ptrBlob);
          end;

          // Enfin, on définit le bookmark de la ligne.
          DefineBookmark(FPosition, Data);
        end;

        // La page vient d'être traitée, on peut dire au provider de libérer les lignes.
        RowSet.ReleaseRows(nbRow, RowHandle, nil, nil, nil);

      until FetchResult = DB_S_ENDOFROWSET;
    finally
      Freemem(RowHandle);
    end;
  finally
    // Il reste à libérer l'accesseur.
    Cnt.OleDbCheck((RowSet as IAccessor).ReleaseAccessor(Accessor, nil));
  end;
end;

constructor TOleDbParams.Create(Params: TParams; ACmd : ICommand; Cnt : TOleDbConnection);
var
  i : integer;

  Param : TParam;
  PData : PFieldData;
  Offset : cardinal;
  ParamSize : cardinal;
  Binding : PDBBINDING;

  value : cardinal;
  DateValue : TDatetime;
  FloatValue : double;
  StringValue : string;
  WidestringValue : widestring;

begin
  FCnt := Cnt;
  if Assigned(Params) and (Params.Count >0)
  then begin
    SetLength(Bindings, Params.Count);
    SetLength(FParamInfo, Params.Count);

    FCapacity := 4096;
    SetLength(FData, 4096);
    PData := @FData[0];
    Offset := 0;
    for i := 0 to Params.Count -1 do
    begin
      Param := Params[i];
      Binding := @Bindings[i];

      // Initialisation de l'index des paramètres.
      FParamInfo[i].Offset := Offset;
      FParamInfo[i].Size := Param.Size;
      ParamSize := 0;

      // On préinitialise le binding pour le paramètre courant.
      Binding.iOrdinal := i+1;
      Binding.pTypeInfo := nil;
      Binding.obValue := Offset + 8;
      Binding.obLength := Offset + 4;
      Binding.obStatus  := Offset;
      Binding.cbMaxLen := Param.Size;
      Binding.dwPart := DBPART_VALUE or DBPART_LENGTH or DBPART_STATUS;
      Binding.pObject   := nil;
      Binding.pBindExt  := nil;
      Binding.dwFlags   := 0;
      Binding.dwMemOwner:= DBMEMOWNER_CLIENTOWNED;
      Binding.bPrecision:= 0;
      Binding.bScale    := 0;
      Binding.wType     := DBTYPE_STR; // wType sera rédéfinit ensuite en fonction du paramètre.

      // On définit eParamIO en fonction du type définit pour le paramètre
      case Param.ParamType of
      ptUnknown,
      ptInput: Binding.eParamIO  := DBPARAMIO_INPUT;
      ptOutput : Binding.eParamIO  := DBPARAMIO_OUTPUT;
      ptInputOutput : Binding.eParamIO  := DBPARAMIO_INPUT or DBPARAMIO_OUTPUT;
      end;

      // Premièrement on regarde si le paramètre est à NULL. Si c'est le cas, il
      // faut indiquer DBSTATUS_S_ISNULL pour le status du champ.
      if Param.IsNull
      then PData^.NullStatus := DBSTATUS_S_ISNULL
      else PData^.NullStatus := DBSTATUS_S_OK;

      // Maintenant, on fait la copie de la valeur du paramètre dans FData  en
      // fonction du type de ce dernier.
      case Param.DataType of
      ftWord, ftBoolean:
        begin
          ParamSize := 2;
          CheckSize(Offset + 8 + ParamSize);
          value := Param.AsInteger;
          move(value, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_UI2;
        end;
      ftSmallint:
        begin
          ParamSize := 2;
          CheckSize(Offset + 8 + ParamSize);
          value := Param.AsInteger;
          move(value, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_I2;
        end;
      ftAutoInc, ftInteger, ftLargeint:
        begin
          ParamSize := 4;
          CheckSize(Offset + 8 + ParamSize);
          value := Param.AsInteger;
          move(value, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_I4;
        end;
      ftDateTime:
        begin
          ParamSize := 8;
          CheckSize(Offset + 8 + ParamSize);
          DateValue := Param.AsDateTime;
          move(DateValue, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_DATE;
        end;
      ftDate, ftTime:
        begin
          ParamSize := 8;
          CheckSize(Offset + 8 + ParamSize);
          DateValue := Param.AsDate;
          move(DateValue, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_DATE;
        end;
      ftFloat,
      ftCurrency,
      ftBCD :
        begin
          CheckSize(Offset + 8 + ParamSize);
          FloatValue := Param.AsFloat;
          move(FloatValue, PData^.Data[0], ParamSize);
          Binding.wType := DBTYPE_R8;
        end;
      ftBlob, ftGraphic, ftFmtMemo, ftBytes, ftVarBytes, ftString, ftMemo:
        begin
          stringValue := Param.AsString;
          ParamSize := length(stringValue);
          Binding.cbMaxLen := ParamSize;

          CheckSize(Offset + 8 + ParamSize);

          PData^.LengthValue := ParamSize;
          move(stringValue[1], PData^.Data[0], ParamSize);

          if (Param.DataType = ftMemo) or (Param.DataType = ftString)
          then Binding.wType := DBTYPE_STR
          else Binding.wType := DBTYPE_BYTES;
        end;
      ftWideString, ftWideMemo:
        begin
          widestringValue := Param.AsWideString;
          ParamSize := length(widestringValue)*2;
          Binding.cbMaxLen := ParamSize;

          CheckSize(Offset + 8 + ParamSize);

          PData^.LengthValue := length(widestringValue);
          move(widestringValue[1], PData^.Data[0], ParamSize);

          if (Param.DataType = ftMemo) or (Param.DataType = ftString)
          then Binding.wType := DBTYPE_STR
          else Binding.wType := DBTYPE_BYTES;
        end;
      end;
      inc(offset, ParamSize + 8);
    end;

    // A présent, il ne reste plus qu'à définir l'accesseur.
    Cmd := ACmd;
    Cnt.OleDbCheck((Cmd as IAccessor).CreateAccessor(DBACCESSOR_PARAMETERDATA,
                    Params.Count,
                    @Bindings[0],
                    0,
                    hAccessor,
                    nil));
    Parameters.cParamSets := 1;
    Parameters.HACCESSOR := hAccessor;
    Parameters.pData := @FData[0];
  end
  else begin
    Parameters.cParamSets := 0;
    Parameters.HACCESSOR := 0;
    Parameters.pData := nil;
  end;
end;

procedure TOleDbParams.UpdateParams(Params: TParams);
var i : integer;
    Param : TParam;
    PData : PFieldData;
    value : cardinal;
    DateValue : TDatetime;
    FloatValue : double;
    StringValue : string;
    WidestringValue : widestring;
begin
  if Assigned(Params) and (Params.Count>0)
  then begin
    // On parcourt la liste des paramètres pour mettre à jour la valeur de paramètres de sorti
    // en fonction du nouvel état du buffer.
    for i := 0 to Params.Count -1 do
    begin
      Param := Params[i];

      // On ne traite que les paramètres de sorti. Inutile de s'occuper de ceux qui sont en
      // entrée seule.
      if (Param.ParamType in [ptOutput, ptInputOutput]) and (i<= high(FParamInfo))
      then begin
        PData := @FData[FParamInfo[i].Offset];
        if PData.NullStatus = DBSTATUS_S_ISNULL // Cas ou le paramètre vaut NULL
        then Param.Clear
        else begin
          // Si le paramètre ne vaut pas null, il reste à copier la valeur du buffer
          // en fonction du type de données 
          case Param.DataType of
          ftWord, ftBoolean, ftSmallint: // Entier sur 2 octets
            begin
              value := 0;
              move(PData.Data[0], value, 2);
              Param.AsInteger := value;
            end;
          ftAutoInc, ftInteger, ftLargeint: // Entier sur 4 octets
            begin
              move(PData.Data[0], value, 4);
              Param.AsInteger := value;
            end;
          ftDate, ftTime, ftDateTime:       // Date
            begin
              move(PData^.Data[0], DateValue, 8);
              Param.AsDateTime := DateValue;
            end;
          ftFloat,
          ftCurrency,
          ftBCD :
            begin
              move(PData^.Data[0], FloatValue, 8);          
              Param.AsFloat := FloatValue;
            end;
          ftBlob, ftGraphic, ftFmtMemo, ftBytes, ftVarBytes, ftString, ftMemo:
            begin
              SetLength(stringValue, PData.LengthValue);
              move(PData.Data[0], stringValue[1], PData.LengthValue);
              Param.AsString := stringValue;
            end;
          ftWideString, ftWideMemo:
            begin
              SetLength(WidestringValue, PData.LengthValue div 2);
              move(PData.Data[0], WidestringValue[1], PData.LengthValue);
              Param.AsString := WidestringValue;
            end;
          end;
        end;
      end;
    end;
  end;
end;

// Si la requête est paramétrée, il faut initialiser les valeurs des paramètres. C'est le rôle
// de la classe TOleDbParams. Si elle n'attend pas de paramètre, TOleDbParams définit un jeu
// de paramètres vide.
OleDbParams := TOleDbParams.Create(Params, Cmd, self);
try
  OleDbCheck(cmd.Execute(nil, IID_IRowset, OleDbParams.Parameters, nil, @unknown));
  if Assigned(unknown)
  then begin
    RowSet := unknown as IRowSet;
    unknown := nil;

    // La source de données vient de rendre la main. On peut lire les données.
    ds := TOleDbDataSet(CreateDataSet); // On instancie le DataSet qui sera retourné.
    ds.LoadFromRowSet(RowSet, self, FetchSize); // Lecture des données.
    RowSet := nil;
  end
  else ds := nil;

  // Après l'exécution de la requête on met à jour les valeurs des paramètres de sorti.
  OleDbParams.UpdateParams(Params);
finally
  OleDbParams.Free;
end;

// On appelle la méthode StartTransaction de l'interface OLEDB
OleDbCheck(FTransaction.StartTransaction(ISOLATIONLEVEL_READCOMMITTED, 0, nil, nil));

procedure TCustomOleDbConnection.StartTransaction;
begin
  CheckConnected;

  // FTransaction vaut nil si le provider OLEDB ne gère pas les transactions
  if Assigned(FTransaction)
  then begin
    try
      // On trace le début de la transaction.
      SQLLogger.TraceStartTransaction(TransactionTime);

      // On appelle la méthode StartTransaction de l'interface OLEDB
      OleDbCheck(FTransaction.StartTransaction(ISOLATIONLEVEL_READCOMMITTED, 0, nil, nil));
    except
      on e:exception do
      begin
        SQLLogger.TraceException(e);
        raise;
      end;
    end;
  end;
end;

      OleDbCheck(FTransaction.Commit(false, XACTTC_SYNC, 0));

procedure TCustomOleDbConnection.Commit;
begin
  CheckConnected;
  if Assigned(FTransaction)
  then begin
    try
      SQLLogger.TraceCommitTransaction(TransactionTime);
      OleDbCheck(FTransaction.Commit(false, XACTTC_SYNC, 0));
    except
      on e:exception do
      begin
        SQLLogger.TraceException(e);
        raise;
      end;
    end;
  end;
end;

      OleDbCheck(FTransaction.Abort(nil, false, false));

procedure TCustomOleDbConnection.Rollback;
begin
  // On vérifie que la connexion est bien ouverte.
  CheckConnected;

  if Assigned(FTransaction)
  then begin
    try
      // On trace le rollback
      SQLLogger.TraceRollbackTransaction(TransactionTime);

      // On appelle Abort pour annuler la transaction.
      OleDbCheck(FTransaction.Abort(nil, false, false));
    except
      on e:exception do
      begin
        SQLLogger.TraceException(e);
        raise;
      end;
    end;
  end;
end;

var cnt : TOleDbConnection;
begin
  // Création d'un nouvel objet TOleDbConnection
  cnt := TOleDbConnection.Create(nil);

  // Ici on demande la construction d'une nouvelle chaîne de connexion.
  cnt.ConnectionString := TOleDbConnection.PromptConnexionString('',
    Application.MainFormHandle);

  // Enfin, on ouvre la connexion :
  cnt.Connected := true;

  // Maintenant on ferme la connexion.
  cnt.Connected := false;

var
  ds : TDataSet;

begin

  // On exécute une requête SELECT quelconque.
  ds := cnt.OpenSQL('select * from SalesLT.Customer');

  // On travaille en mode déconnecté. Une fois la requête exécutée, on peut
  // fermer la connexion et continuer à travailler sur le dataset.
  // Le dataset renvoyé est un dataset bi-directionnel qu'on peut très bien
  // afficher dans une DBGrid !
  DBGrid1.Datasource.DataSet := nil;
  DBGrid1.Datasource.DataSet := ds;

var
  Params : TParams;
  Param : TParam;
  ds : TDataSet;
begin
  // On exécute une requête SELECT avec un paramètre DATE.
  Params := TParams.Create;
  try
    TParam(Params.Add).AsDateTime := EncodeDate(2000, 1, 1);
    ds := cnt.OpenSQL('select * from SalesLT.Product where SellStartDate < ?', Params);
  finally
    Params.free;
  end;

// On exécute une commande PRINT.
cnt.ExecSQL('PRINT ''Message de test''');

// Le message du PRINT est retourné dans InfoMessages.
ShowMessage(cnt.InfoMessages.Text);

Provider=Microsoft.Jet.OLEDB.4.0;Data Source=<Fichier excel à ouvrir>;Extended Properties=Excel 8.0

select * from [Feuil1$]