Hauptmenü

Linux Firewall

Linux Server

Dienstleistungen

Dokumente
Sys2utils Unit
{***************************************************************************}
{*                               SteilSoft                                 *}
{*                                                                         *}
{* ProgramId: Sys2Wort Unit                                                *}
{* Date     : 16.07.2003                                                   *}
{* Time     : 20:00                                                        *}
{* (c) 1995,2003 by M. Weinert                                             *}
{***************************************************************************}
{* Zuerst gedacht f?r simple WortFunktionen aus REXX, mittlerweile jedoch  *}
{* eine Menge gemeiner wichtiger Funktionen hinzugekommen.                 *}
{* 2003 Update Strings => AnsiStrings                                      *}
{* Teilweise Funktionen aus anderen Sourcen                                *}
{* Die Sourcen unten mögen nicht schön sein, funktionieren aber schon seit *}
{* Jahren erstklassig (Beginn 1995!)                                       *}
{***************************************************************************}

Unit SYS2UTILS;

{$H+}
INTERFACE

Uses dos,sysutils;


Function Wort(tz:String; nr:byte):String;			// nr. Wort ausgeben
function wort2(s1: string; wposi: integer): string;		// teilw. Schneller
Function Worte(tz:String):word;					// Z?hlt die Worte
Function KillWort(tz:String;tn : byte):String;			// Löscht nr. Wort
Function ReplaceWort(tz,told,tnew:String):String;		// Ersetzt das told Wort
Function Upper(tz:String):String;				// In Großbuchstaben
Function lower(tz:String):String;				// In kleine
Function Translate(tz:String; von:char; nach:char):String;	// Einzelne Chars ersetzen
Function zentriere(tz:String; Einf:byte):String;                // Einen String zentrieren
Function RemoveLB(Instr:string):string;				// Lösche Leerzeichen hinten
Function RemoveTB(Instr:string):string;				// Lösche Leerzeichen vorne
Function Strip_blks(Instr:string):string;			// Vorne und hinten löschen
Function FillRight(tz:string; nr:byte):String;			// Rechts auf nr. auff?llen
Function FillLeft(tz:string; nr:byte):String;			// Dito links
Function F_String(tz:string):String;				// Formatiert den String ?
Function Format_Bytes(az:LongInt):String;			// Zeigt az als X-KB/MB an
Function Format_KByte(az:LongInt):String;			// az=KB also einmal 1024 weniger
Function BytestoString(az:String):LongInt;			// Wandelt String => Bytes
Function MonNr( B_Month:String):String;				// Monat (String) nach Nummer
Function MonByte( B_Month:String):Byte;				// Umgekehrt
Function NrMon( B_Month:Byte):String;				// Diesmal von Monatrsnr. String
Function Hex2Lint(hs:String):LongInt;				// Hexadezimal => LongInt
Function StrToLong(Nummer:String):LongInt;			// String => LongInt
Function StrToInt(Nummer:String):Integer;			// String => Integer
Function StrToByte(Nummer:String):Byte;				// String => Byte
Function GetCurDT:String;					// Hole aktuelle Uhrzeit/Datum
Function Min(i1,i2 : integer) : integer;
// Function ntohs(lohi: Word):Word;
// K?rzen des Firewall-Strings
Function FwLogEntry(tz:PChar):String;				// Brauchen wir das noch?


// Hier f?ngt es also an:
implementation

// Entfernt NULL-Zeichen durch Leerzeichen
Function F_String(tz:string):String;

begin
  tz:=translate(tz,Chr(0),Chr(32));
  F_String:=translate(tz,Chr(9),Chr(32));
end;


// String nach LongInt
Function StrToLong(Nummer:String):LongInt;
Var
   a,b : LongInt;
begin
  Val(Nummer,a,b);
  StrToLong:=a;
end;

Function StrToInt(Nummer:String):Integer;
begin
 StrToInt:=StrToLong(Nummer);
end;

Function StrToByte(Nummer:String):Byte;
begin
 StrToByte:=StrToLong(Nummer);
end;


{* 1. Funktion zum auslesen des n. Wortes *}
Function wort(tz:String; nr:byte):String;

