Anyone got a hashing function?

[luke]

I need to take blocks of text and produce an MD5/SHA1 hash - I actually don't really care about what algorithm it is, I'm just using it for giving unique names for things.

I'd write my own but I'm lazy and I figure one of you would have one on hand.

[FellippeHeitor]

Code: QB64: [Select]

1. FUNCTION getChecksum$ (File$)
2.     DIM fileHandle AS LONG
3.  
4.     IF _FILEEXISTS(File$) = 0 THEN EXIT SUB
5.  
6.     fileHandle = FREEFILE
7.     OPEN File$ FOR BINARY AS fileHandle
8.     DataArray$ = SPACE$(LOF(fileHandle))
9.     GET #fileHandle, 1, DataArray$
10.     CLOSE #fileHandle
11.  
12.     getChecksum$ = HEX$(crc32~&(DataArray$))
13. END FUNCTION
14.  
15. FUNCTION crc32~& (buf AS STRING)
16.     'adapted from https://rosettacode.org/wiki/CRC-32
17.     STATIC table(255) AS _UNSIGNED LONG
18.     STATIC have_table AS _BYTE
19.     DIM crc AS _UNSIGNED LONG, k AS _UNSIGNED LONG
20.     DIM i AS LONG, j AS LONG
21.  
22.     IF have_table = 0 THEN
23.         FOR i = 0 TO 255
24.             k = i
25.             FOR j = 0 TO 7
26.                 IF (k AND 1) THEN
27.                     k = _SHR(k, 1)
28.                     k = k XOR &HEDB88320
29.                 ELSE
30.                     k = _SHR(k, 1)
31.                 END IF
32.                 table(i) = k
33.             NEXT
34.         NEXT
35.         have_table = -1
36.     END IF
37.  
38.     crc = NOT crc ' crc = &Hffffffff
39.  
40.     FOR i = 1 TO LEN(buf)
41.         crc = (_SHR(crc, 8)) XOR table((crc AND &HFF) XOR ASC(buf, i))
42.     NEXT
43.  
44.     crc32~& = NOT crc
45. END FUNCTION

[RhoSigma]

Hi Luke,
get my libraries collection from the Bonus Stuff Section here (link in signature below), it has both MD5 and SHA2 and has functions for string and file hashing. The algorithms are actually the ones used in Notepad++, hence it can consider they are well tested and reliable.

[Dav]

I remember codeguy posting one on the old site a couple years ago. I did a quick search and it's still up, today at least...
<url removed>

Code: QB64: [Select]

