unit Tools;

interface
  uses Sysutils,inifiles,  Classes,dialogs,lcltype ;

const
  Stop      = 0;
  Abbrechen = 1;
  Weiter    = 2;

type
  TStr = record
    vor, dahinter:String;
  end;


// -- String verarbeitung --
  // Unterstützt solche strings( "Hallo du da" wie geht "608246 0")
  function GetTokenExt(str:String; septChar1,septChar2:Char; TokenNr:Integer):String;
  // SetToken
  
   // Ändert einen tocken in einem String und gibt dann den neuen string zurück
  function SetTokenExt(OldString, NewText:String; SeptChar,SeptChar2:Char; TokenNr:Integer):String;

  function GetBool(Str:String):Boolean;
  // Löscht den letzten eintrag vom verzeichnis
  function DelStr(s:String):String;
  // Teilt den String in zwei hälften und gibt die angebe hälfte zurück
  function SplitStr(str:String;ch:Char):string;
  // gibt die Richtungs tasten(Lings, Rechts, Oben, Unten) als namen zurück
  function GetKeyName(Key:Word):String;

  // Zählt die vorkommen von einem Bestimmten zeichen
  function NumToken(aString: String; SepChar: Char):Byte;

  // gibt einen vorkommen als string zurück
  function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;

  // Löscht einen tocken in einem String und gibt dann den neuen string zurück
  function DelToken(aString,delstr: String):String;

   // Ändert einen tocken in einem String und gibt dann den neuen string zurück
  function SetToken(OldString, NewText:String; SeptChar:Char; TokenNr:Integer):String;


  // Zählt ein bestimmtes zeichen in einem String
  function GetCharCount(C:PChar; str:String):Integer;
  // Gibt eine Zahle zwischen min und max zurück
  function RandomRange(min, max: integer): integer;
 

// -- Sonstige funktionen --

  // Löscht einen eintrag aus einerm array - Geht leider nicht - 
  procedure DeleteArrayItem(Liste:array of Variant; index:Integer);

  // Schreibt in ein RichEdit in der angeben pos(Funktiniert auch bei memo: muss man nur anpassen)
  procedure str_into_RichEdit(Liste1215:TStringList;Insert_Text:string; line:integer; position:integer);

  // Zeigt eine Nachrichten box an(ShowMEssage)
  procedure ShowMessage1(Titel, Text:String);overload;

  // gib eine zufalls zahl zwischen den angeben wert und den angeben wert zu rück
  function Random2(von, bis:Integer):Integer; overload;

  // gibt eine zahl zwischen von und bis auser der in zu angeben zahl
  function Random2(von, bis, zu:Integer):Integer; overload;

  // sucht sich aus den angeben zahlen eine
  function RandomZahl(Zahlen:array of Integer ):Integer;

  // Sucht in einem interger Array einen wert und gibt True wenn er in gefunden hat zurück
  function GetArrayValue(z:array of Integer; wert:Integer):Boolean;

  // nimmer vor - die erste Zahl und nachdem - die zweite
  function Random2A(wert:String):Integer;

  // Gibt eine zufallige Zahl zurück aus der angeben
  function Random2B(Bis, Aus:Integer):Integer;

  // Sucht sich aus einer Booleannischen liste einen Index aus die True ist
  function Random2C(Liste:array of Boolean):Integer;

  // String verschlüsseln
  function myCoder(s: string; password: Integer; decode: Boolean):string;

  // Stream Funktionen

  // deKomprimiert einen Streeam der mit BZIP2 gepackt wurden ist
  procedure DecompressStream(Qulle,Ziel:TStream);

  // Komprimiert einen Stream mit BZIP2
  procedure CompressStream(Qulle, Ziel:TStream);

  // Kopiert einen Stream in den andren wobei man in abbrechen kann
  procedure CopyFrom(Qulle, Ziel:TStream; Size:Integer);
  
  // wandelt MS in Minuten und Sektunden um
  function GetMSToMinSek(ms:Integer; mo:boolean; ms2:Integer):String;

  // Macht aus einer TStringList.Text eigenschaft ein String
  function TStringsToStr(strings:TStrings):String;
  // macht aus einem text einen TSTringList.text
  function StrToTSTrings(text:String):TStrings;
  // sucht nach einem zeichen und gibt das was nach dem angeben zeichen zurück
  // bis zu einmen endzeichen
  procedure GetCharToken(astr:String;aStartChar,aEndChar:Char;aData:TSTringList);