Var
   tmp,Rueck          : String;
   Laenge,Wort_Nummer,Alt,Nummer : word;

Begin
if length(tz)>0 then begin
   for Laenge:=1 to Length(tz) do if tz[Laenge]=Chr(9) then tz[Laenge]:=Chr(32);
   tz:=RemoveLB(tz);
   nr:=nr-1;
   Wort_Nummer:=1;
   Nummer:=0;
   Laenge:=Length(tz)+1;
   Rueck:='';
   Alt:=1;
   repeat
      tmp:='';
      while (tz[Wort_Nummer]<>chr(32)) and (Wort_Nummer<Laenge) do inc(Wort_Nummer);
      tmp:=Copy(tz,Alt,Wort_Nummer-Alt);
      if nr=Nummer then Rueck:=tmp;
      Inc(Nummer);
      while (tz[Wort_Nummer]=chr(32)) and (Wort_Nummer<Laenge) do inc(Wort_Nummer);
      Alt:=Wort_Nummer;
      dec(Wort_Nummer);
      if Wort_Nummer<Laenge then inc(Wort_Nummer);
   until (Rueck<>'') OR (Wort_Nummer>=Laenge);
   wort:=Rueck;
   End;
end;



Function KillWort(tz:String;tn: byte):String;
Var
  Schleife  : byte;
  Anzahl    : word;
  NeuString :String;

begin
  if length(tz)>0 then begin
     Anzahl:=worte(tz);
     NeuString:='';
     for Schleife:=1 to Anzahl do begin
        if (tn<>Schleife) then NeuString:=NeuString+' '+Wort(tz,Schleife);
     end;
     RemoveLB(NeuString);
     KillWort:=NeuString;
  end;
end;

// Diese Funktion erh?lt den String tz. Darin soll das Wort told durch String tnew ersetzt werden.
Function ReplaceWort(tz,told,tnew:String):String;

var
   i : Byte;

begin
  if (length(tz)>0) and (length(told)>0) and (length(tnew)>0) then begin
     i:=POS(told,tz);
     Delete(tz,i,Length(told));
     Insert(tnew,tz,i);
     ReplaceWort:=tz;
  end;
end;


{* 2. Funktion umwandeln eines Strings in Groábuchstaben *}
Function upper(tz:String):String;

Begin
   if length(tz)>0 then upper:=uppercase(tz);
End;

Function lower(tz:String):String;
begin
  if length(tz)>0 then lower:=lowercase(tz);
end;



{* 3. Funktion bestimmte Zeichen in andere Umwandeln *}
Function translate(tz:String; von:char; nach:char):String;

Var
   Laenge,Wort_Nummer : Byte;


begin
   if length(tz)>0 then begin
      Wort_Nummer:=1;
      Laenge:=(Length(tz)+1);
      repeat
         if tz[Wort_Nummer]=von then tz[Wort_Nummer]:=nach;
         inc(Wort_Nummer);
      until Wort_Nummer=Laenge;
      translate:=tz;
   end;
end;




{* 4. Funktion zum W”rter z„hlen *}

Function worte(tz:String):word;

Var
           Laenge,Wort_Nummer,Nummer : Word;
Begin
   Laenge:=Length(tz)+1;
   if Laenge>0 then begin
      Wort_Nummer:=0;
      Nummer:=0;
      tz:=tz+' ';
      {* LEERZEICHEN am Anfang l”schen *}
      while (tz[Wort_Nummer]=' ') and (Wort_Nummer<Laenge) do inc(Wort_Nummer);
      repeat
        while (tz[Wort_Nummer]<>' ') and (Wort_Nummer<Laenge) do inc(Wort_Nummer);
        Inc(Nummer);
        while (tz[Wort_Nummer]=' ') and (Wort_Nummer<Laenge) do inc(Wort_Nummer);
        {* if Wort_Nummer<Laenge then inc(Wort_Nummer); *}
      until Wort_Nummer=Laenge;
      worte:=Nummer;
   end;
End;



Function zentriere(tz:String; Einf:byte):String;

Var
      Laenge,a,b,y,z          : Byte;
      aufv,aufh,aufz          : String;