1. ' This is sha160 and sha256 implemented in pure QB64 with no declare library.
2. ' This is not intended to be efficient. It is very slow.
3. ' It is meant more as a fun and perhaps informative demonstration than as a
4. ' serious library.
5. ' It is a loose translation of:
6. ' http://www.network54.com/Forum/613583/message/1351232518/
7. ' however, without the wildcard capability, and without the file times.
8.  
9. $CONSOLE
10. $SCREENHIDE
11. _DEST _CONSOLE
12. _SOURCE _CONSOLE
13.  
14. DIM SHARED M AS STRING * 64
15. DIM SHARED H(0 TO 7) AS _UNSIGNED LONG
16. DIM SHARED W(0 TO 79) AS _UNSIGNED LONG
17. DIM SHARED mode AS LONG
18. DIM SHARED K(0 TO 63) AS _UNSIGNED LONG
19. DIM SHARED PowerOfTwo(0 TO 31) AS _UNSIGNED LONG
20. '* Precalculate the powers of 2 rather than calculating every time. Exponentiation = CPU cycle hog.
21. PowerOfTwo(0) = 1
22. FOR p = 1 TO UBOUND(PowerOfTwo)
23.     PowerOfTwo(p) = PowerOfTwo(p - 1) * 2
24. NEXT
25. DIM filesize AS _UNSIGNED _INTEGER64
26. DIM remaining AS _UNSIGNED _INTEGER64
27. DIM x AS LONG, y AS LONG
28. DIM b AS STRING * 1
29. DIM t AS _UNSIGNED _BYTE
30. cmd$ = "256 SHA256MCalkins.bas"
31. x = INSTR(cmd$, " ")
32. IF 0 = x THEN usage: SYSTEM
33. y = VAL(LEFT$(cmd$, x - 1))
34. SELECT CASE y
35.     CASE 160, 256: setmode y
36.     CASE ELSE: usage: PRINT "error on 1st parameter.": _DELAY 3: SYSTEM
37. END SELECT
38.  
39. IF _FILEEXISTS(MID$(cmd$, x + 1)) THEN
40.     s# = TIMER(.001)
41.     OPEN MID$(cmd$, x + 1) FOR BINARY ACCESS READ AS 1
42.     filesize = LOF(1)
43.     resethash
44.     remaining = filesize
45.     WHILE remaining >= 64
46.         remaining = remaining - 64
47.         GET 1, , M
48.         nextchunk
49.     WEND
50.     IF remaining THEN
51.         FOR t = 1 TO remaining
52.             GET 1, , b
53.             MID$(M, t, 1) = b
54.         NEXT
55.     END IF
56.     finalchunk filesize
57.     PRINT hexq(filesize); "  "; gethex; "  "; MID$(cmd$, x + 1)
58.     CLOSE 1
59.     e# = TIMER(.001)
60.     PRINT e# - s#;
61.     _DELAY 5
62.     SYSTEM
63. ELSE
64.     usage: PRINT "error on 2nd parameter. File not found.": _DELAY 3: SYSTEM
65. END IF
66.  
67. SUB usage
68. PRINT "Expirimental file hasher (pure qb64 version). Revision 2012 10 26"
69. PRINT "Public domain, Michael Calkins."
70. PRINT "160 and 256 bit hashes derived from fips180-3_final.pdf"
71. PRINT "usage:"
72. PRINT "", "sha {160 | 256} filename"
73. _DELAY 3
74. END SUB
75.  
76. SUB setmode (m AS LONG)
77. SELECT CASE m
78.     CASE 160
79.     CASE 256
80.         K(0) = &H428A2F98: K(1) = &H71374491: K(2) = &HB5C0FBCF: K(3) = &HE9B5DBA5: K(4) = &H3956C25B: K(5) = &H59F111F1: K(6) = &H923F82A4: K(7) = &HAB1C5ED5
81.         K(8) = &HD807AA98: K(9) = &H12835B01: K(10) = &H243185BE: K(11) = &H550C7DC3: K(12) = &H72BE5D74: K(13) = &H80DEB1FE: K(14) = &H9BDC06A7: K(15) = &HC19BF174
82.         K(16) = &HE49B69C1: K(17) = &HEFBE4786: K(18) = &H0FC19DC6: K(19) = &H240CA1CC: K(20) = &H2DE92C6F: K(21) = &H4A7484AA: K(22) = &H5CB0A9DC: K(23) = &H76F988DA
83.         K(24) = &H983E5152: K(25) = &HA831C66D: K(26) = &HB00327C8: K(27) = &HBF597FC7: K(28) = &HC6E00BF3: K(29) = &HD5A79147: K(30) = &H06CA6351: K(31) = &H14292967
84.         K(32) = &H27B70A85: K(33) = &H2E1B2138: K(34) = &H4D2C6DFC: K(35) = &H53380D13: K(36) = &H650A7354: K(37) = &H766A0ABB: K(38) = &H81C2C92E: K(39) = &H92722C85
85.         K(40) = &HA2BFE8A1: K(41) = &HA81A664B: K(42) = &HC24B8B70: K(43) = &HC76C51A3: K(44) = &HD192E819: K(45) = &HD6990624: K(46) = &HF40E3585: K(47) = &H106AA070
86.         K(48) = &H19A4C116: K(49) = &H1E376C08: K(50) = &H2748774C: K(51) = &H34B0BCB5: K(52) = &H391C0CB3: K(53) = &H4ED8AA4A: K(54) = &H5B9CCA4F: K(55) = &H682E6FF3
87.         K(56) = &H748F82EE: K(57) = &H78A5636F: K(58) = &H84C87814: K(59) = &H8CC70208: K(60) = &H90BEFFFA: K(61) = &HA4506CEB: K(62) = &HBEF9A3F7: K(63) = &HC67178F2
88.     CASE ELSE
89.         PRINT "bad mode": END
90. END SELECT
91. mode = m
92. END SUB
93.  
94. FUNCTION shl~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
95. shl = x * PowerOfTwo(n)
96. END FUNCTION
97.  
98. FUNCTION shr~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
99. shr = x \ PowerOfTwo(n)
100. END FUNCTION
101.  
102. FUNCTION shlq~&& (x AS _UNSIGNED _INTEGER64, n AS _UNSIGNED _BYTE)
103. shlq = x * PowerOfTwo(n)
104. END FUNCTION
105.  
106. FUNCTION shrq~&& (x AS _UNSIGNED _INTEGER64, n AS _UNSIGNED _BYTE)
107. shrq = x \ PowerOfTwo(n)
108. END FUNCTION
109.  
110. FUNCTION rol~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
111. rol = shl(x, n) OR shr(x, 32 - n)
112. END FUNCTION
113.  
114. FUNCTION ror~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
115. ror = shr(x, n) OR shl(x, 32 - n)
116. END FUNCTION
117.  
118. FUNCTION Ch~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
119. Ch = x AND y XOR NOT x AND z
120. END FUNCTION
121.  
122. FUNCTION Parity~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
123. Parity = x XOR y XOR z
124. END FUNCTION
125.  
126. FUNCTION Maj~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
127. Maj = x AND y XOR x AND z XOR y AND z
128. END FUNCTION
129.  
130. FUNCTION sum0~& (x AS _UNSIGNED LONG)
131. sum0 = ror(x, 2) XOR ror(x, 13) XOR ror(x, 22)
132. END FUNCTION
133.  
134. FUNCTION sum1~& (x AS _UNSIGNED LONG)
135. sum1 = ror(x, 6) XOR ror(x, 11) XOR ror(x, 25)
136. END FUNCTION
137.  
138. FUNCTION sel0~& (x AS _UNSIGNED LONG)
139. sel0 = ror(x, 7) XOR ror(x, 18) XOR shr(x, 3)
140. END FUNCTION
141.  
142. FUNCTION sel1~& (x AS _UNSIGNED LONG)
143. sel1 = ror(x, 17) XOR ror(x, 19) XOR shr(x, 10)
144. END FUNCTION
145.  
146. SUB resethash
147. SELECT CASE mode
148.     CASE 160
149.         H(0) = &H67452301: H(1) = &HEFCDAB89: H(2) = &H98BADCFE: H(3) = &H10325476: H(4) = &HC3D2E1F0
150.     CASE 256
151.         H(0) = &H6A09E667: H(1) = &HBB67AE85: H(2) = &H3C6EF372: H(3) = &HA54FF53A: H(4) = &H510E527F: H(5) = &H9B05688C: H(6) = &H1F83D9AB: H(7) = &H5BE0CD19
152. END SELECT
153. END SUB
154.  
155. SUB nextchunk
156. DIM t AS _UNSIGNED _BYTE
157. FOR t = 0 TO 63
158.     W(t \ 4) = shl(W(t \ 4), 8) OR ASC(M, 1 + t)
159. NEXT
160. SELECT CASE mode
161.     CASE 160: hash160
162.     CASE 256: hash256
163. END SELECT
164. END SUB
165.  
166. SUB finalchunk (l AS _UNSIGNED _INTEGER64)
167. DIM t AS _UNSIGNED _BYTE
168. FOR t = 0 TO (l AND &H3F) - 1
169.     W(t \ 4) = shl(W(t \ 4), 8) OR ASC(M, 1 + t)
170. NEXT
171. W(t \ 4) = shl(W(t \ 4), 8) OR &H80
172. t = t + 1
173.  
174. WHILE t AND 3
175.     W(t \ 4) = shl(W(t \ 4), 8)
176.     t = t + 1
177. WEND
178.  
179. IF t >= 60 THEN
180.     IF t = 60 THEN W(15) = 0
181.     SELECT CASE mode
182.         CASE 160: hash160
183.         CASE 256: hash256
184.     END SELECT
185.     t = 0
186. ELSE
187.     t = shr(t, 2)
188. END IF
189.  
190. WHILE t < 14
191.     W(t) = 0
192.     t = t + 1
193. WEND
194. W(14) = shrq(l, 29)
195. W(15) = shlq(l, 3)
196. SELECT CASE mode
197.     CASE 160: hash160
198.     CASE 256: hash256
199. END SELECT
200. END SUB
201.  
202. SUB hash160
203. DIM a AS _UNSIGNED LONG, b AS _UNSIGNED LONG, c AS _UNSIGNED LONG
204. DIM d AS _UNSIGNED LONG, e AS _UNSIGNED LONG, Te AS _UNSIGNED LONG
205. DIM t AS _UNSIGNED _BYTE
206.  
207. FOR t = 16 TO 79
208.     W(t) = rol(W(t - 3) XOR W(t - 8) XOR W(t - 14) XOR W(t - 16), 1)
209. NEXT
210.  
211. a = H(0): b = H(1): c = H(2): d = H(3): e = H(4)
212.  
213. FOR t = 0 TO 19
214.     Te = rol(a, 5) + Ch(b, c, d) + e + &H5A827999 + W(t)
215.     e = d: d = c: c = rol(b, 30): b = a: a = Te
216. NEXT
217.  
218. FOR t = 20 TO 39
219.     Te = rol(a, 5) + Parity(b, c, d) + e + &H6ED9EBA1 + W(t)
220.     e = d: d = c: c = rol(b, 30): b = a: a = Te
221. NEXT
222.  
223. FOR t = 40 TO 59
224.     Te = rol(a, 5) + Maj(b, c, d) + e + &H8F1BBCDC + W(t)
225.     e = d: d = c: c = rol(b, 30): b = a: a = Te
226. NEXT
227.  
228. FOR t = 60 TO 79
229.     Te = rol(a, 5) + Parity(b, c, d) + e + &HCA62C1D6 + W(t)
230.     e = d: d = c: c = rol(b, 30): b = a: a = Te
231. NEXT
232.  
233. H(0) = H(0) + a: H(1) = H(1) + b: H(2) = H(2) + c: H(3) = H(3) + d: H(4) = H(4) + e
234. END SUB
235.  
236. SUB hash256
237. DIM a AS _UNSIGNED LONG, b AS _UNSIGNED LONG, c AS _UNSIGNED LONG
238. DIM d AS _UNSIGNED LONG, e AS _UNSIGNED LONG, f AS _UNSIGNED LONG
239. DIM g AS _UNSIGNED LONG, hh AS _UNSIGNED LONG
240. DIM T1 AS _UNSIGNED LONG, T2 AS _UNSIGNED LONG
241. DIM t AS _UNSIGNED _BYTE
242.  
243. FOR t = 16 TO 63
244.     W(t) = sel1(W(t - 2)) + W(t - 7) + sel0(W(t - 15)) + W(t - 16)
245. NEXT
246.  
247. a = H(0): b = H(1): c = H(2): d = H(3): e = H(4): f = H(5): g = H(6): hh = H(7)
248.  
249. FOR t = 0 TO 63
250.     T1 = hh + sum1(e) + Ch(e, f, g) + K(t) + W(t)
251.     T2 = sum0(a) + Maj(a, b, c)
252.     hh = g: g = f: f = e: e = d + T1: d = c: c = b: b = a: a = T1 + T2
253. NEXT
254.  
255. H(0) = H(0) + a: H(1) = H(1) + b: H(2) = H(2) + c: H(3) = H(3) + d: H(4) = H(4) + e: H(5) = H(5) + f: H(6) = H(6) + g: H(7) = H(7) + hh
256. END SUB
257.  
258. FUNCTION gethex$
259. DIM t AS STRING
260. DIM i AS _UNSIGNED _BYTE
261. t = ""
262. FOR i = 0 TO mode \ 32 - 1
263.     t = t + hexd(H(i))
264. NEXT
265. gethex = t
266. END FUNCTION
267.  
268. FUNCTION hexq$ (n AS _UNSIGNED _INTEGER64)
269. DIM t AS STRING
270. t = LCASE$(HEX$(n))
271. hexq = STRING$(16 - LEN(t), &H30) + t
272. END FUNCTION
273.  
274. FUNCTION hexd$ (n AS _UNSIGNED LONG)
275. DIM t AS STRING
276. t = LCASE$(HEX$(n))
277. hexd = STRING$(8 - LEN(t), &H30) + t
278. END FUNCTION

