diff options
| -rw-r--r-- | fileunit.pas | 179 |
1 files changed, 179 insertions, 0 deletions
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<br+rb then begin + pt:=pTmp; + len:=pLen; + pLen:=br+rb+minBufLen; + getmem(pTmp,pLen); + move(pt^,pTmp^,len); + freemem(pt); + end; + rb:=pr.output.read((pTmp+br)^,rb); + br:=br+rb; + end + else sleep(1); + end; + len:=br; + getmem(pt,len); + move(pTmp^,pt^,len); + freemem(pTmp); +end; + +// tInputThread **************************************************************** + +constructor tInputThread.create(p: tProcess; inh: pointer; l: longint); +begin + inherited create(true); + fertig:=false; + inhalt:=inh; + len:=l; + proc:=p; + suspended:=false; +end; + +destructor tInputThread.destroy; +begin + inhalt:=nil; + proc:=nil; + inherited destroy; +end; + +procedure tInputThread.execute; +var + wb,cwb: longint; +begin + wb:=0; + while wb<len do begin + cwb:=proc.input.write((inhalt+wb)^,len-wb); + if cwb=0 then + sleep(1) + else + wb:=wb+cwb; + end; + proc.CloseInput; + fertig:=true; +end; + +end. + |