Cles USB [Résolu]

- - Dernière réponse :  youcef999 - 15 janv. 2013 à 14:16
Bonjour tout le monde :)
voila j ai une question , alors je suis actuellement en formation TSAII(technicien supérieur en automatique et informatique industriel) et on a un projet
j ai deux application a développer la première : l application doit tourner en permanence(thread) et surtout invisible le but c'est scanner le périphérique détecter et prendre la main sur Windows (la dll de détection) ensuite scanner par l'antivirus ,demander un mot de passe pour y accéder (avoir une basse de donner pour les clés USB par exemple avec leur référence :il ne peu accepter que les clés enregistrer )
bien sure avoir un moyen pour rentrer dans les paramètre avec un mot de passe pour rajouter d autre clés USB(ref)
je vous remercie d'avance
et merci pour toute L Equipe codes-sources parce que vous faite un boulot énorme
Afficher la suite 

Votre réponse

20/28 réponses

Meilleure réponse
Messages postés
693
Date d'inscription
jeudi 17 avril 2008
Statut
Membre
Dernière intervention
19 février 2019
19
3
Merci
Dans un premier temps j'ai regardé unit5 :
Dans ton unit5, quelque soit le mot de passe rentré ou non tu fais toujours la même chose !
Form5 (bouton)->
si ok ou bad -> close F5 et F2, ouvre F4

il faut prendre en compte le test du mot de passe et ouvrir ou fermer en conséquence la ou les bonnes fenêtres, sinon un mot de passe n'a aucun intérêt


Dubois77
site perso

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de dubois77
Messages postés
693
Date d'inscription
jeudi 17 avril 2008
Statut
Membre
Dernière intervention
19 février 2019
19
3
Merci
autre chose sur cette unité :
form4.Button3.Enabled:=true ; 
; 
; 
end; 

les ; sont inutiles
procedure TForm5.FormCreate(Sender: TObject); 
begin 
  Label1.Visible:=false ;    // à mettre directement sur la form5
  Label2.Visible:=false ;     // à mettre directement sur la form5
end; 


Dubois77
site perso

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de dubois77
Messages postés
693
Date d'inscription
jeudi 17 avril 2008
Statut
Membre
Dernière intervention
19 février 2019
19
3
Merci
dans l'unit2 dans la procedure ci apère, que l'on oui ou non c'est pareil !

/////////////////QUITTER LA CREATION DE LA FICHE//////////////////////////////// 
procedure TForm2.Button2Click(Sender: TObject); 
begin 
  if (edit1.Text <> '') 
    then 
      if MessageDlg('Voulez_vous vraiment quitter cette fiche ?',mtConfirmation,[mbYes,mbNo],0)=mrYes 
        then 
          if MessageDlg('tout les modifications vont etre perdu !',mtConfirmation,[mbOk,mbCancel],0)=mrCancel 
            then 
              form2.Close ; 
  closefile(USB); 
  close ; 
end; 


Dubois77
site perso

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de dubois77
Messages postés
260
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
3
Merci
Salut,
bon alors que dire ben déjà moi je verrais les choses différemment...
On connecte un support externe, boumm éjection si non connu !
On connecte un support connu, ben on lance l'antivirus !
Faire tourner le programme en permanence c'est possible...
Après pour les infos sur les support externe tu peux presque tout récupérer avec l'unité EjectUSB
mais faut un peu la complétée...
Sauf, le numéro de série physique du support, mais d'un autre coté c'est faux, oui un truc windows pfff...
Avec la méthode que tu utilises tu peux récupérer le numéro physique du support si un autre support de même marque
a déjà été utiliser sur le même poste...sinon windows attribut un ParentIdPrefix, ouais c'est tordu comme truc !
sinon il faut passer par les WMI...
Ensuite tu peux récupérer pas mal d'info diverses.
L'histoire de mot de passe je vois pas trop l’utiliter mais bon,
peut-être un lock de periph ou simplement un verrou de clés dans la base de registre...
@+

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_yanb
Messages postés
260
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
3
Merci
re,
du ménage...euh ben oui un gros gros ménage !!!
Ensuite utilise les balises codes comme a fait dubois stp
Pour l'indentation pareil évite les majuscule à outrance, ASSIGNFILE = AssignFile etc...
Les IF ... THEN
If Test Then
  Instruction
Else
  Instruction

Etc.........!
@+

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_yanb
Messages postés
260
Date d'inscription
lundi 27 octobre 2003
Statut
Membre
Dernière intervention
4 mars 2016
5
3
Merci
Re,
ensuite au vu de ce que tu présentes pourquoi un fichier texte ?
Pourquoi pas une base de donnée, un fichier xml etc...
fichier xml style

<CLES010203 Tranche="Num" Nom_Kit="Nom" Mot_De_Passe="Pass" Combo="Comb" Date_Heure="01/01/2013 10:10:10"/>
...

Bon j'arrête lol
@+

Dire « Merci » 3

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 139 internautes nous ont dit merci ce mois-ci

Commenter la réponse de cs_yanb
Messages postés
693
Date d'inscription
jeudi 17 avril 2008
Statut
Membre
Dernière intervention
19 février 2019
19
0
Merci
c'est quoi la question?

Dubois77
site perso
Commenter la réponse de dubois77
0
Merci
alors voici mon code avec les étapes puis mes question :
Procedure TForm1.EtatConnectionUSB(var Msg: TMessage);
begin
// / Déconnexion physique / / Connexion physique /
if (Msg.wParam $8004) or (Msg.wParam $8000) then
if DEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype=2 then
if DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_flags=0 then
if not Eject then
begin
CheckListBox1.Clear;
Liste_USB(CheckListBox1.Items,True,True,True);
end;
end;
pour cette partie c'est presque bon (detecter le peripherique) sauf que je veux prendre la main sur windows c'est a dire avoir la DLL de detection (panneau de config ; matériel et audio ; PERIPHERIQUE)

//

pour l éjection de mon périphérique aucun souci :
procedure TForm1.Button1Click(Sender: TObject);
var
I : Integer;
Drive: String;
begin
for I := 0 to CheckListBox1.Count - 1 do
if CheckListBox1.Checked[I] then
begin
Eject:=True;
Drive:=CheckListBox1.Items.Strings[i];

