{  (c) Copyright 1998,2000 Bernhard R. Link (2:2476/841.64;brl@gmx.de) et al.
****************************************************************************
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
****************************************************************************}
Unit UString;
{$I platform.inc}
{$I mkglobal.inc}
interface
{TODO: Umlaute werden bisher mit $IFDEF IBMPC nach Dos, sonst Latin1
behandelt. Zumindest unter Delphi sollte man ein AnsiUpper einfgen}
{$DEFINE NOJAM} {Einige Stringfiesheiten weglassen (Schreiben in [0] und hnliches}
{$IFDEF PPC_DELPHI}
{$IFNDEF PPC_DELPHI3}
{$DEFINE DelphiVAL}
{Warum fhrt man solche Inkompatiblitten ein, wenn man die dann wieder abschafft???}
{$ENDIF}
{$ENDIF}

uses aTypes,aString {Independent String-Types}
     {$IFDEF PPC_VIRTUAL}
     ,Use32 {for val and co}
     {$ENDIF}
     ;

{$IFDEF Longstrings}
Type T2digit=AnsiString;
{$ELSE}
Type T2digit=String[2];
{$ENDIF}

const EmptyChars=[' ',#9];

(*
 *  Desc:
 *    Strips EmptyChars from the beginning and the end of given string
 *)
Function TrimStr(const s:Openstring):TString;

Function Part(var s:OpenString):TString;{Vorher TrimSt nicht vergessen!}

Function FillStr(c:Char;len:TSIndex):TString;

(* Desc:
 *  Fills String at right bound up to given length
 *)
Function PadRight(PadSt:OpenString;PadCh:char;L:byte):TString;

Function PadLeft(PadSt:OpenString;PadCh:char;L:byte):TString;

{$IFNDEF PPC_DELPHI}
Function IntToStr(i:Integer):TString;
Function StrToInt(s: OpenString): Integer;
{$ENDIF}
Function LongToStr(l : Longint): TString;
Function StrToLong(const s: OpenString):Longint;
Function Rot13(c:Char):Char;
Function Ro13(s:TString):TString;
Function DelDblSpaces(s:TString):TString;{Besser TrimSt/Part verwenden}
Function Asciiz2Str(const a:Array of Char):TString;
Procedure Str2Asciiz(const s:OpenString;var a:Array of Char);

Function DownCase(c:Char):Char;
Function UpCase(c : char): char;
Function UpString(st:Openstring):TString;

Function get2d(r:Word):T2digit;
Function CopyL(const s:OpenString;start,len:TSIndex):TString;
{Leerzeichenaufgeflltes Kopieren}

function ExtractWord(const str : OpenString; n : Integer) : TString;
Function WordCount(const s:Openstring) : Word;

Function PosLastChar(Ch: Char; Const St: OpenString): Word;


implementation
{$IFDEF UseErrDlg}
uses ErrDlg;
{$ENDIF}

Function get2d(r:Word):T2digit;
begin
get2d:=Chr(Ord('0')+(r div 10))+Chr(Ord('0')+(r mod 10));
end;

function deldblspaces(s:tstring):tstring;
begin
  while pos('  ',s)>0 do
    delete(s,pos('  ',s),1);
  deldblspaces:=s;
end;


Function Rot13(c:Char):Char;
begin
If('a'<=c)and(c<='z') then
  Rot13:=Chr(((Ord(c)-Ord('a'))+13)mod 26+Ord('a'))
 else
  If('A'<=c)and(c<='Z') then
    Rot13:=Chr(((Ord(c)-Ord('A'))+13)mod 26+Ord('A'))
   else
    Rot13:=c
end;


Function Ro13(s:TString):TString;
var i:TSIndex;
begin
for i:=1 to Length(s) do
 s[i]:=Rot13(s[i]);
Ro13:=s
end;

{$IFNDEF PPC_DELPHI}
Function IntToStr(i:Integer):TString;
var s:TString;
begin
str(i,s);
IntToStr:=s;
end;

Function StrToInt(s: OpenString): Integer;
var
  res, error: Integer;
begin
  val(s, res, error);
  StrToInt:=res;
end;
{$ENDIF}

Function LongToStr(l    : Longint): TString;
var
   s : TSTring;
begin
   str(l, s);
   LongToStr:=s;
end;

Function Part(var s:OpenString):TString;
var b:TSIndex;
begin
If s='' then
  Part:=''
 else
  If s[1] in EmptyChars then
    begin
    {$IFDEF UseErrDlg}
    InternalError($6800);
    {$ENDIF}
    Part:='';
    s:=TrimStr(s)
    end
   else
    begin
    b:=2;
    while(b<=Length(s))and not (s[b] in EmptyChars) do
      inc(b);
    Part:=Copy(s,1,b-1);
    {$IFDEF Delphi}
    If b>Length(s) then
      s:=''
     else
    {$ENDIF}
      Delete(s,1,b);
    s:=TrimStr(s);
    end;
end;

Function UpCase(c : char): char;
begin
     case c of
{$IFDEF IBMPC}
       {''}#132 : c := {''}#142;
       {''}#148 : c := {''}#153;
       {''}#129 : c := {''}#154;
{$ELSE}
       #228{''}    : c := #196{''};
       #246{''} : c := #214{''};
       #252{''} : c := #220{''};
{$ENDIF}
       'a'..'z' : dec(c, Ord('a') - Ord('A'));
     end; { case }
   UpCase:=c;
end;

Function UpString (st : Openstring) : Tstring;
 var b, l : TSIndex;
 begin
   UpString := st;
   l := length(st);
   for b := 1 to l do begin
      st[b]:=UpCase(st[b]);
   end;
   UpString := st;
 end;

Function DownCase(c:Char):Char;
begin
   case c of
{$IFDEF IBMPC}
       {''}#142 : c := {''}#132;
       {''}#153 : c := {''}#148;
       {''}#154 : c := {''}#129;
{$ELSE}
       #196{''} : c := #228{''};
       #214{''} : c := #246{''};
       #220{''} : c := #252{''};
{$ENDIF}
     'A'..'Z': inc(c,Ord('a')-Ord('A'));
   end;
DownCase:=c
end;

Function TrimStr(const s:Openstring):TString;
var b,e:TSIndex;
begin
b:=1;
while (b<=length(s))and(s[b] in EmptyChars) do
 inc(b,1);
e:=Length(s);
While (e>b) and (s[e] in EmptyChars) do
  dec(e);
If e<b then
  TrimStr:=''
 else
  TrimStr:=Copy(s,b,e-b+1)
end;

Function FillStr(c:Char;len:TSIndex):TString;
var s:TString;
begin
{$IFNDEF NoJAM}
s[0]:=Chr(Len);
FillChar(s[1],len,c);
{$ELSE}
s:='';
While len>0 do
  begin
  s:=s+c;
  dec(len)
  end;
{$ENDIF}
FillStr:=s;
end;

Function Asciiz2Str(const a:Array of Char):TString;
var s:TString;i:TSIndex;
begin
{$IFNDEF NOJAM}
Move(a[0],s[1],High(a)+1);
s[0]:=Chr(High(a)+1);
i:=Pos(#0,s);
If i=0 then
  s[0]:=Chr(High(a)+1)
 else
  s[0]:=chr(i-1);
{$ELSE}
s:='';i:=0;
While(i<=High(a))and(a[i]<>#0)do
  begin
  s:=s+a[i];
  inc(i)
  end;
{$ENDIF}
Asciiz2Str:=s;
end;

Procedure Str2Asciiz(const s:OpenString;var a:Array of Char);
{$IFDEF NOJaM}var i:TSIndex;{$ENDIF}
begin
{$IFNDEF NoJAM}
move(s[1],a[0],High(a)+1);
If length(s)<=High(a) then
  begin
  a[Length(s)]:=#0;
  {$IFDEF Teste}
  FillChar(a[length(s)],High(a)-length(s)+1,#0);
  {$ENDIF}
  end;
{$ELSE}
i:=0;
While(i<Length(s))and(i<=High(a))do
  begin
  a[i]:=s[i+1];
  inc(i);
  end;
If i<=High(a) then
  a[i]:=#0;
{$ENDIF}
end;

Function StrToLong(const s:OpenString):Longint;
var {$IFDEF DelphiVAL}code:Integer;{$ELSE}code:Word;{$ENDIF}
    Value:LongInt;
begin
val(TrimStr(s),value,code);
If code<>0 then
  StrToLong:=0
 else
  StrToLong:=Value;
end;

Function CopyL(const s:OpenString;start,len:TSIndex):TString;
{Kopieren einer Zeile unter Auffllen fehlender Teile mit Leerzeichen:
CopyL('ABC',2,3)='BC '}
var t:TString;
begin
t:=Copy(s,start,len);
{$IFNDEF NOJAM}
If length(t)<len then
 begin
 FillChar(t[Length(t)+1],len-Length(t),' ');
 t[0]:=chr(len);
 end;
{$ELSE}
While length(t)<len do
  t:=t+' ';
{$ENDIF}
CopyL:=t;
end;

Function WordCount(const s:Openstring) : Word;
  var
    count:Word;
    i: TSIndex;
    finished:Boolean;
  begin
  count := 0;
  i := 1; finished:=false;
  while not finished do
    begin
    while (i <= length(s)) and (s[i] in EmptyChars) do
      inc(i);
    if (i=length(s))or(s[i]=';') then
      finished:=true
     else
      inc(count)
    end;
  wordcount := count;
  end;


(*
 * NOTES:
 *   ; at the end is not evaluated if you want the last word
 *)
function ExtractWord(const str : OpenString; n : Integer) : TString;
  Var
    i,j : TSIndex;
    done : boolean;
  Begin
  if (str='') or (n=0) then begin
    ExtractWord:='';
    exit;
  end;
  ExtractWord:='';
  i := 1;
  done:=false;
  repeat
    dec(n);

    // jump to first letter
    while (i<=length(str)) and (str[i] in EmptyChars) do begin
      inc(i);
    end;
    if i>length(str) then begin
      ExtractWord:='';
      exit;
    end;

    if n = 0 then begin
      j:=i;
      while (j <= length(str)) and not (str[j] in EmptyChars) do begin
        inc(j);
      end;
      if not (str[j] in EmptyChars) then begin
        inc(j);
      end;
      ExtractWord:=Copy(str,i,j-i);
      exit;
    end;

    // jump to first emptychar
    While (i <= length(str)) and (not (str[i] in EmptyChars)) do begin
      inc(i);
    end;
    if (i>length(Str))or(str[i]=';') then begin
       done:=true
    end else begin
    end
  until done;
  End;

Function PadLeft(PadSt:OpenString;PadCh:Char;L:Byte): TString;
{$IFDEF PPC_BP}
Assembler;
asm
  push ds
  cld
  lds  si, PadSt
  les  di, @Result
  xor  ax, ax
  mov  cx, ax
  mov  al, L
  mov  cl, al
  stosb
  lodsb
  mov  ah, al
  cmp  al, cl
  jae  @kopieren
  sub  cl, al
  add  ah, cl
  mov  al, PadCh
  rep  stosb
@kopieren:
  mov  cl, ah
  rep  movsb
  pop  ds
end;
{$ELSE}
{$IFDEF PPC_VIRTUAL}
Assembler;
{$Frame-}
{$Uses edi, esi, ecx}
asm
  cld
  mov  esi, PadSt
  mov  edi, @Result
  xor  eax, eax
  mov  ecx, eax
  mov  al, L
  mov  cl, al
  stosb
  lodsb
  mov  ah, al
  cmp  al, cl
  jae  @kopieren
  sub  cl, al
  add  ah, cl
  mov  al, PadCh
  rep  stosb
@kopieren:
  mov  cl, ah
  rep  movsb
end;
{$Else}
var
   s : TString;
begin
   s:=PadSt;
   while length(s)<l do begin
      s:=PadCh+s;
   end;
   PadLeft:=s;
end;
{$Endif PPC_VIRTUAL}
{$ENDIF PPC_BP}

Function PadRight(PadSt:OpenString;PadCh:char;L:byte):TString;
{$IFDEF PPC_VIRTUAL}
Assembler;
{$Frame-}
{$Uses edi, esi, ecx}
asm
  cld
  mov  esi, PadSt
  mov  edi, @Result
  mov  al, L
  stosb
  xor  eax, eax
  lodsb
  mov  ecx, eax
  mov  ah, al
  rep  movsb
  mov  cl, L
  cmp  al, cl
  jae  @nix_ran
  sub  cl, al
  add  ah, cl
  mov  al, PadCh
  rep  stosb
@nix_ran:
end;
{$Else}
{$IFDEF PPC_BP}
asm
  push ds
  cld
  lds  si, PadSt
  les  di, @Result
  mov  al, L
  stosb
  xor  ax, ax
  lodsb
  mov  cx, ax
  mov  ah, al
  rep  movsb
  mov  cl, L
  cmp  al, cl
  jae  @nix_ran
  sub  cl, al
  add  ah, cl
  mov  al, PadCh
  rep  stosb
@nix_ran:
  pop  ds
end;
{$else}
var
   s : TString;
begin
   s:=PadSt;
   while length(s)<l do begin
      s:=s+PadCh;
   end;
   PadRight:=s;
end;
{$EndIf PPC_BP}
{$EndIf PPC_VIRTUAL}

Function PosLastChar(Ch: Char; Const St: OpenString): Word;
  Var
    i: Word;

  Begin
  i := Length(St);
  While ((i > 0) and (st[i] <> ch)) Do
    Dec(i);
  PosLastChar := i;
  End;

end.