InraPorc

unit UFOrder;

interface

uses

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

  Dialogs, StdCtrls, Buttons, PBNumEdit, IdBaseComponent, IdComponent,

  IdTCPConnection, IdTCPClient, IdFTP, ShellAPI, IdMessage, IdMessageClient,

  IdAttachmentFile, IdSMTP, IdSMTPBase, IdExplicitTLSClientServerBase,

  ExtCtrls, mysql, IdIMAP4, IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack,

  IdSSL, IdSSLOpenSSL, WinInet;

type

  TFOrder = class(TForm)

    EKey: TEdit;

    BBSkip: TBitBtn;

    BBProcess: TBitBtn;

    BBRemove: TBitBtn;

    EContact: TEdit;

    LContact: TLabel;

    EMail: TEdit;

    LMail: TLabel;

    ECompany: TEdit;

    LCompany: TLabel;

    LPostalCode: TLabel;

    LCity: TLabel;

    LCountry: TLabel;

    EPostalCode: TEdit;

    ECity: TEdit;

    ECountry: TEdit;

    GBAddress: TGroupBox;

    EOrderNumber: TEdit;

    LOrderNumber: TLabel;

    BBOrderFile: TBitBtn;

    LWarning: TLabel;

    LLicenses: TLabel;

    EFirstName1: TEdit;

    LFirstName: TLabel;

    ELastName1: TEdit;

    LLastName: TLabel;

    LLicenseNumber: TLabel;

    EFirstName2: TEdit;

    ELastName2: TEdit;

    EFirstName3: TEdit;

    ELastName3: TEdit;

    EFirstName4: TEdit;

    ELastName4: TEdit;

    EFirstName5: TEdit;

    ELastName5: TEdit;

    PBLicenses: TPBNumEdit;

    PBLicenseNumber1: TPBNumEdit;

    PBLicenseNumber2: TPBNumEdit;

    PBLicenseNumber3: TPBNumEdit;

    PBLicenseNumber4: TPBNumEdit;

    PBLicenseNumber5: TPBNumEdit;

    SMTP: TIdSMTP;

    MInraTransfert: TIdMessage;

    MObservations: TMemo;

    MAcknowledgement: TIdMessage;

    PLicenses: TPanel;

    EAddress1: TEdit;

    EAddress2: TEdit;

    PLicense1: TPanel;

    PLicense2: TPanel;

    PLicense3: TPanel;

    PLicense4: TPanel;

    PLicense5: TPanel;

    PLicense6: TPanel;

    EFirstName6: TEdit;

    ELastName6: TEdit;

    PBLicenseNumber6: TPBNumEdit;

    PLicense7: TPanel;

    EFirstName7: TEdit;

    ELastName7: TEdit;

    PBLicenseNumber7: TPBNumEdit;

    PLicense8: TPanel;

    EFirstName8: TEdit;

    ELastName8: TEdit;

    PBLicenseNumber8: TPBNumEdit;

    PLicense9: TPanel;

    EFirstName9: TEdit;

    ELastName9: TEdit;

    PBLicenseNumber9: TPBNumEdit;

    PLicense10: TPanel;

    EFirstName10: TEdit;

    ELastName10: TEdit;

    PBLicenseNumber10: TPBNumEdit;

    EVAT: TEdit;

    IMAP4: TIdIMAP4;

    OpenSSL_IMAP4: TIdSSLIOHandlerSocketOpenSSL;

    OpenSSL_SMTP: TIdSSLIOHandlerSocketOpenSSL;

    procedure FormShow(Sender: TObject);

    procedure BBSkipClick(Sender: TObject);

    procedure BBProcessClick(Sender: TObject);

    procedure BBRemoveClick(Sender: TObject);

    procedure BBOrderFileClick(Sender: TObject);

    procedure FormCreate(Sender: TObject);

  private

    { D?clarations priv?es }

    Key: String;

    Language: String;

    Contact, Mail, Company, VAT: String;

    Address1, Address2, PostalCode, City, Country: String;

    OrderNumber, OrderFile: String;

    Licenses: Integer;

    FirstName, LastName: array[1..10] of String;

    Observations: String;

    procedure DisplayRequest;

  public

    { D?clarations publiques }

    function GetRequest: Boolean;

  end;

