Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Re: CRC CCITT Algo für VB6
Autor: LonelySuicide666
Datum: 30.12.06 18:16
'Code der Klasse "CRC16" Option Explicit Private Declare Function WideCharToMultiByte Lib "kernel32.dll" (ByVal CodePage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long Private CRCTbl(255) As Integer, Poly As Integer Private bIndirect As Boolean, Init As Integer Private Final As Integer, bReverseData As Boolean, bReverseCRC As Boolean Private Sub Class_Initialize() Init = &HFFFF Poly = &H1021 Final = &H0 bReverseData = False bReverseCRC = False ClacCRCTable Poly End Sub Public Property Get Polynom() As Integer Polynom = Poly End Property Public Property Let Polynom(ByVal NewPoly As Integer) Poly = NewPoly End Property Public Property Get IndirectInit() As Boolean IndirectInit = bIndirect End Property Public Property Let IndirectInit(ByVal bIndirectInit As Boolean) bIndirect = bIndirectInit End Property Public Property Get InitValue() As Integer InitValue = Init End Property Public Property Let InitValue(ByVal NewInitValue As Integer) Init = NewInitValue End Property Public Property Get FinalValue() As Integer FinalValue = Final End Property Public Property Let FinalValue(ByVal NewFinalValue As Integer) Final = NewFinalValue End Property Public Property Get ReverseData() As Boolean ReverseData = bReverseData End Property Public Property Let ReverseData(ByVal bReverseDataValue As Boolean) bReverseData = bReverseDataValue End Property Public Property Get ReverseCRC() As Boolean ReverseCRC = bReverseCRC End Property Public Property Let ReverseCRC(ByVal bReverseCRCValue As Boolean) bReverseCRC = bReverseCRCValue End Property Private Sub ClacCRCTable(ByVal p As Integer) Dim I As Integer, HexInt As Integer, j As Byte Poly = Polynom For I = 0 To 255 If I And &H80 Then HexInt = ((I And &H7F) * &H100) Or &H8000 Else HexInt = ((I And &H7F) * &H100) End If For j = 1 To 8 If HexInt And &H8000 Then If HexInt And &H4000 Then HexInt = ((HexInt And &H3FFF) * 2) Or &H8000 Else HexInt = ((HexInt And &H3FFF) * 2) End If HexInt = HexInt Xor Polynom Else If HexInt And &H4000 Then HexInt = ((HexInt And &H3FFF) * 2) Or &H8000 Else HexInt = ((HexInt And &H3FFF) * 2) End If End If Next j CRCTbl(I) = HexInt Next I End Sub Private Function Reflect(ByVal rIn As Integer, Optional ByVal bReflect As Integer = 16) As Integer Dim I As Integer, rOut As Integer, K As Integer Dim TmpInt As Integer, j As Integer, HiBit As Integer j = 1 HiBit = 2 ^ (bReflect - 1) I = HiBit For K = 0 To bReflect - 1 If rIn And I Then rOut = rOut Or j End If I = I / 2 And Not HiBit TmpInt = (j And &H3FFF) * 2 If j And &H4000 Then j = TmpInt Or &H8000 Else j = TmpInt End If Next K Reflect = rOut End Function may be the force with you

CRC CCITT Algo für VB6	5.263	FreeMan	20.11.06 09:28
Re: CRC CCITT Algo für VB6	3.196	sudave	22.11.06 23:14
Re: CRC CCITT Algo für VB6	3.215	FreeMan	27.11.06 10:25
Re: CRC CCITT Algo für VB6	3.040	divinglog	05.12.06 00:50
Re: CRC CCITT Algo für VB6	3.170	divinglog	05.12.06 00:50
Re: CRC CCITT Algo für VB6	3.506	LonelySuicide666	30.12.06 18:15
Re: CRC CCITT Algo für VB6	3.230	LonelySuicide666	30.12.06 18:49
Re: CRC CCITT Algo für VB6	3.092	LonelySuicide666	30.12.06 18:50
Perfekt, super!!!	2.766	divinglog	02.01.07 00:30
Re: CRC CCITT Algo für VB6	2.865	LonelySuicide666	30.12.06 18:16
Re: CRC CCITT Algo für VB6	2.834	LonelySuicide666	30.12.06 18:16
Re: CRC CCITT Algo für VB6	2.807	FreeMan	03.01.07 16:36
Re: CRC CCITT Algo für VB6	2.711	divinglog	03.01.07 17:03
Re: CRC CCITT Algo für VB6	2.733	FreeMan	03.01.07 21:19
Re: CRC CCITT Algo für VB6	2.926	LonelySuicide666	03.01.07 21:08

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen