Cita:
Empezado por ermendalenda
En Vb cambiando poca cosa te vale para net:
Código:
Private Declare Function WideCharToMultiByte Lib "kernel32" ( _
ByVal CodePage As Long, _
ByVal dwFlags As Long, _
ByVal lpWideCharStr As Long, _
ByVal cchWideChar As Long, _
ByVal lpMultiByteStr As Long, _
ByVal cbMultiByte As Long, _
ByVal lpDefaultChar As Long, _
ByVal lpUsedDefaultChar As Long) As Long
Dim CRC8_Table As Variant
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001
''' Return byte array with VBA "Unicode" string encoded in UTF-8
Function Utf8BytesFromString(strInput As String) As Variant
Dim nBytes As Long
' Catch empty or null input string
Utf8BytesFromString = vbNullString
If Len(strInput) < 1 Then Exit Function
' Get length in bytes *including* terminating null
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
' We don't want the terminating null in our byte array, so ask for `nBytes-1` bytes
Dim abBuffer() As Byte
ReDim abBuffer(nBytes - 2) ' NB ReDim with one less byte than you need
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, ByVal VarPtr(abBuffer(0)), nBytes - 1, 0&, 0&)
Utf8BytesFromString = abBuffer
End Function
Public Function crc8(buffer As String, Polynom, Initial As Variant) As Variant
CRC8_Table = Array(&H0, &H7, &HE, &H9, &H1C, &H1B, &H12, &H15, _
&H38, &H3F, &H36, &H31, &H24, &H23, &H2A, &H2D, &H70, &H77, &H7E, &H79, &H6C, &H6B, &H62, &H65, _
&H48, &H4F, &H46, &H41, &H54, &H53, &H5A, &H5D, &HE0, &HE7, &HEE, &HE9, &HFC, &HFB, &HF2, &HF5, _
&HD8, &HDF, &HD6, &HD1, &HC4, &HC3, &HCA, &HCD, &H90, &H97, &H9E, &H99, &H8C, &H8B, &H82, &H85, _
&HA8, &HAF, &HA6, &HA1, &HB4, &HB3, &HBA, &HBD, &HC7, &HC0, &HC9, &HCE, &HDB, &HDC, &HD5, &HD2, _
&HFF, &HF8, &HF1, &HF6, &HE3, &HE4, &HED, &HEA, &HB7, &HB0, &HB9, &HBE, &HAB, &HAC, &HA5, &HA2, _
&H8F, &H88, &H81, &H86, &H93, &H94, &H9D, &H9A, &H27, &H20, &H29, &H2E, &H3B, &H3C, &H35, &H32, _
&H1F, &H18, &H11, &H16, &H3, &H4, &HD, &HA, &H57, &H50, &H59, &H5E, &H4B, &H4C, &H45, &H42, _
&H6F, &H68, &H61, &H66, &H73, &H74, &H7D, &H7A, &H89, &H8E, &H87, &H80, &H95, &H92, &H9B, &H9C, _
&HB1, &HB6, &HBF, &HB8, &HAD, &HAA, &HA3, &HA4, &HF9, &HFE, &HF7, &HF0, &HE5, &HE2, &HEB, &HEC, _
&HC1, &HC6, &HCF, &HC8, &HDD, &HDA, &HD3, &HD4, &H69, &H6E, &H67, &H60, &H75, &H72, &H7B, &H7C, _
&H51, &H56, &H5F, &H58, &H4D, &H4A, &H43, &H44, &H19, &H1E, &H17, &H10, &H5, &H2, &HB, &HC, _
&H21, &H26, &H2F, &H28, &H3D, &H3A, &H33, &H34, &H4E, &H49, &H40, &H47, &H52, &H55, &H5C, &H5B, _
&H76, &H71, &H78, &H7F, &H6A, &H6D, &H64, &H63, &H3E, &H39, &H30, &H37, &H22, &H25, &H2C, &H2B, _
&H6, &H1, &H8, &HF, &H1A, &H1D, &H14, &H13, &HAE, &HA9, &HA0, &HA7, &HB2, &HB5, &HBC, &HBB, _
&H96, &H91, &H98, &H9F, &H8A, &H8D, &H84, &H83, &HDE, &HD9, &HD0, &HD7, &HC2, &HC5, &HCC, &HCB, _
&HE6, &HE1, &HE8, &HEF, &HFA, &HFD, &HF4, &HF3)
Dim data As Variant
data = Utf8BytesFromString(buffer)
Dim alen, i As Integer
Dim crc As Byte
'data = Buffer ':= TEncoding.UTF8.GetBytes(Cadena);
alen = UBound(data)
crc = 0
For i = 0 To alen
crc = CRC8_Table((crc Xor data(i)) And &HFF)
Next
crc8 = crc And &HFF
End Function
Para llamar a la función y que te devuelva en cr8:
cr8 = crc8(Cadena_enviada, 7, 0)
iNITIAL Y POLYNOM CREO QUE PUEDES OBVIARLAS |
Pues te lo agradezco muchisimo! me esta dando fallo en la linea
Código:
nBytes = WideCharToMultiByte(CP_UTF8, 0&, ByVal StrPtr(strInput), -1, 0&, 0&, 0&, 0&)
Exactamente en WideCharToMultiByte
Subo la funcion en si:
Código:
Private Declare Function WideCharToMultiByte Lib "kernel32" (
ByVal CodePage As Long,
ByVal dwFlags As Long,
ByVal lpWideCharStr As Long,
ByVal cchWideChar As Long,
ByVal lpMultiByteStr As Long,
ByVal cbMultiByte As Long,
ByVal lpDefaultChar As Long,
ByVal lpUsedDefaultChar As Long) As Long
Dim CRC8_Table As Object
' CodePage constant for UTF-8
Private Const CP_UTF8 = 65001
Tambien me da error aqui(Exactamente en Array(Es un tipo de clase y no se puede usar como una expresion)):
Código:
Public Function crc8(buffer As String, Polynom As Object, Initial As Object) As Object
CRC8_Table = Array(&H0, &H7, &HE, &H9, &H1C, &H1B, &H12, &H15,
&H38, &H3F, &H36, &H31, &H24, &H23, &H2A, &H2D, &H70, &H77, &H7E, &H79, &H6C, &H6B, &H62, &H65,
&H48, &H4F, &H46, &H41, &H54, &H53, &H5A, &H5D, &HE0, &HE7, &HEE, &HE9, &HFC, &HFB, &HF2, &HF5,
&HD8, &HDF, &HD6, &HD1, &HC4, &HC3, &HCA, &HCD, &H90, &H97, &H9E, &H99, &H8C, &H8B, &H82, &H85,
&HA8, &HAF, &HA6, &HA1, &HB4, &HB3, &HBA, &HBD, &HC7, &HC0, &HC9, &HCE, &HDB, &HDC, &HD5, &HD2,
&HFF, &HF8, &HF1, &HF6, &HE3, &HE4, &HED, &HEA, &HB7, &HB0, &HB9, &HBE, &HAB, &HAC, &HA5, &HA2,
&H8F, &H88, &H81, &H86, &H93, &H94, &H9D, &H9A, &H27, &H20, &H29, &H2E, &H3B, &H3C, &H35, &H32,
&H1F, &H18, &H11, &H16, &H3, &H4, &HD, &HA, &H57, &H50, &H59, &H5E, &H4B, &H4C, &H45, &H42,
&H6F, &H68, &H61, &H66, &H73, &H74, &H7D, &H7A, &H89, &H8E, &H87, &H80, &H95, &H92, &H9B, &H9C,
&HB1, &HB6, &HBF, &HB8, &HAD, &HAA, &HA3, &HA4, &HF9, &HFE, &HF7, &HF0, &HE5, &HE2, &HEB, &HEC,
&HC1, &HC6, &HCF, &HC8, &HDD, &HDA, &HD3, &HD4, &H69, &H6E, &H67, &H60, &H75, &H72, &H7B, &H7C,
&H51, &H56, &H5F, &H58, &H4D, &H4A, &H43, &H44, &H19, &H1E, &H17, &H10, &H5, &H2, &HB, &HC,
&H21, &H26, &H2F, &H28, &H3D, &H3A, &H33, &H34, &H4E, &H49, &H40, &H47, &H52, &H55, &H5C, &H5B,
&H76, &H71, &H78, &H7F, &H6A, &H6D, &H64, &H63, &H3E, &H39, &H30, &H37, &H22, &H25, &H2C, &H2B,
&H6, &H1, &H8, &HF, &H1A, &H1D, &H14, &H13, &HAE, &HA9, &HA0, &HA7, &HB2, &HB5, &HBC, &HBB,
&H96, &H91, &H98, &H9F, &H8A, &H8D, &H84, &H83, &HDE, &HD9, &HD0, &HD7, &HC2, &HC5, &HCC, &HCB,
&HE6, &HE1, &HE8, &HEF, &HFA, &HFD, &HF4, &HF3)
Dim data As Object
data = Utf8BytesFromString(buffer)
Dim alen, i As Integer
Dim crc As Byte
'data = Buffer ':= TEncoding.UTF8.GetBytes(Cadena);
alen = UBound(data)
crc = 0
For i = 0 To alen
crc = CRC8_Table((crc Xor data(i)) And &HFF)
Next
crc8 = crc And &HFF
End Function
|