if MessageDlg('Extraire le support complet ?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
if Eject_USB(Drive[1],4,300,True,True) then
CheckListBox1.ItemEnabled[I]:=False;
end
else
begin
if Eject_USB(Drive[1],4,300,True,False) then
CheckListBox1.ItemEnabled[I]:=False;
end;
end;
CheckListBox1.Clear;
Liste_USB(CheckListBox1.Items,True,True,True);
Eject:=False;
end;

//

et pour mon bouton diagnostic
procedure TForm1.Button3Click(Sender: TObject);
begin
shellexecute(handle,'open',Pchar('C:\Program Files (x86)\Google\Chrome\Application\chrome.exe'),nil,nil,SW_HIDE);
end;

end.

la jai prie un point exe juste comme sa pour voir si sa marche ou pas donc a la place de chrome.exe je metterai NomAntiVirus.exe
alors je voulais tout dabord essayer manuellement mais ce que jai essayer de faire par la suite c'est de les faire tourné en permanence que sa se lance au démarrage de Windows de cree une base de donnee pour les cles usb a enregistrer demande de mot de passe et surtout aussi lancer lantivirus mais avec le scanne sur le périphérique détecter donc jarrete pas a faire des essaie chercher sur internet et je marreterai pas tant jai pas trouver et c'est pour cela je vous demande quelque info ou des idee en plus
Commenter la réponse de youcef999
Messages postés
4996
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
15
0
Merci
ah du fampagne..
et du foi fras..
..cé noellll..
...





cantador
Commenter la réponse de cs_cantador
Messages postés
4996
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
15
0
Merci
@youcef999 :

il faudrait que tu expliques en quoi la méthode que tu as imaginée te pose problèmes :

quels sont les obstacles actuels lors de la mis en oeuvre de cette procédure ?
bref quels sont les bugs ou plantages ?

cantador
Commenter la réponse de cs_cantador
Messages postés
4996
Date d'inscription
dimanche 26 février 2006
Statut
Modérateur
Dernière intervention
27 mars 2018
15
0
Merci
et les message d'erreur évntuels..

cantador
Commenter la réponse de cs_cantador
0
Merci
salut cantador je suis de retour
alors depuis quelque semaine mon appli commence a prendre form voici en detail ce que jai deja realiser puis ce que je compte faire par la suite avec les question :
alors pour commecer jai 5 form la form principal la voici ci ce code je te lavais passer juste avant :

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, EjectUSB, StdCtrls, CheckLst, ExtCtrls, jpeg, Buttons, shellapi,
Menus, ComCtrls, Grids,Calendar,ShellCtrls;

type
TForm1 = class(TForm)
CheckListBox1: TCheckListBox;
Actualiser_La_Liste: TButton;
Image1: TImage;
MainMenu1: TMainMenu;
Fichier1: TMenuItem;
Edition1: TMenuItem;
Affichage1: TMenuItem;
Outils1: TMenuItem;
Options1: TMenuItem;
Aide1: TMenuItem;
Nouveau1: TMenuItem;
FicheUSB1: TMenuItem;
Motdepasse1: TMenuItem;
Listepriphriques1: TMenuItem;
Licone1: TMenuItem;
Afficher1: TMenuItem;
Retirerdelabarredestaches1: TMenuItem;
Chercher1: TMenuItem;
FicheUSB2: TMenuItem;
Ouvrir1: TMenuItem;
Enregistrer1: TMenuItem;
Enregistrersous1: TMenuItem;
Fermer1: TMenuItem;
Quitter1: TMenuItem;
Ejecter1: TMenuItem;
Fentre1: TMenuItem;
Montrer1: TMenuItem;
Cacher1: TMenuItem;
ProgressBar1: TProgressBar;
Timer4: TTimer;
Timer5: TTimer;
Timer6: TTimer;
Timer13: TTimer;
Actualiserlaliste1: TMenuItem;
Diagnostic2: TMenuItem;
Label1: TLabel;
Timer1: TTimer;
Label2: TLabel;
procedure FormActivate(Sender: TObject);
procedure Actualiser_La_ListeClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure DiagnosticClick(Sender: TObject);
procedure FicheUSB1Click(Sender: TObject);
procedure FicheUS1Click(Sender: TObject);
procedure FicheUSB2Click(Sender: TObject);
procedure Afficher1Click(Sender: TObject);
procedure Retirerdelabarredestaches1Click(Sender: TObject);
procedure Montrer1Click(Sender: TObject);
procedure Cacher1Click(Sender: TObject);
procedure Ejecter1Click(Sender: TObject);
procedure Timer4Timer(Sender: TObject);
procedure Timer5Timer(Sender: TObject);
procedure Timer6Timer(Sender: TObject);
procedure Timer13Timer(Sender: TObject);
procedure Diagnostic2Click(Sender: TObject);
procedure Motdepasse1Click(Sender: TObject);
procedure Actualiserlaliste1Click(Sender: TObject);

private
{ Déclarations privées }
Procedure EtatConnectionUSB(var Msg: TMessage);Message WM_DEVICECHANGE;
public
{ Déclarations publiques }
end;

var
Form1 : TForm1;
Eject : Boolean;

implementation

uses Unit2, Unit4, Unit3,Unit5;


{$R *.dfm}
{$R WindowsXP.res}
///////////////////////DETECTION CLES USB//////////////////////////////////////
Procedure TForm1.EtatConnectionUSB(var Msg: TMessage);
begin
// / Déconnexion physique / / Connexion physique /
if (Msg.wParam $8004) or (Msg.wParam $8000) then
if DEV_BROADCAST_HDR(Msg.LParam)^.dbch_devicetype=2 then
if DEV_BROADCAST_VOLUME(Msg.LParam)^.dbcv_flags=0 then
if not Eject then
begin
CheckListBox1.Clear;
Liste_USB(CheckListBox1.Items,True,True,True);
end;

;
;
;
;
end;

////////////ACTUALISER LA LISTE P2RIPH2RIQUE///////////////////////////////////
procedure TForm1.Actualiser_La_ListeClick(Sender: TObject);
begin
progressbar1.Position:=0 ;//on initialise la barprog a 0{le progressebar c'est juste pour la forme et pour faire jolie mais il a aucun role }
CheckListBox1.Clear; //
Liste_USB(CheckListBox1.Items,True,True,True);

progressbar1.Visible:=true;
progressbar1.position:=100 ;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
CheckListBox1.Clear;
// Liste_USB(Lecteurs:TStrings;DriveRemovable,DriveFixed,DriveCDRom:Boolean);
// Lecteurs : Récupération des volumes dans un TStrings
// DriveRemovable : Récupération des périphériques autres que disques et média USB
// DriveFixed : Récupération des disques USB
// DriveCDROM : Récupération des médias USB
Liste_USB(CheckListBox1.Items,True,True,True);//affichage des périphérique dans la listebox
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
label1.Caption:=datetimetostr(now);{pour Obtenir la date de type mardi 11 janvier 2013 }
label2.Caption:=formatdatetime('dddd dd mmmm yyyy',date);{pour Obtenir la date et lheur de type 11/1/2013 08:53:22}

end;

procedure TForm1.CheckListBox1Click(Sender: TObject);
begin

// Msg.wParam and not Eject
// then('C:\ProgramData\Microsoft\Windows\Start Menu\Programs'):=open ;

end;
//////////////CREATION DE LA FORM PéRIPHéRIQUE/////////////////////////////////
procedure TForm1.FormCreate(Sender: TObject);
begin

Application.ShowMainForm := false;
CheckListBox1.Visible:=false;
ShellExecute(Handle,'Open','',nil,nil,SW_HIDE);
// Application.ShowMainForm:=False;

end;
///////////////DIAGNOSTIC MANIUEL///////////////////////////////////////////////
procedure TForm1.DiagnosticClick(Sender: TObject);
begin
shellexecute(handle,'open',Pchar('C:\Program Files (x86)\Google\Chrome\Application\chrome.exe'),nil,nil,SW_HIDE);
// on lance le diagnostic qui va allez chercher le (.exe) de l'antivirus pour faire un scan de la cles detecter avant utilisation
end;


procedure TForm1.FicheUSB1Click(Sender: TObject);
begin
form2.ShowModal;
// ou form2.Visible:=true;
end;

procedure TForm1.FicheUS1Click(Sender: TObject);
begin
form4.ShowModal;
// ou form4.Visible:=true;
end;

procedure TForm1.FicheUSB2Click(Sender: TObject);
begin
form3.ShowModal;
// ou form3.Visible:=true;
// et form1.Visible:=false;
end;
/////////////////AFFICHAGE ICONE SUR LA BARRE DE TACHES/////////////////////////
procedure TForm1.Afficher1Click(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_SHOW);// remet l'icône de la barre des tâches
end;

procedure TForm1.Retirerdelabarredestaches1Click(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_Hide);// retire l'icône de la barre des tâches
end;

///////////////////////AFFICHAGE DE LA LISTBOX/////////////////////////////////////

procedure TForm1.Montrer1Click(Sender: TObject);
begin
CheckListBox1.Visible:=true ;
end;

procedure TForm1.Cacher1Click(Sender: TObject);
begin
CheckListBox1.Visible:=false;
end;

///////////////////EJECT USB////////////////////////////////////////////////////
procedure TForm1.Ejecter1Click(Sender: TObject);
var
I : Integer;
Drive: String;
begin
for I := 0 to CheckListBox1.Count - 1 do
if CheckListBox1.Checked[I]
then
begin
Eject:=True;
Drive:=CheckListBox1.Items.Strings[i];
if MessageDlg('Extraire le support complet ?',mtConfirmation,[mbYes,mbNo],0)=mrYes
then
begin
if Eject_USB(Drive[1],4,300,True,True)
then
CheckListBox1.ItemEnabled[I]:=False;
end
else
begin
if Eject_USB(Drive[1],4,300,True,False) then
CheckListBox1.ItemEnabled[I]:=False;
end;
end;
CheckListBox1.Clear;
Liste_USB(CheckListBox1.Items,True,True,True);
Eject:=False;
end;

procedure TForm1.Timer4Timer(Sender: TObject);
begin
Application.MainForm.Show;// mettre visible la form principale
Timer4.enabled:=false;
end;

procedure TForm1.Timer5Timer(Sender: TObject);
begin
flashWindow(image1.Height,True);
end;

procedure TForm1.Timer6Timer(Sender: TObject);
begin
FlashWindow(Actualiser_La_Liste.Handle,True);
end;

procedure TForm1.Timer13Timer(Sender: TObject);
begin
if (progressbar1.position=100) and(progressbar1.Visible=true )
then
begin
progressbar1.Visible:=false
end;
;
end;

procedure TForm1.Diagnostic2Click(Sender: TObject);
begin
shellexecute(handle,'open',Pchar('C:\Program Files (x86)\Google\Chrome\Application\chrome.exe'),nil,nil,SW_HIDE);
// on lance le diagnostic qui va allez chercher le (.exe) de l'antivirus pour faire un scan de la cles detecter avant utilisation
end;
////////////////button mot de passe/////////////////////////////////////////////
procedure TForm1.Motdepasse1Click(Sender: TObject);
begin
ASSIGNFILE (mot,pass) ;
IF ( FileExists (pass))
THEN
Reset (mot)
ELSE
REWRITE (mot)

;

form4.edit1.Text:='';
form4.edit2.Text:='';
form4.edit3.Text:='';
form4.edit6.Text:='';

end;
procedure TForm1.Actualiserlaliste1Click(Sender: TObject);
begin
progressbar1.Position:=0 ;//on initialise la barprog a 0
CheckListBox1.Clear; //
Liste_USB(CheckListBox1.Items,True,True,True);

progressbar1.Visible:=true;
progressbar1.position:=100 ;
end;

end.
//////////////////enregistrer///////////////////////////////////////////////////
procedure TForm2.EnregistrerClick(Sender: TObject);
begin
SEEK (USB,FILESIZE(USB)) ;

enreg.NUMERO_CLES:=edit1.Text;
enreg.TRANCHE:=edit2.Text;
enreg.NOM_KIT:=uppercase(edit3.Text);
enreg.DONNE_KIT:=edit5.Text;
enreg.MOT_DE_PASSE:=edit6.Text;
ComboBox1.text:=aha;


WRITE (USB, enreg) ;
//form3.ListBox1.Refresh ;

edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
edit5.Text:='';
edit6.Text:='';
// form1.visible:=false ;
end;

end.
jusque ici c'est bon je vous passerai le projet complet sa te permetra de voir mieux les chose ensuite unit 2 ----->
Commenter la réponse de youcef999
0
Merci
on se tutoie sa sera plus simple pcq des moment je te tutoi je te vouvoie lol
pour la detection des péréphériques je voulais que sa lance directement le scan une fois le port et detecter sauf qu il faut avoir acces au parametre de l'anti virus je ne sais pas si sa existe des dll sur avast ou autre pour donner l'ordre du scan
2eme demi probleme je voulais que mon programme tourne en permanence a attendre un péréphérique detecter donc un (thread) jai reussi a cacher lappli plus licone sur un timer je rajouterai un raccourci pour afficher a nouveau lappli
Commenter la réponse de youcef999
0
Merci
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls, StdCtrls;
CONST
repertoire : STRING = 'repertoire.abc' ;
repertoireTemp = 'repertoiretemp.abc' ;

type
ENREGISTREMENT = RECORD
NUMERO_CLES : STRING [5] ;
TRANCHE : STRING [20] ;
NOM_KIT : STRING [10] ;
DONNE_KIT: STRING [10] ;
MOT_DE_PASSE : STRING [10] ;
combo : STRING [10] ;
date_heure : string[15] ;

END ;
FICHIER = FILE OF Enregistrement ;

TForm2 = class(TForm)
Image1: TImage;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Label6: TLabel;
Enregistrer: TButton;
Button2: TButton;
Button3: TButton;
ComboBox1: TComboBox;
Label4: TLabel;
Timer1: TTimer;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure EnregistrerClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;

var
Form2: TForm2;
USB : FICHIER ;
USBTemp : FICHIER ;
enreg : ENREGISTREMENT ;

implementation

{$R *.dfm}
uses Unit1,Unit3,Unit4;

/////////////////QUITTER LA CREATION DE LA FICHE////////////////////////////////
procedure TForm2.Button2Click(Sender: TObject);
begin

if (edit1.Text <> '')
then
if MessageDlg('Voulez_vous vraiment quitter cette fiche ?',mtConfirmation,[mbYes,mbNo],0)=mrYes
then
if MessageDlg('tout les modifications vont etre perdu !',mtConfirmation,[mbOk,mbCancel],0)=mrCancel
then

form2.Close ;
closefile(USB);
close ;

end;


procedure TForm2.FormCreate(Sender: TObject);
begin

button3.Visible:=false;
ASSIGNFILE (USB,repertoire) ;
IF ( FileExists (repertoire))
THEN
Reset (USB)
ELSE
REWRITE (USB)

;

edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
edit6.Text:='';
ComboBox1.Text:='';

end;

////////////////////////////Enregistrer/////////////////////////////////////////
procedure TForm2.EnregistrerClick(Sender: TObject);
begin
SEEK (USB,FILESIZE(USB)) ;

enreg.NUMERO_CLES:=edit1.Text;
enreg.TRANCHE:=edit2.Text;
enreg.NOM_KIT:=uppercase(edit3.Text);
enreg.MOT_DE_PASSE:=edit6.Text;
enreg.combo:=combobox1.text;
enreg.date_heure:=label4.Caption ;


WRITE (USB, enreg) ;
//form3.ListBox1.Refresh ;

edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
edit6.Text:='';
ComboBox1.Text:='';
// form1.visible:=false ;
end;

procedure TForm2.Timer1Timer(Sender: TObject);
begin
label4.Caption:=datetimetostr(now);
end;

end.
Commenter la réponse de youcef999
0
Merci
pour lunit 2 pas tres compliquer c'est le principe d'un agenda creation enregistrer jai encore quelque souci avec les modifications et les suppressions et quand je fait plusieur recherche le programme plante
donc la forme deux c'est pour crèè une nouvelle fiche (le but c'est de ranger des cles usb ) je pourais pas donner plus de detail vue que c'est un programme qui sera unique pour une central nucleaire et c'est pour gerer des donnees confidentille.
Commenter la réponse de youcef999
0
Merci
unit Unit3;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, CheckLst;

