add text file read unit and test program to go with it

git-svn-id: file:///svnroot/lcore/trunk@51 b1de8a11-f9be-4011-bde0-cc7ace90066a

diff --git a/readtxt2.pas b/readtxt2.pas
new file mode 100644 (file)
index 0000000..84c5765
--- /dev/null
+++ b/readtxt2.pas
@@ -0,0 +1,147 @@
+{ Copyright (C) 2009 Bas Steendijk and Peter Green\r
+  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+  which is included in the package\r
+  ----------------------------------------------------------------------------- }\r
+\r
+unit readtxt2;\r
+\r
+interface\r
+\r
+{\r
+readtxt, version 2\r
+by beware\r
+\r
+this can be used to read a text file exposed as a tstream line by line.\r
+automatic handling of CR, LF, and CRLF line endings, and readout of detected line ending type.\r
+fast: 1.5-2 times faster than textfile readln in tests.\r
+}\r
+\r
+uses\r
+  classes,sysutils;\r
+\r
+const\r
+  bufsize=4096;\r
+  eoltype_none=0;\r
+  eoltype_cr=1;\r
+  eoltype_lf=2;\r
+  eoltype_crlf=3;\r
+\r
+type\r
+  treadtxt=class(tobject)\r
+  public\r
+    sourcestream:tstream;\r
+    destroysourcestream:boolean;\r
+    constructor create(asourcestream: tstream; adestroysourcestream:boolean);\r
+    constructor createf(filename : string);\r
+\r
+    function readline:string;\r
+    function eof:boolean;\r
+    destructor destroy; override;\r
+  private\r
+    buf:array[0..bufsize-1] of byte;\r
+    numread:integer;\r
+    bufpointer:integer;\r
+    currenteol,preveol:integer;\r
+    fileeof,reachedeof:boolean;\r
+    eoltype:integer;\r
+  end;\r
+\r
+implementation\r
+\r
+constructor treadtxt.create(asourcestream: tstream; adestroysourcestream:boolean);\r
+begin\r
+  inherited create;\r
+  sourcestream := asourcestream;\r
+  destroysourcestream := adestroysourcestream;\r
+\r
+  if sourcestream.Position >= sourcestream.size then fileeof := true;\r
+  bufpointer := bufsize;\r
+  destroysourcestream := false;\r
+end;\r
+\r
+constructor treadtxt.createf(filename : string);\r
+begin\r
+  create(tfilestream.create(filename,fmOpenRead),true);\r
+end;\r
+\r
+\r
+function treadtxt.readline;\r
+var\r
+  a,b,c,d:integer;\r
+begin\r
+\r
+  result := '';\r
+  repeat\r
+    if bufpointer >= bufsize then begin\r
+      numread := sourcestream.read(buf,bufsize);\r
+      bufpointer := 0;\r
+      if sourcestream.Position >= sourcestream.size then fileeof := true;\r
+    end;\r
+    b := numread-1;\r
+\r
+    {core search loop begin}\r
+    d := -1;\r
+    for a := bufpointer to b do begin\r
+      c := buf[a];\r
+      if (c = 10) or (c = 13) then begin\r
+         d := a;\r
+         break;\r
+      end;\r
+    end;\r
+    {core search loop end}\r
+    \r
+    c := length(result);\r
+    if (d = -1) then begin\r
+      {ran out of buffer before end of line}\r
+      b := numread-bufpointer;\r
+      setlength(result,c+b);\r
+      move(buf[bufpointer],result[c+1],b);\r
+      bufpointer := numread;\r
+      if numread < bufsize then begin\r
+        reachedeof := true;\r
+        exit;\r
+      end;\r
+    end else begin\r
+\r
+      preveol := currenteol;\r
+      currenteol := buf[d];\r
+\r
+      {end of line before end of buffer}\r
+      if (currenteol = 10) and (preveol = 13) then begin\r
+        {it's the second EOL char of a DOS line ending, don't cause a line}\r
+        bufpointer := d+1;\r
+        eoltype := eoltype_crlf;\r
+      end else begin\r
+        if eoltype = eoltype_none then begin\r
+          if (currenteol = 10) then eoltype := eoltype_lf else eoltype := eoltype_cr;\r
+        end;  \r
+        b := d-bufpointer;\r
+        setlength(result,c+b);\r
+        move(buf[bufpointer],result[c+1],b);\r
+        bufpointer := d+1;\r
+\r
+        {EOF check}\r
+        if fileeof then begin\r
+          if (bufpointer >= numread) then reachedeof := true;\r
+          if (currenteol = 13) and (bufpointer = numread-1) then if (buf[bufpointer] = 10) then reachedeof := true;\r
+        end;  \r
+\r
+        exit;\r
+      end;\r
+    end;\r
+  until false;\r
+end;\r
+\r
+function treadtxt.eof:boolean;\r
+begin\r
+\r
+  result := ((bufpointer >= bufsize) and fileeof) or reachedeof;\r
+end;\r
+\r
+destructor treadtxt.destroy;\r
+begin\r
+  if destroysourcestream then if assigned(sourcestream) then sourcestream.destroy;\r
+  inherited destroy;\r
+end;\r
+\r
+end.\r

