Statistiques
| Révision:

root / LicensesMercure / UFAgreement.pas @ 1

Historique | Voir | Annoter | Télécharger (8,851 ko)

1
unit UFAgreement;
2

    
3
interface
4

    
5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
    Dialogs, StdCtrls, Buttons, IdMessage, IdBaseComponent, IdComponent,
8
    IdTCPConnection, IdTCPClient, IdMessageClient, IdAttachmentFile, IdSMTP,
9
    IniFiles, DateUtils, IdExplicitTLSClientServerBase, IdSMTPBase, IdIMAP4,
10
  IdIOHandler, IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL;
11

    
12
type
13
  TFAgreement = class(TForm)
14
    MObservations: TMemo;
15
    CBLicenseNumber: TComboBox;
16
    BBNext: TBitBtn;
17
    LFirstName: TLabel;
18
    LLastName: TLabel;
19
    LCompany: TLabel;
20
    EFirstName: TEdit;
21
    ELastName: TEdit;
22
    ECompany: TEdit;
23
    LLicenseNumber: TLabel;
24
    SMTP: TIdSMTP;
25
    MKey: TIdMessage;
26
    IMAP4: TIdIMAP4;
27
    OpenSSL_IMAP4: TIdSSLIOHandlerSocketOpenSSL;
28
    OpenSSL_SMTP: TIdSSLIOHandlerSocketOpenSSL;
29
    procedure FormCreate(Sender: TObject);
30
    procedure FormShow(Sender: TObject);
31
    procedure CBLicenseNumberChange(Sender: TObject);
32
    procedure BBNextClick(Sender: TObject);
33
  private
34
    { D?clarations priv?es }
35
    procedure ClearAgreement;
36
  public
37
    { D?clarations publiques }
38
  end;
39

    
40
var
41
  FAgreement: TFAgreement;
42

    
43
implementation
44

    
45
uses
46
  UFMenu;
47

    
48
{$R *.dfm}
49

    
50
procedure TFAgreement.FormCreate(Sender: TObject);
51
begin
52
  Top := 0;
53
  Left := 0;
54
  with IMAP4 do
55
  begin
56
    Host := IMAP_SERVER;
57
//    Username := EXCHANGE_USERNAME + '\' + EXCHANGE_SHARED_MAILBOX;
58
    Username := 'INRA\' + FMenu.EUsername.Text + '\' + EXCHANGE_SHARED_MAILBOX;
59
//    Password := EXCHANGE_PASSWORD;
60
    Password := FMenu.EPassword.Text;
61
  end;
62
  with SMTP do
63
  begin
64
    Host := SMTP_SERVER;
65
//    Username := EXCHANGE_USERNAME;
66
    Username := 'INRA\' + FMenu.EUsername.Text;
67
//    Password := EXCHANGE_PASSWORD;
68
    Password := FMenu.EPassword.Text;
69
  end;
70
end;
71

    
72
procedure TFAgreement.FormShow(Sender: TObject);
73
begin
74
  CBLicenseNumber.Clear;
75
  with FMenu.TLicense do
76
  begin
77
    First;
78
    while not Eof do
79
    begin
80
      if (FieldByName('Validity').AsBoolean = False)
81
      then
82
        CBLicenseNumber.Items.Add(FieldByName('LicenseNumber').AsString);
83
      Next;
84
    end;
85
  end;
86
  ClearAgreement;
87
end;
88

    
89
procedure TFAgreement.CBLicenseNumberChange(Sender: TObject);
90
begin
91
  if CBLicenseNumber.ItemIndex = -1 then Exit;
92
  with FMenu.TLicense do
93
  begin
94
    FindKey([CBLicenseNumber.Text]);
95
    EFirstName.Text := FieldByName('FirstName').AsString;
96
    ELastName.Text := FieldByName('LastName').AsString;
97
    ECompany.Text := FieldByName('Company').AsString;
98
  end;
99
  BBNext.Enabled := True;
100
end;
101

    
102
procedure TFAgreement.BBNextClick(Sender: TObject);
103
var
104
  f: TIniFile;
105
  StrMessage: TStrings;
106
begin
107
  FMenu.MLog.Lines.Add('Updating license...');
108
  with FMenu.TLicense do
109
  begin
110
    FindKey([CBLicenseNumber.Text]);
111
    Edit;
112
    FieldByName('Validity').AsBoolean := True;
113
    if not FieldByName('Mail').IsNull
114
    and (FieldByName('FinalDate').AsDateTime < FMenu.DateLimite)
115
    then // Envoyer une cl? de licence
116
    begin
117
      FieldByName('FinalDate').AsDateTime := FMenu.DateLimite;
118
      FieldByName('SoftwareEnableKey').AsString := FMenu.CompleteKey(FieldByName('LicenseNumber').AsInteger, FieldByName('Version').AsString, FieldByName('FirstName').AsString, FieldByName('LastName').AsString, FieldByName('Company').AsString, FieldByName('VolumeSerialNumber').AsString, DateToStr(FMenu.DateLimite));
119
      try
