Rev 749 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 749 | Rev 750 | ||
---|---|---|---|
1 | unit WEID; |
1 | unit WEID; |
2 | 2 | ||
3 | (* |
3 | (* |
4 | * WEID<=>OID Converter for TurboPascal |
4 | * WEID<=>OID Converter for TurboPascal |
5 | * (c) Webfan.de, ViaThinkSoft |
5 | * (c) Webfan.de, ViaThinkSoft |
6 | * Revision 2022-02-19 |
6 | * Revision 2022-02-22 |
7 | *) |
7 | *) |
8 | 8 | ||
9 | (* |
9 | (* |
10 | What is a WEID? |
10 | What is a WEID? |
11 | A WEID (WEhowski IDentifier) is an alternative representation of an |
11 | A WEID (WEhowski IDentifier) is an alternative representation of an |
12 | OID (Object IDentifier) defined by Till Wehowski. |
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. |
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 WeLohn Check Digit). |
14 | Also, each WEID has a check digit at the end (called WeLohn Check Digit). |
15 | 15 | ||
16 | Changes in the December 2021 definition by Daniel Marschall: |
16 | Changes in the December 2021 definition by Daniel Marschall: |
17 | - There are several classes of WEIDs which have different OID bases: |
17 | - There are several classes of WEIDs which have different OID bases: |
18 | "Class C" WEID: weid:EXAMPLE-3 (base .1.3.6.1.4.1.37553.8.) |
18 | "Class C" WEID: weid:EXAMPLE-3 (base .1.3.6.1.4.1.37553.8.) |
19 | oid:1.3.6.1.4.1.37553.8.32488192274 |
19 | oid:1.3.6.1.4.1.37553.8.32488192274 |
20 | "Class B" WEID: weid:pen:SX0-7PR-6 (base .1.3.6.1.4.1.) |
20 | "Class B" WEID: weid:pen:SX0-7PR-6 (base .1.3.6.1.4.1.) |
21 | oid:1.3.6.1.4.1.37476.9999 |
21 | oid:1.3.6.1.4.1.37476.9999 |
22 | "Class A" WEID: weid:root:2-RR-2 (base .) |
22 | "Class A" WEID: weid:root:2-RR-2 (base .) |
23 | oid:2.999 |
23 | oid:2.999 |
24 | - The namespace (weid:, weid:pen:, weid:root:) is now case insensitive. |
24 | - The namespace (weid:, weid:pen:, weid:root:) is now case insensitive. |
25 | - Padding with '0' characters is valid (e.g. weid:000EXAMPLE-3) |
25 | - Padding with '0' characters is valid (e.g. weid:000EXAMPLE-3) |
26 | The paddings do not count into the WeLuhn check-digit. |
26 | The paddings do not count into the WeLuhn check-digit. |
27 | *) |
27 | *) |
28 | 28 | ||
29 | interface |
29 | interface |
30 | 30 | ||
31 | (* |
31 | (* |
32 | Translates a weid to an oid |
32 | Translates a weid to an oid |
33 | "weid:EXAMPLE-3" becomes "1.3.6.1.4.1.37553.8.32488192274" |
33 | "weid:EXAMPLE-3" becomes "1.3.6.1.4.1.37553.8.32488192274" |
34 | If it failed (e.g. wrong namespace, wrong checksum, etc.) then false is returned. |
34 | If it failed (e.g. wrong namespace, wrong checksum, etc.) then false is returned. |
35 | If the weid ends with '?', then it will be replaced with the checksum, |
35 | If the weid ends with '?', then it will be replaced with the checksum, |
36 | e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 |
36 | e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 |
37 | *) |
37 | *) |
38 | function WeidToOid(var weid: string): string; |
38 | function WeidToOid(var weid: string): string; |
39 | 39 | ||
40 | (* |
40 | (* |
41 | Converts an OID to WEID |
41 | Converts an OID to WEID |
42 | "1.3.6.1.4.1.37553.8.32488192274" becomes "weid:EXAMPLE-3" |
42 | "1.3.6.1.4.1.37553.8.32488192274" becomes "weid:EXAMPLE-3" |
43 | *) |
43 | *) |
44 | function OidToWeid(oid: string): string; |
44 | function OidToWeid(oid: string): string; |
45 | 45 | ||
46 | implementation |
46 | implementation |
47 | 47 | ||
48 | uses |
48 | uses |
49 | VtsFuncs; |
49 | VtsFuncs; |
50 | 50 | ||
51 | function weLuhnGetCheckDigit(s: string): integer; |
51 | function weLuhnGetCheckDigit(s: string): integer; |
52 | var |
52 | var |
53 | p: integer; |
53 | p: integer; |
54 | wrkstr: string; |
54 | wrkstr: string; |
55 | c: Char; |
55 | c: Char; |
56 | i: Integer; |
56 | i: Integer; |
57 | sum: integer; |
57 | sum: integer; |
58 | nbdigits: Integer; |
58 | nbdigits: Integer; |
59 | parity: Integer; |
59 | parity: Integer; |
60 | n: Integer; |
60 | n: Integer; |
61 | digit: Integer; |
61 | digit: Integer; |
62 | begin |
62 | begin |
63 | (* Padding zeros don't count to the check digit (December 2021) *) |
63 | (* Padding zeros don't count to the check digit (December 2021) *) |
64 | s := '-' + s + '-'; |
64 | s := '-' + s + '-'; |
65 | while Pos('-0', s) > 0 do |
65 | while Pos('-0', s) > 0 do |
66 | begin |
66 | begin |
67 | s := StringReplace(s, '-0-', #1); |
67 | s := StringReplace(s, '-0-', #1); |
68 | s := StringReplace(s, '-0', '-'); |
68 | s := StringReplace(s, '-0', '-'); |
69 | end; |
69 | end; |
70 | s := StringReplace(s, #1, '-0-'); |
70 | s := StringReplace(s, #1, '-0-'); |
71 | s := Copy(s, 2, Length(s)-2); |
71 | s := Copy(s, 2, Length(s)-2); |
72 | 72 | ||
73 | (* remove separators of the WEID string *) |
73 | (* remove separators of the WEID string *) |
74 | wrkstr := StringReplace(s, '-', ''); |
74 | wrkstr := StringReplace(s, '-', ''); |
75 | 75 | ||
76 | (* Replace 'a' with '10', 'b' with '11', etc. *) |
76 | (* Replace 'a' with '10', 'b' with '11', etc. *) |
77 | for c := 'A' to 'Z' do |
77 | for c := 'A' to 'Z' do |
78 | begin |
78 | begin |
79 | wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10)); |
79 | wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10)); |
80 | end; |
80 | end; |
81 | 81 | ||
82 | (* At the end, wrkstr should only contain digits! Verify it! *) |
82 | (* At the end, wrkstr should only contain digits! Verify it! *) |
83 | for i := 1 to Length(wrkstr) do |
83 | for i := 1 to Length(wrkstr) do |
84 | begin |
84 | begin |
85 | if not (wrkstr[i] in ['0'..'9']) then |
85 | if not (wrkstr[i] in ['0'..'9']) then |
86 | begin |
86 | begin |
87 | weLuhnGetCheckDigit := -1; |
87 | weLuhnGetCheckDigit := -1; |
88 | exit; |
88 | exit; |
89 | end; |
89 | end; |
90 | end; |
90 | end; |
91 | 91 | ||
92 | (* Now do the standard Luhn algorithm *) |
92 | (* Now do the standard Luhn algorithm *) |
93 | nbdigits := Length(wrkstr); |
93 | nbdigits := Length(wrkstr); |
94 | parity := nbdigits and 1; (* mod 2 *) |
94 | parity := nbdigits and 1; (* mod 2 *) |
95 | sum := 0; |
95 | sum := 0; |
96 | for n := nbdigits-1 downto 0 do |
96 | for n := nbdigits-1 downto 0 do |
97 | begin |
97 | begin |
98 | digit := StrToInt(wrkstr[n+1]); |
98 | digit := StrToInt(wrkstr[n+1]); |
99 | if (n and 1) <> parity then digit := digit * 2; |
99 | if (n and 1) <> parity then digit := digit * 2; |
100 | if digit > 9 then digit := digit - 9; |
100 | if digit > 9 then digit := digit - 9; |
101 | sum := sum + digit; |
101 | sum := sum + digit; |
102 | end; |
102 | end; |
103 | 103 | ||
104 | if sum mod 10 = 0 then |
104 | if sum mod 10 = 0 then |
105 | weLuhnGetCheckDigit := 0 |
105 | weLuhnGetCheckDigit := 0 |
106 | else |
106 | else |
107 | weLuhnGetCheckDigit := 10 - (sum mod 10); |
107 | weLuhnGetCheckDigit := 10 - (sum mod 10); |
108 | end; |
108 | end; |
109 | 109 | ||
110 | function WeidToOid(var weid: string): string; |
110 | function WeidToOid(var weid: string): string; |
111 | var |
111 | var |
112 | base: string; |
112 | base: string; |
113 | namespace: string; |
113 | namespace: string; |
114 | p: integer; |
114 | p: integer; |
115 | rest: string; |
115 | rest: string; |
116 | actual_checksum: string; |
116 | actual_checksum: string; |
117 | expected_checksum: integer; |
117 | expected_checksum: integer; |
118 | complete: string; |
118 | complete: string; |
119 | oidstr: string; |
119 | oidstr: string; |
120 | arc: string; |
120 | arc: string; |
121 | begin |
121 | begin |
122 | p := LastCharPos(weid,':'); |
122 | p := LastCharPos(weid,':'); |
123 | namespace := Copy(weid, 1, p); |
123 | namespace := Copy(weid, 1, p); |
124 | rest := Copy(weid, p+1, Length(weid)-p); |
124 | rest := Copy(weid, p+1, Length(weid)-p); |
125 | 125 | ||
126 | namespace := LowerCase(namespace); (* namespace is case insensitive *) |
126 | namespace := LowerCase(namespace); (* namespace is case insensitive *) |
127 | if namespace = 'weid:' then |
127 | if namespace = 'weid:' then |
128 | begin |
128 | begin |
129 | (* Class C *) |
129 | (* Class C *) |
130 | base := '1-3-6-1-4-1-SZ5-8'; |
130 | base := '1-3-6-1-4-1-SZ5-8'; |
131 | end |
131 | end |
132 | else if namespace = 'weid:pen:' then |
132 | else if namespace = 'weid:pen:' then |
133 | begin |
133 | begin |
134 | (* Class B *) |
134 | (* Class B *) |
135 | base := '1-3-6-1-4-1'; |
135 | base := '1-3-6-1-4-1'; |
136 | end |
136 | end |
137 | else if namespace = 'weid:root:' then |
137 | else if namespace = 'weid:root:' then |
138 | begin |
138 | begin |
139 | (* Class A *) |
139 | (* Class A *) |
140 | base := ''; |
140 | base := ''; |
141 | end |
141 | end |
142 | else |
142 | else |
143 | begin |
143 | begin |
144 | (* Wrong namespace *) |
144 | (* Wrong namespace *) |
145 | WeidToOid := ''; |
145 | WeidToOid := ''; |
146 | Exit; |
146 | Exit; |
147 | end; |
147 | end; |
148 | 148 | ||
149 | weid := rest; |
149 | weid := rest; |
150 | 150 | ||
151 | if base <> '' then |
151 | if base <> '' then |
152 | complete := base + '-' + weid |
152 | complete := base + '-' + weid |
153 | else |
153 | else |
154 | complete := weid; |
154 | complete := weid; |
155 | p := LastCharPos(complete, '-'); |
155 | p := LastCharPos(complete, '-'); |
156 | actual_checksum := Copy(complete, p+1, 1); |
156 | actual_checksum := Copy(complete, p+1, 1); |
157 | complete := Copy(complete, 1, p-1); |
157 | complete := Copy(complete, 1, p-1); |
158 | expected_checksum := weLuhnGetCheckDigit(complete); |
158 | expected_checksum := weLuhnGetCheckDigit(complete); |
159 | if (actual_checksum <> '?') then |
159 | if (actual_checksum <> '?') then |
160 | begin |
160 | begin |
161 | if actual_checksum <> IntToStr(expected_checksum) then |
161 | if actual_checksum <> IntToStr(expected_checksum) then |
162 | begin |
162 | begin |
163 | WeidToOid := ''; (* wrong checksum *) |
163 | WeidToOid := ''; (* wrong checksum *) |
164 | Exit; |
164 | Exit; |
165 | end; |
165 | end; |
166 | end |
166 | end |
167 | else |
167 | else |
168 | begin |
168 | begin |
169 | (* If checksum is '?', it will be replaced by the actual checksum, *) |
169 | (* If checksum is '?', it will be replaced by the actual checksum, *) |
170 | (* e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 *) |
170 | (* e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 *) |
171 | weid := StringReplace(weid, '?', IntToStr(expected_checksum)); |
171 | weid := StringReplace(weid, '?', IntToStr(expected_checksum)); |
172 | end; |
172 | end; |
173 | 173 | ||
174 | oidstr := ''; |
174 | oidstr := ''; |
175 | while true do |
175 | while true do |
176 | begin |
176 | begin |
177 | p := Pos('-', complete); |
177 | p := Pos('-', complete); |
178 | if p = 0 then p := Length(complete)+1; |
178 | if p = 0 then p := Length(complete)+1; |
179 | arc := Copy(complete, 1, p-1); |
179 | arc := Copy(complete, 1, p-1); |
180 | Delete(complete, 1, p); |
180 | Delete(complete, 1, p); |
181 | oidstr := oidstr + base_convert_bigint(arc, 36, 10) + '.'; |
181 | oidstr := oidstr + base_convert_bigint(arc, 36, 10) + '.'; |
182 | if complete = '' then break; |
182 | if complete = '' then break; |
183 | end; |
183 | end; |
184 | oidstr := Copy(oidstr, 1, Length(oidstr)-1); |
184 | oidstr := Copy(oidstr, 1, Length(oidstr)-1); |
185 | 185 | ||
186 | weid := namespace + weid; (* add namespace again *) |
186 | weid := LowerCase(namespace) + UpperCase(weid); (* add namespace again *) |
187 | 187 | ||
188 | WeidToOid := oidstr; |
188 | WeidToOid := oidstr; |
189 | end; |
189 | end; |
190 | 190 | ||
191 | function OidToWeid(oid: string): string; |
191 | function OidToWeid(oid: string): string; |
192 | var |
192 | var |
193 | is_class_a: boolean; |
193 | is_class_a: boolean; |
194 | is_class_b: boolean; |
194 | is_class_b: boolean; |
195 | is_class_c: boolean; |
195 | is_class_c: boolean; |
196 | weidstr: string; |
196 | weidstr: string; |
197 | checksum: string; |
197 | checksum: string; |
198 | namespace: string; |
198 | namespace: string; |
199 | p: Integer; |
199 | p: Integer; |
200 | cd: Integer; |
200 | cd: Integer; |
201 | res: string; |
201 | res: string; |
202 | begin |
202 | begin |
203 | if Copy(oid,1,1) = '.' then |
203 | if Copy(oid,1,1) = '.' then |
204 | Delete(oid,1,1); (* remove leading dot *) |
204 | Delete(oid,1,1); (* remove leading dot *) |
205 | 205 | ||
206 | if oid <> '' then |
206 | if oid <> '' then |
207 | begin |
207 | begin |
208 | weidstr := ''; |
208 | weidstr := ''; |
209 | while true do |
209 | while true do |
210 | begin |
210 | begin |
211 | p := Pos('.', oid); |
211 | p := Pos('.', oid); |
212 | if p = 1 then |
212 | if p = 1 then |
213 | begin |
213 | begin |
214 | Delete(oid, 1, 1); |
214 | Delete(oid, 1, 1); |
215 | end |
215 | end |
216 | else if p > 0 then |
216 | else if p > 0 then |
217 | begin |
217 | begin |
218 | weidstr := weidstr + base_convert_bigint(Copy(oid, 1, p-1),10,36) + '-'; |
218 | weidstr := weidstr + base_convert_bigint(Copy(oid, 1, p-1),10,36) + '-'; |
219 | Delete(oid, 1, p); |
219 | Delete(oid, 1, p); |
220 | end |
220 | end |
221 | else |
221 | else |
222 | begin |
222 | begin |
223 | weidstr := weidstr + base_convert_bigint(oid,10,36) + '-'; |
223 | weidstr := weidstr + base_convert_bigint(oid,10,36) + '-'; |
224 | break; |
224 | break; |
225 | end; |
225 | end; |
226 | end; |
226 | end; |
227 | weidstr := Copy(weidstr, 1, Length(weidstr)-1); |
227 | weidstr := Copy(weidstr, 1, Length(weidstr)-1); |
228 | end |
228 | end |
229 | else |
229 | else |
230 | begin |
230 | begin |
231 | weidstr := ''; |
231 | weidstr := ''; |
232 | end; |
232 | end; |
233 | 233 | ||
234 | is_class_c := (Pos('1-3-6-1-4-1-SZ5-8-', weidstr) = 1) or |
234 | is_class_c := (Pos('1-3-6-1-4-1-SZ5-8-', weidstr) = 1) or |
235 | (weidstr = '1-3-6-1-4-1-SZ5-8'); |
235 | (weidstr = '1-3-6-1-4-1-SZ5-8'); |
236 | is_class_b := ((Pos('1-3-6-1-4-1-', weidstr) = 1) or |
236 | is_class_b := ((Pos('1-3-6-1-4-1-', weidstr) = 1) or |
237 | (weidstr = '1-3-6-1-4-1')) |
237 | (weidstr = '1-3-6-1-4-1')) |
238 | and not is_class_c; |
238 | and not is_class_c; |
239 | is_class_a := not is_class_b and not is_class_c; |
239 | is_class_a := not is_class_b and not is_class_c; |
240 | 240 | ||
241 | cd := weLuhnGetCheckDigit(weidstr); |
241 | cd := weLuhnGetCheckDigit(weidstr); |
242 | if cd < 0 then |
242 | if cd < 0 then |
243 | begin |
243 | begin |
244 | OidToWeid := weidstr; |
244 | OidToWeid := weidstr; |
245 | exit; |
245 | exit; |
246 | end; |
246 | end; |
247 | checksum := IntToStr(cd); |
247 | checksum := IntToStr(cd); |
248 | 248 | ||
249 | if is_class_c then |
249 | if is_class_c then |
250 | begin |
250 | begin |
251 | Delete(weidstr, 1, Length('1-3-6-1-4-1-SZ5-8-')); |
251 | Delete(weidstr, 1, Length('1-3-6-1-4-1-SZ5-8-')); |
252 | namespace := 'weid:'; |
252 | namespace := 'weid:'; |
253 | end |
253 | end |
254 | else if is_class_b then |
254 | else if is_class_b then |
255 | begin |
255 | begin |
256 | Delete(weidstr, 1, Length('1-3-6-1-4-1-')); |
256 | Delete(weidstr, 1, Length('1-3-6-1-4-1-')); |
257 | namespace := 'weid:pen:'; |
257 | namespace := 'weid:pen:'; |
258 | end |
258 | end |
259 | else if is_class_a then |
259 | else if is_class_a then |
260 | begin |
260 | begin |
261 | (* weidstr stays *) |
261 | (* weidstr stays *) |
262 | namespace := 'weid:root:'; |
262 | namespace := 'weid:root:'; |
263 | end |
263 | end |
264 | else |
264 | else |
265 | begin |
265 | begin |
266 | (* should not happen *) |
266 | (* should not happen *) |
267 | OidToWeid := ''; |
267 | OidToWeid := ''; |
268 | Exit; |
268 | Exit; |
269 | end; |
269 | end; |
270 | 270 | ||
271 | res := namespace; |
271 | res := namespace; |
272 | if weidstr = '' then |
272 | if weidstr = '' then |
273 | res := res + checksum |
273 | res := res + checksum |
274 | else |
274 | else |
275 | res := res + weidstr + '-' + checksum; |
275 | res := res + weidstr + '-' + checksum; |
276 | OidToWeid := res; |
276 | OidToWeid := res; |
277 | end; |
277 | end; |
278 | 278 | ||
279 | end. |
279 | end. |
280 | 280 |