type
TForm3 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
ListBox1: TListBox;
Label2: TLabel;
procedure Bu(Sender: TObject);
procedure ListBoxRefresh();
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
// procedure ListBox1MouseUp(Sender: TObject; Button: TMouseButton;
//Shift: TShiftState; X, Y: Integer);
// procedure ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
// procedure CheckListBox1Click(Sender: TObject);
// procedure CheckListBox2Click(Sender: TObject);
// procedure CheckListBox2EndDrag(Sender, Target: TObject; X, Y: Integer);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;

var
Form3: TForm3;

implementation

{$R *.dfm}
uses Unit1,Unit2,unit5, Unit4;

//////////////RECHERCHE FICHE///////////////////////////////////////////////////
procedure TForm3.Bu(Sender: TObject);
begin
IF Edit1.text=''
THEN
begin
Label1.Caption:='Veuillez entrer le numero ou le nom du KIT SVP ' ;
Label1.Visible:=TRUE ;
end
ELSE
begin
SEEK (USB,0) ;
Edit1.text:=uppercase(Edit1.Text) ;
WHILE (((enreg.NOM_KIT<>Edit1.Text)OR (enreg.TRANCHE<>Edit1.Text))
AND NOT(EOF(USB))) DO
READ (USB,enreg);
;

IF (EOF(USB)) AND ((enreg.NOM_KIT <> Edit1.Text))
THEN
begin
label1.caption:='Aucun résultat trouvé... ' ;
label1.Visible := TRUE ;
end
ELSE
BEGIN
form4.Visible:= true;
form4.edit1.Text:=enreg.NUMERO_CLES;
form4.edit2.Text:=enreg.TRANCHE;
form4.edit3.Text:=enreg.NOM_KIT;
form4.edit6.Text:=enreg.MOT_DE_PASSE;
form4.ComboBox1.Text:=enreg.combo;

