VBA Code in RPG umsetzen

[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

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 .