fpc 3.0.0 support - fpc 3 renames fields in TInetSockAddr so we define it ourselves...
[lcore.git] / readtxt2.pas
1 { Copyright (C) 2009 Bas Steendijk and Peter Green\r
2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
3   which is included in the package\r
4   ----------------------------------------------------------------------------- }\r
5 \r
6 unit readtxt2;\r
7 \r
8 interface\r
9 \r
10 {\r
11 readtxt, version 2\r
12 by beware\r
13 \r
14 this can be used to read a text file exposed as a tstream line by line.\r
15 automatic handling of CR, LF, and CRLF line endings, and readout of detected line ending type.\r
16 fast: 1.5-2 times faster than textfile readln in tests.\r
17 }\r
18 \r
19 uses\r
20   classes,sysutils;\r
21 \r
22 const\r
23   bufsize=4096;\r
24   eoltype_none=0;\r
25   eoltype_any=0;\r
26   eoltype_cr=1;\r
27   eoltype_lf=2;\r
28   eoltype_crlf=3;\r
29 \r
30 type\r
31   treadtxt=class(tobject)\r
32   private\r
33     buf:array[0..bufsize-1] of byte;\r
34     numread:integer;\r
35     bufpointer:integer;\r
36     currenteol,preveol:integer;\r
37     fileeof,reachedeof:boolean;\r
38     fdetectedeol:integer;\r
39     procedure checkandread;\r
40   public\r
41     sourcestream:tstream;\r
42     destroysourcestream:boolean;\r
43     allowedeol:integer;\r
44     constructor create(asourcestream: tstream; adestroysourcestream:boolean);\r
45     constructor createf(filename : string);\r
46 \r
47     function readline:ansistring;\r
48     function eof:boolean;\r
49     destructor destroy; override;\r
50     property detectedeol : integer read fdetectedeol;\r
51   end;\r
52   \r
53 implementation\r
54 \r
55 constructor treadtxt.create(asourcestream: tstream; adestroysourcestream:boolean);\r
56 begin\r
57   inherited create;\r
58   sourcestream := asourcestream;\r
59   destroysourcestream := adestroysourcestream;\r
60 \r
61   //if sourcestream.Position >= sourcestream.size then fileeof := true;\r
62   bufpointer := bufsize;\r
63 end;\r
64 \r
65 constructor treadtxt.createf(filename: string);\r
66 begin\r
67   create(tfilestream.create(filename,fmOpenRead or fmShareDenyWrite),true);\r
68 end;\r
69 \r
70 \r
71 procedure treadtxt.checkandread;\r
72 begin\r
73   if bufpointer >= numread then begin\r
74     numread := sourcestream.read(buf,bufsize);\r
75     bufpointer := 0;\r
76     if numread = 0 then fileeof := true;\r
77       \r
78   end;\r
79 end;\r
80 \r
81 function treadtxt.readline;\r
82 var\r
83   a,b,c,d:integer;\r
84   prevchar : integer;\r
85   trimchar : boolean;\r
86 begin\r
87   prevchar := 0;\r
88   result := '';\r
89   repeat\r
90     checkandread;\r
91     b := numread-1;\r
92     trimchar := false;\r
93     {core search loop begin}\r
94     d := -1;\r
95     for a := bufpointer to b do begin\r
96       c := buf[a];\r
97       //check if the character can possibly be a line ending before getting\r
98       //into the more complex checks that depend on eol type\r
99       if (c = 10) or (c = 13) then case allowedeol of\r
100         eoltype_any: begin\r
101           d := a;\r
102           break;\r
103         end;\r
104         eoltype_cr: begin\r
105           if (c = 13) then begin\r
106             d := a;\r
107             break;\r
108           end;\r
109         end;\r
110         eoltype_lf: begin\r
111           if (c = 10) then begin\r
112             d := a;\r
113             break;\r
114           end;\r
115         end;\r
116         eoltype_crlf: begin\r
117           if (c = 10) and (prevchar= 13) then begin\r
118             d := a;\r
119             trimchar := true;\r
120             break;\r
121           end;\r
122           prevchar := c;\r
123         end;\r
124         else begin\r
125           raise exception.create('undefined eol type set');\r
126         end;\r
127       end;\r
128       prevchar := c;\r
129     end;\r
130     {core search loop end}\r
131     \r
132     c := length(result);\r
133     if (d = -1) then begin\r
134       {ran out of buffer before end of line}\r
135       b := numread-bufpointer;\r
136       setlength(result,c+b);\r
137       move(buf[bufpointer],result[c+1],b);\r
138       bufpointer := numread;\r
139       if fileeof then begin\r
140         {we reached the end of the file, return what we have}\r
141         reachedeof := true;\r
142         exit;\r
143       end;\r
144     end else begin\r
145 \r
146       preveol := currenteol;\r
147       currenteol := buf[d];\r
148 \r
149       {end of line before end of buffer}\r
150       if (currenteol = 10) and (preveol = 13) and (bufpointer = d) then begin\r
151         {it's the second EOL char of a DOS line ending, don't cause a line}\r
152         bufpointer := d+1;\r
153         fdetectedeol := eoltype_crlf;\r
154       end else begin\r
155         if fdetectedeol = eoltype_none then begin\r
156           if (currenteol = 10) then fdetectedeol := eoltype_lf else fdetectedeol := eoltype_cr;\r
157         end;  \r
158         b := d-bufpointer;\r
159         if trimchar then begin\r
160           setlength(result,c+b-1);\r
161           move(buf[bufpointer],result[c+1],b-1);\r
162           bufpointer := d+1;\r
163         end else begin\r
164           setlength(result,c+b);\r
165           move(buf[bufpointer],result[c+1],b);\r
166           bufpointer := d+1;\r
167         end;\r
168 \r
169         {EOF check}\r
170         if fileeof then begin\r
171           if (bufpointer >= numread) then reachedeof := true;\r
172           if (currenteol = 13) and (bufpointer = numread-1) then if (buf[bufpointer] = 10) then reachedeof := true;\r
173         end;  \r
174 \r
175         exit;\r
176       end;\r
177     end;\r
178   until false;\r
179 end;\r
180 \r
181 function treadtxt.eof:boolean;\r
182 begin\r
183   checkandread;\r
184   result := ((bufpointer >= numread) and fileeof) or reachedeof;\r
185 end;\r
186 \r
187 destructor treadtxt.destroy;\r
188 begin\r
189   if destroysourcestream then if assigned(sourcestream) then sourcestream.destroy;\r
190   inherited destroy;\r
191 end;\r
192 \r
193 end.\r