END ;
;
end ;

end;

procedure TForm3.FormCreate(Sender: TObject);
//VAR i:integer ;
begin
Edit1.Text:='' ;//vider le edit
Label1.Visible:=false ;
Label2.Visible:=false ;


ASSIGNFILE (USB,repertoire) ;
IF ( FileExists (repertoire))

THEN Reset (USB)
ELSE REWRITE (USB)

;
ListBoxRefresh ;
end;

procedure TForm3.ListBoxRefresh();
var
i:integer ;
cur_pos : integer;
begin
cur_pos:=FilePos(USB);
form3.Label2.Caption:=IntToStr(filesize(USB))+ ' Fiche enregistrés ' ;
Label2.Visible:=true ;
ListBox1.Clear;
for i:= 1 to FileSize(USB) do
begin
seek(USB, i - 1);
read(USB, enreg);
ListBox1.Items.Add(enreg.NOM_KIT + ' ' + enreg.TRANCHE);
end;

seek(USB,cur_pos);

end;
procedure TForm3.ListBox1Click(Sender: TObject);
var
i:integer ;
cur_pos : integer;
begin
cur_pos:=FilePos(USB);
form3.Label2.Caption:=IntToStr(filesize(USB))+ ' Fiche enregistrés ' ;
Label2.Visible:=true ;
ListBox1.Clear;
for i:= 1 to FileSize(USB) do
begin
seek(USB, i - 1);
read(USB, enreg);
ListBox1.Items.Add(enreg.NOM_KIT + ' ' + enreg.TRANCHE);
end;

