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 | {=================================================================
TestReg.pp versión 1.2 12/02/2002
Copyright (C) 2000-2002 by Luis Digital (luis@luis-digital.8m.com)
TestReg pone en prueba y sirve de ejemplo para TRegistry.
Este es software libre bajo la licencia GNU/GPL.
Ver COPYING.FPC y COPYING incluidos con este programa.
Este programa es distribuido esperando que sea útil, pero SIN NINGUNA GARANTIA.
=================================================================}
Program TestReg;
{$mode objfpc} {$H+}
Uses registry, SysUtils;
Const SInteger = 'Integer';
SBinaryData = 'Binary';
SBoolean = 'Boolean';
SCurrency = 'Currency';
SExString = 'ExpandString'; SDate = 'Date';
STime = 'Time';
SDateTime = 'DateTime';
SString = 'String';
SFloat = 'Float';
IntVal = 321;
FloatVal = 123.456;
CurrencyVal = 456;
BoolVal = False; StringVal = 'This is a normal string';
SExpandVal = 'This is an expand string: "%SystemDir%"';
Var
I: Integer; SubKey: String;
B : Boolean;
F: Double;
C : Currency;
S : String; BinData: Array [0..15] of Byte;
D : TDateTime;
DateVal,TimeVal,DateTimeVal : TDateTime;
Begin With TRegistry.Create do
Try
RootKey := HKEY_CURRENT_USER;
SubKey := 'SoftwareFPCtestreg';
CreateKey(SubKey); If Not OpenKey(SubKey,False) then
Writeln('Could not open key: ',SubKey)
else
begin
Writeln('Writing data'); WriteInteger(SInteger, IntVal);
For I:= 0 To 15 Do
BinData[I] := I;
WriteBinaryData(SBinaryData,BinData,SizeOf(BinData));
WriteBool(SBoolean, BoolVal); WriteCurrency(SCurrency, CurrencyVal);
WriteFloat(SFloat, FloatVal);
WriteExpandString(SExString,SExpandVal);
WriteString(SString,StringVal);
DateVal:=Date; WriteDate(SDate, DateVal);
TimeVal:=Time;
WriteTime(STime, TimeVal);
DateTimeVal:=Now;
WriteDateTime(SDateTime, DateTimeVal); Writeln('Reading data');
I:=ReadInteger(Sinteger);
If (I<>IntVal) then
Writeln('Read Integer differs: ',I);
FillChar(BinData,SizeOf(Bindata),0); I:=GetDataSize(SBinaryData);
If I<>16 then
Writeln('Size Binary Data differs: ',I)
else
begin ReadBinaryData(SBinaryData, BinData,I);
For I:=0 to 15 do
If BinData[i]<>I then
Write('Binary Data byte ',i,' differs : ',BinData[i]);
end; B:=ReadBool(SBoolean);
If (B<>BoolVal) then
Writeln('Boolean value differs : ',B);
C:=ReadCurrency(SCurrency);
If (C<>CurrencyVal) then Writeln('Currency value differs: ', C);
S:=ReadString(SString);
If (S<>StringVal) then
Writeln('Read String differs: "',S,'"(',Length(s),')<>"',StringVal,'"(',length(StringVal),')');
D:=ReadDateTime(SDateTime); If (D<>DateTimeVal) then
Writeln('Read DateTime differs : ',D);
D:=ReadDate(SDate);
If (D<>DateVal) then
Writeln('Read Date differs : ',D); D:=ReadDateTime(STime);
If (D<>TimeVal) then
Writeln('Read Time differs : ',D);
F:=ReadFloat(SFloat);
If ((F-FloatVal)>1e-4) then Writeln('Read Float differs: ',F);
If Not DeleteValue(SFloat) Then
Writeln('Error: could not delete float value');
CloseKey;
SubKey:='Softwarefpctestreg2'; Createkey(SubKey);
If Not DeleteKey(SubKey) Then
Writeln('Error: could not delete key',subkey);
end;
Finally CloseKey;
free;
end;
End. |
