1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
|
unit Unit_commune;
{$mode objfpc}{$H+}
interface
uses
LazUTF8,Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
Buttons, ComCtrls, Menus, ExtCtrls, StdCtrls,Grids{$ifdef windows},windows,shellapi,registry{$endif}, LazFileUtils;
var
repertoire_executable,repertoire_exemples,repertoire_aide,nomexecutable,repertoire_config_perso,
repertoire_dosage_perso,chemin_po:string;
Function MyGetAppConfigDirUTF8: String;
{$ifdef windows}
Function MyGetMesDocumentsUTF8: String; {$endif}
Function ExpandEnvironmentString(s: String): String;
Function Mystrtofloat(s:string):extended;
implementation
Function Mystrtofloat(s:string):extended;
begin
result:=strtofloat(trim(s));
end;
Function ExpandEnvironmentString(s: String): String;
Var i, k: Integer;
sl: TStringList;
s2: String;
bP, bD: Boolean;
Begin
Result := s;
bP := Pos('%', s) > 0;
bD := Pos('$', s) > 0;
If Not(bP Or bD) Then Exit; // Nichts zu konvertieren
sl := TStringList.Create;
sl.Sorted := bD;
For i := GetEnvironmentVariableCount - 1 DownTo 0 Do // Alle Variablen in eine Liste merken
Begin
s2 := GetEnvironmentStringUTF8(i);
If Length(s2) >= 2 Then
If s2[1] <> '=' Then // Bei Windows kommt sowas auch vor, daher wegoptimieren
sl.Add(s2);
end;
k := 0;
Repeat // Durchlaufe so oft bis alle Env-Variablen aufgelöst sind
s2 := Result;
For i := sl.Count - 1 DownTo 0 Do
Begin
If bP Then
Begin
Result := StringReplace(Result, '%' + sl.Names[i] + '%', sl.ValueFromIndex[i], [rfReplaceAll, rfIgnoreCase]);
If Pos('%', Result) = 0 Then bP := False;
end;
If bD Then
Begin
Result := StringReplace(Result, '$' + sl.Names[i], sl.ValueFromIndex[i], [rfReplaceAll]);
If Pos('$', Result) = 0 Then bD := False;
end;
If Not(bP Or bD) Then Break;
end;
If Not(bP Or bD) Then Break;
If SameText(s2, Result) Then Break; // % $ nicht konvertierbar, da im System nicht vorhanden
Inc(k);
If k > sl.Count - 2 Then Break; // Max Durchläufe
Until True;
sl.Free;
end;
Function MyGetAppConfigDirUTF8: String;
{il est necessaire de modifier GetAppConfigDir car sur les systemes
windows renvoie local setting\application data au lieu de application data}
var
I: Integer;
EnvVars: TStringList;
begin
{$ifndef windows}
result:=(SysUtils.GetAppConfigDir(false));
{$endif}
{$ifdef windows}
EnvVars := TStringList.Create;
try
for I := 0 to GetEnvironmentVariableCount - 1 do
EnvVars.Add(GetEnvironmentString(I));
result:=AppendPathDelim(EnvVars.Values['APPDATA'])+'dozzzaqueux\';
finally
EnvVars.Free;
end;
{$endif}
end;
{$ifdef windows}
Function MyGetMesDocumentsUTF8: String;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\'
+ 'Explorer\User Shell Folders\', False);
result:=ExpandEnvironmentString(Reg.ReadString('Personal'));
finally
Reg.Free;
end;
end;
{$endif}
initialization
repertoire_executable:=AppendPathDelim(extractfilepath((Application.ExeName)));
nomexecutable:=extractfilename(Application.ExeName);
repertoire_exemples:=AppendPathDelim(repertoire_executable+'Exemples');
repertoire_aide:=AppendPathDelim(repertoire_executable+'Aide');
repertoire_config_perso:=AppendPathDelim(MyGetAppConfigDirUTF8);
{$ifdef windows}
repertoire_dosage_perso:=AppendPathDelim(AppendPathDelim(MyGetMesDocumentsUTF8)+'MesDosages');
{$endif}
{$ifndef windows}
repertoire_dosage_perso:=AppendPathDelim({repertoire_config_perso}GetUserDir+'MesDosages');
{$endif}
end.
|
