Rev 750 | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
749 | daniel-mar | 1 | unit WEID_Delphi; |
748 | daniel-mar | 2 | |
3 | (* |
||
4 | * WEID<=>OID Converter for Delphi |
||
5 | * (c) Webfan.de, ViaThinkSoft |
||
1377 | daniel-mar | 6 | * Revision 2023-08-10 |
748 | daniel-mar | 7 | *) |
8 | |||
9 | (* |
||
1377 | daniel-mar | 10 | * What is a WEID? |
11 | * A WEID (WEhowski IDentifier) is an alternative representation of an |
||
12 | * OID (Object IDentifier) defined by Till Wehowski. |
||
13 | * In OIDs, arcs are in decimal base 10. In WEIDs, the arcs are in base 36. |
||
14 | * Also, each WEID has a check digit at the end (called WeLuhn Check Digit). |
||
15 | * |
||
16 | * The full specification can be found here: https://weid.info/spec.html |
||
17 | * |
||
18 | * This converter supports WEID as of Spec Change #11 |
||
19 | * |
||
20 | * A few short notes: |
||
21 | * - There are several classes of WEIDs which have different OID bases: |
||
22 | * "Class A" WEID: weid:root:2-RR-? |
||
23 | * oid:2.999 |
||
24 | * WEID class base OID: (OID Root) |
||
25 | * "Class B" WEID: weid:pen:SX0-7PR-? |
||
26 | * oid:1.3.6.1.4.1.37476.9999 |
||
27 | * WEID class base OID: 1.3.6.1.4.1 |
||
28 | * "Class C" WEID: weid:EXAMPLE-? |
||
29 | * oid:1.3.6.1.4.1.37553.8.32488192274 |
||
30 | * WEID class base OID: 1.3.6.1.4.1.37553.8 |
||
31 | * "Class D" WEID: weid:example.com:TEST-? is equal to weid:9-DNS-COM-EXAMPLE-TEST-? |
||
32 | * Since the check digit is based on the OID, the check digit is equal for both notations. |
||
33 | * oid:1.3.6.1.4.1.37553.8.9.17704.32488192274.16438.1372205 |
||
34 | * WEID class base OID: 1.3.6.1.4.1.37553.8.9.17704 |
||
35 | * - The last arc in a WEID is the check digit. A question mark is the wildcard for an unknown check digit. |
||
36 | * In this case, the converter will return the correct expected check digit for the input. |
||
37 | * - The namespace (weid:, weid:pen:, weid:root:) is case insensitive. |
||
38 | * - Padding with '0' characters is valid (e.g. weid:000EXAMPLE-3) |
||
39 | * The paddings do not count into the WeLuhn check digit. |
||
40 | *) |
||
748 | daniel-mar | 41 | |
42 | interface |
||
43 | |||
44 | (* |
||
45 | Translates a weid to an oid |
||
46 | "weid:EXAMPLE-3" becomes "1.3.6.1.4.1.37553.8.32488192274" |
||
47 | If it failed (e.g. wrong namespace, wrong checksum, etc.) then false is returned. |
||
48 | If the weid ends with '?', then it will be replaced with the checksum, |
||
49 | e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 |
||
50 | *) |
||
51 | function WeidToOid(var weid: string): string; |
||
52 | |||
53 | (* |
||
54 | Converts an OID to WEID |
||
55 | "1.3.6.1.4.1.37553.8.32488192274" becomes "weid:EXAMPLE-3" |
||
56 | *) |
||
57 | function OidToWeid(oid: string): string; |
||
58 | |||
59 | implementation |
||
60 | |||
61 | uses |
||
62 | SysUtils; |
||
63 | |||
64 | function LastCharPos(const S: string; const Chr: char): integer; |
||
65 | var |
||
66 | i: Integer; |
||
67 | begin |
||
68 | for i := length(S) downto 1 do |
||
69 | begin |
||
70 | if S[i] = Chr then |
||
71 | begin |
||
749 | daniel-mar | 72 | result := i; |
748 | daniel-mar | 73 | Exit; |
74 | end; |
||
75 | end; |
||
749 | daniel-mar | 76 | result := 0; |
748 | daniel-mar | 77 | Exit; |
78 | end; |
||
79 | |||
80 | function base_convert_bigint(numstring: string; frombase, tobase: integer): string; |
||
81 | var |
||
82 | i: Integer; |
||
83 | frombase_str: string; |
||
84 | tobase_str: string; |
||
85 | len: Integer; |
||
86 | number: string; |
||
87 | divide: Integer; |
||
88 | newlen: Integer; |
||
89 | res: string; |
||
90 | begin |
||
91 | frombase_str := ''; |
||
92 | for i := 0 to frombase-1 do |
||
93 | begin |
||
94 | if i < 10 then |
||
95 | frombase_str := frombase_str + IntToStr(i) |
||
96 | else |
||
97 | frombase_str := frombase_str + Chr(Ord('A') + (i-10)); |
||
98 | end; |
||
99 | |||
100 | tobase_str := ''; |
||
101 | for i := 0 to tobase-1 do |
||
102 | begin |
||
103 | if i < 10 then |
||
104 | tobase_str := tobase_str + IntToStr(i) |
||
105 | else |
||
106 | tobase_str := tobase_str + Chr(Ord('A') + (i-10)); |
||
107 | end; |
||
108 | |||
109 | len := Length(numstring); |
||
749 | daniel-mar | 110 | result := ''; |
748 | daniel-mar | 111 | number := numstring; (* this is a fake "Int8" array (implemented with chars) *) |
112 | for i := 0 to len-1 do |
||
113 | begin |
||
114 | number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1); |
||
115 | end; |
||
116 | res := ''; |
||
117 | repeat (* Loop until whole number is converted *) |
||
118 | divide := 0; |
||
119 | newlen := 0; |
||
120 | for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *) |
||
121 | begin |
||
122 | divide := divide * frombase + Ord(number[i+1]); |
||
123 | if (divide >= tobase) then |
||
124 | begin |
||
125 | number[newlen+1] := Chr(divide div tobase); |
||
126 | Inc(newlen); |
||
127 | divide := divide mod tobase; |
||
128 | end |
||
129 | else if newlen > 0 then |
||
130 | begin |
||
131 | number[newlen+1] := #0; |
||
132 | Inc(newlen); |
||
133 | end; |
||
134 | end; |
||
135 | len := newlen; |
||
749 | daniel-mar | 136 | res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *) |
748 | daniel-mar | 137 | until newlen = 0; |
749 | daniel-mar | 138 | result := res; |
748 | daniel-mar | 139 | end; |
140 | |||
141 | function weLuhnGetCheckDigit(s: string): integer; |
||
142 | var |
||
143 | p: integer; |
||
144 | wrkstr: string; |
||
145 | c: Char; |
||
146 | i: Integer; |
||
147 | sum: integer; |
||
148 | nbdigits: Integer; |
||
149 | parity: Integer; |
||
150 | n: Integer; |
||
151 | digit: Integer; |
||
152 | begin |
||
153 | (* Padding zeros don't count to the check digit (December 2021) *) |
||
154 | s := '-' + s + '-'; |
||
155 | while Pos('-0', s) > 0 do |
||
156 | begin |
||
157 | s := StringReplace(s, '-0-', #1, [rfReplaceAll]); |
||
158 | s := StringReplace(s, '-0', '-', [rfReplaceAll]); |
||
159 | end; |
||
160 | s := StringReplace(s, #1, '-0-', [rfReplaceAll]); |
||
161 | s := Copy(s, 2, Length(s)-2); |
||
162 | |||
163 | (* remove separators of the WEID string *) |
||
164 | wrkstr := StringReplace(s, '-', '', [rfReplaceAll]); |
||
165 | |||
166 | (* Replace 'a' with '10', 'b' with '11', etc. *) |
||
167 | for c := 'A' to 'Z' do |
||
168 | begin |
||
169 | wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10), [rfReplaceAll]); |
||
170 | end; |
||
171 | |||
749 | daniel-mar | 172 | (* At the end, wrkstr should only contain digits! Verify it! *) |
748 | daniel-mar | 173 | for i := 1 to Length(wrkstr) do |
174 | begin |
||
175 | if not (wrkstr[i] in ['0'..'9']) then |
||
176 | begin |
||
749 | daniel-mar | 177 | result := -1; |
748 | daniel-mar | 178 | exit; |
179 | end; |
||
180 | end; |
||
181 | |||
182 | (* Now do the standard Luhn algorithm *) |
||
183 | nbdigits := Length(wrkstr); |
||
184 | parity := nbdigits and 1; (* mod 2 *) |
||
185 | sum := 0; |
||
186 | for n := nbdigits-1 downto 0 do |
||
187 | begin |
||
188 | digit := StrToInt(wrkstr[n+1]); |
||
189 | if (n and 1) <> parity then digit := digit * 2; |
||
190 | if digit > 9 then digit := digit - 9; |
||
191 | sum := sum + digit; |
||
192 | end; |
||
193 | |||
194 | if sum mod 10 = 0 then |
||
749 | daniel-mar | 195 | result := 0 |
748 | daniel-mar | 196 | else |
749 | daniel-mar | 197 | result := 10 - (sum mod 10); |
748 | daniel-mar | 198 | end; |
199 | |||
200 | function WeidToOid(var weid: string): string; |
||
201 | var |
||
202 | base: string; |
||
203 | namespace: string; |
||
204 | p: integer; |
||
205 | rest: string; |
||
206 | actual_checksum: string; |
||
207 | expected_checksum: integer; |
||
208 | complete: string; |
||
209 | oidstr: string; |
||
210 | arc: string; |
||
1377 | daniel-mar | 211 | domainpart: string; |
212 | tmp: string; |
||
748 | daniel-mar | 213 | begin |
214 | p := LastCharPos(weid,':'); |
||
215 | namespace := Copy(weid, 1, p); |
||
216 | rest := Copy(weid, p+1, Length(weid)-p); |
||
217 | |||
218 | namespace := LowerCase(namespace); (* namespace is case insensitive *) |
||
1377 | daniel-mar | 219 | |
220 | if Copy(namespace, 1, 5) = 'weid:' then |
||
748 | daniel-mar | 221 | begin |
1377 | daniel-mar | 222 | tmp := Copy(namespace, 1, Length(namespace)-1); |
223 | p := Pos(':', tmp, 5); |
||
224 | Delete(tmp, 1, p); |
||
225 | if pos('.', tmp) > 0 then |
||
226 | begin |
||
227 | (* Spec Change 10: Class D / Domain-WEID *) |
||
228 | if pos(':', tmp) > 0 then |
||
229 | begin |
||
230 | result := ''; |
||
231 | exit; |
||
232 | end; |
||
233 | domainpart := ''; |
||
234 | while tmp <> '' do |
||
235 | begin |
||
236 | p := Pos('.', tmp); |
||
237 | if p = 0 then |
||
238 | begin |
||
239 | domainpart := tmp + '-' + domainpart; |
||
240 | break; |
||
241 | end |
||
242 | else |
||
243 | begin |
||
244 | domainpart := Copy(tmp, 1, p-1) + '-' + domainpart; |
||
245 | Delete(tmp, 1, p); |
||
246 | end; |
||
247 | end; |
||
248 | weid := 'weid:9-DNS-' + UpperCase(Domainpart) + Rest; |
||
249 | result := WeidToOid(weid); |
||
250 | exit; |
||
251 | end; |
||
252 | end; |
||
253 | |||
254 | if Copy(namespace, 1, 7) = 'weid:x-' then |
||
255 | begin |
||
256 | (* Spec Change 11: Proprietary Namespaces *) |
||
257 | result := '[Proprietary WEID Namespace]'; |
||
258 | Exit; |
||
259 | end |
||
260 | else if namespace = 'weid:' then |
||
261 | begin |
||
748 | daniel-mar | 262 | (* Class C *) |
263 | base := '1-3-6-1-4-1-SZ5-8'; |
||
264 | end |
||
265 | else if namespace = 'weid:pen:' then |
||
266 | begin |
||
267 | (* Class B *) |
||
268 | base := '1-3-6-1-4-1'; |
||
269 | end |
||
270 | else if namespace = 'weid:root:' then |
||
271 | begin |
||
272 | (* Class A *) |
||
273 | base := ''; |
||
274 | end |
||
275 | else |
||
276 | begin |
||
277 | (* Wrong namespace *) |
||
749 | daniel-mar | 278 | result := ''; |
748 | daniel-mar | 279 | Exit; |
280 | end; |
||
281 | |||
282 | weid := rest; |
||
283 | |||
284 | if base <> '' then |
||
285 | complete := base + '-' + weid |
||
286 | else |
||
287 | complete := weid; |
||
288 | p := LastCharPos(complete, '-'); |
||
289 | actual_checksum := Copy(complete, p+1, 1); |
||
290 | complete := Copy(complete, 1, p-1); |
||
291 | expected_checksum := weLuhnGetCheckDigit(complete); |
||
292 | if (actual_checksum <> '?') then |
||
293 | begin |
||
294 | if actual_checksum <> IntToStr(expected_checksum) then |
||
295 | begin |
||
749 | daniel-mar | 296 | result := ''; (* wrong checksum *) |
748 | daniel-mar | 297 | Exit; |
298 | end; |
||
299 | end |
||
300 | else |
||
301 | begin |
||
302 | (* If checksum is '?', it will be replaced by the actual checksum, *) |
||
303 | (* e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 *) |
||
304 | weid := StringReplace(weid, '?', IntToStr(expected_checksum), [rfReplaceAll]); |
||
305 | end; |
||
306 | |||
307 | oidstr := ''; |
||
308 | while true do |
||
309 | begin |
||
310 | p := Pos('-', complete); |
||
311 | if p = 0 then p := Length(complete)+1; |
||
312 | arc := Copy(complete, 1, p-1); |
||
313 | Delete(complete, 1, p); |
||
314 | oidstr := oidstr + base_convert_bigint(arc, 36, 10) + '.'; |
||
315 | if complete = '' then break; |
||
316 | end; |
||
317 | oidstr := Copy(oidstr, 1, Length(oidstr)-1); |
||
318 | |||
750 | daniel-mar | 319 | weid := LowerCase(namespace) + UpperCase(weid); (* add namespace again *) |
748 | daniel-mar | 320 | |
749 | daniel-mar | 321 | result := oidstr; |
748 | daniel-mar | 322 | end; |
323 | |||
324 | function OidToWeid(oid: string): string; |
||
325 | var |
||
326 | is_class_a: boolean; |
||
327 | is_class_b: boolean; |
||
328 | is_class_c: boolean; |
||
329 | weidstr: string; |
||
330 | checksum: string; |
||
331 | namespace: string; |
||
332 | p: Integer; |
||
333 | cd: Integer; |
||
334 | res: string; |
||
335 | begin |
||
336 | if Copy(oid,1,1) = '.' then |
||
337 | Delete(oid,1,1); (* remove leading dot *) |
||
338 | |||
339 | if oid <> '' then |
||
340 | begin |
||
341 | weidstr := ''; |
||
342 | while true do |
||
343 | begin |
||
344 | p := Pos('.', oid); |
||
345 | if p = 1 then |
||
346 | begin |
||
347 | Delete(oid, 1, 1); |
||
348 | end |
||
349 | else if p > 0 then |
||
350 | begin |
||
351 | weidstr := weidstr + base_convert_bigint(Copy(oid, 1, p-1),10,36) + '-'; |
||
352 | Delete(oid, 1, p); |
||
353 | end |
||
354 | else |
||
355 | begin |
||
356 | weidstr := weidstr + base_convert_bigint(oid,10,36) + '-'; |
||
357 | break; |
||
358 | end; |
||
359 | end; |
||
360 | weidstr := Copy(weidstr, 1, Length(weidstr)-1); |
||
361 | end |
||
362 | else |
||
363 | begin |
||
364 | weidstr := ''; |
||
365 | end; |
||
366 | |||
367 | is_class_c := (Pos('1-3-6-1-4-1-SZ5-8-', weidstr) = 1) or |
||
368 | (weidstr = '1-3-6-1-4-1-SZ5-8'); |
||
369 | is_class_b := ((Pos('1-3-6-1-4-1-', weidstr) = 1) or |
||
370 | (weidstr = '1-3-6-1-4-1')) |
||
371 | and not is_class_c; |
||
372 | is_class_a := not is_class_b and not is_class_c; |
||
373 | |||
374 | cd := weLuhnGetCheckDigit(weidstr); |
||
375 | if cd < 0 then |
||
376 | begin |
||
749 | daniel-mar | 377 | result := weidstr; |
748 | daniel-mar | 378 | exit; |
379 | end; |
||
380 | checksum := IntToStr(cd); |
||
381 | |||
382 | if is_class_c then |
||
383 | begin |
||
384 | Delete(weidstr, 1, Length('1-3-6-1-4-1-SZ5-8-')); |
||
385 | namespace := 'weid:'; |
||
386 | end |
||
387 | else if is_class_b then |
||
388 | begin |
||
389 | Delete(weidstr, 1, Length('1-3-6-1-4-1-')); |
||
390 | namespace := 'weid:pen:'; |
||
391 | end |
||
392 | else if is_class_a then |
||
393 | begin |
||
394 | (* weidstr stays *) |
||
395 | namespace := 'weid:root:'; |
||
396 | end |
||
397 | else |
||
398 | begin |
||
399 | (* should not happen *) |
||
749 | daniel-mar | 400 | result := ''; |
748 | daniel-mar | 401 | Exit; |
402 | end; |
||
403 | |||
404 | res := namespace; |
||
405 | if weidstr = '' then |
||
406 | res := res + checksum |
||
407 | else |
||
408 | res := res + weidstr + '-' + checksum; |
||
749 | daniel-mar | 409 | result := res; |
748 | daniel-mar | 410 | end; |
411 | |||
412 | end. |