120
        f := TIniFile.Create(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic');
121
        f.WriteInteger ('License', 'LicenseType', 2);
122
        f.WriteInteger ('License', 'LicenseNumber', FieldByName('LicenseNumber').AsInteger) ;
123
        f.WriteString ('License', 'Version', FieldByName('Version').AsString);
124
        f.WriteString ('License', 'FirstName', FieldByName('FirstName').AsString);
125
        f.WriteString ('License', 'LastName', FieldByName('LastName').AsString);
126
        f.WriteString ('License', 'Company', FieldByName('Company').AsString);
127
        f.WriteString ('License', 'Address1', FieldByName('Address1').AsString);
128
        f.WriteString ('License', 'Address2', FieldByName('Address2').AsString);
129
        f.WriteString ('License', 'PostalCode', FieldByName('PostalCode').AsString);
130
        f.WriteString ('License', 'City', FieldByName('City').AsString);
131
        f.WriteString ('License', 'Country', FieldByName('Country').AsString);
132
        f.WriteString ('License', 'Phone', FieldByName('Phone').AsString);
133
        f.WriteString ('License', 'Fax', FieldByName('Fax').AsString);
134
        f.WriteString ('License', 'Mail', FieldByName('Mail').AsString);
135
        f.WriteString ('License', 'VolumeSerialNumber', FieldByName('VolumeSerialNumber').AsString);
136
        f.WriteString ('License', 'FinalDate', DateToStr(FieldByName('FinalDate').AsDateTime));
137
        f.WriteString ('License', 'SoftwareEnableKey', FieldByName('SoftwareEnableKey').AsString);
138
        f.Free;
139
        FMenu.MLog.Lines.Add('Mailing to ' + FieldByName('Mail').AsString + '...');
140
        with MKey do
141
        begin
142
          Body.Clear;
143
          MessageParts.Clear;
144
          From.Name := 'InraPorc';
145
          From.Address := MAIL_INRAPORC;
146
          Recipients.EMailAddresses := FieldByName('Mail').AsString;
147
          StrMessage := TStringList.Create;
148
          if FieldByName('Language').AsString = 'FR'
149
          then // R?ponse (fran?ais)
150
          begin
151
            Subject := Format('[InraPorc] Cl? d''activation pour licence num?ro %d', [FieldByName('LicenseNumber').AsInteger]);
152
            StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Contrat_FR.txt');
153
            Body.AddStrings(StrMessage);
154
            Body.Add(Format('La cl? d''activation est valable jusqu''au %s.', [DateToStr(FieldByName('FinalDate').AsDateTime)]));
155
            Body.Add('Un nouveau fichier de licence vous sera automatiquement envoy? avant la date d''expiration.');
156
            Body.Add('');
157
            StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_FR.txt');
158
            Body.AddStrings(StrMessage);
159
          end
160
          else // Reply (english)
161
          begin
162
            Subject := Format('[InraPorc] Software enable key for license number %d', [FieldByName('LicenseNumber').AsInteger]);
163
            StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Contrat_EN.txt');
164
            Body.AddStrings(StrMessage);
165
            Body.Add(Format('The license activation key is valid until %s.', [DateToStr(FieldByName('FinalDate').AsDateTime)]));
166
            Body.Add('You will automatically receive a new license file before the expiration date.');
167
            Body.Add('');
168
            StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_EN.txt');
169
            Body.AddStrings(StrMessage);
170
          end;
171
          StrMessage.Free;
172
          if FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic')
173
          then
174
            TIdAttachmentFile.Create(MessageParts, SHARED_DRIVE + SHARED_FOLDER + '\Fichiers\InraPorc.lic')
175
          else
176
            FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic could not be attached !');
177
        end;
178
        FMenu.MLog.Lines.Add('SMTP...');
179
        try
180
          SMTP.Connect;
181
          try
182
            SMTP.Send(MKey);
183
          finally
184
            SMTP.Disconnect;
185
            if IMAP4.Connect
186
            then
187
              try
188
                if not IMAP4.AppendMsg('?l?ments envoy?s', MKey, MKey.LastGeneratedHeaders)
189
                then
190
                  FMenu.MLog.Lines.Add('Message could not be copied in IMAP server !');
191
              finally
192
                IMAP4.Disconnect;
193
              end
194
            else
195
              FMenu.MLog.Lines.Add('IMAP server could not be connected !');
196
          end;
197
        except
198
          FMenu.MLog.Lines.Add('Message could not be sent !');
199
        end;
200
        if not DeleteFile(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic')
201
        then
202
          FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic could not be deleted !');
203
      except
204
        FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic could not be created !');
205
      end;
206
    end;
207
    Post;
208
  end;
209
  FMenu.MLog.Lines.Add('Logging record...');
210
  with FMenu.TAgreement do
211
  begin
212
    Append;
213
    FieldByName('Date').AsDateTime := Now;
214
    FieldByName('Admin').AsString := FMenu.EAdmin.Text;
215
    FieldByName('LicenseNumber').AsString := CBLicenseNumber.Text;
216
    FieldByName('Observations').AsString := MObservations.Text;
217
    Post;
218
  end;
219
  CBLicenseNumber.DeleteSelected;
220
  ClearAgreement;
221
end;
222

    
223
procedure TFAgreement.ClearAgreement;
224
begin
225
  BBNext.Enabled := False;
226
  CBLicenseNumber.Hint := Format('%d contrats en attente', [CBLicenseNumber.Items.Count]);
227
  CBLicenseNumber.ItemIndex := -1;
228
  EFirstName.Text := '';
229
  ELastName.Text := '';
230
  ECompany.Text := '';
231
  MObservations.Clear;
232
  ActiveControl := CBLicenseNumber;
233
end;
234

    
235
end.