{***************************************************************************}
{*                               SteilSoft                                 *}
{*                                                                         *}
{* ProgramId: SteilWort Unit                                               *}
{* Date     : 08.09.1998                                                   *}
{* Time     : 15:00                                                        *}
{* (c) 1995,1996,1997,1998 by M. Weinert                                   *}
{***************************************************************************}
{* Zuerst gedacht für simple WortFunktionen aus REXX, mittlerweile jedoch  *}
{* eine Menge gemeiner wichtiger Funktionen hinzugekommen.                 *}
{* I used to program in REXX under OS/2 but since OS/2 is kinda dead       *}
{* I'm using Linux since 1998  this unit implements some funcs of REXX     *}
{***************************************************************************}

Unit STWORT;


INTERFACE

Uses DOS,TRINGS,SYSUTILS;


// Stringhandling
Function Wort(tz:String; nr:byte):String;
Function Worte(tz:String):word;
Function KillWort(tz:String;tn : byte):String;
Function ReplaceWort(tz,told,tnew:String):String;
Function Upper(tz:String):String;
Function lower(tz:String):String;
Function Translate(tz:String; von:char; nach:char):String;
Function Zentriere(tz:String; Einf:byte):String;
Function M_Trans(tz:String):String;
Function RemoveLB(Instr:string):string;
Function RemoveTB(Instr:string):string;
Function Strip_blks(Instr:string):string;
Function FillRight(tz:string; nr:byte):String;
Function FillLeft(tz:string; nr:byte):String;
Function F_String(tz:string):String;
Function Format_Bytes(az:LongInt):String;
Function Format_KByte(az:LongInt):String;
Function MonNr( B_Month:String):String;
Function MonByte( B_Month:String):Byte;
Function NrMon( B_Month:Byte):String;
Function ext2String(NetzAKA:extended):String;
Function string2ext(Netzaka:String):extended;
Function Hex2Lint(hs:String):LongInt;
Function HexB(hd:LongInt):String;
Function StrToLong(Nummer:String):LongInt;
Function StrToInt(Nummer:String):Integer;
Function StrToByte(Nummer:String):Byte;
Function GetCurDT:String;
Function Min(i1,i2 : integer) : integer;
// Function ntohs(lohi: Word):Word;
// Shorten of a frewall-string
Function FwLogEntry(tz:PChar):String;


implementation

Function F_String(tz:string):String;

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


Function string2ext(Netzaka:String):extended;
var
   xtemp : String;
   XLO   : LongInt;
   TZon,TNet,TNod,Cp: extended;

begin
    xtemp:=translate(Netzaka,':',' ');
    xtemp:=translate(xtemp,'/',' ');
    xtemp:=translate(xtemp,'.',' ');
    xtemp:=translate(xtemp,'*',' ');
    xtemp:=translate(xtemp,'!',' ');
    Val(wort(xtemp,1),cp,XLO);
    TZon:=10000000000000.0 * cp;
    Val(wort(xtemp,2),cp,XLO);
    Tnet:=1000000000.0 * cp;
    Val(wort(xtemp,3),cp,XLO);
    TNod:=10000.0 * cp;
    Val(wort(xtemp,4),cp,XLO);
    string2ext:=Tzon+Tnet+Tnod+cp;
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;

// This is a leftover from Fidonet ;-)
Function ext2string(NetzAka:extended):String;

Var
   wz,wn,wo,wp          : String;
   TZon,TNet,TNod,Rest  : extended;
   Tpo                  : word;
   M1                   : word;

begin
  TZon:=10000000000000.0;
  TNet:=1000000000.0;
  TNod:=10000.0;
  M1:=TRUNC(NetzAKA/TZon);
  Str(M1,wz);
  Rest:=NetzAKA-(M1 * TZon);
  M1:=TRUNC(Rest / TNet);
  Str(M1,wn);
  Rest:=Rest-(M1 * TNet);
  M1:=TRUNC(Rest / TNod);
  Str(M1,wo);
  TPo:=Trunc(Rest-(M1 * TNod));
  Str(TPo,wp);
  ext2String:=Concat(wz,':',wn,'/',wo,'.',wp);
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
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;



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

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;

// 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
  i:=POS(told,tz);
  Delete(tz,i,Length(told));
  Insert(tnew,tz,i);
  ReplaceWort:=tz;
end;


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

Begin
   upper:=uppercase(tz);
End;

Function lower(tz:String):String;
begin
  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
   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;




{* 4. Funktion zum Wörter zählen *}

Function worte(tz:String):word;

Var
           Laenge,Wort_Nummer,Nummer : Word;
Begin
Wort_Nummer:=0;
Nummer:=0;
Laenge:=Length(tz)+1;
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;



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;



{* Funtion für XENIA um die REC und SEN aus den Sende und
   Empfangsdaten zu holen !
* 06 Oct 23:00:20 XEN  ZRECV/32 bf96fd0e.pkt (1337 bytes), 0 min.
*}


Function M_Trans(tz:String):String;

Begin
  delete(tz,1,1);
  M_Trans:=Copy(tz,1,3);
end;


FUNCTION RemoveLB(Instr:string):string;

VAR n : INTEGER;

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


FUNCTION RemoveTB(Instr:string):string;

VAR n : INTEGER;
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 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 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 // Should be case of ... dummy
   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 HexB(hd:LongInt):Shortstring;
begin
  HexB:=IntToHex(hd,2);
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,l   : 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;



end.

Druckversion

zuletzt geändert am 13.05.2003