Code: QB64: [Select]

1. $CHECKING:OFF
2. $CONSOLE
3. $SCREENHIDE
4. _DEST _CONSOLE
5. _SOURCE _CONSOLE
6.  
7. DIM SHARED M AS STRING * 64
8. DIM SHARED H(0 TO 7) AS _UNSIGNED LONG
9. DIM SHARED W(0 TO 79) AS _UNSIGNED LONG
10. DIM SHARED mode AS LONG
11. DIM SHARED K(0 TO 63) AS _UNSIGNED LONG
12.  
13. DIM filesize AS _UNSIGNED _INTEGER64
14. DIM remaining AS _UNSIGNED _INTEGER64
15. DIM x AS LONG, y AS LONG
16. DIM b AS STRING * 1
17. DIM t AS _UNSIGNED _BYTE
18.  
19. x = INSTR(COMMAND$, " ")
20. IF 0 = x THEN usage: SYSTEM
21. y = VAL(LEFT$(COMMAND$, x - 1))
22. SELECT CASE y
23.  CASE 160, 256: setmode y
24.  CASE ELSE: usage: PRINT "error on 1st parameter.": SYSTEM
25. END SELECT
26.  
27. IF 0 = _FILEEXISTS(MID$(COMMAND$, x + 1)) THEN usage: PRINT "error on 2nd parameter. File not found.": SYSTEM
28. OPEN MID$(COMMAND$, x + 1) FOR BINARY ACCESS READ AS 1
29. filesize = LOF(1)
30. resethash
31. FOR remaining = filesize TO 64 STEP -64
32.  GET 1, , M
33.  nextchunk
34. NEXT
35. IF remaining THEN
36.  FOR t = 1 TO remaining
37.   GET 1, , b
38.   MID$(M, t, 1) = b
39.  NEXT
40. END IF
41. finalchunk filesize
42. PRINT hexq(filesize); "  "; gethex; "  "; MID$(COMMAND$, x + 1)
43. CLOSE 1
44. SYSTEM
45.  
46. SUB usage
47. PRINT "Expirimental file hasher (pure qb64 version). Revision 2017 11 01"
48. PRINT "speed expiriment using hardcoded rotate functions for 160."
49. PRINT "Public domain, Michael Calkins."
50. PRINT "160 and 256 bit hashes derived from fips180-3_final.pdf"
51. PRINT "usage:"
52. PRINT "", "sha {160 | 256} filename"
53. END SUB
54.  
55. SUB setmode (m AS LONG)
56. SELECT CASE m
57.  CASE 160
58.  CASE 256
59.   K(0) = &H428A2F98: K(1) = &H71374491: K(2) = &HB5C0FBCF: K(3) = &HE9B5DBA5: K(4) = &H3956C25B: K(5) = &H59F111F1: K(6) = &H923F82A4: K(7) = &HAB1C5ED5
60.   K(8) = &HD807AA98: K(9) = &H12835B01: K(10) = &H243185BE: K(11) = &H550C7DC3: K(12) = &H72BE5D74: K(13) = &H80DEB1FE: K(14) = &H9BDC06A7: K(15) = &HC19BF174
61.   K(16) = &HE49B69C1: K(17) = &HEFBE4786: K(18) = &H0FC19DC6: K(19) = &H240CA1CC: K(20) = &H2DE92C6F: K(21) = &H4A7484AA: K(22) = &H5CB0A9DC: K(23) = &H76F988DA
62.   K(24) = &H983E5152: K(25) = &HA831C66D: K(26) = &HB00327C8: K(27) = &HBF597FC7: K(28) = &HC6E00BF3: K(29) = &HD5A79147: K(30) = &H06CA6351: K(31) = &H14292967
63.   K(32) = &H27B70A85: K(33) = &H2E1B2138: K(34) = &H4D2C6DFC: K(35) = &H53380D13: K(36) = &H650A7354: K(37) = &H766A0ABB: K(38) = &H81C2C92E: K(39) = &H92722C85
64.   K(40) = &HA2BFE8A1: K(41) = &HA81A664B: K(42) = &HC24B8B70: K(43) = &HC76C51A3: K(44) = &HD192E819: K(45) = &HD6990624: K(46) = &HF40E3585: K(47) = &H106AA070
65.   K(48) = &H19A4C116: K(49) = &H1E376C08: K(50) = &H2748774C: K(51) = &H34B0BCB5: K(52) = &H391C0CB3: K(53) = &H4ED8AA4A: K(54) = &H5B9CCA4F: K(55) = &H682E6FF3
66.   K(56) = &H748F82EE: K(57) = &H78A5636F: K(58) = &H84C87814: K(59) = &H8CC70208: K(60) = &H90BEFFFA: K(61) = &HA4506CEB: K(62) = &HBEF9A3F7: K(63) = &HC67178F2
67.  CASE ELSE
68.   PRINT "bad mode": END
69. END SELECT
70. mode = m
71. END SUB
72.  
73. FUNCTION shl~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
74. shl = x * 2 ^ n
75. END FUNCTION
76.  
77. FUNCTION shl8~& (x AS _UNSIGNED LONG)
78. shl8 = x * 256
79. END FUNCTION
80.  
81. FUNCTION shr~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
82. shr = x \ 2 ^ n
83. END FUNCTION
84.  
85. FUNCTION shlq~&& (x AS _UNSIGNED _INTEGER64, n AS _UNSIGNED _BYTE)
86. shlq = x * 2 ^ n
87. END FUNCTION
88.  
89. FUNCTION shrq~&& (x AS _UNSIGNED _INTEGER64, n AS _UNSIGNED _BYTE)
90. shrq = x \ 2 ^ n
91. END FUNCTION
92.  
93. FUNCTION rol~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
94. rol = shl(x, n) OR shr(x, 32 - n)
95. END FUNCTION
96.  
97. FUNCTION rol1~& (x AS _UNSIGNED LONG)
98. rol1 = x + x OR x \ &H80000000&
99. END FUNCTION
100.  
101. FUNCTION rol5~& (x AS _UNSIGNED LONG)
102. rol5 = x * 32 OR x \ &H8000000
103. END FUNCTION
104.  
105. FUNCTION rol30~& (x AS _UNSIGNED LONG)
106. rol30 = x * &H40000000 OR x \ 4
107. END FUNCTION
108.  
109. FUNCTION ror~& (x AS _UNSIGNED LONG, n AS _UNSIGNED _BYTE)
110. ror = shr(x, n) OR shl(x, 32 - n)
111. END FUNCTION
112.  
113. FUNCTION Ch~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
114. Ch = x AND y XOR NOT x AND z
115. END FUNCTION
116.  
117. FUNCTION Parity~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
118. Parity = x XOR y XOR z
119. END FUNCTION
120.  
121. FUNCTION Maj~& (x AS _UNSIGNED LONG, y AS _UNSIGNED LONG, z AS _UNSIGNED LONG)
122. Maj = x AND y XOR x AND z XOR y AND z
123. END FUNCTION
124.  
125. FUNCTION sum0~& (x AS _UNSIGNED LONG)
126. sum0 = ror(x, 2) XOR ror(x, 13) XOR ror(x, 22)
127. END FUNCTION
128.  
129. FUNCTION sum1~& (x AS _UNSIGNED LONG)
130. sum1 = ror(x, 6) XOR ror(x, 11) XOR ror(x, 25)
131. END FUNCTION
132.  
133. FUNCTION sel0~& (x AS _UNSIGNED LONG)
134. sel0 = ror(x, 7) XOR ror(x, 18) XOR shr(x, 3)
135. END FUNCTION
136.  
137. FUNCTION sel1~& (x AS _UNSIGNED LONG)
138. sel1 = ror(x, 17) XOR ror(x, 19) XOR shr(x, 10)
139. END FUNCTION
140.  
141. SUB resethash
142. SELECT CASE mode
143.  CASE 160
144.   H(0) = &H67452301: H(1) = &HEFCDAB89: H(2) = &H98BADCFE: H(3) = &H10325476: H(4) = &HC3D2E1F0
145.  CASE 256
146.   H(0) = &H6A09E667: H(1) = &HBB67AE85: H(2) = &H3C6EF372: H(3) = &HA54FF53A: H(4) = &H510E527F: H(5) = &H9B05688C: H(6) = &H1F83D9AB: H(7) = &H5BE0CD19
147. END SELECT
148. END SUB
149.  
150. SUB nextchunk
151. DIM t AS _UNSIGNED _BYTE
152. FOR t = 0 TO 63
153.  W(t \ 4) = shl8(W(t \ 4)) OR ASC(M, 1 + t)
154. NEXT
155. SELECT CASE mode
156.  CASE 160: hash160
157.  CASE 256: hash256
158. END SELECT
159. END SUB
160.  
161. SUB finalchunk (l AS _UNSIGNED _INTEGER64)
162. DIM t AS _UNSIGNED _BYTE
163. FOR t = 0 TO (l AND &H3F) - 1
164.  W(t \ 4) = shl8(W(t \ 4)) OR ASC(M, 1 + t)
165. NEXT
166. W(t \ 4) = shl8(W(t \ 4)) OR &H80
167. t = t + 1
168.  
169. WHILE t AND 3
170.  W(t \ 4) = shl8(W(t \ 4))
171.  t = t + 1
172. WEND
173.  
174. IF t >= 60 THEN
175.  IF t = 60 THEN W(15) = 0
176.  SELECT CASE mode
177.   CASE 160: hash160
178.   CASE 256: hash256
179.  END SELECT
180.  t = 0
181. ELSE
182.  t = shr(t, 2)
183. END IF
184.  
185. WHILE t < 14
186.  W(t) = 0
187.  t = t + 1
188. WEND
189. W(14) = shrq(l, 29)
190. W(15) = shlq(l, 3)
191. SELECT CASE mode
192.  CASE 160: hash160
193.  CASE 256: hash256
194. END SELECT
195. END SUB
196.  
197. SUB hash160
198. DIM a AS _UNSIGNED LONG, b AS _UNSIGNED LONG, c AS _UNSIGNED LONG
199. DIM d AS _UNSIGNED LONG, e AS _UNSIGNED LONG, Te AS _UNSIGNED LONG
200. DIM t AS _UNSIGNED _BYTE
201.  
202. FOR t = 16 TO 79
203.  W(t) = rol1(W(t - 3) XOR W(t - 8) XOR W(t - 14) XOR W(t - 16))
204. NEXT
205.  
206. a = H(0): b = H(1): c = H(2): d = H(3): e = H(4)
207.  
208. FOR t = 0 TO 19
209.  Te = rol5(a) + Ch(b, c, d) + e + &H5A827999 + W(t)
210.  e = d: d = c: c = rol30(b): b = a: a = Te
211. NEXT
212.  
213. FOR t = 20 TO 39
214.  Te = rol5(a) + Parity(b, c, d) + e + &H6ED9EBA1 + W(t)
215.  e = d: d = c: c = rol30(b): b = a: a = Te
216. NEXT
217.  
218. FOR t = 40 TO 59
219.  Te = rol5(a) + Maj(b, c, d) + e + &H8F1BBCDC + W(t)
220.  e = d: d = c: c = rol30(b): b = a: a = Te
221. NEXT
222.  
223. FOR t = 60 TO 79
224.  Te = rol5(a) + Parity(b, c, d) + e + &HCA62C1D6 + W(t)
225.  e = d: d = c: c = rol30(b): b = a: a = Te
226. NEXT
227.  
228. H(0) = H(0) + a: H(1) = H(1) + b: H(2) = H(2) + c: H(3) = H(3) + d: H(4) = H(4) + e
229. END SUB
230.  
231. SUB hash256
232. DIM a AS _UNSIGNED LONG, b AS _UNSIGNED LONG, c AS _UNSIGNED LONG
233. DIM d AS _UNSIGNED LONG, e AS _UNSIGNED LONG, f AS _UNSIGNED LONG
234. DIM g AS _UNSIGNED LONG, hh AS _UNSIGNED LONG
235. DIM T1 AS _UNSIGNED LONG, T2 AS _UNSIGNED LONG
236. DIM t AS _UNSIGNED _BYTE
237.  
238. FOR t = 16 TO 63
239.  W(t) = sel1(W(t - 2)) + W(t - 7) + sel0(W(t - 15)) + W(t - 16)
240. NEXT
241.  
242. a = H(0): b = H(1): c = H(2): d = H(3): e = H(4): f = H(5): g = H(6): hh = H(7)
243.  
244. FOR t = 0 TO 63
245.  T1 = hh + sum1(e) + Ch(e, f, g) + K(t) + W(t)
246.  T2 = sum0(a) + Maj(a, b, c)
247.  hh = g: g = f: f = e: e = d + T1: d = c: c = b: b = a: a = T1 + T2
248. NEXT
249.  
250. H(0) = H(0) + a: H(1) = H(1) + b: H(2) = H(2) + c: H(3) = H(3) + d: H(4) = H(4) + e: H(5) = H(5) + f: H(6) = H(6) + g: H(7) = H(7) + hh
251. END SUB
252.  
253. FUNCTION gethex$
254. DIM t AS STRING
255. DIM i AS _UNSIGNED _BYTE
256. t = ""
257. FOR i = 0 TO mode \ 32 - 1
258.  t = t + hexd(H(i))
259. NEXT
260. gethex = t
261. END FUNCTION
262.  
263. FUNCTION hexq$ (n AS _UNSIGNED _INTEGER64)
264. DIM t AS STRING
265. t = LCASE$(HEX$(n))
266. hexq = STRING$(16 - LEN(t), &H30) + t
267. END FUNCTION
268.  
269. FUNCTION hexd$ (n AS _UNSIGNED LONG)
270. DIM t AS STRING
271. t = LCASE$(HEX$(n))
272. hexd = STRING$(8 - LEN(t), &H30) + t
273. END FUNCTION

