FiveTech Support Forums

/***
*
*  BaseToBase( <cInString>, <nInBase>, <nOutBase> ) --> cNewBaseValue
*
*  Konvertiert einen Zahlenstring von einer Zahlenbasis in eine andere,
*  wobei Basen von 2 bis 36 beutzt werden können
*
* Convert a numberstring from one base to another
*  
*
*/
FUNCTION BaseToBase( xInString, nInBase, nOutBase )

   LOCAL cInString := ""
   LOCAL cDigits       := "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
   LOCAL cNewBaseValue := ""
   LOCAL i
   LOCAL DecPos
   LOCAL IntValue      := 0
   LOCAL FracValue     := 0.000000000000000000
   LOCAL FracProduct
   LOCAL FracCounter
   LOCAL IntProdStr
   LOCAL FracOutStr
   LOCAL IntOutString
   LOCAL IntStr
   LOCAL FracString
   LOCAL FracLimit
   LOCAL Block
   LOCAL LChr
   LOCAL Remainder
   LOCAL Quotient
   LOCAL NegSign

   cInString := IIF (ValType(xInstring)="N", Str (Int(xInString),LenNum(xInString),0), xInString)
   cInString := UPPER( ALLTRIM( cInString ) )

   // Parameter prüfen
   IF EMPTY( cInString ) .OR. VALTYPE( cInString ) <> "C" .OR. LEN( cInString ) > 19
      cNewBaseValue := NIL
   ELSE
      nInBase := IF( EMPTY( nInBase  ), 10, nInBase  )
      nOutBase := IF( EMPTY( nOutBase ), 10, nOutBase )

      IF VALTYPE( nInBase ) <> "N" .OR. VALTYPE( nOutBase ) <> "N"
         cNewBaseValue := NIL
      ELSE

         // Prüfen ob Zahlenbasis gültig
         IF ( nInBase > 36 .OR. nOutBase > 36 .OR. nInBase < 2 .OR. nOutBase < 2 )
            cNewBaseValue := NIL
         ELSE
            i := 1

            DO WHILE i++ < LEN( cInString ) .AND. cNewBaseValue <> NIL
               IF .NOT. SUBSTR( cInString, i, 1 ) $ ( SUBSTR( cDigits, 1, nInBase ) + "." )
                  cNewBaseValue := NIL
               ENDIF
            ENDDO

         ENDIF

      ENDIF
   ENDIF


   IF cNewBaseValue <> NIL

      // Prüfen ob cInString negativ ist
      NegSign := IF( SUBSTR( cInString, 1, 1 ) == "-", "-", "" )
      IF .NOT. EMPTY( NegSign )
         cInString := SUBSTR( ALLTRIM( SUBSTR( cInString, 2 ) ), 2 )
      ENDIF

      // Auffinden des Dezimalspunktes
      DecPos := AT( ".", cInString )
      IntStr := IF( DecPos > 1, SUBSTR( cInString, 1, DecPos - 1 ), IF( DecPos == 1, "0", cInString ) )
      FracString := IF( DecPos > 0, SUBSTR( cInString, DecPos + 1 ), "0" )

      // Konvertieren des Integerteils zur Basis 10
      FOR i = LEN( IntStr ) TO 1 STEP -1
         IntValue += ( AT( SUBSTR( IntStr, i, 1 ), cDigits) - 1) * ( nInBase ** ( LEN( IntStr ) - i ) )
      NEXT

      // Konvertieren des Dezimalsrests zur Basis 10
      FOR i := 1 TO LEN( FracString )
         FracValue += ( AT( SUBSTR( FracString, i, 1 ), cDigits ) - 1 ) * ( nInBase ** ( - i ) )
      NEXT

      // Berechnen des Ausgabestrings des Integerteils
      Quotient     := IntValue
      IntOutString := ""

      DO WHILE Quotient <> 0
         Remainder    := Quotient % nOutBase
         Quotient     := INT( Quotient / nOutBase )
         IntOutString := SUBSTR( cDigits, Remainder + 1, 1 ) + IntOutString
      ENDDO

      IntOutString := IF( EMPTY( IntOutstring ), "0", IntOutString )

      // Berechnen des Ausgabestrings
      FracLimit   := 19 - DecPos
      FracProduct := FracValue
      FracCounter := 1
      FracOutStr  := ""

      // Da die folgenden WHILE-Bedingung den Ausdruck enthält:
      // FracCounter++ < FracLimit .AND. FracProduct < 0.00000000000001
      // braucht der Schleifenblock nicht ausgeführt werden, um nachfolgende
      // Nullen zu entfernen

      DO WHILE FracCounter++ < FracLimit .AND. FracProduct <> 0
         IntProdStr  := FracProduct * nOutBase
         FracOutStr  := FracOutStr + SUBSTR( cDigits, INT( IntProdStr ) + 1, 1 )
         FracProduct := IntProdStr - INT( IntProdStr )
      ENDDO

      // Entfernen nachfolgender Nullen
      Block:={ || LChr := RIGHT(FracOutStr, 1), ;
         IF(LChr == "0", FracOutStr := SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1), 0), ;
         IF(LChr == "0", EVAL(Block), FracOutStr) }
      FracOutStr := EVAL( Block )

      /* Der folgende Block benötigt mehr Speicher, ist aber kürzer:
         Block := { |Str| IF(RIGHT(Str, 1) == "0", ;
            EVAL(Block, SUBSTR(FracOutStr, 1, LEN(FracOutStr) - 1)), Str)}
      */

   ENDIF

   // Ausgabe
   IF cNewBaseValue <> NIL
      cNewBaseValue := IF( DecPos > 0, NegSign + IntOutString + "." + FracOutStr, IntOutString )
   ENDIF

 RETURN ( IIF (cNewBaseValue=nil,"Fehler",cNewBaseValue) )