Delphi-PRAXiS - MD5 HASH = 32 HEXZeichen convertto Dezimalzahl

Das ist der funktionierende VB-Code zur Umwandlung eines großen HExcodes in einen Dezimal-String *g*
Nur in DELPHI habe ich Ihn noch nicht komplett vollständig übersetzen können!

VB-Code
Code:
			Option Explicit

Public Function Hex2DecStr(ByVal strHex As String) As String

  Const cstDigits As String = "0123456789ABCDEF"

  Dim intVar As Integer

  Dim strRet As String, strPow As String

' Check Input

  For intVar = 1 To 16

    If InStr(1, cstDigits, Mid$(strHex, intVar, 1), vbTextCompare) = 0 Then Err.Raise 5

  Next intVar

' Convert To Decimal

  strPow = "1"

  strRet = "0"

  For intVar = Len(strHex) To 1 Step -1

    strRet = IntAddition(strRet, IntMultiply(strPow, CStr(InStr(1, cstDigits, Mid$(strHex, intVar, 1), vbTextCompare) - 1)))

    strPow = IntMultiply(strPow, "16")

  Next intVar

  Hex2DecStr = strRet

End Function

Public Function IntAddition(ByVal FirstNum As String, ByVal SecondNum As String) As String

Dim a As Long, DifLen As Long, TempStr As String, TempNum As Integer

Dim Num1 As String, Num2 As String, TempNum1 As Integer, TempNum2 As Integer

Dim CarryOver As Integer, LeftOvers As Long

'Setup the numbers so that they are easier to handle.

'I originally had about 10 nested if statements that this block

'of code simplifies Dramatically.

  If Len(FirstNum) >= Len(SecondNum) Then

      Num1 = FirstNum

      Num2 = SecondNum

  Else

      Num2 = FirstNum

      Num1 = SecondNum

  End If

'Just setup some of the variables that need an initial value

  DifLen = Len(Num1) - Len(Num2)

  CarryOver = 0

  LeftOvers = DifLen

'Ok, now for the real math.  Looping from the end of the numbers

'just like our preschool teachers taught us, we add numbers that

'line up in the 'places' (I.E. ones, tens, hundreds, thousands, etc)

  For a = Len(Num2) To 1 Step -1

      TempNum1 = Int(Mid(Num1, a + DifLen, 1))

      TempNum2 = Int(Mid(Num2, a, 1))

      TempNum = TempNum1 + TempNum2 + CarryOver

      CarryOver = TempNum \ 10

      TempStr = (TempNum - (CarryOver * 10)) & TempStr

  Next a

'What do we do if there is a 1 or a 2 that carries over outside the

'numbers that line up in the places, well, we do the following block of

'code.  The do loop is used incase we get a situation like this:

'

'    199999  When you add 1 to a set of nines it continues to

'    _+___1  Carry over until it hits the first digit

'    200000

  Do Until CarryOver = 0 Or LeftOvers = 0

      TempNum = Int(Mid(Num1, LeftOvers, 1)) + CarryOver

      CarryOver = TempNum \ 10

      TempStr = (TempNum - (CarryOver * 10)) & TempStr

      LeftOvers = LeftOvers - 1

  Loop

'Since there are two possible ways of exiting the Loop above, we need

'to test and apply the other variable and its associated values in the following

'two if statements.

'Handle a possible carryover that will drop off the front end creating a new place.

  If CarryOver > 0 Then TempStr = CarryOver & TempStr

'add any of the numbers that are remaining on the left side of the longer string

  If LeftOvers > 0 Then TempStr = Left(Num1, LeftOvers) & TempStr

'and return the value

  IntAddition = TrimZeros(TempStr)

End Function

Public Function IntMultiply(ByVal FirstNum As String, ByVal SecondNum As String) As String

Dim ZeroStr As String

Dim a As Long, b As Long, Multiplier1 As Integer, Multiplier2 As Integer