var

  FOrder: TFOrder;

implementation

uses

  UFMenu;

{$R *.dfm}

procedure TFOrder.FormCreate(Sender: TObject);

begin

  Top := 0;

  Left := 0;

  with IMAP4 do

  begin

    Host := IMAP_SERVER;

//    Username := EXCHANGE_USERNAME + '\' + EXCHANGE_SHARED_MAILBOX;

    Username := 'INRA\' + FMenu.EUsername.Text + '\' + EXCHANGE_SHARED_MAILBOX;

//    Password := EXCHANGE_PASSWORD;

    Password := FMenu.EPassword.Text;

  end;

  with SMTP do

  begin

    Host := SMTP_SERVER;

//    Username := EXCHANGE_USERNAME;

    Username := 'INRA\' + FMenu.EUsername.Text;

//    Password := EXCHANGE_PASSWORD;

    Password := FMenu.EPassword.Text;

  end;

end;

procedure TFOrder.FormShow(Sender: TObject);

begin

  DisplayRequest;

end;

procedure TFOrder.BBSkipClick(Sender: TObject);

begin

  Inc(cur);

  if (cur < SLOrder.Count) and GetRequest

  then

    DisplayRequest

  else

    Close;

end;

procedure TFOrder.BBProcessClick(Sender: TObject);

var

  i: Integer;

  p: TPanel;

  StrMessage: TStrings;

