0,0 → 1,279 |
unit WEID; |
|
(* |
* WEID<=>OID Converter for TurboPascal |
* (c) Webfan.de, ViaThinkSoft |
* Revision 2022-02-19 |
*) |
|
(* |
What is a WEID? |
A WEID (WEhowski IDentifier) is an alternative representation of an |
OID (Object IDentifier) defined by Till Wehowski. |
In OIDs, arcs are in decimal base 10. In WEIDs, the arcs are in base 36. |
Also, each WEID has a check digit at the end (called WeLohn Check Digit). |
|
Changes in the December 2021 definition by Daniel Marschall: |
- There are several classes of WEIDs which have different OID bases: |
"Class C" WEID: weid:EXAMPLE-3 (base .1.3.6.1.4.1.37553.8.) |
oid:1.3.6.1.4.1.37553.8.32488192274 |
"Class B" WEID: weid:pen:SX0-7PR-6 (base .1.3.6.1.4.1.) |
oid:1.3.6.1.4.1.37476.9999 |
"Class A" WEID: weid:root:2-RR-2 (base .) |
oid:2.999 |
- The namespace (weid:, weid:pen:, weid:root:) is now case insensitive. |
- Padding with '0' characters is valid (e.g. weid:000EXAMPLE-3) |
The paddings do not count into the WeLuhn check-digit. |
*) |
|
interface |
|
(* |
Translates a weid to an oid |
"weid:EXAMPLE-3" becomes "1.3.6.1.4.1.37553.8.32488192274" |
If it failed (e.g. wrong namespace, wrong checksum, etc.) then false is returned. |
If the weid ends with '?', then it will be replaced with the checksum, |
e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 |
*) |
function WeidToOid(var weid: string): string; |
|
(* |
Converts an OID to WEID |
"1.3.6.1.4.1.37553.8.32488192274" becomes "weid:EXAMPLE-3" |
*) |
function OidToWeid(oid: string): string; |
|
implementation |
|
uses |
VtsFuncs; |
|
function weLuhnGetCheckDigit(s: string): integer; |
var |
p: integer; |
wrkstr: string; |
c: Char; |
i: Integer; |
sum: integer; |
nbdigits: Integer; |
parity: Integer; |
n: Integer; |
digit: Integer; |
begin |
(* Padding zeros don't count to the check digit (December 2021) *) |
s := '-' + s + '-'; |
while Pos('-0', s) > 0 do |
begin |
s := StringReplace(s, '-0-', #1); |
s := StringReplace(s, '-0', '-'); |
end; |
s := StringReplace(s, #1, '-0-'); |
s := Copy(s, 2, Length(s)-2); |
|
(* remove separators of the WEID string *) |
wrkstr := StringReplace(s, '-', ''); |
|
(* Replace 'a' with '10', 'b' with '11', etc. *) |
for c := 'A' to 'Z' do |
begin |
wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10)); |
end; |
|
(* At the end, $wrkstr should only contain digits! Verify it! *) |
for i := 1 to Length(wrkstr) do |
begin |
if not (wrkstr[i] in ['0'..'9']) then |
begin |
weLuhnGetCheckDigit := -1; |
exit; |
end; |
end; |
|
(* Now do the standard Luhn algorithm *) |
nbdigits := Length(wrkstr); |
parity := nbdigits and 1; (* mod 2 *) |
sum := 0; |
for n := nbdigits-1 downto 0 do |
begin |
digit := StrToInt(wrkstr[n+1]); |
if (n and 1) <> parity then digit := digit * 2; |
if digit > 9 then digit := digit - 9; |
sum := sum + digit; |
end; |
|
if sum mod 10 = 0 then |
weLuhnGetCheckDigit := 0 |
else |
weLuhnGetCheckDigit := 10 - (sum mod 10); |
end; |
|
function WeidToOid(var weid: string): string; |
var |
base: string; |
namespace: string; |
p: integer; |
rest: string; |
actual_checksum: string; |
expected_checksum: integer; |
complete: string; |
oidstr: string; |
arc: string; |
begin |
p := LastCharPos(weid,':'); |
namespace := Copy(weid, 1, p); |
rest := Copy(weid, p+1, Length(weid)-p); |
|
namespace := LowerCase(namespace); (* namespace is case insensitive *) |
if namespace = 'weid:' then |
begin |
(* Class C *) |
base := '1-3-6-1-4-1-SZ5-8'; |
end |
else if namespace = 'weid:pen:' then |
begin |
(* Class B *) |
base := '1-3-6-1-4-1'; |
end |
else if namespace = 'weid:root:' then |
begin |
(* Class A *) |
base := ''; |
end |
else |
begin |
(* Wrong namespace *) |
WeidToOid := ''; |
Exit; |
end; |
|
weid := rest; |
|
if base <> '' then |
complete := base + '-' + weid |
else |
complete := weid; |
p := LastCharPos(complete, '-'); |
actual_checksum := Copy(complete, p+1, 1); |
complete := Copy(complete, 1, p-1); |
expected_checksum := weLuhnGetCheckDigit(complete); |
if (actual_checksum <> '?') then |
begin |
if actual_checksum <> IntToStr(expected_checksum) then |
begin |
WeidToOid := ''; (* wrong checksum *) |
Exit; |
end; |
end |
else |
begin |
(* If checksum is '?', it will be replaced by the actual checksum, *) |
(* e.g. weid:EXAMPLE-? becomes weid:EXAMPLE-3 *) |
weid := StringReplace(weid, '?', IntToStr(expected_checksum)); |
end; |
|
oidstr := ''; |
while true do |
begin |
p := Pos('-', complete); |
if p = 0 then p := Length(complete)+1; |
arc := Copy(complete, 1, p-1); |
Delete(complete, 1, p); |
oidstr := oidstr + base_convert_bigint(arc, 36, 10) + '.'; |
if complete = '' then break; |
end; |
oidstr := Copy(oidstr, 1, Length(oidstr)-1); |
|
weid := namespace + weid; (* add namespace again *) |
|
WeidToOid := oidstr; |
end; |
|
function OidToWeid(oid: string): string; |
var |
is_class_a: boolean; |
is_class_b: boolean; |
is_class_c: boolean; |
weidstr: string; |
checksum: string; |
namespace: string; |
p: Integer; |
cd: Integer; |
res: string; |
begin |
if Copy(oid,1,1) = '.' then |
Delete(oid,1,1); (* remove leading dot *) |
|
if oid <> '' then |
begin |
weidstr := ''; |
while true do |
begin |
p := Pos('.', oid); |
if p = 1 then |
begin |
Delete(oid, 1, 1); |
end |
else if p > 0 then |
begin |
weidstr := weidstr + base_convert_bigint(Copy(oid, 1, p-1),10,36) + '-'; |
Delete(oid, 1, p); |
end |
else |
begin |
weidstr := weidstr + base_convert_bigint(oid,10,36) + '-'; |
break; |
end; |
end; |
weidstr := Copy(weidstr, 1, Length(weidstr)-1); |
end |
else |
begin |
weidstr := ''; |
end; |
|
is_class_c := (Pos('1-3-6-1-4-1-SZ5-8-', weidstr) = 1) or |
(weidstr = '1-3-6-1-4-1-SZ5-8'); |
is_class_b := ((Pos('1-3-6-1-4-1-', weidstr) = 1) or |
(weidstr = '1-3-6-1-4-1')) |
and not is_class_c; |
is_class_a := not is_class_b and not is_class_c; |
|
cd := weLuhnGetCheckDigit(weidstr); |
if cd < 0 then |
begin |
OidToWeid := weidstr; |
exit; |
end; |
checksum := IntToStr(cd); |
|
if is_class_c then |
begin |
Delete(weidstr, 1, Length('1-3-6-1-4-1-SZ5-8-')); |
namespace := 'weid:'; |
end |
else if is_class_b then |
begin |
Delete(weidstr, 1, Length('1-3-6-1-4-1-')); |
namespace := 'weid:pen:'; |
end |
else if is_class_a then |
begin |
(* weidstr stays *) |
namespace := 'weid:root:'; |
end |
else |
begin |
(* should not happen *) |
OidToWeid := ''; |
Exit; |
end; |
|
res := namespace; |
if weidstr = '' then |
res := res + checksum |
else |
res := res + weidstr + '-' + checksum; |
OidToWeid := res; |
end; |
|
end. |