implementation

uses Tools_File;






function TStringsToStr(strings:TStrings):String;
var
  i:Integer;
  str:String;                          
begin
  for i:=0 to strings.Count-1 do begin
    with strings do begin
      if i = 0 then 
        str:=strings[i]
      else
        str:=str + '|' + strings[i];
    end;
  end;
  result:=str;
end;

function GetBool(Str:String):Boolean;
begin
  if UpperCase(Str) = 'TRUE' then
    result:=True
  else
    result:=False;
end;

function DelStr(s:String):String;
var
  x:Integer;
begin
  for x:=Length(s)-2 downto 0 do begin
    if s[x] = '\' then begin
//      Delete(s,x,StrLen(PChar(s)));
      break;
    end;
  end;
  result:=s +'\';
end;

function Random2A(wert:String):Integer;
begin
 // Randomize;
  if Pos('-',wert) > 0 then
    result:=Random2(StrToInt(GetToken(wert,'-',1)),StrToInt(GetToken(wert,'-',2)))
  else
    result:=StrToInt(wert);
end;

function SplitStr(str:String;ch:char):string;
var
  i:Integer;
begin
{  for i:=(Length(str)-1) downto 1 do begin
    if str[i] = ch then begin
      Delete(str,i,StrLen(PChar(str)));
      Break;
    end;
  end;
  result:=str;}
end;

function GetMSToMinSek(ms:Integer; mo:boolean = True;ms2:Integer = 0):String;
var
  m,s:Integer;
begin
  if mo = True then begin
    ms:=ms  div 1000;
    s:=ms;
    m:=s div 60;

    if s >= 60 then
      s:=s-60*(s div 60)+1;

    result:=Format('%.2d:%.2d ',[m,s]);
  end
  else begin
    ms:=(ms2-ms) div 1000;
    s:=ms;
    m:=s div 60;

    if s >= 60 then
      s:=s-60*(s div 60)+1;

    result:=Format('%.2d:%.2d ',[m,s]);
  end;

end;


function GetCharCount(C:PChar; str:String):Integer;
var
  i,z:Integer;
begin
  z:=0;
  for i:=1 to (Length(str)-1) do begin
    if str[i] = C then
      inc(z);
  end;
  result:=z
end;

function GetArrayValue(Z:array of Integer; wert:Integer):Boolean;
var
  i:integer;
  t:Boolean;
begin
  t:=False;
  for i:=0 to HIGH(z) do begin
    if z[i] = wert then begin
      t:=True;
      break;
    end;
  end;
  result:=t;
end;

procedure CopyFrom(Qulle, Ziel:TStream; Size:Integer);
var
  s, t:Integer;
  doStop:Boolean;
begin
  t:=-1;
  if Size = 0 then begin
    Qulle.Position:=0;
    Size:=Qulle.Size;
  end;

  s:=Ziel.position+Size;
  while not doStop do begin
    if Ziel.position+1 <= s then begin
      t:=Ziel.CopyFrom(Qulle,1);
//      Application.ProcessMessages; //damit man auf den Abbrechen Button drücken kann
    end
    else
      doStop:= true;
  end;
  doStop:=False;
end;

procedure DecompressStream(Qulle,Ziel:TStream);
const
  BufferSize = 65536;
{var
  DecompressionStream: TStream;
  Dest: TStream;
  Count: Integer;
  Buffer: array[0..BufferSize - 1] of Byte;}
begin
{  Dest := TMemoryStream.Create;
  try
    DecompressionStream := TBZDecompressionStream.Create(Qulle);
    try
      while True do
      begin
        Count := DecompressionStream.Read(Buffer, BufferSize);
        if Count <> 0 then Dest.WriteBuffer(Buffer, Count) else Break;
      end;
    finally
      DecompressionStream.Free;
    end;
    CopyFrom(Dest,Ziel,0);

  finally
    Dest.Free;
  end;  }
end;


procedure CompressStream(Qulle, Ziel:TStream);
{var
  Source,stream: TStream;
  CompressionStream: TStream;}
