saving.pas

httpanalyzer, source code for delphi

(*{$I-}
blockread(f, date_out, sizeof(date_out),AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 LoadHtmlCache:=false;
 showmessage('LoadHtmlCache: Blockread Error '+inttostr(bufio)+' = I/O Fehler');
end;
if AmtTransferred<>sizeof(date_out) then showmessage('LoadHtmlCache: Blockread Error '+inttostr(bufio)+' = Konnte nicht alle Daten sichern');
              *)
s:=filesize(f);
p:=stralloc(s+1);

{$I-}
blockread(f, p^,s,AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 LoadHtmlCache:=false;
 raise ESavingError.Create('LoadHtmlCache: Fehler '+inttostr(bufio)+' = I/O Fehler');
end;
if AmtTransferred<>s then raise ESavingError.Create('LoadHtmlCache: Fehler '+inttostr(bufio)+' = Konnte nicht alle Daten sichern');
p[s]:=#0;
//showmessage(p);

get_last_modified(p, date_out); //=false then  showmessage('LoadHtmlCache: Last modified date not found in Server Response');
get_last_etag(p, etag_out); //=false then showmessage('LoadHtmlCache: Last Etag not found in Server Response');
//showmessage(etag_out);

{$I-}
closefile(f);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 LoadHtmlCache:=false;
 raise ESavingError.Create('LoadHtmlCache: Fehler '+inttostr(bufio)+' = Datei kann nicht geschlossen werden');
end;


end;

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

var f : file;
    AmtTransferred : integer;
    bufio : integer;

begin;
if (p<>NIL) and (s>0) then begin
SaveHtmlCache:=true;
{$I-}
assignfile(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 SaveHtmlCache:=false;
 raise ESavingError.Create('SaveHtmlCache: Fehler '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
rewrite(f,1);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 SaveHtmlCache:=false;
 raise ESavingError.Create('SaveHtmlCache: Fehler '+inttostr(bufio)+' = Kein Schreibzugriff m鰃lich');
 exit;
end;
(*
{$I-}
blockwrite(f, date_str, sizeof(date_str));
//, sizeof(date_in),AmtTransferred);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 SaveHtmlCache:=false;
 showmessage('SaveHtmlCache: Blockwrite Error '+inttostr(bufio)+' = I/O Fehler');
end;
//if AmtTransferred<>sizeof(date_in) then showmessage('SaveHtmlCache: Blockwrite Error '+inttostr(bufio)+' = Konnte nicht alle Daten sichern');
  *)

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


end
else begin
  SaveHtmlCache:=false;
  raise ESavingError.Create('SaveHtmlCache:  Fehler : Noch keine Daten empfangen');
end;

end;



function LoadList(Var vlist : TStringList; filename : string) : boolean;
var f : textfile;
    bufs : string;
    bufio : integer;
begin;
loadlist:=false;
vlist.clear;
{$I-}
assign(f,filename);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 loadList:=false;
 //showmessage('LoadList "'+filename+'": AssignFile Error '+inttostr(bufio)+' = Keine Dateizuordnung m鰃lich');
 exit;
end;
{$I-}
reset(f);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
 //showmessage('LoadList "'+filename+'": Reset Error '+inttostr(bufio)+' = Kein Lesezugriff m鰃lich');
 exit;
end;

while not Eof(F) do
begin
 Readln(F, bufs);
 if length(trim(bufs))>0 then vlist.Add(bufs);
end;
{$I-}
CloseFile(F);
{$I+}
bufio:=IOResult;
if bufio<>0 then begin;
// LoadList:=false;
// showmessage('LoadList "'+filename+'": CloseFile Error '+inttostr(bufio)+' = Datei kann nicht geschlossen werden');
end;

loadlist:=true;

//vlist.sort;
vlist.Sorted:=true;
vlist.duplicates:=dupIgnore; // keine Duplikate m鰃lich, fehler ignorieren
end;

procedure LoadPchar(VAR p : pchar; VAR s : longint; filename : string);
var f: file;
begin;
assignfile(f, filename);
{$I-}
reset(f,1);
{$I+}
if IOResult=0 then begin
 s:=filesize(f);
 getmem(p,s);
 blockread(f,p^,s);
 closefile(f);
end
else begin
 raise ESavingError.Create('I/O Fehler in Routine LoadPchar; Datei "'+filename+'"');
 p:=NIL;
 s:=0;
end;

end;

procedure SaveList(Var vlist : Tstringlist; filename : string);
var f : textfile;
    za1 : longint;
begin;
assignfile(f,filename);
{$I-}
rewrite(f);
{$I+}
if IOResult=0 then begin

if vlist.count>0 then begin;
for za1:=0 to (vlist.Count-1) do begin;
  writeln(f, vlist[za1]);
end;
end;
{$I-}
closefile(f);
{$I+}
if IOResult<>0 then raise ESavingError.Create('IO Fehler: Datei "'+filename+'"');
end
else raise ESavingError.Create('IO Fehler beim Sichern der Datei "'+filename+'"');
end;


procedure saveCheckListBox(Var vlistbox : TCheckListbox; filename : string);
var f : textfile;
    za1 : longint;
begin;
assignfile(f,filename);
{$I-}
rewrite(f);
{$I+}
if IOResult=0 then begin
for za1:=0 to (vlistbox.items.Count-1) do begin;
  write(f, vlistbox.checked[za1]);
  writeln(f,chr(09)+vlistbox.items[za1]);
end;
closefile(f);
end
else raise ESavingError.Create('IO Fehler beim Sichern der Datei "'+filename+'"');
end;


procedure loadCheckListBox(Var vlistbox : TCheckListbox; filename : string);
var f : textfile;
    za1 : longint;
    bufs : string;
    bufb : boolean;
begin;
assignfile(f,filename);
{$I-}
reset(f);
{$I+}
if IOResult=0 then begin
for za1:=0 to (vlistbox.items.Count-1) do begin;
  readln(f,bufs);
  if param(bufs,0)='0' then bufb:=false else bufb:=true;

  vlistbox.items[za1]:=param(bufs,1);
end;
closefile(f);
end
else raise ESavingError.Create('IO Fehler beim Laden der Datei "'+filename+'"');
end;


procedure SetCheckListbox(VAR vlistbox : TCheckListBox; VAR vlist : TStringList);
var za1 : integer;
   bufb : boolean;
   bufs : string;
begin;
if vlist.count>0 then begin;
 vlistbox.items.clear;
 for za1:=0 to vlist.count-1 do begin;
   bufs:=vlist[za1];
   vlistbox.Items.add(param(bufs,1));
   if param(bufs,0)='0' then vlistbox.checked[za1]:=false else vlistbox.checked[za1]:=true;
 end;
end;
end;


procedure getCheckListbox(VAR vlistbox : TCheckListBox; VAR vlist : TStringList);
var za1 : integer;
   bufb : boolean;
   bufs : string;
begin;
 vlist.clear;
if vlistbox.items.count>0 then begin;

 for za1:=0 to vlistbox.items.count-1 do begin;
   if vlistbox.Checked[za1]=true then bufs:='1' else bufs:='0';
   bufs:=bufs+chr(09)+vlistbox.items[za1];
   vlist.add(bufs);
 end;
end;
end;

procedure SavePchar( p : pchar;  filename : string);
var f: file;
    s : longint;
begin;
s:=0;
if p<>NIL then s:=strlen(p);
if (s>0) and (p<>NIL) then begin;
assignfile(f, filename);
{$I-}
rewrite(f,1);
{$I+}
if IOResult=0 then begin
 blockwrite(f,p^,s);
 closefile(f);
end
else begin
 raise ESavingError.Create('IO Fehler; Datei "'+filename+'"');
end;
end;

end;

(*  Example fuer Split mit TString "Liste"
procedure TForm1.Button1Click(Sender: TObject) ;
var
   A: TStringList;
begin
   A := TStringList.Create;
   try
     Split(' ', 'your delphi guide', A) ;
     ShowMessage(a[0]) ; //your
     ShowMessage(a[1]) ; //delphi
     ShowMessage(a[2]) ; //guide
   finally
     A.Free;
   end;
end;
*)


procedure Split
   (Input: string; const Delimiter: Char;
   const Strings: TStrings) ;  overload;
begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
      Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
end;


(* Example fuer Funktion die einen Array Of String zurueckgibt
Ausgangsstring LST:
  'Element 1|Element 2|Letztes Element'

Array nach Aufruf A:= Split(LST, '|');
  A[0]: 'Element 1'
  A[1]: 'Element 2'
  A[2]: 'Letztes Element'

procedure Tfrm_main.Button1Click(Sender: TObject);
var s : string;
    A: TStrArray;
begin
  s:='Element 1|Element 2|Letztes Element';

  A:= Split(s, '|');
  showmessage(A[0]);
  showmessage(A[1]);
end;

*)



function Split(S: String; Delimiter: Char): TStrArray;  overload;
var C: Integer;
begin
  Repeat
    SetLength(Result, Length(Result)+ 1);
    C:= Pos(Delimiter, S);
    If C= 0 Then C:= Length(S)+ 1;
    Result[Length(Result)- 1]:= Copy(S, 1, C- 1);
    Delete(S, 1, C);
  Until Length(S)= 0;
end;

end.