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
|
Program Testobj;
uses Objects;
const
{ Possible error codes returned to DOS by this program }
EXIT_NOERROR = 0;
EXIT_NOTIFF = 1;
EXIT_DOSERROR = 2;
(*************************************************************************)
(* Create a stream error procedure which will be called on error of the *)
(* stream. Will Terminate executing program, as well as display info *)
(* on the type of error encountered. *)
(*************************************************************************)
Procedure StreamErrorProcedure(Var S: TStream);
Begin
If S.Status = StError then
Begin
WriteLn('ERROR: General Access failure. Halting');
Halt(EXIT_DOSERROR);
end;
If S.Status = StInitError then
Begin
Write('ERROR: Cannot Init Stream. Halting. ');
{ SPECIFIC TO DOS STREAMS }
Case S.ErrorInfo of
2: WriteLn('File not found.');
3: WriteLn('Path not found.');
5: Writeln('Access denied.');
else
WriteLn;
end;
Halt(EXIT_DOSERROR);
end;
If S.Status = StReadError then
Begin
WriteLn('ERROR: Read beyond end of Stream. Halting');
Halt(EXIT_DOSERROR);
end;
If S.Status = StWriteError then
Begin
WriteLn('ERROR: Cannot expand Stream. Halting');
Halt(EXIT_DOSERROR);
end;
If S.Status = StGetError then
Begin
WriteLn('ERROR: Get of Unregistered type. Halting');
Halt(EXIT_DOSERROR);
end;
If S.Status = StPutError then
Begin
WriteLn('ERROR: Put of Unregistered type. Halting');
Halt(EXIT_DOSERROR);
end;
end;
Procedure WriteInformation;
{ Writes information about the program }
Begin
WriteLn('Usage: fname.ext to check');
Halt(EXIT_NOERROR);
end;
{ Program to demonstrate the TDosStream object. }
Const S : String = '0123456789';
P : Pchar = '9876543210';
Var Stream : TDosStream;
Buf : String;
L : word;
f : file;
begin
StreamError:= @StreamErrorProcedure;
Writeln ('Writing to stream : "01234567899876543210"');
Stream.Init('testobj.tmp',stCreate);
Stream.WriteStr (@S);
Stream.StrWrite (P);
Writeln ('Closing stream.');
Stream.Done;
Writeln ('Reading from stream : ');
Stream.Init('testobj.tmp',StOpenRead);
WriteLn('After opening');
Writeln ('Reading (',S,') : ',Stream.ReadStr^);
Writeln ('Reading (',P,') : ',Stream.StrRead);
Writeln ('Closing stream.');
Stream.Done;
Writeln ('Same thing, using raw read method : ');
Writeln ('Reading from stream : ');
Stream.Init('testobj.tmp',StOpenRead);
Stream.Read (Buf,11);
Writeln ('Reading (',S,') : ',Buf);
Stream.Read (L,2);
Stream.Read (Buf[1],L);
Buf[0]:=chr(L);
Writeln ('Reading (',P,') : ',Buf);
Writeln ('Closing stream.');
Stream.Done;
Writeln ('Statistics about stream : ');
Stream.Init('testobj.tmp',StOpenRead);
Writeln ('Size : ',Stream.GetSize);
Writeln ('Position : ',Stream.GetPos);
Writeln ('Reading (',S,') : ',Stream.ReadStr^);
L:=Stream.GetPos;
Writeln ('Position : ',L);
Writeln ('Closing stream.');
Stream.Done;
Writeln ('Reading from stream : ');
Stream.Init('testobj.tmp',StOpenRead);
Writeln ('Seek to position :',L);
Stream.Seek(L);
Writeln ('Reading (',P,') : ',Stream.StrRead);
Writeln ('Closing stream.');
Stream.Done;
Writeln ('Truncating stream to zero length.');
Stream.Init('testobj.tmp',StOpenWrite);
Stream.Truncate;
Stream.Done;
Assign(f,'testobj.tmp');
Erase(f);
end.
|
