root / LicensesMercure / UFMenu.pas @ 4
Historique | Voir | Annoter | Télécharger (14,254 ko)
1 |
unit UFMenu;
|
---|---|
2 |
|
3 |
interface
|
4 |
|
5 |
uses
|
6 |
Windows, Forms, Messages, SysUtils, Variants, Classes, Graphics, Controls, |
7 |
Dialogs, StdCtrls, Buttons, PBNumEdit, DB, DBTables, mysql, LbCipher, |
8 |
DateUtils, JvComponent, JvComputerInfoEx, JvComponentBase; |
9 |
|
10 |
type
|
11 |
TFMenu = class(TForm)
|
12 |
PBOrders: TPBNumEdit; |
13 |
BBOrders: TBitBtn; |
14 |
PBAjinomoto: TPBNumEdit; |
15 |
BBAjinomoto: TBitBtn; |
16 |
PBKeys: TPBNumEdit; |
17 |
BBKeys: TBitBtn; |
18 |
GBKeys: TGroupBox; |
19 |
GBOrders: TGroupBox; |
20 |
GBAjinomoto: TGroupBox; |
21 |
GBAdmin: TGroupBox; |
22 |
MLog: TMemo; |
23 |
TOrder: TTable; |
24 |
TAjinomoto: TTable; |
25 |
TLicense: TTable; |
26 |
TOrders: TTable; |
27 |
GBINRA: TGroupBox; |
28 |
BBINRA: TBitBtn; |
29 |
GBInvoices: TGroupBox; |
30 |
BBInvoices: TBitBtn; |
31 |
TInvoices: TTable; |
32 |
TINRA: TTable; |
33 |
TLicenses: TTable; |
34 |
BBAnnual: TBitBtn; |
35 |
TEducation: TTable; |
36 |
ComputerInfo: TJvComputerInfoEx; |
37 |
TAgreement: TTable; |
38 |
GBAgreement: TGroupBox; |
39 |
BBAgreement: TBitBtn; |
40 |
BBUSB: TBitBtn; |
41 |
BBManual: TBitBtn; |
42 |
LManual: TLabel; |
43 |
LUSB: TLabel; |
44 |
LAnnual: TLabel; |
45 |
EAdmin: TEdit; |
46 |
EUsername: TEdit; |
47 |
EPassword: TEdit; |
48 |
procedure FormCreate(Sender: TObject);
|
49 |
procedure FormShow(Sender: TObject);
|
50 |
procedure FormClose(Sender: TObject; var Action: TCloseAction); |
51 |
procedure BBOrdersClick(Sender: TObject);
|
52 |
procedure BBAjinomotoClick(Sender: TObject);
|
53 |
procedure BBKeysClick(Sender: TObject);
|
54 |
procedure BBInvoicesClick(Sender: TObject);
|
55 |
procedure BBINRAClick(Sender: TObject);
|
56 |
procedure BBAnnualClick(Sender: TObject);
|
57 |
procedure BBAgreementClick(Sender: TObject);
|
58 |
procedure BBUSBClick(Sender: TObject);
|
59 |
procedure BBManualClick(Sender: TObject);
|
60 |
private
|
61 |
{ D?clarations priv?es }
|
62 |
t: Text; |
63 |
public
|
64 |
{ D?clarations publiques }
|
65 |
DateLimite: TDateTime; |
66 |
function MD5Str(Digest: TMD5Digest): String; |
67 |
function EducationKey(Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String; |
68 |
function CompleteKey(LicenseNumber: Integer; Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String; |
69 |
end;
|
70 |
|
71 |
var
|
72 |
FMenu: TFMenu; |
73 |
|
74 |
const
|
75 |
SHARED_DRIVE = '\\pnas1.stockage.inra.fr\rennes-pegase\root';
|
76 |
SHARED_FOLDER = '\SG-prj-Inraporc\Licenses\';
|
77 |
SMTP_SERVER = 'smtp.inra.fr';
|
78 |
IMAP_SERVER = 'imap.inra.fr';
|
79 |
LDAP_SERVER = 'ldap-authentification.inra.fr';
|
80 |
//EXCHANGE_USERNAME = 'INRA\avalancogne';
|
81 |
//EXCHANGE_PASSWORD = 'Al1Messac35!';
|
82 |
EXCHANGE_SHARED_MAILBOX = 'inraporc-rennes';
|
83 |
MAIL_INRAPORC = 'inraporc-rennes@inra.fr';
|
84 |
MAIL_INRA_TRANSFERT_1 = 'doudja.alili@inra.fr';
|
85 |
MAIL_INRA_TRANSFERT_2 = 'franck.leguerhier@inra.fr';
|
86 |
MAIL_AJINOMOTO = 'Corrent_Etienne@eli.ajinomoto.com';
|
87 |
MYSQL_HOST = 'inraporc.inra.fr';
|
88 |
MYSQL_USER = 'inraporc';
|
89 |
MYSQL_PASSWD = 'jydjvmav';
|
90 |
MYSQL_DB = 'inraporc';
|
91 |
MYSQL_PORT = 3306;
|
92 |
SCP_HOST = 'inraporc.inra.fr';
|
93 |
SCP_HOSTKEY = '64:29:24:0b:24:7b:05:e1:6a:5e:36:d3:81:47:08:f9';
|
94 |
SCP_LOGIN = 'valanc';
|
95 |
SCP_PASSWD = 'al1:7a!?';
|
96 |
SCP_PATH = '/var/www/html/inraporc/Uploads/';
|
97 |
|
98 |
var
|
99 |
con: PMYSQL; // connection handler
|
100 |
res: PMYSQL_RES; // result
|
101 |
row: PMYSQL_ROW; // row
|
102 |
que: AnsiString; // query
|
103 |
cur: Integer; // current record
|
104 |
SLOrder, SLAjinomoto, SLLicense: TStrings; |
105 |
TempFolder: String;
|
106 |
|
107 |
implementation
|
108 |
|
109 |
uses
|
110 |
UFOrder, UFInvoice, UFINRA, UFAjinomoto, UFAgreement, UFKeys, UFAnnual, UFUSB, |
111 |
UFManual, UFConnect; |
112 |
|
113 |
{$R *.dfm}
|
114 |
|
115 |
type
|
116 |
WindowsString = type AnsiString(1252); |
117 |
|
118 |
procedure TFMenu.FormCreate(Sender: TObject);
|
119 |
begin
|
120 |
Top := Forms.Screen.WorkAreaHeight - Height; |
121 |
Left := 0;
|
122 |
end;
|
123 |
|
124 |
procedure TFMenu.FormShow(Sender: TObject);
|
125 |
begin
|
126 |
AssignFile(t, SHARED_DRIVE + SHARED_FOLDER + 'Logs\Errors.log');
|
127 |
if FileExists(SHARED_DRIVE + SHARED_FOLDER + 'Logs\Errors.log') |
128 |
then
|
129 |
try
|
130 |
Append(t); |
131 |
except
|
132 |
MessageDlg('Le fichier de log ne peut pas ?tre ouvert.' + sLineBreak + 'L''application est probablement d?j? lanc?e.', mtError, [mbOK], 0); |
133 |
Application.Terminate; |
134 |
end
|
135 |
else
|
136 |
try
|
137 |
Rewrite(t); |
138 |
except
|
139 |
MessageDlg('Le fichier de log ne peut pas ?tre cr??.' + sLineBreak + 'V?rifier les droits d''acc?s.', mtError, [mbOK], 0); |
140 |
Application.Terminate; |
141 |
end;
|
142 |
|
143 |
FConnect := TFConnect.Create(Self); |
144 |
if FConnect.ShowModal <> mrOk then |
145 |
begin
|
146 |
FConnect.Release; |
147 |
Application.Terminate; |
148 |
end;
|
149 |
FConnect.Release; |
150 |
|
151 |
Writeln(t, '*************************');
|
152 |
Writeln(t, 'BEGIN ', DateTimeToStr(Now));
|
153 |
Writeln(t, 'Computer IP address is ', ComputerInfo.Identification.IPAddress);
|
154 |
EUsername.Text := ComputerInfo.Identification.LocalUserName; |
155 |
Writeln(t, 'Local user name is ', EUsername.Text);
|
156 |
MLog.Lines.Add('User is ' + EAdmin.Text);
|
157 |
SLOrder := TStringList.Create; |
158 |
SLAjinomoto := TStringList.Create; |
159 |
SLLicense := TStringList.Create; |
160 |
MLog.Lines.Add('Opening dBase tables...');
|
161 |
// Probl?me avec Windows Vista (fichier PDOXUSRS.NET)
|
162 |
TLicense.DBSession.NetFileDir := SHARED_DRIVE + SHARED_FOLDER; |
163 |
TOrder.TableName := SHARED_DRIVE + SHARED_FOLDER + TOrder.TableName; |
164 |
try
|
165 |
TOrder.Active := True; |
166 |
except
|
167 |
MLog.Lines.Add('Table ' + TOrder.TableName + ' could not be opened !'); |
168 |
end;
|
169 |
TLicense.TableName := SHARED_DRIVE + SHARED_FOLDER + TLicense.TableName; |
170 |
try
|
171 |
TLicense.Active := True; |
172 |
except
|
173 |
MLog.Lines.Add('Table ' + TLicense.TableName + ' could not be opened !'); |
174 |
end;
|
175 |
TEducation.TableName := SHARED_DRIVE + SHARED_FOLDER + TEducation.TableName; |
176 |
try
|
177 |
TEducation.Active := True; |
178 |
except
|
179 |
MLog.Lines.Add('Table ' + TEducation.TableName + ' could not be opened !'); |
180 |
end;
|
181 |
TOrders.TableName := SHARED_DRIVE + SHARED_FOLDER + TOrders.TableName; |
182 |
try
|
183 |
TOrders.Active := True; |
184 |
except
|
185 |
MLog.Lines.Add('Table ' + TOrders.TableName + ' could not be opened !'); |
186 |
end;
|
187 |
TInvoices.TableName := SHARED_DRIVE + SHARED_FOLDER + TInvoices.TableName; |
188 |
try
|
189 |
TInvoices.Active := True; |
190 |
except
|
191 |
MLog.Lines.Add('Table ' + TInvoices.TableName + ' could not be opened !'); |
192 |
end;
|
193 |
TINRA.TableName := SHARED_DRIVE + SHARED_FOLDER + TINRA.TableName; |
194 |
try
|
195 |
TINRA.Active := True; |
196 |
except
|
197 |
MLog.Lines.Add('Table ' + TINRA.TableName + ' could not be opened !'); |
198 |
end;
|
199 |
TAjinomoto.TableName := SHARED_DRIVE + SHARED_FOLDER + TAjinomoto.TableName; |
200 |
try
|
201 |
TAjinomoto.Active := True; |
202 |
except
|
203 |
MLog.Lines.Add('Table ' + TAjinomoto.TableName + ' could not be opened !'); |
204 |
end;
|
205 |
TLicenses.TableName := SHARED_DRIVE + SHARED_FOLDER + TLicenses.TableName; |
206 |
try
|
207 |
TLicenses.Active := True; |
208 |
except
|
209 |
MLog.Lines.Add('Table ' + TLicenses.TableName + ' could not be opened !'); |
210 |
end;
|
211 |
TAgreement.TableName := SHARED_DRIVE + SHARED_FOLDER + TAgreement.TableName; |
212 |
try
|
213 |
TAgreement.Active := True; |
214 |
except
|
215 |
MLog.Lines.Add('Table ' + TAgreement.TableName + ' could not be opened !'); |
216 |
end;
|
217 |
// Check DLL
|
218 |
libmysql_fast_load(nil);
|
219 |
case libmysql_status of |
220 |
LIBMYSQL_UNDEFINED: MLog.Lines.Add('libmysql_load() has not yet been called !');
|
221 |
LIBMYSQL_MISSING: MLog.Lines.Add('libmySQL.dll could not be located !');
|
222 |
LIBMYSQL_INCOMPATIBLE: MLog.Lines.Add('libmySQL.dll was found but is not compatible !');
|
223 |
end;
|
224 |
if libmysql_status <> LIBMYSQL_READY then Exit; |
225 |
MLog.Lines.Add('Initializing connection handler...');
|
226 |
con := mysql_init(nil);
|
227 |
if con = nil |
228 |
then
|
229 |
begin
|
230 |
MLog.Lines.Add('Insufficient memory to initialize connection handler !');
|
231 |
Exit; |
232 |
end;
|
233 |
MLog.Lines.Add('Connecting to database...');
|
234 |
if mysql_real_connect(con, MYSQL_HOST, MYSQL_USER, MYSQL_PASSWD, MYSQL_DB, MYSQL_PORT, nil, 0) = nil |
235 |
then
|
236 |
begin
|
237 |
MLog.Lines.Add(mysql_error(con)); |
238 |
Exit; |
239 |
end;
|
240 |
que := 'SELECT `Key` FROM `commandes`';
|
241 |
MLog.Lines.Add(que); |
242 |
if mysql_query(con, PAnsiChar(que)) <> 0 |
243 |
then
|
244 |
MLog.Lines.Add(mysql_error(con)) |
245 |
else
|
246 |
begin
|
247 |
res := mysql_use_result(con); |
248 |
if res = nil |
249 |
then
|
250 |
MLog.Lines.Add(mysql_error(con)) |
251 |
else
|
252 |
begin
|
253 |
row := mysql_fetch_row(res); |
254 |
while row <> nil do |
255 |
begin
|
256 |
SLOrder.Add(row^[0]);
|
257 |
row := mysql_fetch_row(res); |
258 |
end;
|
259 |
mysql_free_result(res); |
260 |
end;
|
261 |
end;
|
262 |
PBOrders.AsInteger := SLOrder.Count; |
263 |
que := 'SELECT `Key` FROM `ajinomoto`';
|
264 |
MLog.Lines.Add(que); |
265 |
if mysql_query(con, PAnsiChar(que)) <> 0 |
266 |
then
|
267 |
MLog.Lines.Add(mysql_error(con)) |
268 |
else
|
269 |
begin
|
270 |
res := mysql_store_result(con); |
271 |
if res = nil |
272 |
then
|
273 |
MLog.Lines.Add(mysql_error(con)) |
274 |
else
|
275 |
begin
|
276 |
row := mysql_fetch_row(res); |
277 |
while row <> nil do |
278 |
begin
|
279 |
SLAjinomoto.Add(row^[0]);
|
280 |
row := mysql_fetch_row(res); |
281 |
end;
|
282 |
mysql_free_result(res); |
283 |
end;
|
284 |
end;
|
285 |
PBAjinomoto.AsInteger := SLAjinomoto.Count; |
286 |
que := 'SELECT `Key` FROM `licences`';
|
287 |
MLog.Lines.Add(que); |
288 |
if mysql_query(con, PAnsiChar(que)) <> 0 |
289 |
then
|
290 |
MLog.Lines.Add(mysql_error(con)) |
291 |
else
|
292 |
begin
|
293 |
res := mysql_store_result(con); |
294 |
if res = nil |
295 |
then
|
296 |
MLog.Lines.Add(mysql_error(con)) |
297 |
else
|
298 |
begin
|
299 |
row := mysql_fetch_row(res); |
300 |
while row <> nil do |
301 |
begin
|
302 |
SLLicense.Add(row^[0]);
|
303 |
row := mysql_fetch_row(res); |
304 |
end;
|
305 |
mysql_free_result(res); |
306 |
end;
|
307 |
end;
|
308 |
PBKeys.AsInteger := SLLicense.Count; |
309 |
BBOrders.Enabled := (PBOrders.AsInteger > 0) and TOrder.Active and TLicense.Active and TOrders.Active; |
310 |
BBInvoices.Enabled := TOrder.Active and TLicense.Active and TInvoices.Active; |
311 |
BBINRA.Enabled := TLicense.Active and TINRA.Active;
|
312 |
BBAjinomoto.Enabled := (PBAjinomoto.AsInteger > 0) and TLicense.Active and TAjinomoto.Active; |
313 |
BBKeys.Enabled := (PBKeys.AsInteger > 0) and TLicense.Active and TOrder.Active and TEducation.Active and TLicenses.Active; |
314 |
BBAgreement.Enabled := TLicense.Active and TAgreement.Active;
|
315 |
BBAnnual.Enabled := TLicense.Active; |
316 |
BBUSB.Enabled := TAjinomoto.Active and TEducation.Active;
|
317 |
BBManual.Enabled := TLicense.Active; |
318 |
|
319 |
if MonthOf(Date) < 9 |
320 |
then
|
321 |
DateLimite := EndOfTheYear(Date) |
322 |
else
|
323 |
DateLimite := EndOfTheYear(IncYear(Date)); |
324 |
DateLimite := Trunc(DateLimite); // Suppression de la partie heure
|
325 |
MLog.Lines.Add('Final date is ' + DateToStr(DateLimite));
|
326 |
|
327 |
TempFolder := GetEnvironmentVariable('TEMP');
|
328 |
end;
|
329 |
|
330 |
procedure TFMenu.FormClose(Sender: TObject; var Action: TCloseAction); |
331 |
var
|
332 |
i: Integer; |
333 |
begin
|
334 |
SLOrder.Free; |
335 |
SLAjinomoto.Free; |
336 |
SLLicense.Free; |
337 |
MLog.Lines.Add('Closing server connection...');
|
338 |
if con <> nil then mysql_close(con); |
339 |
MLog.Lines.Add('Closing dBase tables...');
|
340 |
TOrder.Active := False; |
341 |
TLicense.Active := False; |
342 |
TEducation.Active := False; |
343 |
TOrders.Active := False; |
344 |
TInvoices.Active := False; |
345 |
TINRA.Active := False; |
346 |
TAjinomoto.Active := False; |
347 |
TLicenses.Active := False; |
348 |
TAgreement.Active := False; |
349 |
for i := 0 to MLog.Lines.Count - 1 do |
350 |
Writeln(t, MLog.Lines[i]); |
351 |
Writeln(t, 'END ', DateTimeToStr(Now));
|
352 |
Flush(t); |
353 |
CloseFile(t); |
354 |
end;
|
355 |
|
356 |
procedure TFMenu.BBOrdersClick(Sender: TObject);
|
357 |
begin // Type 0 |
358 |
cur := 0;
|
359 |
FOrder := TFOrder.Create(Self); |
360 |
if FOrder.GetRequest
|
361 |
then
|
362 |
FOrder.ShowModal; |
363 |
FOrder.Release; |
364 |
BBOrders.Enabled := PBOrders.AsInteger > 0;
|
365 |
end;
|
366 |
|
367 |
procedure TFMenu.BBInvoicesClick(Sender: TObject);
|
368 |
begin
|
369 |
FInvoice := TFInvoice.Create(Self); |
370 |
FInvoice.ShowModal; |
371 |
FInvoice.Release; |
372 |
end;
|
373 |
|
374 |
procedure TFMenu.BBINRAClick(Sender: TObject);
|
375 |
begin // Type 1 |
376 |
FINRA := TFINRA.Create(Self); |
377 |
FINRA.ShowModal; |
378 |
FINRA.Release; |
379 |
end;
|
380 |
|
381 |
procedure TFMenu.BBAjinomotoClick(Sender: TObject);
|
382 |
begin // Type 2 |
383 |
cur := 0;
|
384 |
FAjinomoto := TFAjinomoto.Create(Self); |
385 |
if FAjinomoto.GetRequest
|
386 |
then
|
387 |
FAjinomoto.ShowModal; |
388 |
FAjinomoto.Release; |
389 |
BBAjinomoto.Enabled := PBAjinomoto.AsInteger > 0;
|
390 |
end;
|
391 |
|
392 |
procedure TFMenu.BBAgreementClick(Sender: TObject);
|
393 |
begin
|
394 |
FAgreement := TFAgreement.Create(Self); |
395 |
FAgreement.ShowModal; |
396 |
FAgreement.Release; |
397 |
end;
|
398 |
|
399 |
procedure TFMenu.BBKeysClick(Sender: TObject);
|
400 |
begin
|
401 |
cur := 0;
|
402 |
FKeys := TFKeys.Create(Self); |
403 |
if FKeys.GetRequest
|
404 |
then
|
405 |
FKeys.ShowModal; |
406 |
FKeys.Release; |
407 |
BBKeys.Enabled := PBKeys.AsInteger > 0;
|
408 |
end;
|
409 |
|
410 |
procedure TFMenu.BBManualClick(Sender: TObject);
|
411 |
begin
|
412 |
FManual := TFManual.Create(Self); |
413 |
FManual.ShowModal; |
414 |
FManual.Release; |
415 |
end;
|
416 |
|
417 |
procedure TFMenu.BBUSBClick(Sender: TObject);
|
418 |
begin
|
419 |
FUSB := TFUSB.Create(Self); |
420 |
FUSB.ShowModal; |
421 |
FUSB.Release; |
422 |
end;
|
423 |
|
424 |
procedure TFMenu.BBAnnualClick(Sender: TObject);
|
425 |
begin
|
426 |
FAnnual := TFAnnual.Create(Self); |
427 |
FAnnual.ShowModal; |
428 |
FAnnual.Release; |
429 |
end;
|
430 |
|
431 |
function TFMenu.MD5Str(Digest: TMD5Digest): String; |
432 |
var
|
433 |
i: Byte; |
434 |
sb: TStringBuilder; |
435 |
const
|
436 |
Digits: array[0..15] of Char = |
437 |
('0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 'A', 'B', 'C', 'D', 'E', 'F'); |
438 |
begin
|
439 |
sb := TStringBuilder.Create; |
440 |
for i := 0 to 15 do |
441 |
sb.Append(Digits[(Digest[I] shr 4) and $0f]).Append(Digits[Digest[I] and $0f]); |
442 |
sb.Insert(24, '-').Insert(16, '-').Insert(8, '-'); |
443 |
Result := sb.ToString; |
444 |
FreeAndNil(sb); |
445 |
end;
|
446 |
|
447 |
function TFMenu.EducationKey(Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String; |
448 |
var
|
449 |
sb: TStringBuilder; |
450 |
Digest: TMD5Digest; |
451 |
begin
|
452 |
sb := TStringBuilder.Create; |
453 |
sb.Append(Format('InraPorc version %s : ', [Version[1]])); |
454 |
sb.Append('licence limit?e ? l''?ducation ');
|
455 |
sb.Append(Format('sur le volume %s ', [VolumeSerialNumber]));
|
456 |
sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));
|
457 |
sb.Append(Format('valable jusqu''au %s', [FinalDate]));
|
458 |
StringHashMD5(Digest, WindowsString(sb.ToString)); |
459 |
FreeAndNil(sb); |
460 |
Result := MD5Str(Digest); |
461 |
end;
|
462 |
|
463 |
function TFMenu.CompleteKey(LicenseNumber: Integer; Version, FirstName, LastName, Company, VolumeSerialNumber, FinalDate: String): String; |
464 |
var
|
465 |
sb: TStringBuilder; |
466 |
Digest: TMD5Digest; |
467 |
begin
|
468 |
sb := TStringBuilder.Create; |
469 |
sb.Append(Format('InraPorc version %s : ', [Version[1]])); |
470 |
sb.Append(Format('licence num?ro %d ', [LicenseNumber]));
|
471 |
sb.Append(Format('sur le volume %s ', [VolumeSerialNumber]));
|
472 |
sb.Append(Format('accord?e ? %s %s (%s) ', [FirstName, LastName, Company]));
|
473 |
sb.Append(Format('valable jusqu''au %s', [FinalDate]));
|
474 |
StringHashMD5(Digest, WindowsString(sb.ToString)); |
475 |
FreeAndNil(sb); |
476 |
Result := MD5Str(Digest); |
477 |
end;
|
478 |
|
479 |
end.
|