- Dav

[_vince]

Here is one written by one the best QBasic programmers.
source: https://www.tapatalk.com/groups/qbasic/programlist-artelius-t30556.html

Code: QB64: [Select]

1. DECLARE FUNCTION hexp$ (A AS LONG)
2. DECLARE FUNCTION MD5$ (in AS STRING)
3. DECLARE FUNCTION add& (A AS LONG, B AS LONG)
4. DECLARE FUNCTION leftrotate& (A AS LONG, B AS INTEGER)
5.  
6. 'Demo
7. PRINT MD5("")
8.  
9. FUNCTION add& (A AS LONG, B AS LONG)
10. DIM C AS LONG
11. C = (A AND &HFFFFFF) + (B AND &HFFFFFF)
12. POKE VARPTR(C) + 3, PEEK(VARPTR(A) + 3) + PEEK(VARPTR(B) + 3) - (C > &HFFFFFF)
13. add = C
14. END FUNCTION
15.  
16. 'Remove LCASE$ if you want uppercase hex
17. FUNCTION hexp$ (A AS LONG)
18. DIM I AS INTEGER, T AS STRING
19. FOR I = 0 TO 3
20. T = T + RIGHT$(LCASE$(HEX$(256 + PEEK(VARPTR(A) + I))), 2)
21. NEXT
22. hexp = T
23. END FUNCTION
24.  
25. FUNCTION leftrotate& (A AS LONG, B AS INTEGER)
26. DIM C AS LONG, I AS INTEGER
27. C = A
28. FOR I = 1 TO B
29. C = add(C, C)
30. NEXT
31. leftrotate = C OR (((A AND &H7FFFFFFF) \ 2 OR (A < 0) AND &H40000000) \ (2 ^ (31 - B)))
32. END FUNCTION
33.  
34. FUNCTION MD5$ (in AS STRING)
35. STATIC init AS INTEGER, r() AS INTEGER, Garbage() AS LONG
36.  
37. DIM I AS INTEGER, J AS INTEGER, dtemp AS DOUBLE
38. DIM h0 AS LONG, h1 AS LONG, h2 AS LONG, h3 AS LONG
39. DIM A AS LONG, B AS LONG, C AS LONG, D AS LONG
40. DIM F AS LONG, G AS LONG, temp AS LONG
41. DIM mess(0 TO 15) AS LONG
42.  
43. IF init = 0 THEN
44. REDIM r(0 TO 63) AS INTEGER, Garbage(0 TO 63) AS LONG
45. r(0) = 7: r(1) = 12: r(2) = 17: r(3) = 22
46. r(4) = 5: r(5) = 9: r(6) = 14: r(7) = 20
47. r(8) = 4: r(9) = 11: r(10) = 16: r(11) = 23
48. r(12) = 6: r(13) = 10: r(14) = 15: r(15) = 21
49.  
50. FOR I = 63 TO 4 STEP -1
51. r(I) = r((I AND 3) OR ((I AND 48) \ 4))
52. NEXT
53.  
54. FOR I = 0 TO 63
55. dtemp = ABS(SIN(CDBL(I + 1))) * 4294967296#
56. IF dtemp >= 2147483648# THEN dtemp = dtemp - 4294967296#
57. Garbage(I) = INT(dtemp)
58. NEXT
59. init = 1
60. END IF
61.  
62.  
63. h0 = &H67452301
64. h1 = &HEFCDAB89
65. h2 = &H98BADCFE
66. h3 = &H10325476
67.  
68. in = in + CHR$(128) + STRING$((55 - LEN(in) AND 63), 0) + CHR$((LEN(in) * 8) AND 255) + CHR$(LEN(in) \ 32) + STRING$(6, 0)
69.  
70. FOR I = 0 TO LEN(in) - 1 STEP 64
71. FOR J = 0 TO 15
72. mess(J) = CVL(MID$(in, J * 4 + I + 1, 4))
73. NEXT
74. A = h0
75. B = h1
76. C = h2
77. D = h3
78. FOR J = 0 TO 15
79. F = ((C XOR D) AND B) XOR D
80. G = J
81. GOSUB shuffle
82. NEXT
83. FOR J = 16 TO 31
84. F = ((B XOR C) AND D) XOR C
85. G = (5 * J + 1) AND 15
86. GOSUB shuffle
87. NEXT
88. FOR J = 32 TO 47
89. F = B XOR C XOR D
90. G = (3 * J + 5) AND 15
91. GOSUB shuffle
92. NEXT
93. FOR J = 48 TO 63
94. F = (D IMP B) XOR C
95. G = (7 * J) AND 15
96. GOSUB shuffle
97. NEXT
98.  
99. h0 = add(h0, A)
100. h1 = add(h1, B)
101. h2 = add(h2, C)
102. h3 = add(h3, D)
103.  
104. NEXT
105.  
106. MD5 = hexp(h0) + hexp(h1) + hexp(h2) + hexp(h3)
107.  
108. EXIT FUNCTION
109. shuffle:
110. temp = A
111. A = D
112. D = C
113. C = B
114. B = add(B, leftrotate(add(add(add(temp, F), Garbage(J)), mess(G)), r(J)))
115. RETURN
116.  
117. END FUNCTION
118.