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 possiblly 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