FAQ DelphiConsultez toutes les FAQ

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
uses 
  SysUtils, 
  Strutils; // AnsiIndexStr 
  
type 
TBuilder=record 
  ChaineConnexion : ShortString; 
  numeroTemplate  : Byte; 
end; 
  
Const 
NombreProvider=4; 
NombreTemplate=2; 
  
// Chaîne de connexion à construire 
Template : Array[1..NombreTemplate] of String = 
  ('Provider=%S;Persist Security Info=False;Password=%S;User ID=%S;Initial  
Catalog=%S', 
  'Provider=%S;Persist Security Info=False;Password=%S;User ID=%S;Data  
Source=%S' 
  ); 
  
// Nom des providers ADO 
Provider : Array[0..NombreProvider-1] of String= 
  ('SQLSERVER', 
   'ACCESS', 
   'ODBC', 
   'ORACLE' 
  ); 
// Informations utilisées dans la construction de la chaîne de connexion, cf. Template 
// Elles sont en correspondance avec l'indice du nom du provider. 
tabBuilder : Array [0..NombreProvider-1] Of TBuilder= 
  ((ChaineConnexion :'SQLOLEDB.1'; numeroTemplate :1),              // SQLSERVER 
   (ChaineConnexion :'Microsoft.Jet.OLEDB.4.0'; numeroTemplate :2), // ACCESS 
   (ChaineConnexion :'MSDASQL.1';numeroTemplate :2),                // ODBC 
   (ChaineConnexion :'MSDAORA.1';numeroTemplate :2)                 // ORACLE 
  ); 
  
function buildConnexionString(Fournisseur,Base,User,PassWord: string):string; 
var Monprovider :Integer; 
begin 
  Monprovider:=AnsiIndexStr(Fournisseur, Provider); 
  If Monprovider >= 0 then 
   with tabBuilder[Monprovider] do 
    Result := Format(Template[numeroTemplate],[ChaineConnexion,Password,User,Base]) 
  else raise Exception.Create(Format('Le fournisseur %s est inconnu.',[Fournisseur])); 
end;

1
2
ADOConnection1.ConnectionString :=  
  buildConnexionString('ODBC','MaBaseNameAliasODBC','UserName','MotDePasse');

Application.Initialize;

CoInitialize(nil);

CoUnInitialize;

1
2
3
4
5
6
7
8
9
10
procedure ConfigurerAdo; 
begin 
  AdoConnection .Connected := False;//Ou utiliser l'équivalent AdoConnection.Close; 
  EditConnectionString(AdoConnection); 
  try 
    AdoConnection .Connected := True;//Ou utiliser l'équivalent AdoConnection.Open; 
  Except on E:Exception do 
    Showmessage(E.Message); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Uses ...,OleDB, ComObj, ActiveX,... 
  
... 
implementation 
... 
  
function ADOConnectionString(ParentHandle:THandle;InitialString:WideString;out NewString: string): Boolean; 
var 
  DataInit: IDataInitialize; 
  DBPrompt: IDBPromptInitialize; 
  DataSource: IUnknown; 
  InitStr: PWideChar; 
begin 
  Result   := False; 
  DataInit := CreateComObject(CLSID_DataLinks) as IDataInitialize; 
  if InitialString <> '' then 
    DataInit.GetDataSource(nil,CLSCTX_INPROC_SERVER,PWideChar(InitialString),IUnknown, DataSource); 
  DBPrompt := CreateComObject(CLSID_DataLinks) as IDBPromptInitialize; 
  if Succeeded(DBPrompt.PromptDataSource(nil, ParentHandle, 
    DBPROMPTOPTIONS_PROPERTYSHEET, 0, nil, nil, IUnknown, DataSource)) then 
  begin 
    InitStr := nil; 
    DataInit.GetInitializationString(DataSource, True, InitStr); 
    NewString := InitStr; 
    Result    := True; 
  end; 
end; 
  
procedure TForm1.Button1Click(Sender: TObject); 
var 
  initst, nexstr : string; 
begin 
  initst := 'Provider=SQLOLEDB.1;Persist Security Info=False;User ID=MonLogin;Initial Catalog=MaBdd;Data Source=MonServeur'; 
  if ADOConnectionString(form1.Handle,initst, nexstr) then 
    MessageDlg(nexstr, mtWarning, [mbOK], 0); 
end;

Function PromptDataSource(ParentHandle: THandle; InitialString: WideString): WideString;

PromptDataSource(0, ADOConnection.ConnectionString);

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Unit Import_Export_Ado_Xml; 
interface 
  
uses 
  Classes, 
  ADOInt; 
  
function TableVersXML(const Atable: _Recordset): String; 
function TableDepuisXML(const XML: String): _Recordset; 
  
implementation 
  
uses 
  ComObj; 
  
function TableVersXML(const Atable: _Recordset): String; 
var 
  VT        : Variant; 
  AStream    : TStringStream; 
