VBA Script in Delphi umsetzen

[himitsu]

Ich hab oben noch bissl was dazu-editiert.

Zitat von BUllweih:

Code:

ReDim Crc32Table(255)

Das ist laut Beschreibung die Speicherreservierung.

Joar, aber scheinbar für 255 Einträge.
0..255 sind allerdings 256. (nja, das kannst du aber auch gleich als statisches Array deklarieren und brauchts kein SetLength)

[DeddyH]

Nachschauen hat noch nie geschadet. Aus http://msdn.microsoft.com/de-de/libr...=vs.90%29.aspx:

Zitat:

Arraygrenzen. Jeder Eintrag in boundlist kann die Unter- und Obergrenze der betreffenden Dimension angeben. Die Untergrenze ist immer 0 (null), unabhängig davon, ob Sie sie angeben. Die Obergrenze ist der höchste mögliche Wert für diesen Feldindex und nicht die Länge der Dimension (die durch die Obergrenze plus eins bestimmt wird). Jeder Feldindex kann zwischen 0 (null) und dem Wert seiner Obergrenze betragen.

[himitsu]

Bei Hex mußt du aufpassen, in welcher reihenfolge das Hex die Werte schreibt.
Links groß und rechts klein oder andersrum und zusätzlich könnte es auch nochmal für jedes Byte eingeln gedreht sein, aber das erkennt man ja in einem Vergleichswert.
Wobei du in deiner Beschreibung vergessen hast zu erwähnen was du bekommst und was du erwartest.

=> BinToHex oder ganz einfach Format mit %.8x [edit] OK, dann ht sich das mit der 255 geklärt und ist gut so ^^

[DeddyH]

Mal ein Versuch:

Delphi-Quellcode:

function Skr_CRC32(const Data: string): string;
var
  i, lCRC32, iBit: DWORD;
  Crc32Table: array[0..255] of DWORD;
begin
  for i := Low(Crc32Table) to High(Crc32Table) do
    begin
      lCRC32 := i;
      for iBit := 0 to 7 do
        begin
          if lCRC32 and $01 <> 0 then
            lCRC32 := ((lCRC32 and $FFFFFFFE div 2) and $7FFFFFFF) xor $EDB88320
          else
            lCRC32 := (lCRC32 and $FFFFFFFE div 2) and $7FFFFFFF;
        end;
      Crc32Table[i] := lCRC32;
    end;
  lCRC32 := $FFFFFFFF;
  for i := 1 to Length(Data) do
    lCRC32 := ((lCRC32 and $FFFFFF00 div $100) and $00FFFFFF) xor
      Crc32Table[(lCRC32 and $FF) xor Ord(Data[i])];
  Result := Format('%.8x', [lCRC32 xor $FFFFFFFF]);
end;

Ohne Vergleichswerte fällt das Testen allerdings schwer.

[himitsu]

lCRC32 xor $FFFFFFFF = not lCRC32

Bei (lCRC32 and $FFFFFFFE div 2) fehlt die Klammer um das AND, aber $FFFFFFFE scheint nur dazusein, damit das / einen ganzzahligen Wert liefert.
> ((lCRC32 and $FFFFFFFE) div 2) oder einfach nur lCRC32 div 2 , da DIV das ganzzahlige Abrunden schon erledigt.


lCRC32 and $01 <> 0 dürfte dem Odd entsprechen
Und bei (lCRC32 and $FFFFFF00 div $100) bin ich mir nicht ganz sicher, ob Delphi das DIV nicht vor dem AND aufläst, aber auch hier dürfte lCRC32 div $100 oder lCRC32 shr 8 ausreichen.
In ((lCRC32 and $FFFFFF00 div $100) and $00FFFFFF) kann das and $00FFFFFF weg, da das erste $FF000000 sowieso leer ist. (wegen dem div $100)


(mit bissl Syntax-Highlighting und als Pascal, sticht gleich so viel in Auge)


[add]
Mir fällt grade auf, daß die im originalen Code auch schon die Klammern unterschiedlich gesetzt haben.
z.B. (lCRC32 And &HFFFFFFFE) \ &H2 und lCRC32 And &HFFFFFF00 \ &H100
Hier müsste man aufpassen in welcher Reihenfolge Visual Basic und Delphi die AND|OR|*|/|DIV auflösen.

[BUllweih]

Zitat von DeddyH:

Mal ein Versuch:

Delphi-Quellcode:

function Skr_CRC32(const Data: string): string;
var
  i, lCRC32, iBit: DWORD;
  Crc32Table: array[0..255] of DWORD;
begin
  for i := Low(Crc32Table) to High(Crc32Table) do
    begin
      lCRC32 := i;
      for iBit := 0 to 7 do
        begin
          if lCRC32 and $01 <> 0 then
            lCRC32 := ((lCRC32 and $FFFFFFFE div 2) and $7FFFFFFF) xor $EDB88320
          else
            lCRC32 := (lCRC32 and $FFFFFFFE div 2) and $7FFFFFFF;
        end;
      Crc32Table[i] := lCRC32;
    end;
  lCRC32 := $FFFFFFFF;
  for i := 1 to Length(Data) do
    lCRC32 := ((lCRC32 and $FFFFFF00 div $100) and $00FFFFFF) xor
      Crc32Table[(lCRC32 and $FF) xor Ord(Data[i])];
  Result := Format('%.8x', [lCRC32 xor $FFFFFFFF]);