Begin
   Laenge:=0; a:=0; b:=0; y:=0;
   z:=0; aufv:=''; aufh:=''; aufz:='                                                                                         ';
   Laenge:=Length(tz); a:=Einf-Laenge;
   y:=a DIV 2; z:=y+y; b:=y;
   if z<a then b:=y+1;
   aufv:=Copy(aufz,1,y);
   aufh:=Copy(aufz,1,b);
   zentriere:=Concat(aufv,tz,aufh);
end;


function RemoveLB(Instr:string):string;

var
   n : INTEGER;

begin
  if length(instr)>0 then begin
    n := 1;
    while (instr[n]=' ') and (n < LENGTH(instr)) DO n := n+1;
    RemoveLB := COPY(instr,n,length(instr));
  end;
end; {end Function removelb}


function RemoveTB(Instr:string):string;

var
   n : INTEGER;

begin
   if Length(instr)>0 then begin
      n := LENGTH(instr);
      while (instr[n]=' ') or (instr[n]<chr(10)) do begin
         instr := COPY(instr,1,n-1);
         n := n-1;
         IF n=0 then begin
            RemoveTb := '';
            EXIT;
         end;
       end;
       RemoveTB:= instr;
   end;
end; {end Function removetb}


function Strip_blks(Instr:string):string;

begin
   strip_blks := Removelb(Removetb(instr));
end; {end Function strip_blks}



Function FillRight(tz:string; nr:byte):String;

Var
    fill : String;
    na   : word;

Begin
   fill:='                                                                             ';
//   if tz[0]=Chr(0) then begin
//      FillRight:=copy(fill,1,nr);
//      FillRight[0]:=Chr(nr);
//   end
//   else begin
      tz:=Removetb(tz);
      na:=Length(tz);
      if nr>na then begin
         na:=nr-na;
         FillRight:=Concat(tz,copy(fill,1,na));
      end
      else begin
         if na>nr then FillRight:=Copy(tz,1,nr);
         if na=nr then FillRight:=tz;
      end;
//   end;
end;

Function FillLeft(tz:string; nr:byte):String;

Var
    fill : String;
    na   : word;

Begin
    fill:='                                                                       ';
    na:=Length(tz);
    if nr>na then begin
       na:=nr-na;
       FillLeft:=Concat(copy(fill,1,na),tz);
    end
    else begin
       if na>nr then FillLeft:=Copy(tz,1,nr);
       if na=nr then FillLeft:=tz;
    end;
end;


Function Format_Bytes(az:LongInt):String;

Var
    Suffix,um,ru       : String;
    rest               : Real;
    irest              : LongInt;

Begin
{* Bytes formatieren *}
    if az<0 then begin
       az:=(az DIV 2)*(-1);  {* Die H„lfte *}
       az:=az DIV 512; {* Dementsprechend nochmal durch 512 *}
       Suffix:='KB';
    end else Suffix:='B';
    irest:=0;
    rest:=0.0;
    while az>1024 do
    begin
         irest:=az MOD 1024;
         az:=az DIV 1024;
         if Suffix='MB' then Suffix:='GB';
         if Suffix='KB' then Suffix:='MB';
         if Suffix='B'  then Suffix:='KB';
    end;
    rest:=irest/100;
    irest:=Round(rest);
    if irest=10 then irest:=1;
    if az>999 then begin
       irest:=0;
       az:=1;
       if Suffix='MB' then Suffix:='GB';
       if Suffix='KB' then Suffix:='MB';
       if Suffix='B'  then Suffix:='KB';
    end;
    STR(irest,ru);
    STR(az,um);
    Format_Bytes:=Concat(um,'.',ru,Suffix);
end;


Function Format_KByte(az:LongInt):String;

Var
    Suffix,um,ru     : String;
    rest             : Real;
    irest            : LongInt;

Begin
{* Bytes formatieren *}
    Suffix:='KB';
    irest:=0;
    rest:=0.0;
    while az>1024 do
    begin
         irest:=az MOD 1024;
         az:=az DIV 1024;
         if Suffix='GB' then Suffix:='TB';
         if Suffix='MB' then Suffix:='GB';
         if Suffix='KB' then Suffix:='MB';
    end;
    rest:=irest/100;
    irest:=Round(rest);
    if irest=10 then irest:=1;
    if az>999 then begin
       irest:=0;
       az:=1;
       if Suffix='MB' then Suffix:='GB';
       if Suffix='KB' then Suffix:='MB';
       if Suffix='B'  then Suffix:='KB';
    end;
    STR(irest,ru);
    STR(az,um);
    Format_KByte:=Concat(um,'.',ru,Suffix);
