fileunit.pas neu zum (un)komprimierten Laden und Speichern

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.
+