WebSVN – oidplus – Diff – /trunk_dos/WEID_Delphi.pas



unit WEID_Delphi;
 
(*
 * WEID<=>OID Converter for Delphi
 * (c) Webfan.de, ViaThinkSoft
 * Revision 2022-02-19

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

    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;

        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;

  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 *)

    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;

    base := '';
  end
  else
  begin
    (* Wrong namespace *)
    result := '';
    Exit;
  end;
 
  weid := rest;
 

  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

  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_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

    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.

Rev 748	Rev 749
Line 1...	Line 1...
1	unit WEID;	1	unit WEID_Delphi;
2		2
3	(*	3	(*
4	* WEID<=>OID Converter for Delphi	4	* WEID<=>OID Converter for Delphi
5	* (c) Webfan.de, ViaThinkSoft	5	* (c) Webfan.de, ViaThinkSoft
6	* Revision 2022-02-19	6	* Revision 2022-02-19
Line 54...	Line 54...
54	begin	54	begin
55	for i := length(S) downto 1 do	55	for i := length(S) downto 1 do
56	begin	56	begin
57	if S[i] = Chr then	57	if S[i] = Chr then
58	begin	58	begin
59	LastCharPos := i;	59	result := i;
60	Exit;	60	Exit;
61	end;	61	end;
62	end;	62	end;
63	LastCharPos := 0;	63	result := 0;
64	Exit;	64	Exit;
65	end;	65	end;
66		66
67	function base_convert_bigint(numstring: string; frombase, tobase: integer): string;	67	function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
68	var	68	var
Line 92...	Line 92...
92	else	92	else
93	tobase_str := tobase_str + Chr(Ord('A') + (i-10));	93	tobase_str := tobase_str + Chr(Ord('A') + (i-10));
94	end;	94	end;
95		95
96	len := Length(numstring);	96	len := Length(numstring);
97	base_convert_bigint := '';	97	result := '';
98	number := numstring; (* this is a fake "Int8" array (implemented with chars) *)	98	number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
99	for i := 0 to len-1 do	99	for i := 0 to len-1 do
100	begin	100	begin
101	number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);	101	number[i+1] := Chr(Pos(UpCase(numstring[i+1]), frombase_str)-1);
102	end;	102	end;
Line 118...	Line 118...
118	number[newlen+1] := #0;	118	number[newlen+1] := #0;
119	Inc(newlen);	119	Inc(newlen);
120	end;	120	end;
121	end;	121	end;
122	len := newlen;	122	len := newlen;
123	res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *)	123	res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)
124	until newlen = 0;	124	until newlen = 0;
125	base_convert_bigint := res;	125	result := res;
126	end;	126	end;
127		127
128	function weLuhnGetCheckDigit(s: string): integer;	128	function weLuhnGetCheckDigit(s: string): integer;
129	var	129	var
130	p: integer;	130	p: integer;
Line 154...	Line 154...
154	for c := 'A' to 'Z' do	154	for c := 'A' to 'Z' do
155	begin	155	begin
156	wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10), [rfReplaceAll]);	156	wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10), [rfReplaceAll]);
157	end;	157	end;
158		158
159	(* At the end, $wrkstr should only contain digits! Verify it! *)	159	(* At the end, wrkstr should only contain digits! Verify it! *)
160	for i := 1 to Length(wrkstr) do	160	for i := 1 to Length(wrkstr) do
161	begin	161	begin
162	if not (wrkstr[i] in ['0'..'9']) then	162	if not (wrkstr[i] in ['0'..'9']) then
163	begin	163	begin
164	weLuhnGetCheckDigit := -1;	164	result := -1;
165	exit;	165	exit;
166	end;	166	end;
167	end;	167	end;
168		168
169	(* Now do the standard Luhn algorithm *)	169	(* Now do the standard Luhn algorithm *)
Line 177...	Line 177...
177	if digit > 9 then digit := digit - 9;	177	if digit > 9 then digit := digit - 9;
178	sum := sum + digit;	178	sum := sum + digit;
179	end;	179	end;
180		180
181	if sum mod 10 = 0 then	181	if sum mod 10 = 0 then
182	weLuhnGetCheckDigit := 0	182	result := 0
183	else	183	else
184	weLuhnGetCheckDigit := 10 - (sum mod 10);	184	result := 10 - (sum mod 10);
185	end;	185	end;
186		186
187	function WeidToOid(var weid: string): string;	187	function WeidToOid(var weid: string): string;
188	var	188	var
189	base: string;	189	base: string;
Line 217...	Line 217...
217	base := '';	217	base := '';
218	end	218	end
219	else	219	else
220	begin	220	begin
221	(* Wrong namespace *)	221	(* Wrong namespace *)
222	WeidToOid := '';	222	result := '';
223	Exit;	223	Exit;
224	end;	224	end;
225		225
226	weid := rest;	226	weid := rest;
227		227
Line 235...	Line 235...
235	expected_checksum := weLuhnGetCheckDigit(complete);	235	expected_checksum := weLuhnGetCheckDigit(complete);
236	if (actual_checksum <> '?') then	236	if (actual_checksum <> '?') then
237	begin	237	begin
238	if actual_checksum <> IntToStr(expected_checksum) then	238	if actual_checksum <> IntToStr(expected_checksum) then
239	begin	239	begin
240	WeidToOid := ''; (* wrong checksum *)	240	result := ''; (* wrong checksum *)
241	Exit;	241	Exit;
242	end;	242	end;
243	end	243	end
244	else	244	else
245	begin	245	begin
Line 260...	Line 260...
260	end;	260	end;
261	oidstr := Copy(oidstr, 1, Length(oidstr)-1);	261	oidstr := Copy(oidstr, 1, Length(oidstr)-1);
262		262
263	weid := namespace + weid; (* add namespace again *)	263	weid := namespace + weid; (* add namespace again *)
264		264
265	WeidToOid := oidstr;	265	result := oidstr;
266	end;	266	end;
267		267
268	function OidToWeid(oid: string): string;	268	function OidToWeid(oid: string): string;
269	var	269	var
270	is_class_a: boolean;	270	is_class_a: boolean;
Line 316...	Line 316...
316	is_class_a := not is_class_b and not is_class_c;	316	is_class_a := not is_class_b and not is_class_c;
317		317
318	cd := weLuhnGetCheckDigit(weidstr);	318	cd := weLuhnGetCheckDigit(weidstr);
319	if cd < 0 then	319	if cd < 0 then
320	begin	320	begin
321	OidToWeid := weidstr;	321	result := weidstr;
322	exit;	322	exit;
323	end;	323	end;
324	checksum := IntToStr(cd);	324	checksum := IntToStr(cd);
325		325
326	if is_class_c then	326	if is_class_c then
Line 339...	Line 339...
339	namespace := 'weid:root:';	339	namespace := 'weid:root:';
340	end	340	end
341	else	341	else
342	begin	342	begin
343	(* should not happen *)	343	(* should not happen *)
344	OidToWeid := '';	344	result := '';
345	Exit;	345	Exit;
346	end;	346	end;
347		347
348	res := namespace;	348	res := namespace;
349	if weidstr = '' then	349	if weidstr = '' then
350	res := res + checksum	350	res := res + checksum
351	else	351	else
352	res := res + weidstr + '-' + checksum;	352	res := res + weidstr + '-' + checksum;
353	OidToWeid := res;	353	result := res;
354	end;	354	end;
355		355
356	end.	356	end.

Subversion Repositories oidplus

oidplus/trunk_dos/WEID_Delphi.pas – Rev 748 → 749