end;

Function BytestoString(az:String):LongInt;

var
	Multi: Char;
	rc   : LongInt;
	mm   : LongInt;
	ts   : String;

begin
  ts:=az;
  Multi:=ts[Length(ts)];	// 11M => M
  mm:=1;
  case multi of
     'K' : mm := 1024;
     'M' : mm := 1048576;
     'G' : mm := 1073741824;
  end;
  if mm<>1 then Delete(ts,length(ts),1);	// 11
  rc:=StrtoLong(ts);		// Zahl
  BytesToString:=mm*rc;
end;



Function MonNr( B_Month:String):String;

Begin
   if B_Month='Jan' then MonNr:='01';
   if B_Month='Feb' then MonNr:='02';
   if B_Month='Mar' then MonNr:='03';
   if B_Month='Apr' then MonNr:='04';
   if B_Month='May' then MonNr:='05';
   if B_Month='Jun' then MonNr:='06';
   if B_Month='Jul' then MonNr:='07';
   if B_Month='Aug' then MonNr:='08';
   if B_Month='Sep' then MonNr:='09';
   if B_Month='Oct' then MonNr:='10';
   if B_Month='Nov' then MonNr:='11';
   if B_Month='Dec' then MonNr:='12';
end;

Function MonByte( B_Month:String):Byte;

Begin
   MonByte:=0;
   if B_Month='Jan' then MonByte:=1;
   if B_Month='Feb' then MonByte:=2;
   if B_Month='Mar' then MonByte:=3;
   if B_Month='Apr' then MonByte:=4;
   if B_Month='May' then MonByte:=5;
   if B_Month='Jun' then MonByte:=6;
   if B_Month='Jul' then MonByte:=7;
   if B_Month='Aug' then MonByte:=8;
   if B_Month='Sep' then MonByte:=9;
   if B_Month='Oct' then MonByte:=10;
   if B_Month='Nov' then MonByte:=11;
   if B_Month='Dec' then MonByte:=12;
end;


Function NrMon( B_Month:Byte):String;

Begin
   if B_Month=01 then NrMon:='Jan';
   if B_Month=02 then NrMon:='Feb';
   if B_Month=03 then NrMon:='Mar';
   if B_Month=04 then NrMon:='Apr';
   if B_Month=05 then NrMon:='Mai';
   if B_Month=06 then NrMon:='Jun';
   if B_Month=07 then NrMon:='Jul';
   if B_Month=08 then NrMon:='Aug';
   if B_Month=09 then NrMon:='Sep';
   if B_Month=10 then NrMon:='Oct';
   if B_Month=11 then NrMon:='Nov';
   if B_Month=12 then NrMon:='Dec';
end;


Function Hex2Lint(hs:String):LongInt;

var
  Digit : char;
  Sch   : LongInt;
  nr    : LongInt;
  Multi : LongInt;
  Erg   : LongInt;

begin
  Erg:=0;
  for Sch:=1 to Length(hs) do begin
      Digit:=hs[Sch];
      case Digit of
      '0' : nr:=0;
      '1' : nr:=1;
      '2' : nr:=2;
      '3' : nr:=3;
      '4' : nr:=4;
      '5' : nr:=5;
      '6' : nr:=6;
      '7' : nr:=7;
      '8' : nr:=8;
      '9' : nr:=9;
      'a' : nr:=10;
      'b' : nr:=11;
      'c' : nr:=12;
      'd' : nr:=13;
      'e' : nr:=14;
      'f' : nr:=15;
      'A' : nr:=10;
      'B' : nr:=11;
      'C' : nr:=12;
      'D' : nr:=13;
      'E' : nr:=14;
      'F' : nr:=15;
      else  nr:=0;
      end;
      case Length(hs) of
      4 : begin
        if Sch=1 then Multi:=4096;
        if Sch=2 then Multi:=256;
        if Sch=3 then Multi:=16;
        if Sch=4 then Multi:=1;
        Erg:=Erg+(Multi*nr);
        end;

      3 : begin
        if Sch=1 then Multi:=256;
        if Sch=2 then Multi:=16;
        if Sch=3 then Multi:=1;
        Erg:=Erg+(Multi*nr);
        end;

      2 : begin
        if Sch=1 then Multi:=16;
        if Sch=2 then Multi:=1;
        Erg:=Erg+(Multi*nr);
        end;

      1 : Erg:=nr;
      end; {* Case Length *}
  end;
  Hex2Lint:=Erg;
  end;

