InraPorc

unit UFMenu;

interface

uses

  Windows, Forms, Messages, SysUtils, Variants, Classes, Graphics, Controls,

  Dialogs, StdCtrls, Buttons, PBNumEdit, DB, DBTables, mysql, LbCipher,

  DateUtils, JvComponent, JvComputerInfoEx, JvComponentBase;

type

  TFMenu = class(TForm)

    PBOrders: TPBNumEdit;

    BBOrders: TBitBtn;

    PBAjinomoto: TPBNumEdit;

    BBAjinomoto: TBitBtn;

    PBKeys: TPBNumEdit;

    BBKeys: TBitBtn;

    GBKeys: TGroupBox;

    GBOrders: TGroupBox;

    GBAjinomoto: TGroupBox;

    GBAdmin: TGroupBox;

    MLog: TMemo;

    TOrder: TTable;

    TAjinomoto: TTable;

    TLicense: TTable;

    TOrders: TTable;

    GBINRA: TGroupBox;

    BBINRA: TBitBtn;

    GBInvoices: TGroupBox;

    BBInvoices: TBitBtn;

    TInvoices: TTable;

    TINRA: TTable;

    TLicenses: TTable;

    BBAnnual: TBitBtn;

    TEducation: TTable;

    ComputerInfo: TJvComputerInfoEx;

    TAgreement: TTable;

    GBAgreement: TGroupBox;

    BBAgreement: TBitBtn;

    BBUSB: TBitBtn;

    BBManual: TBitBtn;

    LManual: TLabel;

    LUSB: TLabel;

    LAnnual: TLabel;

    EAdmin: TEdit;

    EUsername: TEdit;

    EPassword: TEdit;

    procedure FormCreate(Sender: TObject);

    procedure FormShow(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure BBOrdersClick(Sender: TObject);

    procedure BBAjinomotoClick(Sender: TObject);

    procedure BBKeysClick(Sender: TObject);

    procedure BBInvoicesClick(Sender: TObject);

    procedure BBINRAClick(Sender: TObject);

    procedure BBAnnualClick(Sender: TObject);

    procedure BBAgreementClick(Sender: TObject);

    procedure BBUSBClick(Sender: TObject);

    procedure BBManualClick(Sender: TObject);

  private

    { D?clarations priv?es }

    t: Text;

  public

    { D?clarations publiques }

    DateLimite: TDateTime;

    function MD5Str(Digest: TMD5Digest): String;

    function EducationKey(Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String;

    function CompleteKey(LicenseNumber: Integer; Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String;

  end;

var

  FMenu: TFMenu;

const

  SHARED_DRIVE = '\\pnas1.stockage.inra.fr\rennes-pegase\root';

  SHARED_FOLDER = '\SG-prj-Inraporc\Licenses\';

  SMTP_SERVER = 'smtp.inrae.fr';

  IMAP_SERVER = 'imap.inrae.fr';

  LDAP_SERVER = 'ldap-authentification.inra.fr';

  //EXCHANGE_USERNAME = 'INRA\avalancogne';

  //EXCHANGE_PASSWORD = 'Al1Messac35!';

  EXCHANGE_SHARED_MAILBOX = 'inraporc-rennes';

  MAIL_INRAPORC = 'inraporc-rennes@inrae.fr';

  MAIL_INRA_TRANSFERT_1 = 'doudja.alili@inrae.fr';

  MAIL_INRA_TRANSFERT_2 = 'franck.leguerhier@inrae.fr';

  MAIL_AJINOMOTO = 'Corrent_Etienne@eli.ajinomoto.com';

  MYSQL_HOST = 'inraporc.inrae.fr';

  MYSQL_USER = 'inraporc';

  MYSQL_PASSWD = 'jydjvmav';

  MYSQL_DB = 'inraporc';

  MYSQL_PORT = 3306;

  SCP_HOST = 'inraporc.inrae.fr';

  SCP_HOSTKEY = '64:29:24:0b:24:7b:05:e1:6a:5e:36:d3:81:47:08:f9';

  SCP_LOGIN = 'valanc';

  SCP_PASSWD = 'al1:7a!?';

  SCP_PATH = '/var/www/html/inraporc/Uploads/';

var

  con: PMYSQL;          // connection handler

  res: PMYSQL_RES;      // result

  row: PMYSQL_ROW;      // row

  que: AnsiString;      // query

  cur: Integer;         // current record

  SLOrder, SLAjinomoto, SLLicense: TStrings;

  TempFolder: String;

implementation

uses

  UFOrder, UFInvoice, UFINRA, UFAjinomoto, UFAgreement, UFKeys, UFAnnual, UFUSB,

  UFManual, UFConnect;

{$R *.dfm}

type

  WindowsString = type AnsiString(1252);

procedure TFMenu.FormCreate(Sender: TObject);

begin

  Top := Forms.Screen.WorkAreaHeight - Height;

  Left := 0;

end;

procedure TFMenu.FormShow(Sender: TObject);

begin

  AssignFile(t, SHARED_DRIVE + SHARED_FOLDER + 'Logs\Errors.log');

  if FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Logs\Errors.log')

  then

    try

      Append(t);

    except

      MessageDlg('Le fichier de log ne peut pas ?tre ouvert.' + sLineBreak + 'L''application est probablement d?j? lanc?e.', mtError, [mbOK], 0);

      Application.Terminate;

    end

  else

    try

      Rewrite(t);

    except

      MessageDlg('Le fichier de log ne peut pas ?tre cr??.' + sLineBreak + 'V?rifier les droits d''acc?s.', mtError, [mbOK], 0);

      Application.Terminate;

    end;

  FConnect := TFConnect.Create(Self);

  if FConnect.ShowModal <> mrOk then

  begin

    FConnect.Release;

    Application.Terminate;

  end;

  FConnect.Release;

  Writeln(t, '*************************');

  Writeln(t, 'BEGIN ', DateTimeToStr(Now));

  Writeln(t, 'Computer IP address is ', ComputerInfo.Identification.IPAddress);

  EUsername.Text := ComputerInfo.Identification.LocalUserName;

  Writeln(t, 'Local user name is ', EUsername.Text);

  MLog.Lines.Add('User is ' + EAdmin.Text);

  SLOrder := TStringList.Create;

  SLAjinomoto := TStringList.Create;

  SLLicense := TStringList.Create;

  MLog.Lines.Add('Opening dBase tables...');

  // Probl?me avec Windows Vista (fichier PDOXUSRS.NET)

  TLicense.DBSession.NetFileDir := SHARED_DRIVE + SHARED_FOLDER;

  TOrder.TableName := SHARED_DRIVE + SHARED_FOLDER + TOrder.TableName;

  try

    TOrder.Active := True;

  except

    MLog.Lines.Add('Table ' + TOrder.TableName + ' could not be opened !');

  end;

  TLicense.TableName := SHARED_DRIVE + SHARED_FOLDER + TLicense.TableName;

  try

    TLicense.Active := True;

  except

    MLog.Lines.Add('Table ' + TLicense.TableName + ' could not be opened !');

  end;

  TEducation.TableName := SHARED_DRIVE + SHARED_FOLDER + TEducation.TableName;

  try

    TEducation.Active := True;

  except

    MLog.Lines.Add('Table ' + TEducation.TableName + ' could not be opened !');

  end;

  TOrders.TableName := SHARED_DRIVE + SHARED_FOLDER + TOrders.TableName;

  try

    TOrders.Active := True;

  except

    MLog.Lines.Add('Table ' + TOrders.TableName + ' could not be opened !');

  end;

  TInvoices.TableName := SHARED_DRIVE + SHARED_FOLDER + TInvoices.TableName;

  try

    TInvoices.Active := True;

  except

    MLog.Lines.Add('Table ' + TInvoices.TableName + ' could not be opened !');

  end;

  TINRA.TableName := SHARED_DRIVE + SHARED_FOLDER + TINRA.TableName;

  try

    TINRA.Active := True;

  except

    MLog.Lines.Add('Table ' + TINRA.TableName + ' could not be opened !');

  end;

  TAjinomoto.TableName := SHARED_DRIVE + SHARED_FOLDER + TAjinomoto.TableName;

  try

    TAjinomoto.Active := True;

  except

    MLog.Lines.Add('Table ' + TAjinomoto.TableName + ' could not be opened !');

  end;

  TLicenses.TableName := SHARED_DRIVE + SHARED_FOLDER + TLicenses.TableName;

  try

    TLicenses.Active := True;

  except

    MLog.Lines.Add('Table ' + TLicenses.TableName + ' could not be opened !');

  end;

  TAgreement.TableName := SHARED_DRIVE + SHARED_FOLDER + TAgreement.TableName;

  try

    TAgreement.Active := True;

  except

    MLog.Lines.Add('Table ' + TAgreement.TableName + ' could not be opened !');

  end;

  // Check DLL

  libmysql_fast_load(nil);

  case libmysql_status of

    LIBMYSQL_UNDEFINED: MLog.Lines.Add('libmysql_load() has not yet been called !');

    LIBMYSQL_MISSING: MLog.Lines.Add('libmySQL.dll could not be located !');

    LIBMYSQL_INCOMPATIBLE: MLog.Lines.Add('libmySQL.dll was found but is not compatible !');

  end;

  if libmysql_status <> LIBMYSQL_READY then Exit;

  MLog.Lines.Add('Initializing connection handler...');

  con := mysql_init(nil);

  if con = nil

  then

  begin

    MLog.Lines.Add('Insufficient memory to initialize connection handler !');

    Exit;

  end;

  MLog.Lines.Add('Connecting to database...');

  if mysql_real_connect(con, MYSQL_HOST, MYSQL_USER, MYSQL_PASSWD, MYSQL_DB, MYSQL_PORT, nil, 0) = nil

  then

  begin

    MLog.Lines.Add(mysql_error(con));

    Exit;

  end;

  que := 'SELECT `Key` FROM `commandes`';

  MLog.Lines.Add(que);

  if mysql_query(con, PAnsiChar(que)) <> 0

  then

    MLog.Lines.Add(mysql_error(con))

  else

  begin

    res := mysql_use_result(con);

    if res = nil

    then

      MLog.Lines.Add(mysql_error(con))

    else

    begin

      row := mysql_fetch_row(res);

      while row <> nil do

      begin

        SLOrder.Add(row^[0]);

        row := mysql_fetch_row(res);

      end;

      mysql_free_result(res);

    end;

  end;

  PBOrders.AsInteger := SLOrder.Count;

  que := 'SELECT `Key` FROM `ajinomoto`';

  MLog.Lines.Add(que);

  if mysql_query(con, PAnsiChar(que)) <> 0

  then

    MLog.Lines.Add(mysql_error(con))

  else

  begin

    res := mysql_store_result(con);

    if res = nil

    then

      MLog.Lines.Add(mysql_error(con))

    else

    begin

      row := mysql_fetch_row(res);

      while row <> nil do

      begin

        SLAjinomoto.Add(row^[0]);

        row := mysql_fetch_row(res);

      end;

      mysql_free_result(res);

    end;

  end;

  PBAjinomoto.AsInteger := SLAjinomoto.Count;

  que := 'SELECT `Key` FROM `licences`';

  MLog.Lines.Add(que);

  if mysql_query(con, PAnsiChar(que)) <> 0

  then

    MLog.Lines.Add(mysql_error(con))

  else

  begin

    res := mysql_store_result(con);

    if res = nil

    then

      MLog.Lines.Add(mysql_error(con))

    else

    begin

      row := mysql_fetch_row(res);

      while row <> nil do

      begin

        SLLicense.Add(row^[0]);

        row := mysql_fetch_row(res);

      end;

      mysql_free_result(res);

    end;

  end;

  PBKeys.AsInteger := SLLicense.Count;

  BBOrders.Enabled := (PBOrders.AsInteger > 0) and TOrder.Active and TLicense.Active and TOrders.Active;

  BBInvoices.Enabled := TOrder.Active and TLicense.Active and TInvoices.Active;

  BBINRA.Enabled := TLicense.Active and TINRA.Active;

  BBAjinomoto.Enabled := (PBAjinomoto.AsInteger > 0) and TLicense.Active and TAjinomoto.Active;

  BBKeys.Enabled := (PBKeys.AsInteger > 0) and TLicense.Active and TOrder.Active and TEducation.Active and TLicenses.Active;

  BBAgreement.Enabled := TLicense.Active and TAgreement.Active;

  BBAnnual.Enabled := TLicense.Active;

  BBUSB.Enabled := TAjinomoto.Active and TEducation.Active;

  BBManual.Enabled := TLicense.Active;

  if MonthOf(Date) < 9

  then

    DateLimite := EndOfTheYear(Date)

  else

    DateLimite := EndOfTheYear(IncYear(Date));

  DateLimite := Trunc(DateLimite); // Suppression de la partie heure

  MLog.Lines.Add('Final date is ' + DateToStr(DateLimite));

  TempFolder := GetEnvironmentVariable('TEMP');

end;

procedure TFMenu.FormClose(Sender: TObject; var Action: TCloseAction);

var

  i: Integer;

begin

  SLOrder.Free;

  SLAjinomoto.Free;

  SLLicense.Free;

  MLog.Lines.Add('Closing server connection...');

  if con <> nil then mysql_close(con);

  MLog.Lines.Add('Closing dBase tables...');

  TOrder.Active := False;

  TLicense.Active := False;

  TEducation.Active := False;

  TOrders.Active := False;

  TInvoices.Active := False;

  TINRA.Active := False;

  TAjinomoto.Active := False;

  TLicenses.Active := False;

  TAgreement.Active := False;

  for i := 0 to MLog.Lines.Count - 1 do

    Writeln(t, MLog.Lines[i]);

  Writeln(t, 'END   ', DateTimeToStr(Now));

  Flush(t);

  CloseFile(t);

end;

procedure TFMenu.BBOrdersClick(Sender: TObject);

begin // Type 0

  cur := 0;

  FOrder := TFOrder.Create(Self);

  if FOrder.GetRequest

  then

    FOrder.ShowModal;

  FOrder.Release;

  BBOrders.Enabled := PBOrders.AsInteger > 0;

end;

procedure TFMenu.BBInvoicesClick(Sender: TObject);

begin

  FInvoice := TFInvoice.Create(Self);

  FInvoice.ShowModal;

  FInvoice.Release;

end;

procedure TFMenu.BBINRAClick(Sender: TObject);

begin // Type 1

  FINRA := TFINRA.Create(Self);

  FINRA.ShowModal;

  FINRA.Release;

end;

procedure TFMenu.BBAjinomotoClick(Sender: TObject);

begin // Type 2

  cur := 0;

  FAjinomoto := TFAjinomoto.Create(Self);

  if FAjinomoto.GetRequest

  then

    FAjinomoto.ShowModal;

  FAjinomoto.Release;

  BBAjinomoto.Enabled := PBAjinomoto.AsInteger > 0;

end;

procedure TFMenu.BBAgreementClick(Sender: TObject);

begin

  FAgreement := TFAgreement.Create(Self);

  FAgreement.ShowModal;

  FAgreement.Release;

end;

procedure TFMenu.BBKeysClick(Sender: TObject);

begin

  cur := 0;

  FKeys := TFKeys.Create(Self);

  if FKeys.GetRequest

  then

    FKeys.ShowModal;

  FKeys.Release;

  BBKeys.Enabled := PBKeys.AsInteger > 0;

end;

procedure TFMenu.BBManualClick(Sender: TObject);

begin

  FManual := TFManual.Create(Self);

  FManual.ShowModal;

  FManual.Release;

end;

procedure TFMenu.BBUSBClick(Sender: TObject);

begin

  FUSB := TFUSB.Create(Self);

  FUSB.ShowModal;

  FUSB.Release;

end;

procedure TFMenu.BBAnnualClick(Sender: TObject);

begin

  FAnnual := TFAnnual.Create(Self);

  FAnnual.ShowModal;

  FAnnual.Release;

end;

function TFMenu.MD5Str(Digest: TMD5Digest): String;

var

        i: Byte;

  sb: TStringBuilder;

const

        Digits: array[0..15] of Char =

                ('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F');

begin

  sb := TStringBuilder.Create;

  for i := 0 to 15 do

    sb.Append(Digits[(Digest[I] shr 4) and $0f]).Append(Digits[Digest[I] and $0f]);

  sb.Insert(24, '-').Insert(16, '-').Insert(8, '-');

  Result := sb.ToString;

  FreeAndNil(sb);

end;

function TFMenu.EducationKey(Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String;

var

  sb: TStringBuilder;

  Digest: TMD5Digest;

begin

  sb := TStringBuilder.Create;

  sb.Append(Format('InraPorc version %s : ', [Version[1]]));

  sb.Append('licence limit?e ? l''?ducation ');

  sb.Append(Format('sur le volume %s ', [VolumeSerialNumber]));

  sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));

  sb.Append(Format('valable jusqu''au %s', [FinalDate]));

  StringHashMD5(Digest, WindowsString(sb.ToString));

  FreeAndNil(sb);

  Result := MD5Str(Digest);

end;

function TFMenu.CompleteKey(LicenseNumber: Integer; Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String;

var

  sb: TStringBuilder;

  Digest: TMD5Digest;

begin

  sb := TStringBuilder.Create;

  sb.Append(Format('InraPorc version %s : ', [Version[1]]));

  sb.Append(Format('licence num?ro %d ', [LicenseNumber]));

  sb.Append(Format('sur le volume %s ', [VolumeSerialNumber]));

  sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));

  sb.Append(Format('valable jusqu''au %s', [FinalDate]));

  StringHashMD5(Digest, WindowsString(sb.ToString));

  FreeAndNil(sb);

  Result := MD5Str(Digest);

end;

end.