unit WEID_Delphi;
(*
* WEID<=>OID Converter for Delphi
* (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
SysUtils;
function LastCharPos(const S: string; const Chr: char): integer;
var
i: Integer;
begin
for i := length(S) downto 1 do
begin
if S[i] = Chr then
begin
result := i;
Exit;
end;
end;
result := 0;
Exit;
end;
function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
var
i: Integer;
frombase_str: string;
tobase_str: string;
len: Integer;
number: string;
divide: Integer;
newlen: Integer;
res: string;
begin
frombase_str := '';
for i := 0 to frombase-1 do
begin
if i < 10 then
frombase_str := frombase_str + IntToStr(i)
else
frombase_str := frombase_str + Chr(Ord('A') + (i-10));
end;
tobase_str := '';
for i := 0 to tobase-1 do
begin
if i < 10 then
tobase_str := tobase_str + IntToStr(i)
else
tobase_str := tobase_str + Chr(Ord('A') + (i-10));
end;
len := Length(numstring);
result := '';
number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
for i := 0 to len-1 do
begin
number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);
end;
res := '';
repeat (* Loop until whole number is converted *)
divide := 0;
newlen := 0;
for i := 0 to len-1 do (* Perform division manually (which is why this works with big numbers) *)
begin
divide := divide * frombase + Ord(number[i+1]);
if (divide >= tobase) then
begin
number[newlen+1] := Chr(divide div tobase);
Inc(newlen);
divide := divide mod tobase;
end
else if newlen > 0 then
begin
number[newlen+1] := #0;
Inc(newlen);
end;
end;
len := newlen;
res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)
until newlen = 0;
result := res;
end;
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, [rfReplaceAll]);
s := StringReplace(s, '-0', '-', [rfReplaceAll]);
end;
s := StringReplace(s, #1, '-0-', [rfReplaceAll]);
s := Copy(s, 2, Length(s)-2);
(* remove separators of the WEID string *)
wrkstr := StringReplace(s, '-', '', [rfReplaceAll]);
(* 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), [rfReplaceAll]);
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
result := -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
result := 0
else
result := 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 *)
result := '';
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
result := ''; (* 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), [rfReplaceAll]);
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 *)
result := 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
result := 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 *)
result := '';
Exit;
end;
res := namespace;
if weidstr = '' then
res := res + checksum
else
res := res + weidstr + '-' + checksum;
result := res;
end;
end.