{***************************************************************************}
{* 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.
 Druckversionzuletzt geändert am 16.07.2003
|
