unit saving;

// Neue Version mit Exceptions statt showmessage

interface
uses classes, SysUtils, checklst;

type
 ESavingError = class(Exception);

type TStrArray= Array Of String;
procedure Split(Input: string; const Delimiter: Char; const Strings: TStrings) ;  overload;
function Split(S: String; Delimiter: Char):  TStrArray; overload;

function paramX(strin : string; nr : integer; trennzeichen : char) : string; //0 = erster eintrag usw.
function param(strin : string; nr : integer) : string; // Trennzeichen= #09 (TAB)

function get_last_modified(p : pchar; VAR date_str : string) : boolean;
function get_last_Etag(p : pchar; VAR etag_str : string) : boolean;


function savepointer(rec_p : pointer; rec_s: longint; filename : string) : boolean;
function loadpointer(var rec_p : pointer; var rec_s : longint; filename : string) : boolean;  overload;
function loadpointer(var rec_p : pchar; var rec_s : longword; filename : string) : boolean; overload;


procedure LoadPchar(VAR p : pchar; VAR s : longint; filename : string);
function LoadList(Var vlist : TStringList; filename : string) : boolean;

procedure SaveList(Var vlist : Tstringlist; filename : string);
procedure SavePchar(p : pchar; filename : string);


function LoadHtmlCache(VAR p :pchar; VAR s : longint; filename : string;
                    VAR date_out : string; VAR etag_out : string) : boolean;

function SaveHtmlCache(p : pchar; s : longint; filename : string) : boolean;

procedure saveCheckListBox(Var vlistbox : TCheckListbox; filename : string);
procedure loadCheckListBox(Var vlistbox : TCheckListbox; filename : string);

procedure SetCheckListbox(VAR vlistbox : TCheckListBox; VAR vlist : TStringList);
procedure getCheckListbox(VAR vlistbox : TCheckListBox; VAR vlist : TStringList);

//procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string);

implementation


(*
procedure PathExtractElements(const Source: string; var Drive, Path, FileName, Ext: string);
begin
  Drive := ExtractFileDrive(Source);
  Path := ExtractFilePath(Source);
  // Path includes drive so remove that
  if Drive <> '' then
    Delete(Path, 1, Length(Drive));
  // add/remove separators
  Drive := PathAddSeparator(Drive);
  Path := PathRemoveSeparator(Path);
  if (Path <> '') and (Path[1] = PathSeparator) then
    Delete(Path, 1, 1);
  // and extract the remaining elements
  FileName := PathExtractFileNameNoExt(Source);
  Ext := ExtractFileExt(Source);
end;
  *)

function paramX(strin : string; nr : integer; trennzeichen : char) : string; //0 = erster eintrag usw.
var za1,i,l : integer;
    bufs : string;
begin;

za1:=0;
i:=0; l:=length(strin);
bufs:='';

if nr>0 then begin;
 repeat
  i:=i+1;
  if i<=l then begin;
   if strin[i]=trennzeichen then inc(za1);
  end;

 until (za1=nr) or (i>l);
end;

if i<l then begin;
 repeat
  i:=i+1;
  if strin[i]<>trennzeichen then bufs:=bufs+strin[i] else i:=l;
 until i>=l;
end;
paramX:=bufs;

end;



function param(strin : string; nr : integer) : string; //0 = erster eintrag usw.
var za1,i,l : integer;
    bufs : string;
begin;

za1:=0;
i:=0; l:=length(strin);
bufs:='';

if nr>0 then begin;
 repeat
  i:=i+1;
  if i<=l then begin;
   if strin[i]=chr(09) then inc(za1);
  end;

 until (za1=nr) or (i>l);
end;

if i<l then begin;
 repeat
  i:=i+1;
  if strin[i]<>chr(09) then bufs:=bufs+strin[i] else i:=l;
 until i>=l;
end;
param:=bufs;

end;


function savepointer(rec_p : pointer; rec_s: longint; filename : string) : boolean;
var f : file;
    AmtTransferred : integer;
    bufio : integer;
