root / LicensesMercure / UFAnnual.pas @ 1
Historique | Voir | Annoter | Télécharger (7,186 ko)
1 |
unit UFAnnual;
|
---|---|
2 |
|
3 |
interface
|
4 |
|
5 |
uses
|
6 |
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, |
7 |
Dialogs, ComCtrls, StdCtrls, Buttons, IdMessage, IdBaseComponent, |
8 |
IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, |
9 |
IdAttachmentFile, IdSMTP, IniFiles, DateUtils, |
10 |
IdExplicitTLSClientServerBase, IdSMTPBase, IdIMAP4, IdIOHandler, |
11 |
IdIOHandlerSocket, IdIOHandlerStack, IdSSL, IdSSLOpenSSL; |
12 |
|
13 |
type
|
14 |
TFAnnual = class(TForm)
|
15 |
SMTP: TIdSMTP; |
16 |
MKey: TIdMessage; |
17 |
BBNext: TBitBtn; |
18 |
LDate: TLabel; |
19 |
DTPDate: TDateTimePicker; |
20 |
IMAP4: TIdIMAP4; |
21 |
OpenSSL_IMAP4: TIdSSLIOHandlerSocketOpenSSL; |
22 |
OpenSSL_SMTP: TIdSSLIOHandlerSocketOpenSSL; |
23 |
procedure FormCreate(Sender: TObject);
|
24 |
procedure BBNextClick(Sender: TObject);
|
25 |
private
|
26 |
{ D?clarations priv?es }
|
27 |
public
|
28 |
{ D?clarations publiques }
|
29 |
end;
|
30 |
|
31 |
var
|
32 |
FAnnual: TFAnnual; |
33 |
|
34 |
implementation
|
35 |
|
36 |
uses
|
37 |
UFMenu; |
38 |
|
39 |
{$R *.dfm}
|
40 |
|
41 |
procedure TFAnnual.FormCreate(Sender: TObject);
|
42 |
begin
|
43 |
Top := 0;
|
44 |
Left := 0;
|
45 |
DTPDate.DateTime := Now; |
46 |
with IMAP4 do |
47 |
begin
|
48 |
Host := IMAP_SERVER; |
49 |
// Username := EXCHANGE_USERNAME + '\' + EXCHANGE_SHARED_MAILBOX;
|
50 |
Username := 'INRA\' + FMenu.EUsername.Text + '\' + EXCHANGE_SHARED_MAILBOX; |
51 |
// Password := EXCHANGE_PASSWORD;
|
52 |
Password := FMenu.EPassword.Text; |
53 |
end;
|
54 |
with SMTP do |
55 |
begin
|
56 |
Host := SMTP_SERVER; |
57 |
// Username := EXCHANGE_USERNAME;
|
58 |
Username := 'INRA\' + FMenu.EUsername.Text;
|
59 |
// Password := EXCHANGE_PASSWORD;
|
60 |
Password := FMenu.EPassword.Text; |
61 |
end;
|
62 |
end;
|
63 |
|
64 |
procedure TFAnnual.BBNextClick(Sender: TObject);
|
65 |
var
|
66 |
f: TIniFile; |
67 |
OldDate, NewDate: TDateTime; |
68 |
StrMessage: TStrings; |
69 |
begin
|
70 |
FMenu.MLog.Lines.Add('Updating licenses...');
|
71 |
NewDate := FMenu.DateLimite; |
72 |
with FMenu.TLicense do |
73 |
begin
|
74 |
First; |
75 |
while not Eof do |
76 |
begin
|
77 |
OldDate := FieldByName('FinalDate').AsDateTime;
|
78 |
if FieldByName('Validity').AsBoolean |
79 |
and not FieldByName('Mail').IsNull |
80 |
and not FieldByName('Version').IsNull |
81 |
and not FieldByName('VolumeSerialNumber').IsNull |
82 |
and (OldDate < NewDate)
|
83 |
then // Envoyer une cl? de licence |
84 |
begin
|
85 |
Edit; |
86 |
FieldByName('FinalDate').AsDateTime := NewDate;
|
87 |
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)); |
88 |
try
|
89 |
f := TIniFile.Create(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic');
|
90 |
f.WriteInteger ('License', 'LicenseType', 2); |
91 |
f.WriteInteger ('License', 'LicenseNumber', FieldByName('LicenseNumber').AsInteger) ; |
92 |
f.WriteString ('License', 'Version', FieldByName('Version').AsString); |
93 |
f.WriteString ('License', 'FirstName', FieldByName('FirstName').AsString); |
94 |
f.WriteString ('License', 'LastName', FieldByName('LastName').AsString); |
95 |
f.WriteString ('License', 'Company', FieldByName('Company').AsString); |
96 |
f.WriteString ('License', 'Address1', FieldByName('Address1').AsString); |
97 |
f.WriteString ('License', 'Address2', FieldByName('Address2').AsString); |
98 |
f.WriteString ('License', 'PostalCode', FieldByName('PostalCode').AsString); |
99 |
f.WriteString ('License', 'City', FieldByName('City').AsString); |
100 |
f.WriteString ('License', 'Country', FieldByName('Country').AsString); |
101 |
f.WriteString ('License', 'Phone', FieldByName('Phone').AsString); |
102 |
f.WriteString ('License', 'Fax', FieldByName('Fax').AsString); |
103 |
f.WriteString ('License', 'Mail', FieldByName('Mail').AsString); |
104 |
f.WriteString ('License', 'VolumeSerialNumber', FieldByName('VolumeSerialNumber').AsString); |
105 |
f.WriteString ('License', 'FinalDate', DateToStr(FieldByName('FinalDate').AsDateTime)); |
106 |
f.WriteString ('License', 'SoftwareEnableKey', FieldByName('SoftwareEnableKey').AsString); |
107 |
f.Free; |
108 |
FMenu.MLog.Lines.Add('Mailing to ' + FieldByName('Mail').AsString + '...'); |
109 |
with MKey do |
110 |
begin
|
111 |
Body.Clear; |
112 |
MessageParts.Clear; |
113 |
From.Name := 'InraPorc';
|
114 |
From.Address := MAIL_INRAPORC; |
115 |
Recipients.EMailAddresses := FieldByName('Mail').AsString;
|
116 |
StrMessage := TStringList.Create; |
117 |
if FieldByName('Language').AsString = 'FR' |
118 |
then // R?ponse (fran?ais) |
119 |
begin
|
120 |
Subject := Format('[InraPorc] Cl? d''activation pour licence num?ro %d', [FieldByName('LicenseNumber').AsInteger]); |
121 |
StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Renouvellement_FR.txt');
|
122 |
Body.AddStrings(StrMessage); |
123 |
Body.Add('');
|
124 |
StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_FR.txt');
|
125 |
Body.AddStrings(StrMessage); |
126 |
end
|
127 |
else // Reply (english) |
128 |
begin
|
129 |
Subject := Format('[InraPorc] Software enable key for license number %d', [FieldByName('LicenseNumber').AsInteger]); |
130 |
StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Renouvellement_EN.txt');
|
131 |
Body.AddStrings(StrMessage); |
132 |
Body.Add('');
|
133 |
StrMessage.LoadFromFile(SHARED_DRIVE + SHARED_FOLDER + 'Messages\Signature_EN.txt');
|
134 |
Body.AddStrings(StrMessage); |
135 |
end;
|
136 |
StrMessage.Free; |
137 |
if FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic') |
138 |
then
|
139 |
TIdAttachmentFile.Create(MessageParts, SHARED_DRIVE + SHARED_FOLDER + '\Fichiers\InraPorc.lic')
|
140 |
else
|
141 |
FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic not found!');
|
142 |
end;
|
143 |
FMenu.MLog.Lines.Add('SMTP...');
|
144 |
try
|
145 |
SMTP.Connect; |
146 |
try
|
147 |
SMTP.Send(MKey); |
148 |
// Validation des modifications
|
149 |
Post; |
150 |
// Copie du message dans les ?l?ments envoy?s
|
151 |
if IMAP4.Connect
|
152 |
then
|
153 |
try
|
154 |
if not IMAP4.AppendMsg('?l?ments envoy?s', MKey, MKey.LastGeneratedHeaders) |
155 |
then
|
156 |
FMenu.MLog.Lines.Add('Message could not be copied in IMAP server!');
|
157 |
finally
|
158 |
IMAP4.Disconnect; |
159 |
end
|
160 |
else
|
161 |
FMenu.MLog.Lines.Add('IMAP server could not be connected!');
|
162 |
finally
|
163 |
SMTP.Disconnect; |
164 |
end;
|
165 |
except
|
166 |
FMenu.MLog.Lines.Add('Message could not be sent!');
|
167 |
// Annulation des modifications
|
168 |
Cancel; |
169 |
end;
|
170 |
if not DeleteFile(SHARED_DRIVE + SHARED_FOLDER + 'Fichiers\InraPorc.lic') |
171 |
then
|
172 |
FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic could not be deleted!');
|
173 |
except
|
174 |
FMenu.MLog.Lines.Add('File Fichiers\InraPorc.lic could not be created!');
|
175 |
end;
|
176 |
end;
|
177 |
Next; |
178 |
end;
|
179 |
end;
|
180 |
Close; |
181 |
end;
|
182 |
|
183 |
end.
|