1 | unit UAutoRegistry;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Registry;
|
---|
7 |
|
---|
8 | type
|
---|
9 | TAutoRegistry = class
|
---|
10 | private
|
---|
11 | FItems: array of record
|
---|
12 | Nazev: string;
|
---|
13 | Typ: Integer;
|
---|
14 | Data: Pointer;
|
---|
15 | end;
|
---|
16 | FPath: string;
|
---|
17 | public
|
---|
18 | Update: Boolean;
|
---|
19 | constructor Create(Path: string);
|
---|
20 | procedure SaveToRegistry; // Uloží všechny proměnné do registrů
|
---|
21 | procedure LoadFromRegistry; // Načte proměnné z registrů
|
---|
22 | // Metody vloží do vnitřní tabulky odkaz na zadanou proměnnou, která má být uchována v registrech
|
---|
23 | procedure Include(NovyNazev: string; var NovaData: string; DefaultValue: string); overload;
|
---|
24 | procedure Include(NovyNazev: string; var NovaData: Integer; DefaultValue: Integer); overload;
|
---|
25 | procedure Include(NovyNazev: string; var NovaData: Boolean; DefaultValue: Boolean); overload;
|
---|
26 | procedure Include(NovyNazev: string; var NovaData: Real; DefaultValue: Real); overload;
|
---|
27 | procedure Delete;
|
---|
28 | destructor Destroy; override; // Uloží proměnné a uvolní se
|
---|
29 | end;
|
---|
30 |
|
---|
31 | implementation
|
---|
32 |
|
---|
33 | uses
|
---|
34 | Dialogs, SysUtils;
|
---|
35 |
|
---|
36 | constructor TAutoRegistry.Create(Path: string);
|
---|
37 | begin
|
---|
38 | FPath:= Path;
|
---|
39 | end;
|
---|
40 |
|
---|
41 | destructor TAutoRegistry.Destroy;
|
---|
42 | //var
|
---|
43 | // I: Integer;
|
---|
44 | begin
|
---|
45 | // for I:= 0 to High(FItems) do FItems[I].Free;
|
---|
46 | end;
|
---|
47 |
|
---|
48 | procedure TAutoRegistry.LoadFromRegistry;
|
---|
49 | var
|
---|
50 | I: Integer;
|
---|
51 | begin
|
---|
52 | with TRegistry.Create do begin
|
---|
53 | try
|
---|
54 | RootKey := HKEY_CURRENT_USER;
|
---|
55 | if not KeyExists(FPath) then SaveToRegistry;
|
---|
56 | OpenKey(FPath, True);
|
---|
57 | for I:= 0 to High(FItems) do with FItems[I] do begin
|
---|
58 | if Typ=1 then begin
|
---|
59 | if ValueExists(Nazev) and not Update then Integer(Data^):= ReadInteger(Nazev)
|
---|
60 | else WriteInteger(Nazev, Integer(Data^));
|
---|
61 | end else if Typ=3 then begin
|
---|
62 | if ValueExists(Nazev) and not Update then Boolean(Data^):= ReadBool(Nazev)
|
---|
63 | else WriteBool(Nazev,Boolean(Data^));
|
---|
64 | end else if Typ=4 then begin
|
---|
65 | if ValueExists(Nazev) and not Update then Real(Data^):= ReadFloat(Nazev)
|
---|
66 | else WriteFloat(Nazev,Real(Data^));
|
---|
67 | end else if Typ=2 then begin
|
---|
68 | if ValueExists(Nazev) and not Update then string(Data^):= ReadString(Nazev)
|
---|
69 | else WriteString(Nazev,string(Data^));
|
---|
70 | end;
|
---|
71 | end;
|
---|
72 | finally
|
---|
73 | Free;
|
---|
74 | end;
|
---|
75 | end;
|
---|
76 | end;
|
---|
77 |
|
---|
78 | procedure TAutoRegistry.SaveToRegistry;
|
---|
79 | var
|
---|
80 | I: Integer;
|
---|
81 | begin
|
---|
82 | with TRegistry.Create do begin
|
---|
83 | try
|
---|
84 | RootKey := HKEY_CURRENT_USER;
|
---|
85 | OpenKey(FPath, True);
|
---|
86 | for I:= 0 to High(FItems) do with FItems[I] do begin
|
---|
87 | if Typ = 1 then WriteInteger(Nazev,Integer(Data^)) else
|
---|
88 | if Typ = 3 then WriteBool(Nazev,Boolean(Data^)) else
|
---|
89 | if Typ = 4 then WriteFloat(Nazev, real(Data^)) else
|
---|
90 | if Typ = 2 then WriteString(Nazev, string(Data^));
|
---|
91 | end;
|
---|
92 | finally
|
---|
93 | Free;
|
---|
94 | end;
|
---|
95 | end;
|
---|
96 | end;
|
---|
97 |
|
---|
98 | procedure TAutoRegistry.Include(NovyNazev: string; var NovaData: string; DefaultValue: string);
|
---|
99 | begin
|
---|
100 | if not Update then NovaData:= DefaultValue;
|
---|
101 | SetLength(FItems,Length(FItems)+1);
|
---|
102 | with FItems[High(FItems)] do begin
|
---|
103 | Nazev:= NovyNazev;
|
---|
104 | Data:= Pointer(@NovaData);
|
---|
105 | Typ:= 2;
|
---|
106 | end;
|
---|
107 | end;
|
---|
108 |
|
---|
109 | procedure TAutoRegistry.Include(NovyNazev: string; var NovaData: Integer; DefaultValue: Integer);
|
---|
110 | begin
|
---|
111 | if not Update then NovaData:= DefaultValue;
|
---|
112 | SetLength(FItems,Length(FItems)+1);
|
---|
113 | with FItems[High(FItems)] do begin
|
---|
114 | Nazev:= NovyNazev;
|
---|
115 | Data:= Pointer(@NovaData);
|
---|
116 | Typ:= 1;
|
---|
117 | end;
|
---|
118 | end;
|
---|
119 |
|
---|
120 | procedure TAutoRegistry.Include(NovyNazev: string; var NovaData: Boolean; DefaultValue: Boolean);
|
---|
121 | begin
|
---|
122 | if not Update then NovaData:= DefaultValue;
|
---|
123 | SetLength(FItems,Length(FItems)+1);
|
---|
124 | with FItems[High(FItems)] do begin
|
---|
125 | Nazev:= NovyNazev;
|
---|
126 | Data:= Pointer(@NovaData);
|
---|
127 | Typ:= 3;
|
---|
128 | end;
|
---|
129 | end;
|
---|
130 |
|
---|
131 | procedure TAutoRegistry.Include(NovyNazev: string; var NovaData: Real; DefaultValue: Real);
|
---|
132 | begin
|
---|
133 | if not Update then NovaData:= DefaultValue;
|
---|
134 | SetLength(FItems,Length(FItems)+1);
|
---|
135 | with FItems[High(FItems)] do begin
|
---|
136 | Nazev:= NovyNazev;
|
---|
137 | Data:= Pointer(@NovaData);
|
---|
138 | Typ:= 4;
|
---|
139 | end;
|
---|
140 | end;
|
---|
141 |
|
---|
142 | procedure TAutoRegistry.Delete;
|
---|
143 | begin
|
---|
144 | with TRegistry.Create do begin
|
---|
145 | try
|
---|
146 | RootKey := HKEY_CURRENT_USER;
|
---|
147 | DeleteKey(FPath);
|
---|
148 | finally
|
---|
149 | Free;
|
---|
150 | end;
|
---|
151 | end;
|
---|
152 | SetLength(FItems,0);
|
---|
153 | //LoadFromRegistry;
|
---|
154 | end;
|
---|
155 |
|
---|
156 | end.
|
---|