root / LicensesMercure / UFAgreement.pas @ 5
Historique | Voir | Annoter | Télécharger (8,722 ko)
1 | 1 | avalancogn | 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 | 4 | avalancogn | f := TIniFile.Create(TempFolder + '\InraPorc.lic');
|
121 | 1 | avalancogn | 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 | 4 | avalancogn | if FileExists(TempFolder + '\InraPorc.lic') |
173 | 1 | avalancogn | then
|
174 | 4 | avalancogn | TIdAttachmentFile.Create(MessageParts, TempFolder + '\InraPorc.lic')
|
175 | 1 | avalancogn | else
|
176 | 4 | avalancogn | FMenu.MLog.Lines.Add('File InraPorc.lic could not be attached !');
|
177 | 1 | avalancogn | 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 | 4 | avalancogn | if not DeleteFile(TempFolder + '\InraPorc.lic') |
201 | 1 | avalancogn | then
|
202 | 4 | avalancogn | FMenu.MLog.Lines.Add('File InraPorc.lic could not be deleted !');
|
203 | 1 | avalancogn | except
|
204 | 4 | avalancogn | FMenu.MLog.Lines.Add('File InraPorc.lic could not be created !');
|
205 | 1 | avalancogn | 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. |