From: plugwash Date: Thu, 18 Jun 2009 00:48:22 +0000 (+0000) Subject: add text file read unit and test program to go with it X-Git-Url: http://www.lcore.org/git/lcore.git/commitdiff_plain/a1858883733a454b6ffb73aa263ef5badc2a1d07?ds=inline 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 index 0000000..84c5765 --- /dev/null +++ b/readtxt2.pas @@ -0,0 +1,147 @@ +{ Copyright (C) 2009 Bas Steendijk and Peter Green + For conditions of distribution and use, see copyright notice in zlib_license.txt + which is included in the package + ----------------------------------------------------------------------------- } + +unit readtxt2; + +interface + +{ +readtxt, version 2 +by beware + +this can be used to read a text file exposed as a tstream line by line. +automatic handling of CR, LF, and CRLF line endings, and readout of detected line ending type. +fast: 1.5-2 times faster than textfile readln in tests. +} + +uses + classes,sysutils; + +const + bufsize=4096; + eoltype_none=0; + eoltype_cr=1; + eoltype_lf=2; + eoltype_crlf=3; + +type + treadtxt=class(tobject) + public + sourcestream:tstream; + destroysourcestream:boolean; + constructor create(asourcestream: tstream; adestroysourcestream:boolean); + constructor createf(filename : string); + + function readline:string; + function eof:boolean; + destructor destroy; override; + private + buf:array[0..bufsize-1] of byte; + numread:integer; + bufpointer:integer; + currenteol,preveol:integer; + fileeof,reachedeof:boolean; + eoltype:integer; + end; + +implementation + +constructor treadtxt.create(asourcestream: tstream; adestroysourcestream:boolean); +begin + inherited create; + sourcestream := asourcestream; + destroysourcestream := adestroysourcestream; + + if sourcestream.Position >= sourcestream.size then fileeof := true; + bufpointer := bufsize; + destroysourcestream := false; +end; + +constructor treadtxt.createf(filename : string); +begin + create(tfilestream.create(filename,fmOpenRead),true); +end; + + +function treadtxt.readline; +var + a,b,c,d:integer; +begin + + result := ''; + repeat + if bufpointer >= bufsize then begin + numread := sourcestream.read(buf,bufsize); + bufpointer := 0; + if sourcestream.Position >= sourcestream.size then fileeof := true; + end; + b := numread-1; + + {core search loop begin} + d := -1; + for a := bufpointer to b do begin + c := buf[a]; + if (c = 10) or (c = 13) then begin + d := a; + break; + end; + end; + {core search loop end} + + c := length(result); + if (d = -1) then begin + {ran out of buffer before end of line} + b := numread-bufpointer; + setlength(result,c+b); + move(buf[bufpointer],result[c+1],b); + bufpointer := numread; + if numread < bufsize then begin + reachedeof := true; + exit; + end; + end else begin + + preveol := currenteol; + currenteol := buf[d]; + + {end of line before end of buffer} + if (currenteol = 10) and (preveol = 13) then begin + {it's the second EOL char of a DOS line ending, don't cause a line} + bufpointer := d+1; + eoltype := eoltype_crlf; + end else begin + if eoltype = eoltype_none then begin + if (currenteol = 10) then eoltype := eoltype_lf else eoltype := eoltype_cr; + end; + b := d-bufpointer; + setlength(result,c+b); + move(buf[bufpointer],result[c+1],b); + bufpointer := d+1; + + {EOF check} + if fileeof then begin + if (bufpointer >= numread) then reachedeof := true; + if (currenteol = 13) and (bufpointer = numread-1) then if (buf[bufpointer] = 10) then reachedeof := true; + end; + + exit; + end; + end; + until false; +end; + +function treadtxt.eof:boolean; +begin + + result := ((bufpointer >= bufsize) and fileeof) or reachedeof; +end; + +destructor treadtxt.destroy; +begin + if destroysourcestream then if assigned(sourcestream) then sourcestream.destroy; + inherited destroy; +end; + +end. diff --git a/testreadtxt2.dof b/testreadtxt2.dof new file mode 100644 index 0000000..691825f --- /dev/null +++ b/testreadtxt2.dof @@ -0,0 +1,81 @@ + +[Compiler] +A=1 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=0 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; + +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=0 +DebugInfo=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= + +[Directories] +OutputDir= +UnitOutputDir= +SearchPath= +Packages=vclx30;VCL30;vcldb30;vcldbx30;Qrpt30;VclSmp30;teeui30;teedb30;tee30;IBEVNT30 +Conditionals= +DebugSourceDirs= +UsePackages=0 + +[Parameters] +RunParams= +HostApplication= + +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=2057 +CodePage=1252 + +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= diff --git a/testreadtxt2.dpr b/testreadtxt2.dpr new file mode 100644 index 0000000..a378293 --- /dev/null +++ b/testreadtxt2.dpr @@ -0,0 +1,36 @@ +{ Copyright (C) 2009 Bas Steendijk and Peter Green + For conditions of distribution and use, see copyright notice in zlib_license.txt + which is included in the package + ----------------------------------------------------------------------------- } + + +program testreadtxt2; +uses readtxt2, classes; + +var + t: treadtxt; + f: file; +procedure writestring(var f: file; s : string); +begin + blockwrite(f,s[1],length(s)); +end; + +begin + assignfile(f,'mixed.txt'); + rewrite(f,1); + writestring(f,'DOS'#13#10); + writestring(f,'UNIX'#10); + writestring(f,'MAC'#13); + writestring(f,'NONE'); + closefile(f); + t := treadtxt.createf('mixed.txt'); + if t.readline = 'DOS' then writeln('DOS success') else writeln('DOS fail'); + if t.readline = 'UNIX' then writeln('UNIX success') else writeln('UNIX fail'); + if t.readline = 'MAC' then writeln('MAC success') else writeln('MAC fail'); + if t.readline = 'NONE' then writeln('NONE success') else writeln('NONE fail'); + t.destroy; + {$ifdef win32} + //make things a little easier to test in the delphi GUI + readln; + {$endif} +end.