// aboutbox devrait aparaitre dessus form main
// relire auto apres effacement ?

unit Transfert;

interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
     Dialogs, Buttons, StdCtrls, ComCtrls, ExtCtrls, USB2Lib, Grids,
     Strutils, Dateutils, Gauges;

type
  Tmodul = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    cleGrd: TStringGrid;
    TabSheet2: TTabSheet;
    passGrd: TStringGrid;
    TabSheet3: TTabSheet;
    envcBtn: TBitBtn;
    effacBtn: TBitBtn;
    BitBtn1: TBitBtn;
    Timer1: TTimer;
    MonthCal1: TMonthCalendar;
    procedure PageControl1Change(Sender: TObject);
    procedure envcBtnClick(Sender: TObject);
    procedure cleGrdSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
    procedure cleGrdGetEditText(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure cleGrdGetEditMask(Sender: TObject; ACol, ARow: Integer;
      var Value: String);
    procedure effacBtnClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure MonthCal1Click(Sender: TObject);
    procedure cleGrdKeyPress(Sender: TObject; var Key: Char);
    procedure FormPaint(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  public
 end;

const
 MP_WRITE = 0;
 MP_READ = 1;
 ADR_DEBUT_CLE = $1600;
 ADR_FIN_CLE = $3B7E;
 NMAX_CLE = 300;

 ADR_DEBUT_PASS = $4000;
 ADR_FIN_PASS = $5Bff;
 NMAX_PASS = 450;

var
 modul: TForm;
 vidpid : string = 'vid_04d8&pid_000c';
 nlen:byte;
 InPipe, OutPipe: longint;
 rec: array [0..63] of byte;
 sd: array [0..63] of byte;
 ncle, npass : integer;
 sended, recv : integer;

{--------------------------------------------------------------------------}
implementation

uses wait1;

{$R *.dfm}

function hhtostr(i:integer):string;
var t:string;
begin
  t:='0'+inttostr(i);
  hhtostr:=rightbstr(t,2);
end;


function SetClock():integer;
label finset;
begin
 //////////////////////////////////////////////////////////////////
 //Met a l'heure aussi l'horloge

 //Lit et verifie l'heure serrure
 OutPipe := MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'),MP_WRITE,0);
 InPipe :=MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'), MP_READ,0);


 //Lance l'ordre lecture heure/date
 sd[0] := $CA;
 //Met en forme la date
 sd[4]:=dayof(now);
 sd[3]:=monthof(now);
 sd[2]:=yearof(now) div 256;
 sd[1]:=yearof(now) mod 256;

 //Met en forme l'heure
 sd[5]:=hourof(now);
 sd[6]:=minuteof(now);
 sd[7]:=secondof(now);

 If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then
   begin
     SetClock:=0;
     goto finset;
   end;
 If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then
   begin
     SetClock:=0;
     goto finset;
   end;

 SetClock:=rec[0];

finset:
 //Ferme les pipes USB
 MPUSBClose(inpipe);
 MPUSBClose(outpipe);
end;


procedure Tmodul.PageControl1Change(Sender: TObject);
begin
 if pagecontrol1.ActivePageIndex =2 then
   Application.Terminate;
end;


procedure Tmodul.envcBtnClick(Sender: TObject);
label
 usberror,finproc;
var
 adr, nrow, i : integer;
 yyyy, mm, dd: word;
 txt:string;
begin
 if MessageDlg('Mettre à jour les données  ?', mtConfirmation,[mbYes,mbNo],0)
    <>mrYes then exit;

 OutPipe := MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'),MP_WRITE,0);
 InPipe :=MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'), MP_READ,0);

 waitfrm.show;
 waitfrm.ProgBar1.Position :=0;

 //Adresse de depart zone des cles
 nrow:=1;
 adr := ADR_DEBUT_CLE;
 repeat
   //Lance l'ordre d'ecriture bloc de 16 octets
   sd[0] := $58;
   sd[1] := adr mod 256;
   sd[2] := adr div 256;

   //encode la ligne de clé en octets
   txt:=clegrd.cells[1,nrow];
   if txt='' then break;
   sd[3] := strtoint('$'+midstr(txt,1,2));
   sd[4] := strtoint('$'+midstr(txt,4,2));
   sd[5] := strtoint('$'+midstr(txt,7,2));
   sd[6] := strtoint('$'+midstr(txt,10,2));
   sd[7] := strtoint('$'+midstr(txt,13,2));

   //Voit si y a une date de fin validité
   txt:=clegrd.cells[2,nrow];
   if txt<>'' then
   begin
     try
       DecodeDate(strtodate(txt),yyyy,mm,dd);
     except
       MessageDlg('Date incorrecte !',mtError,[mbOK],0);
       waitfrm.Close;
       exit;
     end;
     sd[8]:= yyyy mod 256;
     sd[9]:= yyyy div 256;
     sd[10]:= mm;
     sd[11]:= dd;
   end;

   //Voit si il y a un nom
   txt:=clegrd.cells[3,nrow];
   if txt<>'' then
   begin
     for i:=1 to length(txt) do
       sd[11+i]:= ord(txt[i]);
   end;
   If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
   If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;
   If (rec[0]<>$AA) Then GoTo usberror;

   //Avance le compteur
   waitfrm.ProgBar1.Position := (waitfrm.ProgBar1.Position+10) mod 100;

   adr := adr + 32;
   nrow:=nrow+1;
 until (nrow>=clegrd.RowCount);

 //Envoie 32 octets vides pour marquer la fin de liste des clés
 if adr<ADR_FIN_CLE then
  begin
    sd[0] := $58;
    sd[1] := adr mod 256;
    sd[2] := adr div 256;
    for i:=3 to 31 do sd[i]:=0;
    //Transmet l'ordre
    If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
    If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;
    If (rec[0]<>$AA) Then GoTo usberror;
  end;

 //Ferme les pipes USB
 MPUSBClose(inpipe);
 MPUSBClose(outpipe);

 //////////////////////////////////////////////////////////////////
 //Met a l'heure aussi l'horloge
 SetClock();

 GoTo finproc;
usberror:
 MessageDlg('Erreur usb - Débranchez & rebranchez la carte !',mtError,[mbOK],0);
finproc:
 waitfrm.Close;
end;


procedure Tmodul.cleGrdSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  if acol<2 then
   clegrd.Options:=clegrd.Options-[goEditing]
  else
   clegrd.Options:=clegrd.Options+[goEditing];
end;


procedure Tmodul.cleGrdGetEditText(Sender: TObject; ACol, ARow: Integer;
  var Value: String);
begin
  envcbtn.Enabled :=true;
end;


procedure Tmodul.cleGrdGetEditMask(Sender: TObject; ACol, ARow: Integer;
  var Value: String);
begin
 case acol of
  2: begin
      value:='##/##/##';
      if not MonthCal1.Visible then
        begin
          MonthCal1.Visible:=true;
          try
           MonthCal1.Date:=strtodate(clegrd.Cells[clegrd.Col,clegrd.row]);
          except
          end;
        end;
     end;
  3:  value:=StringOfChar('c', 19);
  else
    clegrd.Options:=clegrd.Options-[goEditing];
  end;
end;


procedure Tmodul.effacBtnClick(Sender: TObject);
label
 usberror,fineffacer;
var
 adr, r, c : integer;
begin
 ////////////////// EFFACEMENT D'UNE CLE ?  /////////////////////////
 if pagecontrol1.ActivePageIndex =0 then
 begin
   if (npass<1) then
    begin
     MessageDlg('Rien à effacer !', mtError,[mbOk],0);
     exit;
    end;

   if MessageDlg('Effacer la clé '+inttostr(clegrd.Row)+' ?', mtConfirmation,
      [mbYes,mbNo],0)<>mrYes then exit;

   //Sinon efface la ligne dans le tableau et renvoie tout en bloc...
   if clegrd.Rowcount>2 then
   begin
     for r:=clegrd.Row to clegrd.Rowcount-1 do
       for c:=0 to clegrd.colcount-1 do
         clegrd.Cells[c,r]:=clegrd.Cells[c,r+1];
     clegrd.Rowcount:=clegrd.Rowcount-1;
   end
   else
   begin
     for c:=0 to clegrd.colcount-1 do
       clegrd.Cells[c,1]:='';
   end;

   envcBtnClick(sender);
   BitBtn1Click(sender);
   exit;
 end;

 //////////////// EFFACEMENT DES PASSAGES ? /////////////////////////
 if pagecontrol1.ActivePageIndex =1 then
 begin
  if MessageDlg('Effacer tout l`historique ?', mtConfirmation,[mbYes,mbNo],0)
    <>mrYes then exit;

  OutPipe := MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'),MP_WRITE,0);
  InPipe :=MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'), MP_READ,0);

  waitfrm.show;
  waitfrm.ProgBar1.Position :=0;

  //Adresse de depart zone des cles
  adr := ADR_DEBUT_PASS;
  repeat
   //Lance l'ordre d'effacement bloc flash de 64octets
   sd[0] := $55;
   sd[1] := adr mod 256;
   sd[2] := adr div 256;

   If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
   If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;
   If (rec[0]<>$AA) Then GoTo usberror;

   //Avance le compteur
   waitfrm.ProgBar1.Position := (waitfrm.ProgBar1.Position+10) mod 100;

   adr := adr + 64;
  until (adr>=ADR_FIN_PASS);

  //Ferme les pipes USB
  MPUSBClose(inpipe);
  MPUSBClose(outpipe);

  //Rafraichit ecran
  BitBtn1Click(sender);
 end;

GoTo fineffacer;
usberror:
 MessageDlg('Erreur usb - Débranchez & rebranchez la carte !',mtError,[mbOK],0);
fineffacer:
 waitfrm.Close;
end;


procedure Tmodul.BitBtn1Click(Sender: TObject);
label
 usberror, finproc;
var
 i,n, n2, ndebut, nfin : integer;
 adr, adr32, prems : integer;
 txt, numcle: string;
 accs: array[0..NMAX_PASS,0..15] of byte;
 nrow : integer;
begin
 OutPipe := MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'),MP_WRITE,0);
 InPipe :=MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'), MP_READ,0);

 waitfrm.show;
 waitfrm.ProgBar1.Position :=0;

 ////////////////////////////////////////////////////////////////
 //        DEPART LECTURE ZONE DES CLES VALIDEES
 ////////////////////////////////////////////////////////////////
 adr := ADR_DEBUT_CLE;
 ncle := 0;
 clegrd.RowCount := 2;

 //Debut boucle lecture toute la memoire des Clés
 repeat
  //Lance l'ordre avec les sd(...) deja regles
  sd[0] := $85;
  sd[1] := adr mod 256;
  sd[2] := adr div 256;

  If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
  If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;

  numcle:='';
  //Décode le numero de saisie en hexa
  for n:=0 to 3 do numcle:=numcle+inttohex(rec[n],2)+'.';
  numcle:=numcle+inttohex(rec[4],2);

  if (numcle='00.00.00.00.00') then
   break
  else
   ncle:=ncle+1;

  if ncle>1 then clegrd.RowCount := clegrd.RowCount+1;
  clegrd.cells[0,ncle]:=inttostr(ncle);
  clegrd.cells[1,ncle]:=numcle;

  //Décode une éventuelle date de validité
  if (rec[5]<>0) and (rec[5]<>$ff) then
   begin
    txt:=inttostr(rec[8])+'/'+inttostr(rec[7])+'/';
    txt:=txt+inttostr(rec[5]+256*rec[6]);
    clegrd.cells[2,ncle]:=txt;
   end;

  //Décode le nom qui peut etre ajouté
  if (rec[9]<>0) and (rec[9]<>$ff) then
   begin
    txt:='';
    for n:=9 to 27 do txt:=txt+chr(rec[n]);
    clegrd.cells[3,ncle]:=txt;
   end;

  //Avance le compteur
  waitfrm.ProgBar1.Position := (waitfrm.ProgBar1.Position+10) mod 100;

  adr:=adr+32;
 until (adr>=ADR_FIN_CLE) or (numcle='00.00.00.00.00');

 if ncle=0 then
   MessageDlg('Pas de clés en mémoire !',mtInformation,[mbOK],0);

 ////////////////////////////////////////////////////////////////
 //          DEPART LECTURE ZONE DES ACCES MEMORISES
 ////////////////////////////////////////////////////////////////
 adr := ADR_DEBUT_PASS;
 npass := 0;
 //Debut boucle lecture de toute la memoire des Clés
 repeat
   //Lance l'ordre avec les sd(...) deja regles
   sd[0] := $85;
   sd[1] := adr mod 256;
   sd[2] := adr div 256;

   If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
   If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;

   //arrete si le mois est vide
   if (rec[2]=0) or (rec[2]=$ff) then break;
   npass:=npass+1;
   //Stocke un paquet de 16 ocs
   for n:=0 to 15 do accs[npass,n]:=rec[n];

   //arrete si le mois est vide
   if (rec[16+2]=0) or (rec[16+2]=$ff) then break;
   npass:=npass+1;
   //Stocke un paquet de 16 ocs
   for n:=0 to 15 do accs[npass,n]:=rec[16+n];

   waitfrm.ProgBar1.Position := (waitfrm.ProgBar1.Position+10) mod 100;
   adr:=adr+32;
 until (adr>=ADR_FIN_PASS) or (npass>NMAX_PASS);
 //Ferme les pipes USB
 MPUSBClose(inpipe);
 MPUSBClose(outpipe);

 //Vide deja le tableau
 passgrd.RowCount := 2;
 nrow:=1;
 for n:=0 to 4 do passgrd.cells[n,nrow]:='';

 if npass=0 then
   begin
    waitfrm.Close;
    MessageDlg('Pas d`accès en mémoire !',mtInformation,[mbOK],0);
    exit;
   end;

 //Si toute la memoire est utilisée, retrouve le debut
 ndebut:=1;
 nfin:=npass;
 if  npass>=NMAX_PASS then
 begin
  adr:=1;
  n:=accs[adr,14]+256*accs[adr,15];
  repeat
    //Prend le numero de la ligne (pour trouver la premiere)
    adr:=adr+1;
    if adr>=NMAX_PASS then break;
    n2:=accs[adr,14]+256*accs[adr,15];
    if abs(n2-n)>1 then
     begin
       ndebut := adr;
       nfin := adr-1;
       if nfin<0 then nfin:=nfin+NMAX_PASS;
       break;
     end;
     n:=n2;
  until (adr>=NMAX_PASS);
 end;

 //Décode maintenant chaque ligne de 16octets dans le passgrd
 //en commencant par le debut
 n:=ndebut;
 repeat
   //fait la date
   txt:=inttostr(accs[n,3])+'/'+inttostr(accs[n,2])+'/';
   txt:=txt+inttostr(accs[n,0]+256*accs[n,1]);
   if nrow>1 then passgrd.RowCount := passgrd.RowCount+1;
   passgrd.cells[1,nrow]:=txt;

   //Fait colonne autorisé ou pas
   if (accs[n,12]<>0) then
     passgrd.cells[0,nrow]:='OUI'
   else
     passgrd.cells[0,nrow]:='NON';

   //fait l'heure
   txt:=hhtostr(accs[n,4])+':'+hhtostr(accs[n,5])+':'+hhtostr(accs[n,6]);
   passgrd.cells[2,nrow]:=txt;

   //fait No série
   txt:=inttohex(accs[n,7],2);
   for i:=8 to 11 do txt:=txt+'.'+inttohex(accs[n,i],2);
   passgrd.cells[3,nrow]:=txt;

   //Test si sortie de boucle
   if n=nfin then break;

   //Avance le compteur
   n:=n+1;
   nrow:=nrow+1;
   if n>=NMAX_PASS+1 then n:=1;
   waitfrm.ProgBar1.Position := (waitfrm.ProgBar1.Position+10) mod 100;
 until (false);

GoTo finproc;
usberror:
 MessageDlg('Erreur usb - Débranchez & rebranchez la carte !',mtError,[mbOK],0);
finproc:
 waitfrm.Close;
end;

procedure Tmodul.MonthCal1Click(Sender: TObject);
begin
 if clegrd.Col=2 then
 clegrd.Cells[clegrd.Col,clegrd.row]:=datetostr(monthcal1.date);
end;


procedure Tmodul.cleGrdKeyPress(Sender: TObject; var Key: Char);
begin
if (clegrd.Col =2) and (key=chr(13)) then
  monthcal1.visible:=false;
end;


procedure Tmodul.FormPaint(Sender: TObject);
label
 usberror;
var
 hms, tt :string;
begin
 if not ChargerDLL then
  begin
    showmessage('MPUSBAPI.DLL est introuvable !');
    application.Terminate;
  end;

 if clegrd.cells[0,0]='No' then exit;

 //Formate les tableaux
 with clegrd do
 begin
  cells[0,0]:='No';
  cells[1,0]:='No série';
  cells[2,0]:='Date fin';
  cells[3,0]:='Identité';
  colwidths[0]:=trunc(width*0.07);
  colwidths[1]:=trunc(width*0.17);
  colwidths[2]:=trunc(width*0.17);
  colwidths[3]:=trunc(width*0.58);
 end;

 //Formate les tableaux
 with passgrd do
 begin
  cells[0,0]:='Accés';
  cells[1,0]:='Date';
  cells[2,0]:='Heure';
  cells[3,0]:='No série';
  cells[4,0]:='Identité';
  colwidths[0]:=trunc(width*0.065);
  colwidths[1]:=trunc(width*0.11);
  colwidths[2]:=trunc(width*0.09);
  colwidths[3]:=trunc(width*0.15);
  colwidths[4]:=trunc(width*0.574);
 end;

 //Lit et verifie l'heure serrure
 OutPipe := MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'),MP_WRITE,0);
 InPipe :=MPUSBOpen(0,pchar(vidpid),pchar('\MCHP_EP1'), MP_READ,0);

 //Lance l'ordre lecture heure/date
 sd[0] := $C5;

 If MPUSBWrite(outpipe, @sd, 32, @sended, 1000) = 0 Then GoTo usberror;
 If MPUSBRead(inpipe, @rec, 32, @recv, 1000) = 0 Then GoTo usberror;
 If (rec[0]<>$AA) Then GoTo usberror;

 //Ferme les pipes USB
 MPUSBClose(inpipe);
 MPUSBClose(outpipe);

 //Affiche la date
 if date<>strtodate(inttostr(rec[4])+'/'+ inttostr(rec[3])
                          +'/'+inttostr(256*rec[2]+rec[1])) then
   if MessageDlg('La date est inexacte, voulez-vous la régler ?',
       mtError,[mbYes,mbNo],0)=mRYes then
     begin
       SetClock();
       MessageDlg('Horloge réglée !', mtConfirmation,[mbOk],0);
       exit;
     end;

 //Affiche l'heure
 hms:=inttostr(rec[5])+':'+hhtostr(rec[6])+':'+hhtostr(rec[7]);
 tt:=timetostr(time);
 if tt<>hms then
   if MessageDlg('La serrure est réglée à '+hms+' pour '+tt+', voulez-vous la synchroniser ?',
       mtError,[mbYes,mbNo],0)=mRYes then
     begin
       SetClock();
       MessageDlg('Horloge réglée !', mtConfirmation,[mbOk],0);
     end;

 exit;
usberror:
 MessageDlg('Serrure introuvable, vérifiez le câble USB !',mtError,[mbOK],0);
end;

procedure Tmodul.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 application.Terminate;
end;



end.