begin;
if (rec_p<>NIL) and (rec_s>0) then begin
savepointer:=true;
{$I-}
assignfile(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 savepointer:=false;
 raise ESavingError.create('savepointer: Fehler '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
rewrite(f,1);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 savepointer:=false;
 raise ESavingError.Create('savepointer: Fehler '+inttostr(bufio)+' = Kein Schreibzugriff m鰃lich');
 exit;
end;

{$I-}
blockwrite(f,rec_p^, rec_s,AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 savepointer:=false;
 raise ESavingError.Create('savepointer: Fehler '+inttostr(bufio)+' = I/O Fehler');
end;
if AmtTransferred<>rec_s then raise ESavingError.Create('savepointer: Fehler '+inttostr(bufio)+' = Konnte nicht alle Daten sichern');
{$I-}
closefile(f);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 savepointer:=false;
 raise ESavingError.Create('savepointer: Fehler '+inttostr(bufio)+' = Datei kann nicht geschlossen werden');
end;
end
else begin
  savepointer:=false;
  raise ESavingError.Create('savepointer:  Fehler: Noch keine Daten empfangen');
end;
end;


function loadpointer(var rec_p : pointer; var rec_s: longint; filename : string) : boolean;
var f : file;
    AmtTransferred : integer;
    bufio : integer;
begin;

loadpointer:=true;
{$I-}
assignfile(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
reset(f,1);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Kein Lesezugriff m鰃lich');
 exit;
end;
rec_s:=filesize(f);
if rec_s>0 then begin
getmem(rec_p, rec_s);
{$I-}
blockread(f,rec_p^, rec_s,AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = I/O Fehler');
end;
if AmtTransferred<>rec_s then raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Konnte nicht alle Daten laden');
{$I-}
closefile(f);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Datei kann nicht geschlossen werden');
end;
end
else begin
  loadpointer:=false;
  raise ESavingError.Create('loadpointer:  Datei scheint leer zu sein');
end;
end;


function loadpointer(var rec_p : pchar; var rec_s: longword; filename : string) : boolean;
var f : file;
    AmtTransferred : longword;
    bufio : integer;
begin;

loadpointer:=true;
{$I-}
assignfile(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
reset(f,1);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Kein Lesezugriff m鰃lich');
 exit;
end;
rec_s:=filesize(f);
if rec_s>0 then begin
getmem(rec_p, rec_s);
{$I-}
blockread(f,rec_p^, rec_s,AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = I/O Fehler');
end;
if AmtTransferred<>rec_s then raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Konnte nicht alle Daten laden');
{$I-}
closefile(f);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadpointer:=false;
 raise ESavingError.Create('loadpointer: Fehler '+inttostr(bufio)+' = Datei kann nicht geschlossen werden');
end;
end
else begin
  loadpointer:=false;
  raise ESavingError.Create('loadpointer:  Datei scheint leer zu sein');
end;
end;



function get_last_Etag(p : pchar; VAR etag_str : string) : boolean;
const
 C_MATCH = 'ETag: '; // ANSWER
var
 pstart : pchar;
 za1 : integer;
begin;
 get_last_etag:=true;
 etag_str:='';
 pstart:=strpos(p,PCHAR(C_MATCH));
 if pstart<>NIL then begin

  za1:=length(C_MATCH)-1;
  repeat
    za1:=za1+1;
    if pstart[za1]<>#13 then etag_str:=etag_str+pstart[za1];
  until (pstart[za1]=#13) or (za1=strlen(pstart));

end else get_last_etag:=false;
end;




function get_last_modified(p : pchar; VAR date_str : string) : boolean;
const
 C_MODIFIED = 'Last-Modified: ';
var
 pstart : pchar;
 za1 : integer;
begin;
 get_last_modified:=true;
 date_str:='';
 pstart:=strpos(p,PCHAR(C_MODIFIED));
 if pstart<>NIL then begin

  za1:=length(C_MODIFIED)-1;
  repeat
    za1:=za1+1;
    if pstart[za1]<>#13 then date_str:=date_str+pstart[za1];
  until (pstart[za1]=#13) or (za1=strlen(pstart));

end else get_last_modified:=false;
end;


function LoadHtmlCache(VAR p :pchar; VAR s : longint; filename : string;
                    VAR date_out : string; VAR etag_out : string) : boolean;
var f : file;
    AmtTransferred : integer;
    bufio : integer;

begin;
LoadHtmlCache:=true;
p:=NIL;
s:=0;
date_out:='';
etag_out:='';

{$I-}
assignfile(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 LoadHtmlCache:=false;
 raise ESavingError.Create('LoadHtmlCache: Fehler '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
reset(f,1);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 LoadHtmlCache:=false;
 raise ESavingError.Create('LoadHtmlCache: Fehler '+inttostr(bufio)+' = Kein Lesezugriff m鰃lich');
 exit;
end;