Statistiques
| Révision:

root / LicensesMercure / UFInvoice.pas

Historique | Voir | Annoter | Télécharger (9,449 ko)

1 1 avalancogn
unit UFInvoice;
2
3
interface
4
5
uses
6
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7
    Dialogs, StdCtrls, PBNumEdit, Buttons, ComCtrls, IniFiles, IdMessage,
8
    IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
9
    IdMessageClient, IdAttachmentFile, IdSMTP, DateUtils,
10
    IdExplicitTLSClientServerBase, IdSMTPBase, IdIMAP4, IdIOHandler,
11
  IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL;
12
13
type
14
  TFInvoice = class(TForm)
15
    CBOrder: TComboBox;
16
    LOrder: TLabel;
17
    LPayment: TLabel;
18
    DTPPayment: TDateTimePicker;
19
    BBNext: TBitBtn;
20
    LLicenses: TLabel;
21
    PBLicenses: TPBNumEdit;
22
    MObservations: TMemo;
23
    SMTP: TIdSMTP;
24
    MKey: TIdMessage;
25
    IMAP4: TIdIMAP4;
26
    OpenSSL_IMAP4: TIdSSLIOHandlerSocketOpenSSL;
27
    OpenSSL_SMTP: TIdSSLIOHandlerSocketOpenSSL;
28
    procedure CBOrderChange(Sender: TObject);
29
    procedure BBNextClick(Sender: TObject);
30
    procedure FormShow(Sender: TObject);
31
    procedure FormCreate(Sender: TObject);
32
  private
33
    { D?clarations priv?es }
34
    procedure ClearInvoice;
35
  public
36
    { D?clarations publiques }
37
  end;
38
39
var
40
  FInvoice: TFInvoice;
41
42
implementation
43
44
uses
45
  UFMenu;
46
47
{$R *.dfm}
48
49
procedure TFInvoice.FormCreate(Sender: TObject);
50
begin
51
  Top := 0;
52
  Left := 0;
53
  DTPPayment.DateTime := Now;
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 TFInvoice.FormShow(Sender: TObject);
73
begin
74
  CBOrder.Clear;
75
  with FMenu.TOrder do
76
  begin
77
    First;
78
    while not Eof do
79
    begin
80
      if FieldByName('Payment').IsNull
81
      then
82
        CBOrder.Items.Add(FieldByName('Key').AsString);
83
      Next;
84
    end;
85
  end;
86
  ClearInvoice;
87
end;
88
89
procedure TFInvoice.CBOrderChange(Sender: TObject);
90
begin
91
  if CBOrder.ItemIndex = -1 then Exit;
92
  with FMenu.TOrder do
93
    if FindKey([CBOrder.Text])
94
    then
95
    begin
96
      PBLicenses.AsInteger := FieldByName('Licenses').AsInteger;
97
      BBNext.Enabled := PBLicenses.AsInteger > 0;
98
      ActiveControl := DTPPayment;
99
    end;
100
end;
101
102
procedure TFInvoice.BBNextClick(Sender: TObject);
103
var
104
  n: Integer;
105
  f: TIniFile;
106
  StrMessage: TStrings;
107
begin
108
  FMenu.MLog.Lines.Add('Updating order...');
109
  with FMenu.TOrder do
110
  begin
111
    Edit;
112
    FieldByName('Payment').AsDateTime := DTPPayment.Date;
113
    Post;
114
  end;
115
  FMenu.MLog.Lines.Add('Updating licenses...');
116
  n := 0;
117
  with FMenu.TLicense do
118
    if Locate('Type;Source', VarArrayOf([0, CBOrder.Text]), [])
119
    then
120
      repeat
121
        Inc(n);
122
        Edit;
123
        FieldByName('Validity').AsBoolean := True;
124
        if not FieldByName('Mail').IsNull
125
        and (FieldByName('FinalDate').AsDateTime < FMenu.DateLimite)
126
        then // Envoyer une cl? de licence
127
        begin
128
          FieldByName('FinalDate').AsDateTime := FMenu.DateLimite;
129
          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));
130
          try
131 4 avalancogn
            f := TIniFile.Create(TempFolder + '\InraPorc.lic');
132 1 avalancogn
            f.WriteInteger ('License', 'LicenseType', 2);
133
            f.WriteInteger ('License', 'LicenseNumber', FieldByName('LicenseNumber').AsInteger) ;
134
            f.WriteString ('License', 'Version', FieldByName('Version').AsString);
135
            f.WriteString ('License', 'FirstName', FieldByName('FirstName').AsString);
136
            f.WriteString ('License', 'LastName', FieldByName('LastName').AsString);
137
            f.WriteString ('License', 'Company', FieldByName('Company').AsString);
138
            f.WriteString ('License', 'Address1', FieldByName('Address1').AsString);
139
            f.WriteString ('License', 'Address2', FieldByName('Address2').AsString);
140
            f.WriteString ('License', 'PostalCode', FieldByName('PostalCode').AsString);
141
            f.WriteString ('License', 'City', FieldByName('City').AsString);
142
            f.WriteString ('License', 'Country', FieldByName('Country').AsString);
143
            f.WriteString ('License', 'Phone', FieldByName('Phone').AsString);
144
            f.WriteString ('License', 'Fax', FieldByName('Fax').AsString);