diff --git a/testreadtxt2.dof b/testreadtxt2.dof
new file mode 100644 (file)
index 0000000..691825f
--- /dev/null
+++ b/testreadtxt2.dof
@@ -0,0 +1,81 @@
+\r
+[Compiler]\r
+A=1\r
+B=0\r
+C=1\r
+D=1\r
+E=0\r
+F=0\r
+G=1\r
+H=1\r
+I=1\r
+J=1\r
+K=0\r
+L=1\r
+M=0\r
+N=1\r
+O=1\r
+P=1\r
+Q=0\r
+R=0\r
+S=0\r
+T=0\r
+U=0\r
+V=1\r
+W=0\r
+X=1\r
+Y=0\r
+Z=1\r
+ShowHints=1\r
+ShowWarnings=1\r
+UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;\r
+\r
+[Linker]\r
+MapFile=0\r
+OutputObjs=0\r
+ConsoleApp=0\r
+DebugInfo=0\r
+MinStackSize=16384\r
+MaxStackSize=1048576\r
+ImageBase=4194304\r
+ExeDescription=\r
+\r
+[Directories]\r
+OutputDir=\r
+UnitOutputDir=\r
+SearchPath=\r
+Packages=vclx30;VCL30;vcldb30;vcldbx30;Qrpt30;VclSmp30;teeui30;teedb30;tee30;IBEVNT30\r
+Conditionals=\r
+DebugSourceDirs=\r
+UsePackages=0\r
+\r
+[Parameters]\r
+RunParams=\r
+HostApplication=\r
+\r
+[Version Info]\r
+IncludeVerInfo=0\r
+AutoIncBuild=0\r
+MajorVer=1\r
+MinorVer=0\r
+Release=0\r
+Build=0\r
+Debug=0\r
+PreRelease=0\r
+Special=0\r
+Private=0\r
+DLL=0\r
+Locale=2057\r
+CodePage=1252\r
+\r
+[Version Info Keys]\r
+CompanyName=\r
+FileDescription=\r
+FileVersion=1.0.0.0\r
+InternalName=\r
+LegalCopyright=\r
+LegalTrademarks=\r
+OriginalFilename=\r
+ProductName=\r
+ProductVersion=1.0.0.0\r
+Comments=\r

diff --git a/testreadtxt2.dpr b/testreadtxt2.dpr
new file mode 100644 (file)
index 0000000..a378293
--- /dev/null
+++ b/testreadtxt2.dpr
@@ -0,0 +1,36 @@
+{ Copyright (C) 2009 Bas Steendijk and Peter Green\r
+  For conditions of distribution and use, see copyright notice in zlib_license.txt\r
+  which is included in the package\r
+  ----------------------------------------------------------------------------- }\r
+\r
+\r
+program testreadtxt2;\r
+uses readtxt2, classes;\r
+\r
+var\r
+  t: treadtxt;\r
+  f: file;\r
+procedure writestring(var f: file; s : string);\r
+begin\r
+  blockwrite(f,s[1],length(s));\r
+end;\r
+\r
+begin\r
+  assignfile(f,'mixed.txt');\r
+  rewrite(f,1);\r
+  writestring(f,'DOS'#13#10);\r
+  writestring(f,'UNIX'#10);\r
+  writestring(f,'MAC'#13);\r
+  writestring(f,'NONE');\r
+  closefile(f);\r
+  t := treadtxt.createf('mixed.txt');\r
+  if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail');\r
+  if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail');\r
+  if t.readline = 'MAC' then writeln('MAC success') else writeln('MAC fail');\r
+  if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail');\r
+  t.destroy;\r
+  {$ifdef win32}\r
+    //make things a little easier to test in the delphi GUI\r
+    readln;\r
+  {$endif}\r
+end.\r