blob: 5e4797e4c98e9fb96e2e783fe731f05c6bc61513 (
plain)
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
|
{ Source provided for Free Pascal Bug Report 3595 }
{ Submitted by "Martin Schreiber" on 2005-01-24 }
{ e-mail: }
program project1;
{$ifdef FPC} {$mode objfpc}{$H+} {$endif}
uses
Classes,sysutils;
type
ttest = class(tcomponent)
private
fwstr: widestring;
published
property wstr: widestring read fwstr write fwstr;
end;
const
textfilename = 'test.txt';
var
test1,test2: ttest;
memstream: tmemorystream;
filestream: tfilestream;
function widestringtocharinfo(const str: widestring): string;
var
int1: integer;
begin
result:= '';
for int1:= 1 to length(str) do begin
result:= result + '#' + inttostr(ord(str[int1]));
end;
end;
begin
test1:= ttest.create(nil);
test2:= ttest.create(nil);
with test1 do begin
setlength(fwstr,3);
fwstr[1]:= widechar(255);
fwstr[2]:= widechar(256);
fwstr[3]:= widechar(257);
fwstr:= fwstr + #0#1'abcde'#127#128#129;
end;
filestream:= tfilestream.create(textfilename,fmcreate);
memstream:= tmemorystream.create;
memstream.writecomponent(test1);
memstream.position:= 0;
objectbinarytotext(memstream,filestream);
memstream.free;
filestream.free;
try
filestream:= tfilestream.create(textfilename,fmopenread);
memstream:= tmemorystream.create;
try
objecttexttobinary(filestream,memstream);
writeln('objecttexttobinary OK');
try
memstream.position:= 0;
memstream.readcomponent(test2);
writeln('object reading OK');
if test1.wstr = test2.wstr then begin
writeln('data OK');
end
else begin
writeln('data wrong. expected:');
writeln(widestringtocharinfo(test1.wstr));
writeln('actual:');
writeln(widestringtocharinfo(test2.wstr));
halt(1);
end;
except
on e: exception do begin
writeln('object reading fails: '+ e.message);
halt(1);
end;
end;
except
on e: exception do begin
writeln('objecttexttobinary fails: '+e.message);
halt(1);
end;
end;
filestream.free;
memstream.free;
except
writeln('file '+textfilename+' not found.');
halt(1);
end;
test1.free;
test2.free;
deletefile(textfilename);
end.
|