Dim Num As Integer, CarryOver As Integer, TempStr As String, TallyStr As String

'THIS FUNCTION IS COMPLETE AND WORKS

'This function can handle two extra longs. It cycles through

'the firstnum one digit at a time from secondnum.

'this function works on the distrubution Principle of Multiplication:

' 9999 * 222 = (9999 * 2) + (9999 * 20) + (9999 * 200)

'

'The zero's are concatinated on after the multiplication takes place.

'

'This function is dependent on the IntAddition function above.

  For a = Len(FirstNum) To 1 Step -1

      'setup variables for this loop of multiplication

      TempStr = ""

      CarryOver = 0

      Multiplier1 = Mid(FirstNum, a, 1)

      'Multiply one digit at a time from right to left

      For b = Len(SecondNum) To 1 Step -1

        Multiplier2 = Mid(SecondNum, b, 1)

        Num = (Multiplier1 * Multiplier2) + CarryOver

        CarryOver = Num \ 10

        TempStr = (Num - (CarryOver * 10)) & TempStr

      Next b

      'Check to see if the multiplication added a new digit

      If CarryOver > 0 Then TempStr = CarryOver & TempStr

      'Add the zeros

      TempStr = TempStr & ZeroStr

      TallyStr = IntAddition(TempStr, TallyStr)

      ZeroStr = ZeroStr & "0"

  Next a

  IntMultiply = TrimZeros(TallyStr)

End Function

Public Function TrimZeros(ByVal Num As String) As String

Dim a As Long, TempStr As String

  For a = 1 To Len(Num)

      If Mid(Num, a, 1) <> 0 Then GoTo YuckFu

  Next a

  TrimZeros = "0"

Exit Function

YuckFu:

  TrimZeros = Mid(Num, a, Len(Num) - a + 1)

End Function

Private Sub CommandButton1_Click()

   Label1.Caption = Hex2DecStr(TextBox1.Text)

End Sub

###########################################################################################################################

Function TrimZeros(Num: String) : String;

var a: Integer;

var TempStr: String;

begin

  result:='0';

  For a:= 1 To Length(Num) do

  begin

      If (copy(Num, a, 1) <> '0') Then

      begin

        result:= copy(Num, a, Length(Num) - a + 1);

        exit;

      end;

  end;

End;

Function IntAddition(const FirstNum: String; SecondNum: String):String;

var a, DifLen : integer;

var TempStr: string;

var TempNum: Integer;

var Num1,Num2: string;

var TempNum1, TempNum2: Integer;

var CarryOver, LeftOvers: Integer;

//'Setup the numbers so that they are easier to handle.

//'I originally had about 10 nested if statements that this block

//'of code simplifies Dramatically.

begin

  If Length(FirstNum) >= Length(SecondNum) Then

  begin

      Num1 := FirstNum;

      Num2 := SecondNum;

  end Else

  begin

      Num2 := FirstNum;

      Num1 := SecondNum;

  End;

//'Just setup some of the variables that need an initial value

  DifLen   := Length(Num1) - Length(Num2);

  CarryOver:= 0;

  LeftOvers:= DifLen;

//'Ok, now for the real math.  Looping from the end of the numbers

//'just like our preschool teachers taught us, we add numbers that

//'line up in the 'places' (I.E. ones, tens, hundreds, thousands, etc)

  For a:= Length(Num2) downto 1 do

  begin

      TempNum1 := StrToint(copy(Num1, a + DifLen, 1));

      TempNum2 := StrToint(copy(Num2, a, 1));

      TempNum  := TempNum1 + TempNum2 + CarryOver;

      CarryOver:= TempNum div 10; // \

      TempStr  := Inttostr((TempNum - (CarryOver * 10))) + TempStr; //&

  end;

//'What do we do if there is a 1 or a 2 that carries over outside the

//'numbers that line up in the places, well, we do the following block of

//'code.  The do loop is used incase we get a situation like this:

//'

//'    199999  When you add 1 to a set of nines it continues to

//'    _+___1  Carry over until it hits the first digit

//'    200000

  repeat

    TempNum  := StrtoInt(copy(Num1, LeftOvers, 1)) + CarryOver;

    CarryOver:= TempNum div 10;

    TempStr  := Inttostr((TempNum - (CarryOver * 10))) + TempStr;

    LeftOvers:= LeftOvers - 1;

  Until ((CarryOver = 0) Or (LeftOvers = 0));

//'Since there are two possible ways of exiting the Loop above, we need

//'to test and apply the other variable and its associated values in the following

//'two if statements.

//'Handle a possible carryover that will drop off the front end creating a new place.

  If (CarryOver > 0) Then TempStr := Inttostr(CarryOver) + TempStr;

//'add any of the numbers that are remaining on the left side of the longer string

  If (LeftOvers > 0) Then TempStr := copy(Num1, 1, LeftOvers) + TempStr;

//'and return the value

  result := TrimZeros(TempStr);

End;

Function IntMultiply(const FirstNum: String; const SecondNum: String): String;

var ZeroStr: String;

var a, b , Multiplier1, Multiplier2, Num , CarryOver : Integer;

var TempStr, TallyStr: String;

//'THIS FUNCTION IS COMPLETE AND WORKS

//'This function can handle two extra longs. It cycles through

//'the firstnum one digit at a time from secondnum.

//'this function works on the distrubution Principle of Multiplication:

//' 9999 * 222 = (9999 * 2) + (9999 * 20) + (9999 * 200)

//'

//'The zero's are concatinated on after the multiplication takes place.

//'

//'This function is dependent on the IntAddition function above.

begin

  For a:= Length(FirstNum) downto 1  do

  begin

//      'setup variables for this loop of multiplication

      TempStr := '';

      CarryOver := 0;

      Multiplier1 := strToint(copy(FirstNum, a, 1));

//      'Multiply one digit at a time from right to left

      For b:= Length(SecondNum) downto 1 do

      begin

        Multiplier2 := StrToint(copy(SecondNum, b, 1));

        Num := (Multiplier1 * Multiplier2) + CarryOver;

        CarryOver:= Num div 10;

        TempStr := InttoStr((Num - (CarryOver * 10))) + TempStr;  //addieren?

      end;//for b

//      'Check to see if the multiplication added a new digit

      If (CarryOver > 0) Then TempStr := InttoStr(CarryOver) + TempStr;

//      'Add the zeros

      TempStr := TempStr + ZeroStr;

      TallyStr:= IntAddition(TempStr, TallyStr);

      ZeroStr := ZeroStr + '0';

  end;//for a

  result := TrimZeros(TallyStr);

End;

Function Hex2DecStr(const strHex: String):string;

Const cstDigits = '0123456789ABCDEF';

var intVar: Integer;

var strRet: String;

var strPow: String;

var temp: string;

begin

  temp:=UpperCase(strHex);

////' Check Input

//  For intVar:= 1 To 16

//    If pos(1, cstDigits, Mid$(temp, intVar, 1), vbTextCompare) = 0 Then exit;

//  end;

//' Convert To Decimal

  strPow := '1';

  strRet := '0';

  For intVar:= Length(temp) downto 1 do

  begin

// muss noch übersetzt werden   strRet := IntAddition(strRet, IntMultiply(strPow, CStr(InStr(1, cstDigits, Mid$(temp, intVar, 1), vbTextCompare) - 1)))

    strPow := IntMultiply(strPow, '16');

  end;

  result:= strRet;

end;
Wer Zeit und muße hat den Quellcode richtig vollständig zu Übersetzen *g* :gruebel:, dem bin ich tausend-fach dankbar!

Grüße Bolli

[edit=Luckie]Code-Tags. Mfg, Luckie[/edit]