VBA Code in RPG umsetzen

[oulbrich]

Hallo zusammen,

ich muß für die Ansteuerung eines EC-Cash Gerätes einen CRC16 <acronym title="Google Page Ranking">Pr</acronym>üfsumme berechnnen. Im Netz habe ich einen VBA Code gefunden der dieses macht. Da ich aber VBA Laie bin bekomme ich den Code nicht korrekt übersetzt.
Der VBA Code lautet

CRC = CRCT(LB Xor Asc(Mid$(daten, i, 1))) Xor HB

CRCT ist eine Tabelle mit 225 Einträge. LB=143, HB=114, daten=99:
Ergebnis:15513



Meine RPG Code
CRC=CRC16TABLE(%bitxor(%bitxor(LB :Num):HB))

B=143, HB=114, daten=99
Ergebnis:20332


Hat da vielleicht einer eine Idee oder ein RPG Programm mit dem man CRC16 berechnen kann?

Gruß Olaf
http://newsolutions.de/forum-systemi-as400-i5-iseries/images/buttons/edit.gif (http://newsolutions.de/forum-systemi-as400-i5-iseries/editpost.php?do=editpost&p=79888)

[Fuerchau]

Da scheint schon irgendwas falsch zu sein:
Die Tabelle sollte eigentlich 256 Werte umfassen, da schließlich Werte von 0-255 vorkommen können.
Das Ganze muss auch noch in einer Schleife für jedes Zeichen passieren.
Zusätzlich basiert das VBA-Beispiel auf ASCII während du in RPG ja wohl EBCDIC hat. Dies führt zu einer ganz anderen Checksumme.

Poste doch mal den vollständigen Code, wenn es geht auch den ursprünglichen VBA-Code.

[oulbrich]

Hier der VBA Code

' * Zuerst die Codetabelle erzeugen *
Dim CRCT(0 To 255) As Long ' Codetabelle für CRC-16-Check
Dim CRC As Long ' Kurzzeitige Verwendung
Dim i As Integer ' Schleifenvariable
Dim j As Integer ' Schleifenvariable
Dim HB As Long ' CRC-Highbyte
Dim LB As Long ' CRC-Lowbyte

' * Codetabelle erzeugen (CRC-16) *
' Dieses braucht nur 1x gemacht werden.
For i = 0 To 255
CRC = i
For j = 1 To 8
If (CRC And 1) = 1 Then
CRC = Fix(CRC / 2) Xor 33800
Else
CRC = Fix(CRC / 2)
End If
Next j
CRCT(i) = CRC
Next i


' CRC über den String "Daten" berechnen.
' Werte von CRC-Highbyte ist dann in HB, CRC-Lowbyte ist dann in LB.
CRC = 0
For i = 1 To Len(daten)
HB = Fix(CRC / 256)
LB = CRC - (256 * HB)
CRC = CRCT(LB Xor Asc(Mid$(daten, i, 1))) Xor HB
Next i
HB = Fix(CRC / 256) ' CRC-High-Byte
LB = CRC - (256 * HB) ' CRC-Low-Byte

Debug.Print "LB="; "hex--"; Hex(LB); "--dezimal"; LB
Debug.Print "HB="; "hex--"; Hex(HB); "--dezimal"; HB

End Function



und das habe ich daraus gemacht

H* ************************************************** *****************************************
FASCPF010 IF E K DISK
H* ************************************************** *****************************************
D CvtDta S 10a
D CvtTbl S 10a
D DtaLen S 5p 0
D CvtDtaLen S 5p 0
D Crc16Table S 10I 0 dim(256)
D crc S 10I 0
D i S 10I 0 inz
D j S 10I 0 inz
D HB s 10s 0
D LB s 10s 0
D LBa s 10a
D HBa s 10a
D LBHEX s 20a
D HBHEX s 20a
* ************************************************** *****************************************
D DS
D Num 3I 0 inz
D Char 1A overlay(num)
* ************************************************** *********************
* ************************************************** *********************
c *entry plist
c parm CvtDta
* OutPut
c parm LBHEX
c parm HBHex
*
* ************************************************** *********************
* Erstellen CRC CodeTabelle
c exsr CrtCrcTable
* Erstellen CRC Low und High Byte einer Zeichenkette
c exsr CrtLbHb
*
c eval *inlr=*on
* ************************************************** *********************
* Erstellen CRC Low und High Byte
c CrtLBHB begsr
c
c eval DtaLen=%len(%trim(CvtDta))
* Konvertieren Ebcdic to Ascii
c exsr CvtEbToAs
c clear CRC
c for i = 1 to DtaLen
c eval HB=%uns(crc /256)
c eval LB=CRC - (256 * HB)
c eval Char=%subst(CvtDta:i:1)
c eval Num =Num+1
c eval CRC=CRC16TABLE(%bitxor(%bitxor(LB :Num):HB))
c endfor
c eval HB=%uns(crc /256)
c eval LB=CRC - (256 * HB)
*
* Ascii DEC nach Ascii Hex umbanden
c eval ascdec=HB
c exsr CvtDecHex
c if %Found
c eval HBHex=AscHex
c endif
c eval ascdec=LB
c exsr CvtDecHex
c if %Found
c eval LBHex=AscHex
c endif
*
c endsr
* ************************************************** ********************
* Erstellen CRC CodeTabelle
c CrtCrcTable begsr
*
c clear i
c for i = 0 to 255
c eval crc=i
c for j=8 downto 1
c if %bitand(crc:x'01')=1
c eval crc = %uns(crc/2)
c eval crc = %bitxor(crc:33800)
c else
c eval crc = %uns(crc/2)
c endif
c endfor
c eval crc16Table(i+1) = Crc
c endfor
*
c endsr
* ************************************************** ************************************
* Konvertieren Ebcdic to Ascii
c CvtEbToAs begsr
c
c eval CvtDtaLen=%len(%trim(CvtDta))
c
c call 'QDCXLATE'
C PARM CvtDtaLen
C PARM CvtDta
C PARM 'QASCII' CvtTbl

c endsr
* ************************************************** **********************
* Ascii DEC nach Ascii Hex umbanden
c CvtDecHex begsr
c AscKey klist
c kfld ascdec
c asckey chain ascpf010
c if %found
c endif
c
c endsr

[Fuerchau]

Ich denke hier ist dein Fehler:

eval CRC=CRC16TABLE(1+%bitxor(%bitxor(LB :Num):HB))

Im RPG sind die Indizes 1-256, in VBA aber 0 - 255.

Solange der 0-Wert ja nicht vorkommt, gibts auch keinen MCH-Fehler, allerdings greifst du auf das falsche Element zu.

Übrigens:
Für die ASCII-Codewandlung ist QASCII nur dann korrekt, wenn deine Daten aus der CCSID 037 (EBCDIC-USA) kommen.
Besser wäre es, dieses API zu verwenden:
Convert a Graphic Character String (CDRCVRT, QTQCVRT) API (http://publib.boulder.ibm.com/infocenter/iseries/v5r4/topic/apis/CDRCVRT.htm)

Hier kannst du gezielt z.B. auf 1252 (ANSI) konvertieren.

[oulbrich]

Hallo Fuerchau,

der Ansatz war schon richtig aber die Formel ist falsch.


so ist es korrekt
eval crc=%bitxor(crc16table(%bitxor(lb:num)+1):HB)

Es mußte erst der Wert aus der Tabelle geholt und dann erst der zweite Bitvergleich ausführen werden.

Besten Dank für deine Mühe

[Fuerchau]

Hauptsache es funktioniert jetzt :).