seek(USB,cur_pos);

end;

{
procedure TForm3.ListBox1EndDrag(Sender, Target: TObject; X, Y: Integer);
var resultat:string;
begin
resultat:='fileListBox1EndDrag(sender='+(sender AS ListBox1.Items.Text ).Name+', Target=';
if Target=nil
then resultat:=resultat+'nil(refus))'
else resultat:=resultat+( Target AS tcomponent).Name+')';
canvas.TextOut(memo1.left,memo1.top+memo1.height+40,resultat);
end;

end;
}



end.
Commenter la réponse de youcef999
0
Merci
unit 3 tu va trouver beaucoup de commentaire ou des fonction entre () parceque tout simplement sa a pas marcher
rien de special un edit une listebox un label pour afficher le nombre de fiche enregistrer et un button pour lancer la recherche de la fiche
Commenter la réponse de youcef999
0
Merci
unit Unit4;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, jpeg, ExtCtrls;

type
TForm4 = class(TForm)
Image1: TImage;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label5: TLabel;
Label6: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit6: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
MainMenu1: TMainMenu;
Fiche1: TMenuItem;
Modifier1: TMenuItem;
Supprimer1: TMenuItem;
Quitter1: TMenuItem;
ComboBox1: TComboBox;
Label4: TLabel;
// procedure FormActivate(Sender: TObject);
procedure Supprimer1Click(Sender: TObject);
// procedure Modifier1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Quitter1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Modifier1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;