begin
{  Source := TMemoryStream.Create;
  stream := TMemoryStream.Create;
  try
    CopyFrom(Qulle,Source,0);
    

    CompressionStream := TBZCompressionStream.Create(bs9, stream);
    stream.Position:=0;

    try
      CompressionStream.CopyFrom(Source, 0);
    finally
      CompressionStream.Free;
    end;
  finally
    Source.Position:=0;
    CopyFrom(stream,Ziel,0);
    Source.Free;
  end; }


end;

function myCoder(s: string; password: Integer; decode: Boolean):string;
var 
  i, c, x: Integer; 
begin 
  if decode then x := -1 else x := 1; 
  RandSeed := password; 
  Result := ''; 
  for i := 1 to length(s) do 
  begin 
    c := ord(s[i]); 
    if c in [32..122] then 
    begin 
      c := c+(x*Random(90)); 
      if (c<32) or (c>122) then c := c-(x*90); 
    end; 
    Result := Result + chr(c); 
  end; 
end; 

procedure DeleteArrayItem(liste:array of Variant; Index:Integer);
var
  i:Integer;
begin
  if Length(liste) -1 >= 1 then begin
    for i:=Index to HIGH(liste) do
      liste[i]:=liste[i+1];
//    SetLength(liste,Length(liste)-1 );
  end;
end;

procedure ShowMessage1(Titel, Text:String);
begin
//  MessageBox(0,PChar(Text),Pchar(Titel),MB_OK or MB_ICONEXCLAMATION)
end;

function Random2C(Liste:array of Boolean):Integer;
var
  r:Integer;
begin
  r:=Random(High(Liste));
  repeat
    r:=Random(High(Liste));
  until Liste[r] = True;
  result:=r;
end;

function Random2B(Bis, Aus:Integer):Integer;
var
  r:Integer;
begin
  r:=random(bis);
  repeat
    r:=random(bis);
  until r <> aus;
  result:=r;

end;

function RandomZahl(Zahlen:array of Integer):Integer;
var
  r,m:Integer;
begin
  r:=-1;
  M:=High(Zahlen)+1;
  r:=random(m);
  result:=Zahlen[r];
end;

function Random2(von, bis,zu:Integer):Integer;
var
  z,l:Integer;
begin
  z:=-1; L:=0;
  repeat
    z:=random(bis);
    inc(l);
  until (z > von) and (z < bis) and (z <> zu) or ( l > 6);
  result:=z;  
end;

function RandomRange(min, max: integer): integer;
begin
  result := 0;
  if min > max then
    exit;
  result := random(max - min + 1) + min;  
end;

function Random2(von, bis:Integer):Integer;
var
  z:Integer;
begin
  z:=0;
  Randomize;
  repeat
    z:=random(bis);
  until (z > von) and (z < bis);
  result:=z;  
end;



function GetKeyName(Key:Word):String;
begin
  if Key = VK_LEFT then result:='Pfeil Taste Links';
  if Key = VK_RIGHT then result:='Pfeil Taste Rechts';
  if Key = VK_UP then result:='Pfeil Taste Oben';
  if Key = VK_Down then result:='Pfeil Taste Unten';  
end;

procedure str_into_RichEdit(Liste1215:TStringList;Insert_Text:string; line:integer; position:integer);
var
  h : integer;
begin

with Liste1215 do begin 
  for h := Count to line-1 do 
    Add(''); 

  for h := length(Strings[line-1]) to position do
    Strings[line-1] := Strings[line-1] + ' '; 

  Strings[line-1] := copy(Strings[line-1], 1, position-1) + Insert_Text + copy(Strings[line-1], position+1, length(Strings[line-1])); 

end;end;

function DelToken(aString,delstr: String):String;
begin
  result:=StringReplace(aString,delstr,'',[]);
end;


function GetTokenExt(str:String; septChar1,septChar2:Char; TokenNr:Integer):String;
var
  x,x1,x2,index,t,l:Integer;
  str1:String;
begin
  l:=Length(str);
  index:=0;  t:=0; x1:=0; x2:=0;
  for x:=1 to l do begin
    if (str[x] = SeptChar2) and (index <> 2) then begin
      index:=2;
    end
    else begin
      if (index = 2) and (str[x] = SeptChar2) then begin
        index:=0;
      end;
    end;

    if (x =l ) or (str[x] = SeptChar1) and (index = 0) then begin
      inc(t);
      if t = tokennr then begin
        if x = l then
          str1:=copy(str,x1+1,(x-x1)+1)
        else
          str1:=copy(str,x1+1,x-x1);

        break;
      end;
      x1:=x;
    end;
  end;
  result:=str1;
