(*****************************************************************************)
(* MODULE: BSEUTILS^                                                         *)
(* RIGHTS: Reggatta Systems - COPYRIGHT 1995 - 2000                          *)
(* DESCR.: This module contains utility routines.                            *)
(*****************************************************************************)
Unit BseUtils;
{$I BSE.INC}
{$I BAPI.INC}
Interface
Uses
  BDE;

Procedure TrailFill( Var S : ShortString; Ch : Char; Size : Word );
Function  Strip( Const S : ShortString ) : ShortString;
Function  ArrayToStr( Const A : Array of Char; MaxSize : Integer ) : ShortString;
Function  ArrayToStrZ( Const A : Array of Char; MaxSize : Integer ) : ShortString;
Procedure StrToSpacePaddedArray( Dest : PChar; Const S : ShortString; Size : Word );
Function  Compare( Var A, B; Size : Word ) : Integer;
Procedure AddChar( Var S : ShortString; Ch : Char );
Function  AddBackSlash( Const S : ShortString ) : ShortString;
Procedure MoveZero( Var P; Size : Word );
Function  Center( Const S : String; Width : Word ) : String;
Function  Stringof( Ch : Char; Width : Word ) : String;
Function  Pad( Const S : String; Width : Word ) : String;
Function  IsBlank( P : PChar; Size : Word ) : Boolean;
Function  RemoveChar( Const S : ShortString; Ch : Char ) : ShortString;
Function  PosOfCh( SearchCh : Char; Const S : String ) : Integer;
Function  ReplaceChar( Const S : ShortString; OldCh, NewCh : Char ) : ShortString;
Function  HasPath( P : PChar; InclDot : Boolean ) : Boolean;
Function  GetIniFileLocation( Const FName : ShortString ) : ShortString;
Function  Max( X, Y : Cardinal ) : Cardinal;
Function  Min( X, Y : Cardinal ) : Cardinal;
Procedure ChangeChar( P : PChar; Size : Integer; OldCh, NewCh : Char );
Procedure ChangeNonLiteralChar( P : PChar; Size : Integer; OldCh, NewCh : Char );
Function  ReplaceSubStr( S : PChar; OldStr : PChar; NewStr : PChar; MaxSize : Word ) : Boolean;
Function  CutString( P : PChar; Ch : Char ) : PChar;
Procedure GetNetUserName ( pszNetUserName : PChar );
Function  BuildPath( Const S, Alt : ShortString ) : ShortString;


Function BdeBcdFromFloat (                                  { Converts FLOAT number into FMTBcd format }
var   iVal          : Double;                               { Float to convert }
      iPrecision    : Word;                                 { Precision of BCD }
      iPlaces       : Word;                                 { Number of decimals }
var   Bcd           : FMTBcd                                { returns Bcd number (length = iPrecision +2) }
   ): DBIResult;


Function BdeBcdToFloat (                                    { Converts FMTBcd number to FLOAT }
var   Bcd           : FMTBcd;                               { Bcd number to convert }
var   iVal          : Double                                { Returns converted float }
   ): DBIResult;

implementation
Uses
  SysUtils,
  Windows,

  BseConst;


Function BuildPath( Const S, Alt : ShortString ) : ShortString;
begin
  Result := ExtractFilePath( S );
  If ( Result = '' ) then
    Result := Alt;
  Result := AddBackSlash( Result ) + ExtractFileName( S );
end;


Procedure TrailFill( Var S : ShortString; Ch : Char; Size : Word );
var
  i,j : integer;
begin
  i := Length( S );
  j := Succ( i );
  If ( Size > 1 ) and ( Size > i ) then
  begin
    i := Pred( Size ) - i;
    if ( i > 0 ) then
      FillChar( S[ j ], i, Ch );
  end;
end;


Function Strip( Const S : ShortString ) : ShortString;
var
  i,j : Word;
begin
  j := 0;
  for i := 1 to length( S ) do
    if ( S[ i ] in [ '0'..'9', '.', '+', '-' ] ) then
    begin
      inc( j );
      Result[ j ] := S[ i ];
    end;
  SetLength( Result, j );
end;


Function ArrayToStr( Const A : Array of Char; MaxSize : Integer ) : ShortString;
begin
  Move( A, Result[ 1 ], MaxSize );
  Result[ 0 ] := Chr( MaxSize );
  Result := Trim( Result );
end;


Function ArrayToStrZ( Const A : Array of Char; MaxSize : Integer ) : ShortString;
begin
  Result := ArrayToStr( A, MaxSize ) + Chr( 0 );
end;


Procedure StrToSpacePaddedArray( Dest : PChar; Const S : ShortString; Size : Word );
var
  sLen : Word;
begin
  sLen := Length( S );
  If ( sLen >= Size ) then
    Move( S[ 1 ], Dest^, Size )
  else
  begin
    Move( S[ 1 ], Dest^, sLen );
    Inc( Dest, sLen );
    FillChar( Dest^, Size - sLen, ' ' );
  end;
end;


