1

I'm looking for a VBA function that generates a very short hash code, say 3 characters, based on a string content

Riccardo
  • 2,054
  • 6
  • 33
  • 51
  • What kind of content is filled with your string? How long can it be? Do you need hashes are unique or not? Give us more info... – Marco Sep 09 '11 at 08:28
  • string length is variable, no need to be unique... maybe a CRC16 with HEX notation could do? – Riccardo Sep 09 '11 at 08:31
  • Yes, CRC16 in hex will always be 4 chars. If you use a higher base you could stay printable but reduce the number of chars - base64 would use 3 chars, for example. – AakashM Sep 09 '11 at 08:45
  • found http://www.di-mgt.com.au/crypto.html#CRC after which I'm sure base64 in VBA has been discussed on stackoverflow before. – AakashM Sep 09 '11 at 08:51
  • @Riccardo http://www.lammertbies.nl/forum/viewtopic.php?t=302 works fine in VBA with two corrections, one as proposed in the second post, two add 'k' to mas (ie mask) in line above `Next j` – Fionnuala Sep 09 '11 at 09:02

3 Answers3

1

Found this, just modified the code a bit:

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
Riccardo
  • 2,054
  • 6
  • 33
  • 51
  • Did you get a change to read my comment and look at the link (above) ? – Fionnuala Sep 09 '11 at 09:50
  • Sorry, it was hidden, I've read it now. Yes, I have tried that but wasn't working in my case, although I've modified the code as suggested by user regregex – Riccardo Sep 09 '11 at 10:01
  • Did you add k to the end of mas to give mask? I test the code before I posted the link. – Fionnuala Sep 09 '11 at 10:02
1

From: 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
Fionnuala
  • 90,370
  • 7
  • 114
  • 152
  • This appears to confuse hex coding and character counts. Surely Nc should step by one character, and the Mid(txt, nC, 2) can't be the conversion of text to hex. Consider http://www8.cs.umu.se/~isak/snippets/crc-16.c as an alternative ref. Also in VBScript (not the same language;-) the Int is only 16 bits so everything has to be done in Long using CLng()! – Philip Oakley Apr 03 '14 at 21:20
  • The txt string should be a hex string, i.e. listing the hex characters if it is to properly convert the `j = Val("&H" + Mid(txt, nC, 2))` statement from hex pairs to single bytes. – Philip Oakley May 12 '14 at 22:14
0

In recent versions of Excel (March 2022 and later), the new array formulas make it possible to create hash functions without VBA.

Here is the formula for Bernstein's djb2 hash function (see e.g. http://www.cse.yorku.ca/~oz/hash.html):

hash_djb2 = LAMBDA(v,
    MAP(
        v,
        LAMBDA(x,
            LET(
                y, VALUETOTEXT(x, 0),
                l, LEN(y),
                REDUCE(
                    5381,
                    SEQUENCE(l),
                    LAMBDA(a, j,
                        LET(
                            z, CODE(MID(y, j, 1)),
                            MOD(a * 33 + z, 2 ^ 32)
                        )
                    )
                )
            )
        )
    )
);

The output is an integer smaller than 2^32 (~4e9). It can be further shortened to 8 characters using DEC2HEX, or to 6 characters with a Base64 implementation.

AndreA
  • 295
  • 2
  • 12