end;

function NumToken(aString: String; SepChar: Char):Byte;
var
   RChar     : Char;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  if SepChar = '#' then begin
    RChar := '*'
  end
  else begin
    RChar := '#'
  end;
   StrLen := Length(aString);
   TNum   := 0;
   TEnd   := StrLen;
  while TEnd <> 0 do  begin
    Inc(TNum);
    TEnd := Pos(SepChar,aString);
    if TEnd <> 0 then begin
      aString[TEnd] := RChar;
    end;
  end;
  Result := TNum;
end;

function GetToken(aString: String; SepChar: Char; TokenNum: Byte):String;
var
   Token     : String;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
  if aString <> '' then begin
    StrLen := Length(aString);
    TNum   := 1;
    TEnd   := StrLen;
    while ((TNum <= TokenNum) and (TEnd <> 0)) do begin
    //"Test wie geht es dir so" hallo "Tach"
      TEnd := Pos(SepChar,aString);
      if TEnd <> 0 then begin
        Token := Copy(aString,1,TEnd-1);
        Delete(aString,1,TEnd);
        Inc(TNum);
      end else Token := aString;
    end;

    if TNum >= TokenNum then
      Result := Token
    else begin
      Result := Format('Fehler: Tokennummer (%s) ist größer als token !',[aString]);
//      MessageBox(0,pchar(Result),nil,MB_OK or MB_ICONEXCLAMATION);
    end;
  end;
end;

function SetTokenExt(OldString, NewText:String; SeptChar,SeptChar2:Char; TokenNr:Integer):String;
var
  ende,x,SeptCount:Integer;
  str:String;
begin
  if TokenNr > NumToken(OldString,SeptChar) then begin
    result:='1';
    exit;
  end;

  SeptCount:=0; str:='';

  for x:=1 to Length(OldString) do begin
    if OldString[x] = SeptChar then inc(SeptCount);
    if SeptCount = TokenNr-1 then begin
      str:=OldString;
      ende:=Length( GetTokenExt(OldString,SeptChar,SeptChar2,TokenNr));
      Delete(str, x+1, ende);
      insert(NewText,str,x+1);
      result:=str;
      Break;
    end;
  end;
end;


function SetToken(OldString, NewText:String; SeptChar:Char; TokenNr:Integer):String;
var
  ende,x,SeptCount:Integer;
  str:String;
begin
  if TokenNr > NumToken(OldString,SeptChar) then begin
    result:='1';
    exit;
  end;

  SeptCount:=0; str:='';

  for x:=1 to Length(OldString) do begin
    if OldString[x] = SeptChar then inc(SeptCount);
    if SeptCount = TokenNr-1 then begin
      str:=OldString;
      ende:=Length( GetToken(OldString,SeptChar,TokenNr));
      Delete(str, x+1, ende);
      insert(NewText,str,x+1);
      result:=str;
      Break;
    end;
  end;
end;




function StrToTSTrings(text:String):TStrings;
var
  i:Integer;
  l:TStringList;
begin
  l:=TSTringList.Create;
  for i:=1 to NumToken(text,'|') do begin
    l.Add(GetToken(text,'|',i))
  end;
  result:=l;
end;

procedure GetCharToken(astr:String;aStartChar,aEndChar:Char;aData:TSTringList);
var
  x,i,s,m:Integer;
  str:String;
  raus,r1:Boolean;
begin
{//  ShowMEssage(aStr);
  r1:=True; i:=0; s:=0; x:=0; m:=1;
  while (x+1 <= StrLen(Pchar(aStr))) do begin
    if r1 = True then begin
      inc(x);
      if (x+1 < StrLen(Pchar(aStr))) and (aStr[x] = '=') then begin
        i:=x; s:=x;
        r1:=False;
      end;
    end;  // if i+1

    if r1 = False then begin

      if (i-1 > 1) and (aStr[i-1] = ' ')  then begin
        if (aStr[s] <> ' ') and (s <=StrLen(Pchar(aStr)))  then
          inc(s)
        else begin
          str:=copy(aStr,i,s-i);
          aData.add(str);


          r1:=True;
        end;

      end
      else
        dec(i);
    end;
  end; }
end;
end.