begin

  FMenu.MLog.Lines.Add('Recording order...');

  with FMenu.TOrder do

  begin

    Insert;

    FieldByName('Key').AsString := Key;

    FieldByName('Language').AsString := Language;

    FieldByName('Contact').AsString := EContact.Text;

    FieldByName('Mail').AsString := EMail.Text;

    FieldByName('Company').AsString := ECompany.Text;

    FieldByName('VAT').AsString := EVAT.Text;

    FieldByName('Address1').AsString := EAddress1.Text;

    FieldByName('Address2').AsString := EAddress2.Text;

    FieldByName('PostalCode').AsString := EPostalCode.Text;

    FieldByName('City').AsString := ECity.Text;

    FieldByName('Country').AsString := ECountry.Text;

    FieldByName('OrderNumber').AsString := EOrderNumber.Text;

    FieldByName('OrderFile').AsString := OrderFile;

    FieldByName('Licenses').AsInteger := PBLicenses.AsInteger;

    Post;

  end;

  FMenu.MLog.Lines.Add('Recording licenses (type 0)...');

  for i := 1 to PBLicenses.AsInteger do

    with FMenu.TLicense do

    begin

      Insert;

      FieldByName('Validity').AsBoolean := False;

      FieldByName('Type').AsInteger := 0;

      FieldByName('Source').AsString := Key;

      p := PLicenses.Controls[i + 2] as TPanel;

      FieldByName('LicenseNumber').AsInteger := (p.Controls[2] as TPBNumEdit).AsInteger;

      FieldByName('FirstName').AsString := (p.Controls[0] as TEdit).Text;

      FieldByName('LastName').AsString := (p.Controls[1] as TEdit).Text;

      FieldByName('Company').AsString := ECompany.Text;

      FieldByName('FinalDate').AsDateTime := IncMonth(Date, 2);

      Post;

    end;

  FMenu.MLog.Lines.Add('Mailing to ' + MAIL_INRA_TRANSFERT_1 + '...');

  with MInraTransfert do

  begin

    Body.Clear;

    MessageParts.Clear;

    From.Name := 'InraPorc';

    From.Address := MAIL_INRAPORC;

    Recipients.EMailAddresses := MAIL_INRA_TRANSFERT_1;

    CCList.EMailAddresses := MAIL_INRA_TRANSFERT_2;

    Body.Add(Format('Commande num?ro "%s" portant sur %d licence(s)', [Key, PBLicenses.AsInteger]));

    Body.Add('');

    Body.Add(EContact.Text);

    if Length(ECompany.Text) > 0

    then

      if Length(EVAT.Text) > 0

      then

        Body.Add(Format ('%s (%s)', [ECompany.Text, EVAT.Text]))

      else

        Body.Add(ECompany.Text);

    if Length(EAddress1.Text) > 0

    then

      Body.Add(EAddress1.Text);

    if Length(EAddress2.Text) > 0

    then

      Body.Add(EAddress2.Text);

    Body.Add(Format('%s %s', [EPostalCode.Text, ECity.Text]));

    Body.Add(ECountry.Text);

    Body.Add('');

    Body.Add(EMail.Text);

    if Length(EOrderNumber.Text) > 0

    then

    begin

      Body.Add('');

      Body.Add(Format('N? commande client : %s', [EOrderNumber.Text]));

    end;

    if (Length(OrderFile) > 0) and FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\' + OrderFile)

    then

    begin

      ContentType := 'multipart/mixed';

      TIdAttachmentFile.Create(MessageParts, SHARED_DRIVE + SHARED_FOLDER + '\Fichiers\' + OrderFile);

    end;

    Body.Add('');

    Body.Add('Les num?ros de licence suivants ont ?t? attribu?s :');

    for i := 1 to PBLicenses.AsInteger do

    begin

      p := PLicenses.Controls[i + 2] as TPanel;

      Body.Add(Format('%d : %s %s', [(p.Controls[2] as TPBNumEdit).AsInteger, (p.Controls[0] as TEdit).Text, (p.Controls[1] as TEdit).Text]));

    end;

    if Length(MObservations.Text) > 0

    then

    begin

      Body.Add('');

      Body.Add('OBSERVATIONS');

      Body.Add('------------');

      Body.Add(MObservations.Text);

    end;

    Body.Add('');

    Body.Add('Cordialement');

    Body.Add('--');

    Body.Add(FMenu.EAdmin.Text);

  end;

  FMenu.MLog.Lines.Add('Mailing to ' + EMail.Text + '...');

  with MAcknowledgement do

  begin

    Body.Clear;

    From.Name := 'InraPorc';

    From.Address := MAIL_INRAPORC;

    Recipients.EMailAddresses := EMail.Text;

    StrMessage := TStringList.Create;

    if Language = 'FR'

    then // Accus? de r?ception (fran?ais)

    begin

      Subject := '[InraPorc] Confirmation de commande';

      Body.Add(Format('Votre bon de commande pour %d licence(s) d''InraPorc a ?t? enregistr?e sous le num?ro "%s".', [PBLicenses.AsInteger, Key]));

      Body.Add('Votre demande a ?t? transf?r?e ? Inra Transfert, qui vous enverra la facture.');

      Body.Add('');

      Body.Add('Les num?ros de licence suivants ont ?t? attribu?s :');

      for i := 1 to PBLicenses.AsInteger do

      begin

        p := PLicenses.Controls[i + 2] as TPanel;

        Body.Add(Format('%d : %s %s', [(p.Controls[2] as TPBNumEdit).AsInteger, (p.Controls[0] as TEdit).Text, (p.Controls[1] as TEdit).Text]));

      end;

      Body.Add('');

      StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Commande_FR.txt');

      Body.AddStrings(StrMessage);

      Body.Add('');

      StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_FR.txt');

      Body.AddStrings(StrMessage);

    end

    else // Acknowledgement (english)

    begin

      Subject := '[InraPorc] Order confirmation';

      Body.Add(Format('Your purchase order for %d license(s) of InraPorc has been registered as number "%s".', [PBLicenses.AsInteger, Key]));

      Body.Add('Your request has been forwarded to Inra Transfert, who will send you an invoice.');

      Body.Add('');

      Body.Add('The following license numbers have been assigned:');

      for i := 1 to PBLicenses.AsInteger do

      begin

        p := PLicenses.Controls[i + 2] as TPanel;

        Body.Add(Format('%d: %s %s', [(p.Controls[2] as TPBNumEdit).AsInteger, (p.Controls[0] as TEdit).Text, (p.Controls[1] as TEdit).Text]));

      end;

      Body.Add('');

      StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Commande_EN.txt');

      Body.AddStrings(StrMessage);

      Body.Add('');

      StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_EN.txt');

      Body.AddStrings(StrMessage);

    end;

    StrMessage.Free;

  end;

  FMenu.MLog.Lines.Add('SMTP...');

  try

    SMTP.Connect;

    try

      SMTP.Send(MInraTransfert);

      SMTP.Send(MAcknowledgement);

    finally

      SMTP.Disconnect;

      if IMAP4.Connect

      then

        try

          if not IMAP4.AppendMsg('?l?ments envoy?s', MInraTransfert, MInraTransfert.LastGeneratedHeaders)

          or not IMAP4.AppendMsg('?l?ments envoy?s', MAcknowledgement, MAcknowledgement.LastGeneratedHeaders)

          then

            FMenu.MLog.Lines.Add('Message could not be copied in IMAP server !');

        finally

          IMAP4.Disconnect;

        end

      else

        FMenu.MLog.Lines.Add('IMAP server could not be connected !');

    end;

  except

    FMenu.MLog.Lines.Add('Messages could not be sent !');

  end;

  BBRemoveClick(nil);

end;

procedure TFOrder.BBRemoveClick(Sender: TObject);

var

  i: Integer;

begin

  FMenu.MLog.Lines.Add('Logging record...');

  with FMenu.TOrders do

  begin

    Append;

    FieldByName('Date').AsDateTime := Now;

    FieldByName('Admin').AsString := FMenu.EAdmin.Text;

    FieldByName('Key').AsString := Key;

    FieldByName('Language').AsString := Language;

    FieldByName('Contact').AsString := Contact;

    FieldByName('Mail').AsString := Mail;

    FieldByName('Company').AsString := Company;

    FieldByName('VAT').AsString := VAT;

    FieldByName('Address1').AsString := Address1;

    FieldByName('Address2').AsString := Address2;

    FieldByName('PostalCode').AsString := PostalCode;

    FieldByName('City').AsString := City;

    FieldByName('Country').AsString := Country;

    FieldByName('OrderNumber').AsString := OrderNumber;

    FieldByName('OrderFile').AsString := OrderFile;

    FieldByName('Licenses').AsInteger := Licenses;

    for i := 1 to 10 do

    begin

      FieldByName(Format('FirstName%d', [i])).AsString := FirstName[i];

      FieldByName(Format('LastName%d', [i])).AsString := LastName[i];

    end;

    FieldByName('Observations').AsVariant := Observations;

    Post;

  end;

  que := 'DELETE FROM `commandes` where `Key` = ''' + SLOrder[cur] + '''';

  FMenu.MLog.Lines.Add(que);

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

  then

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

  else

  begin

    SLOrder.Delete(cur);

    FMenu.PBOrders.AsInteger := FMenu.PBOrders.AsInteger - 1;

    Dec(cur);

  end;

  BBSkipClick(nil);

end;

procedure TFOrder.BBOrderFileClick(Sender: TObject);

begin

  if ShellExecute(Handle, 'open', PChar(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\' + OrderFile), nil, nil, SW_SHOW) <= 32

  then

    FMenu.MLog.Lines.Add(SysErrorMessage(GetLastError));

end;

function TFOrder.GetRequest: Boolean;

var

  i: Integer;

begin

  Result := False;

  que := 'SELECT * FROM `commandes` where `Key` = ''' + SLOrder[cur] + '''';

  FMenu.MLog.Lines.Add(que);

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

  then

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

  else

  begin

    res := mysql_store_result(con);

    if res = nil

    then

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

    else

    begin

      row := mysql_fetch_row(res);

      if row = nil

      then

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

      else

      begin

        Key := row^[0];

        Language := row^[1];

        Contact := row^[2];

        Mail := row^[3];

        Company := row^[4];

        VAT := row^[5];

        Address1 := row^[6];

        Address2 := row^[7];

        PostalCode := row^[8];

        City := row^[9];

        Country := row^[10];

        OrderNumber := row^[11];

        OrderFile := row^[12];

        Licenses := StrToInt(row^[13]);

        for i := 1 to 10 do

        begin

          FirstName[i] := row^[2*i+12];

          LastName[i] := row^[2*i+13];

        end;

        Observations := row^[34];

        Result := True;

      end;

      mysql_free_result(res);

    end;

  end;

end;

procedure TFOrder.DisplayRequest;

const

  ReadBuffer = 1024;

var

  Command: String;

  Security: TSecurityAttributes;

  ReadPipe, WritePipe: THandle;

  Start: TStartUpInfo;

  ProcessInfo: TProcessInformation;

  Buffer: PAnsiChar;

  BytesRead: DWord;

  Apprunning: DWord;

  i: Integer;

  p: TPanel;

begin

  EKey.Text := Key;

  EContact.Text := Contact;

  EMail.Text := Mail;

  ECompany.Text := Company;

  EVAT.Text := VAT;

  EAddress1.Text := Address1;

  EAddress2.Text := Address2;

  EPostalCode.Text := PostalCode;

  ECity.Text := City;

  ECountry.Text := Country;

  EOrderNumber.Text := OrderNumber;

  BBOrderFile.Enabled := Length(OrderFile) > 0;

  BBOrderFile.Hint := Format('Afficher le bon de commande joint (%s)', [OrderFile]);

  if (Length(OrderFile) > 0) and not FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\' + OrderFile)

  then

    try

      FMenu.MLog.Lines.Add('SCP ' + SCP_HOST + '...');

      Security.nLength := SizeOf(TSecurityAttributes);

      Security.bInheritHandle := true;

      Security.lpSecurityDescriptor := nil;

      if Createpipe (ReadPipe, WritePipe, @Security, 0)

      then

      begin

        Buffer := AllocMem(ReadBuffer + 1);

        FillChar(Start, Sizeof(Start), #0);

        Start.cb := SizeOf(Start);

        Start.hStdOutput := WritePipe;

        Start.hStdInput := ReadPipe;

        Start.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;

        Start.wShowWindow := SW_HIDE;

        Command := 'pscp.exe -batch -hostkey ' + SCP_HOSTKEY + ' -pw ' + SCP_PASSWD + ' ' + SCP_LOGIN + '@' + SCP_HOST + ':' + SCP_PATH + OrderFile + ' ' + SHARED_DRIVE + SHARED_FOLDER + 'Fichiers';

        if CreateProcess(nil, PChar(Command), @Security, @Security, true, NORMAL_PRIORITY_CLASS, nil, nil, Start, ProcessInfo)

        then

        begin

          repeat

            Apprunning := WaitForSingleObject(ProcessInfo.hProcess, 100);

            Application.ProcessMessages;

          until (Apprunning <> WAIT_TIMEOUT);

          repeat

            BytesRead := 0;

            ReadFile(ReadPipe,Buffer[0], ReadBuffer, BytesRead, nil);

            Buffer[BytesRead] := #0;

            OemToAnsi(Buffer, Buffer);

            FMenu.MLog.Text := FMenu.MLog.text + String(Buffer);

          until (BytesRead < ReadBuffer);

        end;

        FreeMem(Buffer);

        CloseHandle(ProcessInfo.hProcess);

        CloseHandle(ProcessInfo.hThread);

        CloseHandle(ReadPipe);

        CloseHandle(WritePipe);

      end;

    except

      FMenu.MLog.Lines.Add('File ' + OrderFile + ' could not be got !');

    end;

  PBLicenses.AsInteger := Licenses;

  for i := 1 to 10 do

  begin

    p := PLicenses.Controls[i + 2] as TPanel;

    p.Visible := i <= Licenses;

    (p.Controls[0] as TEdit).Text := FirstName[i];

    (p.Controls[1] as TEdit).Text := LastName[i];

    (p.Controls[2] as TPBNumEdit).AsInteger := FMenu.TLicense.RecordCount + i;

  end;

  MObservations.Text := Observations;

end;

end.