Function Compare( Var A, B; Size : Word ) : Integer;
var
  AP : PChar;
  BP : PChar;
  i  : Word;
begin
  AP := @A;
  BP := @B;
  For i := 1 to Size do
  begin
    if ( AP^ < BP^ ) then
    begin
      Result := -1;
      Exit;
    end
    else
      if ( AP^ > BP^ ) then
      begin
        Result := 1;
        Exit;
      end
      else
      begin
        Inc( AP );
        Inc( BP );
      end;
  end;
  Result := 0;
end;


Procedure AddChar( Var S : ShortString; Ch : Char );
begin
  Inc( Byte( S[ 0 ] ) );
  S[ Byte( S[ 0 ] ) ] := Ch;
end;


Function AddBackSlash( Const S : ShortString ) : ShortString;
const
  BACKSLASH_CHAR = '\';
begin
  Result := S;
  if ( S[ Length( S ) ] <> BACKSLASH_CHAR ) then
    AddChar( Result, BACKSLASH_CHAR );
end;


Procedure MoveZero( Var P; Size : Word );
begin
  FillChar( P, Size, 0 );
end;


Function Center( Const S : String; Width : Word ) : String;
begin
  if ( Length( S ) < Width ) then
    Result := StringOf( ' ', ( ( Width - Length( S ) ) div 2 ) ) + S
  else
    Result := Copy( S, 1, Width );
end;

Function Stringof( Ch : Char; Width : Word ) : String;
begin
  SetLength( Result, Width );
  FillChar( Result[ 1 ], Width, Ch );
end;


Function Pad( Const S : String; Width : Word ) : String;
begin
  Result := StringOf( ' ', Width );
  Move( S[ 1 ], Result[ 1 ], Length( S ) );
end;


Function IsBlank( P : PChar; Size : Word ) : Boolean;
var
  i : Word;
  T : PChar;