// FirewallLogEntry Format. Elendig langer String ! (PCHAR)

// Example (1 Line):
// Dec 23 07:08:54 firewall kernel: EXT: IN=eth0 OUT= MAC=00:50:da:38:80:89:00:b0:c2:89:28:e6:08:00
// SRC=216.34.77.12 DST=213.69.151.242 LEN=84 TOS=0x00 PREC=0x00
// TTL=48 ID=61055 PROTO=ICMP TYPE=8 CODE=0 ID=2 SEQ=42975

Function FwLogEntry(tz:PChar):String;

var
//  i     : Word;       //
  a,b     : LongInt;    // Z?hlvariablen
  tx      : Pchar;      // SuchString
  tn      : String;      // NeuString

begin
  tx:=StrAlloc(512);
  tn:=StrAlloc(512);
  tx:='MAC='+Chr(0);
  // l:=StrLen(tz);
  // zuerst machen wir den MAC-Eintrag raus.
  a:=longInt(StrPos(tz,tx)-longInt(tz));
 // StrCopy
  for b:=LongInt(tz) to LongInt(tz)+a do begin
    tn[(b-LongInt(tz))+1]:=tz[1];

  end;
  writeln(tn);
  FwLogEntry:='';  // Function setzen
end; // FwLogEntry


Function GetCurDT:String;

var
   y,m,d,h,mi,sek:Word;
   dow,msek      :Word;

begin
  GetDate(y,m,d,dow);
  GetTime(h,mi,sek,msek);
  GetCurDT:=IntToStr(d)+'.'+IntToStr(m)+'.'+IntToStr(y)+'  '+
            IntToStr(h)+':'+IntToStr(mi)+':'+IntToStr(sek);   // Wann ausgefallen ?
end;

Function Min(i1,i2 : integer) : integer;

Begin
  If i1 < i2 Then
     Min := i1
  Else
     Min := i2;
End;



procedure word_index(s1: string; var word: string; wposi: integer; var pa, pe: integer; c1: char);
      var
         i       : integer;
         wz      : integer;
         f       : boolean;
      begin
         pa := 0;
         pe := 0;
         if (wposi <= 0) or (length(s1) = 0) then begin
            word := '';
            exit;
         end;
         if (length(s1) = 1) and (s1 = c1) then begin
            word := '';
            exit;
         end;
         if (length(s1) = 1) and (s1 <> c1) then begin
            if wposi = 1 then
               word := s1
            else
               word := '';
            exit;
         end;
         i := 1;
         if s1[1] = c1  then f := false
                        else f := true;
         wz := 0;
         s1 := s1 + c1;
         while (i <= length(s1)) and (wz <= wposi) do begin
            if f and not (s1[i] = c1) and (wz < wposi) then begin {word ein}
               f := not f;
               wz := wz + 1;
               pa := i;
            end;
            if not f and (s1[i] = c1) then begin {word aus}
               f := not f;
               pe := i;
            end;
            i := i + 1;
         end;
         if wz = wposi
            then word := copy(s1, pa, pe- pa)
            else begin
               word := '';
               pa := 0;
               pe := 0;
            end;
      end;

function wort2(s1: string; wposi: integer): string;
      var
         pa, pe    : integer;
         s2        : string;
      begin
         word_index(s1,s2,wposi,pa,pe,' ');
         wort2 := s2;
      end;




end.




Druckversion

zuletzt geändert am 16.07.2003


(c) 2003,2015 by M. Weinert       
SysQuadrat Portal Linux Firewall / Security und mehr
Diese Seite ist Bestandteil von www.linux-firewall.de