var
Form4: TForm4;

implementation

uses Unit3, Unit2,unit1,unit5;

{$R *.dfm}
///////////CREATION FORM MODIFICATION///////////////////////////////////////////
procedure TForm4.FormActivate(Sender: TObject);
begin
edit1.Enabled:=false;
edit2.Enabled:=false;
edit3.Enabled:=false;
edit6.Enabled:=false;
Button2.Enabled:=false ;
Button3.Enabled:=false ;
end;

///////////////SUPPRIMER LA FICHE_USB///////////////////////////////////////////
procedure TForm4.Supprimer1Click(Sender: TObject);
VAR
i:integer ;
begin
if MessageDlg('Voulez_vous vraiment supprimer cette fiche ?',mtConfirmation,[mbYes,mbNo],0)=mrYes
then
begin
ASSIGNFILE(USBTemp,repertoireTemp) ;
REWRITE(USBTemp) ;
SEEK(USB,0) ;

FOR i:=1 TO FILESIZE(USB) DO
Begin
READ(USB,enreg) ;
IF ((enreg.NOM_KIT<>Edit3.Text)or(enreg.NUMERO_CLES<>Edit1.Text)or
(enreg.TRANCHE<>Edit2.Text) or(enreg.combo<>Edit1.Text) or
(enreg.MOT_DE_PASSE<>Edit6.Text))
THEN
WRITE (USBTemp,enreg)

;
End
;



CLOSEFILE(USB) ;
erase(usb);

RENAME(USBTemp,repertoire ) ;
CLOSEFILE(USBTemp) ;
ASSIGNFILE (USB,repertoire) ;
RESET(USB) ;
form4.close ;
form3.ListBox1.Refresh ;
end;
end;

///////////////////////MODIFIER FICHE///////////////////////////////////////////
{procedure TForm4.Modifier1Click(Sender: TObject);
begin
edit1.Enabled:=TRUE;
edit2.Enabled:=TRUE;
edit3.Enabled:=TRUE;
edit5.Enabled:=TRUE;
edit6.Enabled:=TRUE;
Button1.Enabled:=TRUE ;
end;
}
procedure TForm4.Button1Click(Sender: TObject);
begin
form4.Visible:= true;
button3.Visible:=true;
if MessageDlg('Voulez_vous enregistrer les modifications ?',mtConfirmation,[mbYes,mbNo],0)=mrYes
then
begin
enreg.NUMERO_CLES:=edit1.Text;
enreg.TRANCHE:=edit2.Text;
enreg.NOM_KIT:=uppercase(edit3.Text);
enreg.MOT_DE_PASSE:=edit6.Text;
WRITE(USB,enreg) ;
form3.ListBox1.Refresh ;
closefile(USB);
form4.close
end
else
form4.Visible:=true;
end;

procedure TForm4.FormClose(Sender: TObject; var Action: TCloseAction);
VAR
i:integer ;
begin
form3.ListBox1.clear ;
FOR i:=0 TO (FILESIZE(USB)) DO
form3.ListBox1.Items.Add(enreg.NOM_KIT+' '+(enreg.TRANCHE)) ;
;
end;


procedure TForm4.Quitter1Click(Sender: TObject);
begin
form2.Close ;
form3.Close ;
form4.Close ;
closefile(USB);
end;