begin
  T := P;
  for i := 1 to Size do
  begin
    if ( T^ <> #0 ) then
    begin
      Result := FALSE;
      Exit;
    end
    else
      Inc( T );
  end;
  Result := TRUE;
end;


Function PosOfCh( SearchCh : Char; Const S : String ) : Integer;
begin
  For Result := 1 to Length( S ) do
    If ( S[ Result ] = SearchCh ) then
      Exit;
  Result := 0;
end;


Function RemoveChar( Const S : ShortString; Ch : Char ) : ShortString;
var
  P, R : PChar;
  i, j : Word;
begin
  P := @S[ 1 ];
  R := @Result[ 1 ];
  j := 0;
  For i := 1 to length( S ) do
  begin
    if ( P^ <> Ch ) then
    begin
      R^ := P^;
      Inc( R );
      Inc( j );
    end;
    Inc( P );
  end;
  Result[ 0 ] := Chr( j );
end;


Function ReplaceChar( Const S : ShortString; OldCh, NewCh : Char ) : ShortString;
begin
  Result := S;
  ChangeChar( @Result[ 1 ], Length( Result ), OldCh, NewCh );
end;


Procedure ChangeChar( P : PChar; Size : Integer; OldCh, NewCh : Char );
var
  i : Word;
  R : PChar;
begin
  R := P;
  For i := 1 to Size do
  begin
    if ( R^ = OldCh ) then
      R^ := NewCh;
    Inc( R );
  end;
end;


Procedure ChangeNonLiteralChar( P : PChar; Size : Integer; OldCh, NewCh : Char );
{ Any occurence of <oldCh> within the string is changed to <newCh> so long }
{ as the <oldCh> is not embedded between single or double quotes.          }
{ This code does not handle the case where there are embedded literals     }
{ delimited by a mix of single and double quotes.  For example, the        }
{ following will break: 'hello ":bye"  '                                   }
var
  i       : Word;
  R       : PChar;
  InDelim : Boolean;
begin
  InDelim := FALSE;
  R := P;
  For i := 1 to Size do
  begin
    If ( R^ in [ '''', '"' ] ) then
      InDelim := Not InDelim
    else
      if not InDelim and ( R^ = OldCh ) then
        R^ := NewCh;
    Inc( R );
  end;
end;


Function HasPath( P : PChar; InclDot : Boolean ) : Boolean;
begin
  Result := ( StrPos( P, ':' ) <> NIL ) or
            ( StrPos( P, '\' ) <> NIL );
  If not Result and InclDot then
    Result := ( StrPos( P, '.' ) <> NIL );
end;




Function GetIniFileLocation( Const FName : ShortString ) : ShortString;
begin
    Result := FName;
end;


Function Max( X, Y : Cardinal ) : Cardinal;
begin
  if ( X > Y ) then
    Result := X
  else
    Result := Y;
end;


Function Min( X, Y : Cardinal ) : Cardinal;
begin
  if ( X > Y ) then
    Result := Y
  else
    Result := X;
end;


Function ReplaceSubStr( S : PChar; OldStr : PChar; NewStr : PChar; MaxSize : Word ) : Boolean;
var
  Buffer : PChar;
  Curr   : PChar;
begin
  Curr   := StrPos( S, OldStr );
  Result := ( Curr <> NIL );
  if Result then
  begin
    Buffer := StrAlloc( Succ( MaxSize ) );
    Try
      StrLCopy( Buffer, S, Curr - S );
      if ( NewStr <> NIL ) then
        StrCat( Buffer, NewStr );
      Inc( Curr, StrLen( OldStr ) );
      StrCat( Buffer, Curr );
      StrLCopy( S, Buffer, MaxSize );
    Finally
      StrDispose( Buffer );
    end;
  end;
end;


Function CutString( P : PChar; Ch : Char ) : PChar;
var
  Location : PChar;
begin
  If ( P <> NIL ) then
  begin
    Location := StrScan( P, Ch );
    if ( Location <>  NIL ) then
      Location^ := #0;
  end;
  Result := P;
end;


Procedure GetNetUserName ( pszNetUserName : PChar );
Var
  Len  : DWord;
  Name : Array[0..255] of Char;
begin
  Len := SizeOf( Name );
  WNetGetUser( NIL, @Name, Len );
  StrCopy( pszNetUserName, @Name );
end;


Var
  LnOf10 : Double;

Const
  NUMISNEGATIVE = $80;
  NUMISBLANK    = $40;
  NUMPLACES     = $3F;

Type
  PByte = ^Byte;

Function BdeBcdToFloat (                                    { Converts FMTBcd number to FLOAT }
           var Bcd     : FMTBcd;                            { Bcd number to convert }
           var iVal    : Double                             { Returns converted float }
         ): DBIResult;
var
  i,Power,curNum,temp, numDec: Integer;
  PSrc: PByte;

  Procedure CalcIt;
  begin
    if ( temp > 0 ) then
      iVal := iVal + temp * Int( Exp( Power * LnOf10 ) );
  end;

begin
  Result := DBIERR_NONE;
  iVal   := 0.0;
  PSrc   := @Bcd.iFraction;
  Power  := Pred( Bcd.iPrecision );
  for i:= 1 to ( Bcd.iPrecision div 2 ) do
  begin
    curNum := PSrc^;
    if ( curNum <> 0 ) then
    begin
      {a to the nth power...Exp(n * Ln(a)); }
      temp := curNum div 16;
      CalcIt;
      Dec( Power );
      temp := curNum and $F;
      CalcIt;
      Dec( Power );
    end
    else
      Dec( Power, 2 );
    Inc( PSrc );
  end;
  curNum := PSrc^;
  if ( curNum <> 0 ) then
  begin
    {a to the nth power...Exp(n * Ln(a)); }
    temp := curNum div 16;
    CalcIt;
  end;
  if ( ( Bcd.iSignSpecialPlaces and NUMISNEGATIVE ) > 0 ) then
    iVal := iVal * -1;
  NumDec := Bcd.iSignSpecialPlaces and NUMPLACES;
  if ( NumDec > 0 ) then
    iVal := iVal / Int( Exp( NumDec * LnOf10 ) );
end;


Function BdeBcdFromFloat (                                  { Converts FLOAT number into FMTBcd format }
           var iVal      : Double;                          { Float to convert }
           iPrecision    : Word;                            { Precision of BCD }
           iPlaces       : Word;                            { Number of decimals }
           var Bcd       : FMTBcd                           { returns Bcd number (length = iPrecision +2) }
         ): DBIResult;
var
  Power : Integer;
  temp  : Double;
  Value : Double;
  hold  : Byte;
  PDest : PByte;
begin
  Result := DBIERR_NONE;
  Value := abs( iVal );
  MoveZero( Bcd.iFraction, sizeof(Bcd.iFraction) );
  pDest := @Bcd.iFraction;
  Bcd.iPrecision :=iPrecision;
  Bcd.iSignSpecialPlaces := iPlaces and NUMPLACES;  {make sure it is a valid number...}
  if ( iVal < 0 ) then
    Bcd.iSignSpecialPlaces := ( Bcd.iSignSpecialPlaces or NUMISNEGATIVE );
  Power := Pred( Bcd.iPrecision );
  Value := Value * Int( Exp( iPlaces * LnOf10 ) );
  while ( Value > 0 ) and ( Power > 0 ) do
  begin
    pDest ^ := 0;
    temp := Int( Exp( Power * LnOf10 ) );
    hold := Byte( Trunc( Value / temp ) );
    if ( hold > 0 ) then
    begin
      Value  := Value - temp * Hold;
      hold   := hold shl 4;
      pDest^ := pDest^ or hold;
    end;
    Dec( Power );
    if ( Power < 0 ) then
      break;
    temp := Int( Exp( Power * LnOf10 ) );
    hold := Byte( Trunc( Value / temp ) );
    if ( hold > 0 ) then
    begin
      Value  := Value - temp * Hold;
      pDest^ := pDest^ or hold;
    end;
    Dec( Power );
    Inc( pDest );
  end;
end;

begin
  LnOf10 := Ln( 10 );
end.
