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 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
| unit main_connect;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
ComCtrls, Regexpr,process , Buttons, f_dm;
type
{ Tf_connect }
Tf_connect = class(TForm)
bt_choix_lib: TBitBtn;
bt_quitte_onglet: TButton;
bt_test: TButton;
bt_ping: TButton;
Liste_bases: TComboBox;
Emplacement_librairie: TEdit;
Nom_hote: TEdit;
Nom_utilisateur: TEdit;
Mot_de_passe: TEdit;
Image3: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
label_fede: TLabel;
open_librairie: TOpenDialog;
Panel1: TPanel;
Panel8: TPanel;
procedure bt_choix_libClick(Sender: TObject);
procedure bt_pingClick(Sender: TObject);
procedure bt_quitte_ongletClick(Sender: TObject);
procedure bt_testClick(Sender: TObject);
procedure Emplacement_librairieExit(Sender: TObject);
procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
procedure open_librairieSelectionChange(Sender: TObject);
private
public
end;
var
f_connect: Tf_connect;
implementation
Uses
main;
{$R *.lfm}
{ Tf_connect }
//************************************************
//********** Fermeture de la fenêtre
//************************************************
procedure Tf_connect.bt_quitte_ongletClick(Sender: TObject);
Begin
f_connect.Close;
end;
procedure Tf_connect.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
f_main.Show;
end;
//************************************************
//********** test de la connection
//************************************************
procedure Tf_connect.bt_testClick(Sender: TObject);
Var
I : Integer ;
test : Boolean;
reponse , adresse : string;
Begin
test:=True;
// Vérification de l'intégrité des données
// Zones de saisie TEdit
for i := 0 to pred(Panel1.ControlCount) do
Begin
if (Panel1.Controls[i] is TEdit) Then
Begin
If trim((Panel1.Controls[i] as TEdit).Text ) = '' Then test:=False;
End;
end;
// Zone de saisie liste bases
If Trim(Liste_bases.Text) = '' Then test:=False;
// Ping de l'hôte
// test de la présence du mot : "pas" ... à confirmer
If Nom_hote.Text <> '' Then Begin
adresse :=Nom_hote.Text;
RunCommand('ping',['-n','1',adresse],reponse);
if pos('pas',reponse) > 0 then test:=False;
end;
// Tests ok on passe à la connection
If test Then Begin
dm_spf.sgbd_connect.HostName:=Nom_hote.Text;
dm_spf.sgbd_connect.User:=Nom_utilisateur.Text;
dm_spf.sgbd_connect.Password:=Mot_de_passe.Text;
dm_spf.sgbd_connect.LibraryLocation:=Emplacement_librairie.Text;
dm_spf.sgbd_connect.Catalog:=Liste_bases.Text;
// Essai de connecter la base
try
dm_spf.sgbd_connect.Connected:=True;
Except;
ShowMessage('pas de base');
end;
end;
end;
//****************************************************************
//********** Remplissage de la liste des catalogues de la base
//****************************************************************
procedure Tf_connect.Emplacement_librairieExit(Sender: TObject);
Var
I : Integer ;
test : Boolean;
reponse , adresse : string;
Begin
test:=True;
// Vérification de l'intégrité des données
// Zones de saisie TEdit
for i := 0 to pred(Panel1.ControlCount) do
Begin
if (Panel1.Controls[i] is TEdit) Then
Begin
If trim((Panel1.Controls[i] as TEdit).Text ) = '' Then Begin
test:=False;
ShowMessage('La zone ' + (Panel1.Controls[i] as TEdit).Name + ' doit être reseignée' );
end;
End;
end;
// Forcer l'utilisation de la base mysql qui existe
Liste_bases.Text:= 'mysql' ;
// Ping de l'hôte
// test de la présence du mot : pas ... à confirmer
If Nom_hote.Text <> '' Then Begin
adresse :=Nom_hote.Text;
RunCommand('ping',['-n','1',adresse],reponse);
if pos('pas',reponse) > 0 then Begin
test:=False;
Showmessage('Impossible de joindre le serveur de la base de données') ;
End;
end;
// Test d'intégrité Ok tentative de connection
If test Then begin
dm_spf.sgbd_connect.HostName:=Nom_hote.Text;
dm_spf.sgbd_connect.User:=Nom_utilisateur.Text;
dm_spf.sgbd_connect.Password:=Mot_de_passe.Text;
dm_spf.sgbd_connect.LibraryLocation:=Emplacement_librairie.Text;
dm_spf.sgbd_connect.Catalog:=Liste_bases.Text;
ShowMessage(
Nom_hote.Text +
Nom_utilisateur.Text +
Mot_de_passe.Text +
Emplacement_librairie.Text +
Liste_bases.Text );
try
dm_spf.sgbd_connect.Connected:=True;
Except;
ShowMessage('Pas de connection au serveur de base de données');
test:=False;
end;
// Connection remplissage de la base
If test Then Begin
dm_spf.sql_self_service.SQL.Clear;
dm_spf.sql_self_service.SQL.Text:='show databases';
Try
dm_spf.sql_self_service.open;
except
ShowMessage('Impossible de récupérer la liste des catalogues');
test:=False;
end;
// Si base connectée remplisasge de la liste
If test then begin
dm_spf.sql_self_service.First;
Liste_bases.Items.Clear;
while not dm_spf.sql_self_service.EOF do begin
Liste_bases.Items.Add(dm_spf.sql_self_service.Fields[0].AsString);
dm_spf.sql_self_service.Next;
end;
end;
end; // Connection remplissage de la base
end; // Test d'intégrité Ok tentative de connection
end;
//************************************************
//********** mise à jour chemin librairie mysql
//************************************************
procedure Tf_connect.open_librairieSelectionChange(Sender: TObject);
begin
Emplacement_librairie.Caption:= open_librairie.FileName;
end;
//************************************************
//********** lancement selection chemin librairie mysql
//************************************************
procedure Tf_connect.bt_choix_libClick(Sender: TObject);
begin
open_librairie.Execute;
end;
//************************************************
//********** ping de l'adresse du serveur
//************************************************
procedure Tf_connect.bt_pingClick(Sender: TObject);
var reponse , adresse : string;
begin
If Nom_hote.Text <> '' Then Begin
adresse :=Nom_hote.Text;
RunCommand('ping',['-n','1',adresse],reponse);
if pos('pas',reponse) > 0 then ShowMessage('Adresse '+ adresse +' non joignable')else
begin
ShowMessage('L''hôte '+ adresse + ' est joignable');
end;
end;
end;
end. |
Partager