procedure TForm4.Button2Click(Sender: TObject);
begin

form2.Close ;
form3.Close ;
form4.Close ;
closefile(USB);
end;

procedure TForm4.Button3Click(Sender: TObject);
begin
if MessageDlg('veuillez saisir votre mot de passe SVP',mtConfirmation,[mbyes,mbno],0)=mrYes
then
begin
form5.ShowModal;
end;
end;



procedure TForm4.Modifier1Click(Sender: TObject);
begin
combobox1.text:=form2.ComboBox1.Text;
form4.combobox1.visible:=true;
combobox1.enabled:=true ;
button3.Visible:=true;
button1.Visible:=true;
edit1.Enabled:=true;
edit2.Enabled:=true;
edit3.Enabled:=true;
edit6.Enabled:=true;
Button2.Enabled:=true ;
Button3.Enabled:=true ;

form4.Visible:= true;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
button1.Visible:=false;
button3.Visible:=false;
combobox1.visible:=true;
combobox1.enabled:=false;
combobox1.Text:=enreg.combo;
label4.Caption:=enreg.date_heure;



end;
//////////////////////////supprimer//////////////////////////////////////
procedure TForm4.Button4Click(Sender: TObject);
VAR
i:integer ;
begin
if MessageDlg('Voulez_vous vraiment supprimer cette fiche ?',mtConfirmation,[mbYes,mbNo],0)=mrYes
then
begin
ASSIGNFILE(USBTemp,repertoireTemp) ;
REWRITE(USBTemp) ;
SEEK(USB,0) ;

FOR i:=1 TO FILESIZE(USB) DO
Begin
READ(USB,enreg) ;
IF (enreg.NOM_KIT<>Edit1.Text )
THEN
WRITE (USBTemp,enreg)
;
End
;
ERASE(USB) ;
CLOSEFILE(USB) ;
CLOSEFILE(USBTemp) ;

RENAME(USBTemp,repertoire ) ;
ASSIGNFILE (USB,repertoire) ;
RESET(USB) ;
form4.close ;
form3.ListBox1.Refresh ;
end;
end;
///////////////////////////////////////////////////////////////////////////////

end.
Commenter la réponse de youcef999
0
Merci
mon second 1/2 probleme unit 4 avec la suppression ou quand je veu enregistrer une fiche que je viens de modifier !! bizarre ! ou soit ma logique n'est pas bonne a revoir ..
Commenter la réponse de youcef999
0
Merci
unit Unit5;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
CONST
pass : STRING = 'pass.abc' ;
passTemp = 'passTemp.abc' ;
mot_pass ='2013catt';

type
ENREGISTREMENT1 = RECORD
mot_pass : STRING [10] ;
END ;
PW = FILE OF Enregistrement1 ;
type
TForm5 = class(TForm)
Edit1: TEdit;
Label1: TLabel;
Button1: TButton;
Label2: TLabel;
procedure FormActivate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;

var
Form5: TForm5;
mot : PW;
motTemp : PW ;
enreg1 : ENREGISTREMENT1 ;

implementation
uses Unit3, Unit2,unit1,unit4;
{$R *.dfm}

procedure TForm5.FormActivate(Sender: TObject);
begin
edit1.Text:='';
end;
///////////////mot de passe////////////////////////////////////////////////////
procedure TForm5.Button1Click(Sender: TObject);
begin
IF Edit1.text=''
THEN
begin
Label2.Caption:='Veuillez entrer le mot de passe svp ' ;
Label2.Visible:=TRUE ;
end
ELSE
if (edit1.Text<>mot_pass)
then
Label2.Caption:='Mot de passe incorrecte '
else
if (edit1.Text = mot_pass)
then
showmessage('Mot de passe correct :)');
form5.Close;
form2.Close;
form4.Visible:=true;
button1.Visible:=true;
form4.edit1.Enabled:=true;
form4.edit2.Enabled:=true;
form4.edit3.Enabled:=true;
form4.edit5.Enabled:=true;
form4.Edit6.Visible:=true;
form4.edit6.Enabled:=true;
form4.Button2.Enabled:=true ;
form4.Button3.Enabled:=true ;
;
;
end;
////////////////////////////////////////////////////////////////////////////
procedure TForm5.FormCreate(Sender: TObject);
begin
Label1.Visible:=false ;
Label2.Visible:=false ;
end;

end.
Commenter la réponse de youcef999

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.