From 421750275f6e81adda2833b0aeb57abbad817538 Mon Sep 17 00:00:00 2001 From: Erich Eckner Date: Wed, 18 Nov 2015 20:39:02 +0100 Subject: fileunit.pas neu zum (un)komprimierten Laden und Speichern --- fileunit.pas | 179 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 179 insertions(+) create mode 100644 fileunit.pas (limited to 'fileunit.pas') diff --git a/fileunit.pas b/fileunit.pas new file mode 100644 index 0000000..4530967 --- /dev/null +++ b/fileunit.pas @@ -0,0 +1,179 @@ +unit fileunit; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, Process; + +type + tInputThread = class (tThread) + fertig: boolean; + inhalt: pointer; + len: longint; + proc: tProcess; + constructor create(p: tProcess; inh: pointer; l: longint); + destructor destroy; override; + procedure execute; override; + end; + +procedure saveToFile(name: string; pt: pointer; len: longint); inline; +procedure saveToGz(name: string; pt: pointer; len: longint); inline; +procedure loadFromFile(name: string; out pt: pointer; out len: longint); inline; +procedure loadFromGz(name: string; out pt: pointer; out len: longint); inline; + +implementation + +uses systemunit, math; + +const + minBufLen = 1024*1024; + +procedure saveToFile(name: string; pt: pointer; len: longint); +var + f: file; + n: string; +begin + if fileexists(name) then + n:=mkTemp(name+'.XXXXXX') + else + n:=name; + assignfile(f,n); + rewrite(f,1); + blockwrite(f,pt^,len); + closefile(f); + if name<>n then begin + deleteFile(name); + rename(f,name); + end; +end; + +procedure saveToGz(name: string; pt: pointer; len: longint); +var + pr: tProcess; + buf: array of byte; + f: file; + rb: longint; + it: tInputThread; + datNam: string; +begin + if fileexists(name) then + datNam:=mkTemp(name+'.XXXXXX') + else + datNam:=name; + + pr:=tProcess.create(nil); + pr.executable:='gzip'; + pr.parameters.add('--best'); + pr.parameters.add('-c'); + pr.options:=pr.options + [poUsePipes]; + pr.execute; + setlength(buf,minBufLen); + fillchar(buf[0],length(buf)*sizeof(buf[0]),$0); + it:=tInputThread.create(pr,pt,len); + assignfile(f,datNam); + rewrite(f,1); + while pr.running or (not it.fertig) or (pr.output.numBytesAvailable>0) do begin + rb:=min(length(buf),pr.output.numBytesAvailable); + if rb>0 then begin + rb:=pr.output.read(buf[0],rb); + blockwrite(f,buf[0],rb); + end + else + sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir + end; + pr.free; + it.free; + closefile(f); + if name<>datNam then begin + deleteFile(name); + rename(f,name); + end; +end; + +procedure loadFromFile(name: string; out pt: pointer; out len: longint); +var + f: file; +begin + assign(f,name); + reset(f,1); + len:=filesize(f); + getmem(pt,len); + blockread(f,pt^,len); + close(f); +end; + +procedure loadFromGz(name: string; out pt: pointer; out len: longint); +var + pr: tProcess; + pTmp: pByte; + pLen,rb,br: longint; +begin + pr:=tProcess.create(nil); + pr.executable:='zcat'; + pr.parameters.add(name); + pr.options:=pr.options + [poUsePipes]; + pLen:=minBufLen; + getmem(pTmp,pLen); + br:=0; + pr.execute; + while pr.running or (pr.output.numBytesAvailable>0) do begin + rb:=pr.output.numBytesAvailable; + if rb>0 then begin + if pLen