145
            f.WriteString ('License', 'Mail', FieldByName('Mail').AsString);
146
            f.WriteString ('License', 'VolumeSerialNumber', FieldByName('VolumeSerialNumber').AsString);
147
            f.WriteString ('License', 'FinalDate', DateToStr(FieldByName('FinalDate').AsDateTime));
148
            f.WriteString ('License', 'SoftwareEnableKey', FieldByName('SoftwareEnableKey').AsString);
149
            f.Free;
150
            FMenu.MLog.Lines.Add('Mailing to ' + FieldByName('Mail').AsString + '...');
151
            with MKey do
152
            begin
153
              Body.Clear;
154
              MessageParts.Clear;
155
              From.Name := 'InraPorc';
156
              From.Address := MAIL_INRAPORC;
157
              Recipients.EMailAddresses := FieldByName('Mail').AsString;
158
              StrMessage := TStringList.Create;
159
              if FieldByName('Language').AsString = 'FR'
160
              then // R?ponse (fran?ais)
161
              begin
162
                Subject := Format('[InraPorc] Cl? d''activation pour licence num?ro %d', [FieldByName('LicenseNumber').AsInteger]);
163
                StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Facture_FR.txt');
164
                Body.AddStrings(StrMessage);
165
                Body.Add(Format('La cl? d''activation est valable jusqu''au %s.', [DateToStr(FieldByName('FinalDate').AsDateTime)]));
166
                Body.Add('Un nouveau fichier de licence vous sera automatiquement envoy? avant la date d''expiration.');
167
                Body.Add('');
168
                StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_FR.txt');
169
                Body.AddStrings(StrMessage);
170
              end
171
              else // Reply (english)
172
              begin
173
                Subject := Format('[InraPorc] Software enable key for license number %d', [FieldByName('LicenseNumber').AsInteger]);
174
                StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Facture_EN.txt');
175
                Body.AddStrings(StrMessage);
176
                Body.Add(Format('The license activation key is valid until %s.', [DateToStr(FieldByName('FinalDate').AsDateTime)]));
177
                Body.Add('You will automatically receive a new license file before the expiration date.');
178
                Body.Add('');
179
                StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_EN.txt');
180
                Body.AddStrings(StrMessage);
181
              end;
182
              StrMessage.Free;
183 4 avalancogn
              if FileExists(TempFolder + '\InraPorc.lic')
184 1 avalancogn
              then
185 4 avalancogn
                TIdAttachmentFile.Create(MessageParts, TempFolder + '\InraPorc.lic')
186 1 avalancogn
              else
187 4 avalancogn
                FMenu.MLog.Lines.Add('File InraPorc.lic could not be attached !');
188 1 avalancogn
            end;
189
            FMenu.MLog.Lines.Add('SMTP...');
190
            try
191
              SMTP.Connect;
192
              try
193
                SMTP.Send(MKey);
194
              finally
195
                SMTP.Disconnect;
196
                if IMAP4.Connect
197
                then
198
                  try
199
                    if not IMAP4.AppendMsg('?l?ments envoy?s', MKey, MKey.LastGeneratedHeaders)
200
                    then
201
                      FMenu.MLog.Lines.Add('Message could not be copied in IMAP server !');
202
                  finally
203
                    IMAP4.Disconnect;
204
                  end
205
                else
206
                  FMenu.MLog.Lines.Add('IMAP server could not be connected !');
207
              end;
208
            except
209
              FMenu.MLog.Lines.Add('Message could not be sent !');
210
            end;
211 4 avalancogn
            if not DeleteFile(TempFolder + '\InraPorc.lic')
212 1 avalancogn
            then
213 4 avalancogn
              FMenu.MLog.Lines.Add('File InraPorc.lic could not be deleted !');
214 1 avalancogn
          except
215 4 avalancogn
            FMenu.MLog.Lines.Add('File InraPorc.lic could not be created !');
216 1 avalancogn
          end;
217
        end;
218
        Post;
219
        Next;
220
      until Eof or (FieldByName('Type').AsInteger <> 0) or (FieldByName('Source').AsString <> CBOrder.Text);
221
  if n <> PBLicenses.AsInteger
222
  then
223
    FMenu.MLog.Lines.Add(Format('%d licenses updated / %d expected !', [n, PBLicenses.AsInteger]));
224
  FMenu.MLog.Lines.Add('Logging record...');
225
  with FMenu.TInvoices do
226
  begin
227
    Append;
228
    FieldByName('Date').AsDateTime := Now;
229
    FieldByName('Admin').AsString := FMenu.EAdmin.Text;
230
    FieldByName('Order').AsString := CBOrder.Text;
231
    FieldByName('Payment').AsDateTime := DTPPayment.Date;
232
    FieldByName('Observations').AsString := MObservations.Text;
233
    Post;
234
  end;
235
  CBOrder.DeleteSelected;
236
  ClearInvoice;
237
end;
238
239
procedure TFInvoice.ClearInvoice;
240
begin
241
  BBNext.Enabled := False;
242
  CBOrder.Hint := Format('%d factures en attente / %d commandes', [CBOrder.Items.Count, FMenu.TOrder.RecordCount]);
243
  PBLicenses.Text := '';
244
  MObservations.Clear;
245
  ActiveControl := CBOrder;
246
end;
247
248
end.