我正在寻找一个VBA函数，根据字符串内容生成一个非常短的哈希码，比如3个字符
答案 0 :(得分：1)
找到了this，刚刚修改了一下代码：
Dim usCRC(0 To 255) As Long
Public Function myhash(s As String) As String
Dim X As Long
Dim crc As Long
Dim i As Integer
If (usCRC(1) <> &HC0C1) Then
mbus_FillCRCTable
End If
crc = 65535 ' start with all 1's for a reverse CRC
For i = 1 To Len(s) ' process each character in the message */
X = Asc(Mid(s, i, 1)) ' get next char
X = (crc Xor X) And 255 '
X = usCRC(X) And 65535 '
crc = (crc \ 256) Xor X
Next i
CRCLo = crc Mod 256
CRCHi = (crc - CRCLo) / 256
myhash = crc
End Function
Public Sub mbus_FillCRCTable()
' This is a very silly function, but I cannot think
' of a better way to init this array (other than .DLL)
' VB doesn't have the DATA/READ statement used by earlier BASIC
usCRC(0) = &H0: usCRC(1) = &HC0C1: usCRC(2) = &HC181: usCRC(3) = &H140
usCRC(4) = &HC301: usCRC(5) = &H3C0: usCRC(6) = &H280: usCRC(7) = &HC241
usCRC(8) = &HC601: usCRC(9) = &H6C0: usCRC(10) = &H780: usCRC(11) = &HC741
usCRC(12) = &H500: usCRC(13) = &HC5C1: usCRC(14) = &HC481: usCRC(15) = &H440
usCRC(16) = &HCC01: usCRC(17) = &HCC0: usCRC(18) = &HD80: usCRC(19) = &HCD41
usCRC(20) = &HF00: usCRC(21) = &HCFC1: usCRC(22) = &HCE81: usCRC(23) = &HE40
usCRC(24) = &HA00: usCRC(25) = &HCAC1: usCRC(26) = &HCB81: usCRC(27) = &HB40
usCRC(28) = &HC901: usCRC(29) = &H9C0: usCRC(30) = &H880: usCRC(31) = &HC841
usCRC(32) = &HD801: usCRC(33) = &H18C0: usCRC(34) = &H1980: usCRC(35) = &HD941
usCRC(36) = &H1B00: usCRC(37) = &HDBC1: usCRC(38) = &HDA81: usCRC(39) = &H1A40
usCRC(40) = &H1E00: usCRC(41) = &HDEC1: usCRC(42) = &HDF81: usCRC(43) = &H1F40
usCRC(44) = &HDD01: usCRC(45) = &H1DC0: usCRC(46) = &H1C80: usCRC(47) = &HDC41
usCRC(48) = &H1400: usCRC(49) = &HD4C1: usCRC(50) = &HD581: usCRC(51) = &H1540
usCRC(52) = &HD701: usCRC(53) = &H17C0: usCRC(54) = &H1680: usCRC(55) = &HD641
usCRC(56) = &HD201: usCRC(57) = &H12C0: usCRC(58) = &H1380: usCRC(59) = &HD341
usCRC(60) = &H1100: usCRC(61) = &HD1C1: usCRC(62) = &HD081: usCRC(63) = &H1040
usCRC(64) = &HF001: usCRC(65) = &H30C0: usCRC(66) = &H3180: usCRC(67) = &HF141
usCRC(68) = &H3300: usCRC(69) = &HF3C1: usCRC(70) = &HF281: usCRC(71) = &H3240
usCRC(72) = &H3600: usCRC(73) = &HF6C1: usCRC(74) = &HF781: usCRC(75) = &H3740
usCRC(76) = &HF501: usCRC(77) = &H35C0: usCRC(78) = &H3480: usCRC(79) = &HF441
usCRC(80) = &H3C00: usCRC(81) = &HFCC1: usCRC(82) = &HFD81: usCRC(83) = &H3D40
usCRC(84) = &HFF01: usCRC(85) = &H3FC0: usCRC(86) = &H3E80: usCRC(87) = &HFE41
usCRC(88) = &HFA01: usCRC(89) = &H3AC0: usCRC(90) = &H3B80: usCRC(91) = &HFB41
usCRC(92) = &H3900: usCRC(93) = &HF9C1: usCRC(94) = &HF881: usCRC(95) = &H3840
usCRC(96) = &H2800: usCRC(97) = &HE8C1: usCRC(98) = &HE981: usCRC(99) = &H2940
usCRC(100) = &HEB01: usCRC(101) = &H2BC0: usCRC(102) = &H2A80: usCRC(103) = &HEA41
usCRC(104) = &HEE01: usCRC(105) = &H2EC0: usCRC(106) = &H2F80: usCRC(107) = &HEF41
usCRC(108) = &H2D00: usCRC(109) = &HEDC1: usCRC(110) = &HEC81: usCRC(111) = &H2C40
usCRC(112) = &HE401: usCRC(113) = &H24C0: usCRC(114) = &H2580: usCRC(115) = &HE541
usCRC(116) = &H2700: usCRC(117) = &HE7C1: usCRC(118) = &HE681: usCRC(119) = &H2640
usCRC(120) = &H2200: usCRC(121) = &HE2C1: usCRC(122) = &HE381: usCRC(123) = &H2340
usCRC(124) = &HE101: usCRC(125) = &H21C0: usCRC(126) = &H2080: usCRC(127) = &HE041
usCRC(128) = &HA001: usCRC(129) = &H60C0: usCRC(130) = &H6180: usCRC(131) = &HA141
usCRC(132) = &H6300: usCRC(133) = &HA3C1: usCRC(134) = &HA281: usCRC(135) = &H6240
usCRC(136) = &H6600: usCRC(137) = &HA6C1: usCRC(138) = &HA781: usCRC(139) = &H6740
usCRC(140) = &HA501: usCRC(141) = &H65C0: usCRC(142) = &H6480: usCRC(143) = &HA441
usCRC(144) = &H6C00: usCRC(145) = &HACC1: usCRC(146) = &HAD81: usCRC(147) = &H6D40
usCRC(148) = &HAF01: usCRC(149) = &H6FC0: usCRC(150) = &H6E80: usCRC(151) = &HAE41
usCRC(152) = &HAA01: usCRC(153) = &H6AC0: usCRC(154) = &H6B80: usCRC(155) = &HAB41
usCRC(156) = &H6900: usCRC(157) = &HA9C1: usCRC(158) = &HA881: usCRC(159) = &H6840
usCRC(160) = &H7800: usCRC(161) = &HB8C1: usCRC(162) = &HB981: usCRC(163) = &H7940
usCRC(164) = &HBB01: usCRC(165) = &H7BC0: usCRC(166) = &H7A80: usCRC(167) = &HBA41
usCRC(168) = &HBE01: usCRC(169) = &H7EC0: usCRC(170) = &H7F80: usCRC(171) = &HBF41
usCRC(172) = &H7D00: usCRC(173) = &HBDC1: usCRC(174) = &HBC81: usCRC(175) = &H7C40
usCRC(176) = &HB401: usCRC(177) = &H74C0: usCRC(178) = &H7580: usCRC(179) = &HB541
usCRC(180) = &H7700: usCRC(181) = &HB7C1: usCRC(182) = &HB681: usCRC(183) = &H7640
usCRC(184) = &H7200: usCRC(185) = &HB2C1: usCRC(186) = &HB381: usCRC(187) = &H7340
usCRC(188) = &HB101: usCRC(189) = &H71C0: usCRC(190) = &H7080: usCRC(191) = &HB041
usCRC(192) = &H5000: usCRC(193) = &H90C1: usCRC(194) = &H9181: usCRC(195) = &H5140
usCRC(196) = &H9301: usCRC(197) = &H53C0: usCRC(198) = &H5280: usCRC(199) = &H9241
usCRC(200) = &H9601: usCRC(201) = &H56C0: usCRC(202) = &H5780: usCRC(203) = &H9741
usCRC(204) = &H5500: usCRC(205) = &H95C1: usCRC(206) = &H9481: usCRC(207) = &H5440
usCRC(208) = &H9C01: usCRC(209) = &H5CC0: usCRC(210) = &H5D80: usCRC(211) = &H9D41
usCRC(212) = &H5F00: usCRC(213) = &H9FC1: usCRC(214) = &H9E81: usCRC(215) = &H5E40
usCRC(216) = &H5A00: usCRC(217) = &H9AC1: usCRC(218) = &H9B81: usCRC(219) = &H5B40
usCRC(220) = &H9901: usCRC(221) = &H59C0: usCRC(222) = &H5880: usCRC(223) = &H9841
usCRC(224) = &H8801: usCRC(225) = &H48C0: usCRC(226) = &H4980: usCRC(227) = &H8941
usCRC(228) = &H4B00: usCRC(229) = &H8BC1: usCRC(230) = &H8A81: usCRC(231) = &H4A40
usCRC(232) = &H4E00: usCRC(233) = &H8EC1: usCRC(234) = &H8F81: usCRC(235) = &H4F40
usCRC(236) = &H8D01: usCRC(237) = &H4DC0: usCRC(238) = &H4C80: usCRC(239) = &H8C41
usCRC(240) = &H4400: usCRC(241) = &H84C1: usCRC(242) = &H8581: usCRC(243) = &H4540
usCRC(244) = &H8701: usCRC(245) = &H47C0: usCRC(246) = &H4680: usCRC(247) = &H8641
usCRC(248) = &H8201: usCRC(249) = &H42C0: usCRC(250) = &H4380: usCRC(251) = &H8341
usCRC(252) = &H4100: usCRC(253) = &H81C1: usCRC(254) = &H8081: usCRC(255) = &H4040
End Sub
答案 1 :(得分：1)
来自：http://www.lammertbies.nl/forum/viewtopic.php?t=302
Sub CRC16()
Dim x As Long
Dim mask, i, j, nC, Crc As Integer
Dim c As String
txt = "Now is the time for all good BEMs to come to the aid of the mothership"
Crc = &HFFFF ' crc mit $ffff initalisieren
For nC = 1 To Len(txt) Step 2
j = Val("&H" + Mid(txt, nC, 2)) 'im HEX-Format
Crc = Crc Xor j
For j = 1 To 8
mask = 0
If Crc / 2 <> Int(Crc / 2) Then mask = &HA001
Crc = Int(Crc / 2) And &H7FFF: Crc = Crc Xor mask
Next j
Next nC
txt = Hex$(Crc) 'Checksumme
End Sub