end;

Ohne Vergleichswerte fällt das Testen allerdings schwer.

Danke für die Mühe,
Ich habe es fast ähnlich gelöst.

Delphi-Quellcode:

Function Skr_CRC32(Data :String) : String;
function Hex(data: longint; width: word): string;
  (* pads with leading zeroes to reach specified width; use width=0 for tight fit *)
  const
    HexChars: array[0..$F] of char = '0123456789ABCDEF';
  var
    txt: string;
  begin
    txt := '';
    repeat
      insert(HexChars[data and $F],txt,1);
      data := data shr 4;
    until data=0;
    while length(txt) < width do
      insert('0',txt,1);
    Hex:= txt;
  end;

var
  i, lCRC32, iBit       : dword;
  Crc32Table            : array[0..255] of dword;
  txt                   : string;
begin
  For i := 0 To 255 do   //$B40BBE37
   begin
      lCRC32 := i;
      For iBit := 0 To 7 do
       begin
          If (lCRC32 And $1) <> 0 Then
              lCRC32 := (((lCRC32 And $FFFFFFFE) div $2) And $7FFFFFFF) Xor $EDB88320
          Else
              lCRC32 := ((lCRC32 And $FFFFFFFE) div $2) And $7FFFFFFF;
       end;
      Crc32Table[i] := lCRC32;
  end;

  lCRC32 := $FFFFFFFF;
  For i := 1 To length(Data) do
   begin

      lCRC32 := ((lCRC32 And $FFFFFF00 div $100) And $FFFFFF) Xor
       Crc32Table[(lCRC32 and $FF) xor Ord(Data[i])];

   end;
  result := Hex(lCRC32 Xor $FFFFFFFF,8);
end;

Ich habe nur ein Problem.
Das Script gibt in Excel(VBA) beim User(testuser) immer testuser->60DA836E aus und das Delphiprog testuser->B9851374

[himitsu]

Zitat:

Ich habe nur ein Problem.

- Die erwähnten Punkte, bezüglich der Klammerungen, hast du mal durchprobiert?

Und bei dem DWORD bin ich mir auch nicht sicher.
Was nimmt den VB als Typ, wenn man das so als DIM deklariert?

DWORD/Cardinal oder Integer ... je nach dem, kommt bei $8******* bzw. $F******* (usw.) etwas Anderes raus, wenn man DIV verwendet > mit oder ohne Vorzeichen.

Zitat:

Delphi-Quellcode:

function Hex(data: longint; width: word): string;
  (* pads with leading zeroes to reach specified width; use width=0 for tight fit *)
  const
    HexChars: array[0..$F] of char = '0123456789ABCDEF';
  var
    txt: string;
  begin
    txt := '';
    repeat
      insert(HexChars[data and $F],txt,1);
      data := data shr 4;
    until data=0;
    while length(txt) < width do
      insert('0',txt,1);
    Hex:= txt;
  end;

Ich würde dir empfehlen nicht den Funktionsnamen als Zuweisung zu nutzen.
Es geht zwar, aber Result ist da besser.
- man sieht, daß es der Rückgabewert ist (und nicht irgendeine Variable von sonstwo)
- und wenn man die Funktion umbenennt, dann muß man nicht aufpassen wo der Name in der Funktion noch verwendet wird

Und du kannst dann auch die Variable txt weglassen und stattdessen direkt Result verwenden, denn das kann man auch auslesen, im Gegensatz zu dem Funktionsnamen.

[BUllweih]

Ja ich habe die Klammerungen getestet, es hat sich aber nichts geändert.

Delphi-Quellcode:

var
  i, lCRC32, iBit       : dword ;
  Crc32Table            : array[0..255] of dword ;
  txt                   : string;
begin
  For i := 0 To 255 do   //$B40BBE37
   begin
      lCRC32 := i;
      For iBit := 0 To 7 do
       begin
          If (lCRC32 And $1) <> 0 Then
              lCRC32 := ((lCRC32 div $2) And $7FFFFFFF) Xor $EDB88320
          Else
              lCRC32 := (lCRC32 div $2) And $7FFFFFFF;
       end;
      Crc32Table[i] := lCRC32;
  end;

  lCRC32 := $FFFFFFFF;
  For i := 1 To length(Data) do
   begin

      lCRC32 := ((lCRC32 shr 8) And $FFFFFF) Xor
       Crc32Table[(lCRC32 and $FF) xor Ord(Data[i])];

   end;
  result := Hex(lCRC32 Xor $FFFFFFFF,8);
end;

Wenn ich allerdings diese Deklaration ändere i, lCRC32, iBit : dword ; von dword in integer kommt was anderes raus. Aber auch nicht das was VBA macht.

[DeddyH]

Gib uns doch mal ein paar Beispiele mit Eingangsstring und Ergebnis des Makros.