begin 
  Result     := ''; 
  if Atable   = nil then Exit; 
  AStream  :=TStringStream.Create(''); 
  try 
    VT := CreateOleObject('ADODB.Recordset'); 
    VT := ATable; 
    VT.Save(TStreamAdapter.Create(Astream) as IUnknown, adPersistXML); 
    AStream.Position:= 0; 
    Result     := AStream.DataString; 
  finally 
    AStream.Free; 
  end; 
end; 
  
function TableDepuisXML(const XML: String): _Recordset; 
var 
  VT : Variant; 
  AStream : TStringStream; 
begin 
  Result := nil; 
  if XML = '' then Exit; 
  try 
    AStream := TStringStream.Create(XML); 
    AStream.Position:= 0; 
    VT := CreateOleObject('ADODB.Recordset'); 
    VT.Open(TStreamAdapter.Create(AStream) as IUnknown); 
    Result := IUnknown(VT) as _Recordset; 
  finally 
    AStream.Free; 
  end; 
end; 
  
end.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
// 
Uses 
... 
Import_Export_Ado_Xml; 
// 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  Memo1.Lines.Text := TableVersXML(ADOQuery1.Recordset); //Exportation  
end; 
  
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  ADOQuery1.Recordset := TableDepuisXML(Memo1.Lines.Text); //Importation 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
type 
  ESaveDataSetNoData = Class(Exception); 
  EDictionnaireVide=Class(Exception); 
  
  
const 
  COLUMNDELIMITER = ';'; 
  MsgNoData='Aucune donnée.'; 
  
{*------------------------------------------------------------------------------ 
Renvoie le contenu d'un RecordSet ADO au format CSV. Attention à la taille des données renvoyées. 
Le Header ( nom des champs sur la première ligne) n'est pas géré. 
  @param ARecordSet   RecordSet ADO 
  @param StringFormat   Format d'export : adClipString 
  @param ColumnDelimiter   Séparateur de champ 
  @param RowDelimiter   Séparateur de ligne 
  @param NullExpr   Expression pour les valeur de champ à NULL 
  @return Une chaîne contenant l'intégralité d'un RecordSet ADO au format CSV 
------------------------------------------------------------------------------*} 
Function SaveDataSetCSV(ARecordSet : _Recordset; StringFormat: StringFormatEnum; 
                        const ColumnDelimiter: WideString; const RowDelimiter: WideString; 
                        const NullExpr: WideString): WideString; 
begin 
  Result := ''; 
  //Récupère, au format CSV, l'intégralité d'un dataset dans une string 
  With ARecordSet do 
  begin 
    if RecordCount = 0 then 
      Raise ESaveDataSetNoData.Create(MsgNoData); 
    Result := GetString(StringFormat, RecordCount, ColumnDelimiter, RowDelimiter, NullExpr); 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
{*------------------------------------------------------------------------------ 
Ecrit, au format CSV, le contenu d'un RecordSet ADO dans un fichier. Attention à la taille des données renvoyées. 
S'il existe déjà un fichier portant ce nom, il est ouvert en mode écriture. 
  @param AADOARecordSet   RecordSet ADO 
  @param AFilename   Nom du fichier CSV 
------------------------------------------------------------------------------*} 
Procedure SaveDataSetTo(AADOARecordSet : _Recordset; AFilename :TFileName); Overload; 
var 
  AllData: string; 
  Liste : TStringList; 
begin 
   // Repositionne le curseur pour enregistrer l'intégralité des données. 
  AADOARecordSet.First; 
  Liste := TStringList.Create; 
  try 
   Liste.Text := SaveDataSetCSV(AADOARecordSet, adClipString, COLUMNDELIMITER, sLineBreak, ''); 
   Liste.SaveToFile(AFilename); 
  finally 
    Liste.Free; 
  end; 
end;

1
2
3
4
5
6
7
8
9
10
11
12
13
14
{*------------------------------------------------------------------------------ 
Ecrit, au format CSV, le contenu d'un RecordSet ADO dans une TStrings existante. Attention à la taille des données renvoyées. 
La liste est remise à zéro avant l'opération. 
  @param AADOARecordSet   RecordSet ADO 
  @param AList   Liste de chaîne hébergeant les lignes du RecordSet 
------------------------------------------------------------------------------*} 
Procedure SaveDataSetTo(AADOARecordSet : _Recordset; AList: TStringList);Overload; 
  
begin 
  // obligatoire sinon la récupération des données ne se fera 
  // qu'à la position courante du curseur dans la base de données: 
  MoveFirst; 
  AList.Text := SaveDataSetCSV(AADOARecordSet, adClipString, COLUMNDELIMITER, sLineBreak, ''); 
end;

1
2
3
4
5
6
7
8
9
10
11
var Dictionnaire : TStringList 
begin 
  ...//Creation de la requête 
  try 
    SaveDataSetTo(Query.Recordset,Dictionnaire); 
  except 
    on ESaveDataSetNoData do 
    Raise EDictionnaireVide.Create('Le dictionnaire de recherche est vide'); 
  end; 
  ... 
end;