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. |