root / UFLoader.pas
Historique | Voir | Annoter | Télécharger (3,863 ko)
1 | 3 | avalancogn | unit UFLoader;
|
---|---|---|---|
2 | |||
3 | interface
|
||
4 | |||
5 | uses
|
||
6 | Windows, Forms, Classes, Controls, ComCtrls; |
||
7 | |||
8 | type
|
||
9 | TFLoader = class(TForm)
|
||
10 | PBLoader: TProgressBar; |
||
11 | private
|
||
12 | { D?clarations priv?es }
|
||
13 | public
|
||
14 | { D?clarations publiques }
|
||
15 | procedure Init;
|
||
16 | end;
|
||
17 | |||
18 | var
|
||
19 | FLoader: TFLoader; |
||
20 | |||
21 | implementation
|
||
22 | |||
23 | uses
|
||
24 | Dialogs, SysUtils, gnugettext, UVariables, UStrings, UInit, UUtil, UFIntro, |
||
25 | UFLicense; |
||
26 | |||
27 | {$R *.dfm}
|
||
28 | |||
29 | procedure TFLoader.Init;
|
||
30 | var
|
||
31 | FileName: String;
|
||
32 | VolumeSerialNumber: String;
|
||
33 | Ok: Boolean; |
||
34 | s: String;
|
||
35 | begin
|
||
36 | if Screen.Fonts.IndexOf('Arial Unicode MS') <> -1 |
||
37 | then
|
||
38 | Font.Name := 'Arial Unicode MS';
|
||
39 | // Langue
|
||
40 | UseLanguage(LanguageCode); |
||
41 | TranslateComponent(Self); |
||
42 | if ParamCount > 1 |
||
43 | then // Nombre de param?tres incorrect |
||
44 | MessageDlg(Format(MsgParamCount, [ParamCount, ParamStr(0), ExtractFileName(Application.ExeName)]), mtError, [mbOk], 0); |
||
45 | PBLoader.StepIt; |
||
46 | // Licence
|
||
47 | InitLicense; |
||
48 | LoadLicense; |
||
49 | if (MajorVersion > 9) |
||
50 | or (MinorVersion > 9) |
||
51 | or (ReleaseVersion > 9) |
||
52 | or (BuildVersion > 9) |
||
53 | then // Num?ro de version incorrect |
||
54 | begin
|
||
55 | MessageDlg(Format(StrVersion, [MajorVersion, MinorVersion, ReleaseVersion, BuildVersion]), mtError, [mbOk], 0);
|
||
56 | Application.Terminate; |
||
57 | Exit; |
||
58 | end;
|
||
59 | if ((LicenseType = 1) or (LicenseType = 2)) and (StrToInt(FormatDateTime('yyyymmdd', Date)) > StrToInt(Copy(FinalDate, 7, 4) + Copy(FinalDate, 4, 2) + Copy(FinalDate, 1, 2))) |
||
60 | then // Date limite d?pass?e |
||
61 | MessageDlg(MsgFinalDate, mtWarning, [mbOk], 0);
|
||
62 | if (LicenseType = 2) and (DriveType(Drive) <> DRIVE_FIXED) |
||
63 | then // La version compl?te doit ?tre install?e sur un disque fixe |
||
64 | MessageDlg(MsgFixedDrive, mtWarning, [mbOk], 0);
|
||
65 | VolumeSerialNumber := BdRReadString('\Software\InraPorc\License', 'VolumeSerialNumber', Volume); |
||
66 | if ((LicenseType = 1) or (LicenseType = 2)) and (Volume <> VolumeSerialNumber) |
||
67 | then // Changement de disque |
||
68 | MessageDlg(MsgDiskChanged, mtWarning, [mbOk], 0);
|
||
69 | // Aide
|
||
70 | if Copy(LanguageCode, 1, 2) = 'fr' |
||
71 | then // Fran?ais |
||
72 | FileName := ChangeFileExt(Application.ExeName, '_fr.chm')
|
||
73 | else // Anglais |
||
74 | FileName := ChangeFileExt(Application.ExeName, '_en.chm');
|
||
75 | if FileExists(FileName)
|
||
76 | then
|
||
77 | Application.HelpFile := FileName; |
||
78 | // Contrat de licence
|
||
79 | case LicenseType of |
||
80 | 1: s := 'AcceptEducation'; |
||
81 | 2: s := 'AcceptComplete'; |
||
82 | else s := 'AcceptEvaluation'; |
||
83 | end;
|
||
84 | if not BdRReadBoolean('\Software\InraPorc', s, False) |
||
85 | then
|
||
86 | begin
|
||
87 | FIntro := TFIntro.Create(Self); |
||
88 | Ok := FIntro.ShowModal = mrOk; |
||
89 | FIntro.Release; |
||
90 | if Ok
|
||
91 | then // Accepter |
||
92 | BdRWriteBoolean('\Software\InraPorc', s, True)
|
||
93 | else // Refuser |
||
94 | begin
|
||
95 | Application.Terminate; |
||
96 | Exit; |
||
97 | end;
|
||
98 | end;
|
||
99 | PBLoader.StepIt; |
||
100 | // Configuration
|
||
101 | LoadConfig; |
||
102 | // Donn?es
|
||
103 | if ParamCount = 1 |
||
104 | then // R?pertoire pass? en param?tre |
||
105 | if DirectoryExists(ParamStr(1)) |
||
106 | then // R?pertoire enregistr? dans la configuration |
||
107 | DataFolderExists := SetCurrentDir(ParamStr(1))
|
||
108 | else
|
||
109 | begin
|
||
110 | MessageDlg(Format(MsgDataDirectory, [ParamStr(1)]), mtError, [mbOk], 0); |
||
111 | DataFolderExists := False; |
||
112 | end
|
||
113 | else // R?pertoire par d?faut (Configuration) |
||
114 | if DirectoryExists(Folder)
|
||
115 | then // R?pertoire enregistr? dans la configuration |
||
116 | DataFolderExists := SetCurrentDir(Folder) |
||
117 | else
|
||
118 | begin
|
||
119 | MessageDlg(Format(MsgDataDirectory, [Folder]), mtError, [mbOk], 0);
|
||
120 | DataFolderExists := False; |
||
121 | end;
|
||
122 | PBLoader.StepIt; |
||
123 | InitData; |
||
124 | PBLoader.StepIt; |
||
125 | LoadData; |
||
126 | PBLoader.StepIt; |
||
127 | if ((LicenseType = 0) or (LicenseType = 1)) and TooMuchRecords |
||
128 | then // Trop d'enregistrements |
||
129 | MessageDlg(MsgTooMuchRecords, mtWarning, [mbOk], 0);
|
||
130 | if not IsComplete and not IsEducation |
||
131 | then
|
||
132 | begin
|
||
133 | FLicense := TFLicense.Create(Self); |
||
134 | FLicense.ShowModal; |
||
135 | FLicense.Release; |
||
136 | end;
|
||
137 | end;
|
||
138 | |||
139 | end. |