Subversion Repositories oidplus

Compare Revisions

No changes between revisions

Regard whitespace Rev 748 → Rev 749

/trunk_dos/OIDPLUS.EXE
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/trunk_dos/OIDPLUS.PAS
3,7 → 3,7
(************************************************)
(* OIDPLUS.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-20 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - "OIDplus for DOS" program *)
22,8 → 22,7
Weid;
 
const
VERSIONINFO = 'Revision: 2022-02-19';
DEFAULT_STATUSBAR = '(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.';
VERSIONINFO = 'Revision: 2022-02-20';
TITLEBAR_LEFT_TEXT = 'OIDplus';
DISKIO_SOUND_DEBUGGING = false;
DISKIO_SOUND_DELAY = 500;
46,7 → 45,7
CursorOn;
ReadKey;
CursorOff;
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
end;
 
function _WriteOidFile(filename: string; oid: POid; ShowErrorMessage: boolean): boolean;
62,7 → 61,7
NoSound;
Delay(10);
end;
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
 
_WriteOidFile := res;
 
86,7 → 85,7
NoSound;
Delay(10);
end;
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
 
_ReadOidFile := res;
 
143,7 → 142,7
menuIdSave := ListAppend(asnList, '<SAVE>');
menuIdExit := ListAppend(asnList, '<CANCEL>');
 
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
x := SINGLE_LINE_BOX_PADDING;
y := ScreenHeight div 2 - ASNEDIT_LINES div 2;
w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2;
281,7 → 280,7
menuIdSave := ListAppend(iriList, '<SAVE>');
menuIdExit := ListAppend(iriList, '<CANCEL>');
 
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
x := SINGLE_LINE_BOX_PADDING;
y := ScreenHeight div 2 - ASNEDIT_LINES div 2;
w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2;
443,7 → 442,7
FreeList(list);
end;
 
function NumIdAlreadyExisting(parentOID: POID; sInput: string): boolean;
function NumIdAlreadyExisting(parentOID: POID; arcval: string): boolean;
var
searchDotNotation: string;
sTmp: string;
450,9 → 449,9
i: integer;
begin
if parentOID^.DotNotation = '' then
searchDotNotation := sInput
searchDotNotation := arcval
else
searchDotNotation := parentOID^.DotNotation + '.' + sInput;
searchDotNotation := parentOID^.DotNotation + '.' + arcval;
for i := 0 to ListCount(parentOID^.SubIds)-1 do
begin
sTmp := ListGetElement(parentOID^.SubIds, i);
468,37 → 467,70
function NumIdEditor(oid: POID; parentOID: POID): boolean;
var
sInput: string;
title: string;
base36mode: boolean;
arcval: string;
begin
NumIdEditor := false;
sInput := '';
 
base36mode := false;
CursorOn;
repeat
if base36mode then
begin
DrawStatusBar('Press ESC to cancel');
title := 'ENTER BASE36 ID'
end
else
begin
DrawStatusBar('Enter "WEID" to enter a Base36 instead of Base10; press ESC to cancel');
title := 'ENTER NUMERIC ID';
end;
if QueryVal(sInput,
SINGLE_LINE_BOX_PADDING_INNER,
ScreenHeight div 2,
ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
1,
'ENTER NUMERIC ID',
title,
2) then
begin
if sInput = '' then continue;
if not IsPositiveIntegerOrZero(sInput) then
if not base36mode and (sInput = 'WEID') then
begin
sInput := '';
base36mode := true;
end
else if not base36mode and not IsPositiveIntegerOrZero(sInput) then
begin
ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true);
_Pause;
end
else if (parentOID^.DotNotation='') and (StrToInt(sInput) > 2) then
else if base36mode and not IsBase36String(sInput) then
begin
ShowMessage('Invalid base36 ID (must be 0..9, A..Z)', 'ERROR', true);
_Pause;
end
else
begin
if base36mode then
arcval := base_convert_bigint(sInput, 36, 10)
else
arcval := sInput;
arcval := StripLeadingZeros(arcval);
 
if (parentOID^.DotNotation='') and (arcval <> '0') and (arcval <> '1') and (arcval <> '2') then
begin
ShowMessage('Invalid numeric ID (root arc can only be 0, 1, or 2)', 'ERROR', true);
_Pause;
end
else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and (StrToInt(sInput) > 39) then
else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and
((Length(arcval)>2) or (StrToInt(arcval) > 39)) then
begin
ShowMessage('Invalid numeric ID (root 0 and 1 must have sub-arc of 0..39)', 'ERROR', true);
_Pause;
end
else if NumIdAlreadyExisting(parentOID, sInput) then
else if NumIdAlreadyExisting(parentOID, arcval) then
begin
ShowMessage('This numeric ID is already used in this arc', 'ERROR', true);
_Pause;
506,15 → 538,17
else
begin
if parentOID^.DotNotation = '' then
oid^.DotNotation := sInput
oid^.DotNotation := arcval
else
oid^.DotNotation := parentOID^.DotNotation + '.' + sInput;
oid^.DotNotation := parentOID^.DotNotation + '.' + arcval;
NumIdEditor := true; (* request caller to save <oid> *)
Break;
end;
end;
end
else
begin
(* User pressed ESC *)
Break;
end;
until false;
763,21 → 797,18
 
ClrScr;
_DrawOidTitleBar(filename, oid);
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
GotoXY(1,2);
 
(*if oid^.DotNotation <> '' then*)
begin
Write('Dot notation: ');
WriteLnKeepX(DotNotation(oid));
Write('IRI notation: ');
WriteLnKeepX(IriNotation(oid));
Write('ASN.1 notation: ');
WriteLnKeepX(AsnNotation(oid));
Write('OID-IRI: ');
WriteLnKeepX(IriNotation(oid));
Write('WEID notation: ');
WriteLnKeepX(WeidNotation(oid));
WriteLn('');
end;
 
if Trim(oid^.Description) <> '' then
begin
878,7 → 909,7
 
if oid^.DotNotation <> '' then
begin
menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels');
menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels (OID-IRI)');
ListAppend(subfiles, '');
end
else menuIdIriEdit := -99;
1128,7 → 1159,7
list, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2);
(* TODO: Jump to selected OID *)
 
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
 
FreeList(list);
end;
1148,7 → 1179,7
rootfile := _GetRootFile(true);
if rootfile = '' then
begin
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
Exit;
end;
 
1161,7 → 1192,7
(* Can happen if disk is read-only (Runtime Error 150) *)
ShowMessage('Cannot open '+TREEVIEW_FILENAME+' for writing.', 'ERROR', true);
_Pause;
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
Exit;
end;
 
1176,7 → 1207,7
 
Close(F);
 
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('');
if res then
begin
ShowMessage('TreeView successfully exported as '+TREEVIEW_FILENAME, 'TREEVIEW EXPORT', true);
1196,7 → 1227,7
ClrScr;
 
DrawTitleBar('Welcome to OIDplus for DOS', '', '');
DrawStatusBar(DEFAULT_STATUSBAR);
DrawStatusBar('(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.');
GoToXY(ScreenWidth-Length(VERSIONINFO), ScreenHeight-1);
Write(VERSIONINFO);
 
/trunk_dos/OIDUTILS.PAS
18,7 → 18,7
function CompareOID(a, b: string): integer;
procedure ListBubbleSortOID(list: PStringList);
function ASN1IDValid(asn1id: string): boolean;
function UnicodeLabelValid(unicodeLabel: string): boolean;
function UnicodeLabelValid(arc: string): boolean;
 
implementation
 
129,77 → 129,89
ASN1IDValid := true;
end;
 
function UnicodeLabelValid(unicodeLabel: string): boolean;
(* Note: Since this is DOS, we don't support Unicode, so we just check *)
(* for Latin characters in the Unicode Label *)
function IriCharValid(c: char; firstchar, lastchar: boolean): boolean;
begin
UnicodeLabelValid := true;
(* TODO: Implement *)
(* see Rec. ITU-T X.660, clause 7.5 *)
(*
if ((firstchar or lastchar) and (c = '-')) then
begin
IriCharValid := false;
Exit;
end;
 
if (c in ['-', '.', '_', '~']) then
begin
IriCharValid := true;
Exit;
end;
 
function iri_char_valid($c, $firstchar, $lastchar) {
// see Rec. ITU-T X.660, clause 7.5
if ((c in ['0'..'9']) and not firstchar) or
(c in ['A'..'Z']) or
(c in ['a'..'z']) then
begin
IriCharValid := true;
Exit;
end;
 
if (($firstchar || $lastchar) && ($c == '-')) return false;
(*
v = mb_ord(c);
if ((v >= 0x000000A0) && (v <= 0x0000DFFE)) return true;
if ((v >= 0x0000F900) && (v <= 0x0000FDCF)) return true;
if ((v >= 0x0000FDF0) && (v <= 0x0000FFEF)) return true;
if ((v >= 0x00010000) && (v <= 0x0001FFFD)) return true;
if ((v >= 0x00020000) && (v <= 0x0002FFFD)) return true;
if ((v >= 0x00030000) && (v <= 0x0003FFFD)) return true;
if ((v >= 0x00040000) && (v <= 0x0004FFFD)) return true;
if ((v >= 0x00050000) && (v <= 0x0005FFFD)) return true;
if ((v >= 0x00060000) && (v <= 0x0006FFFD)) return true;
if ((v >= 0x00070000) && (v <= 0x0007FFFD)) return true;
if ((v >= 0x00080000) && (v <= 0x0008FFFD)) return true;
if ((v >= 0x00090000) && (v <= 0x0009FFFD)) return true;
if ((v >= 0x000A0000) && (v <= 0x000AFFFD)) return true;
if ((v >= 0x000B0000) && (v <= 0x000BFFFD)) return true;
if ((v >= 0x000C0000) && (v <= 0x000CFFFD)) return true;
if ((v >= 0x000D0000) && (v <= 0x000DFFFD)) return true;
if ((v >= 0x000E1000) && (v <= 0x000EFFFD)) return true;
*)
 
if ($c == '-') return true;
if ($c == '.') return true;
if ($c == '_') return true;
if ($c == '~') return true;
if (($c >= '0') && ($c <= '9') && (!$firstchar)) return true;
if (($c >= 'A') && ($c <= 'Z')) return true;
if (($c >= 'a') && ($c <= 'z')) return true;
(* Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked *)
(* in ISO/IEC 10646 as "(This position shall not be used)" *)
(* But tool implementers should be tolerate them, since these limitations can be removed in future. *)
 
$v = mb_ord($c);
IriCharValid := false;
end;
 
if (($v >= 0x000000A0) && ($v <= 0x0000DFFE)) return true;
if (($v >= 0x0000F900) && ($v <= 0x0000FDCF)) return true;
if (($v >= 0x0000FDF0) && ($v <= 0x0000FFEF)) return true;
if (($v >= 0x00010000) && ($v <= 0x0001FFFD)) return true;
if (($v >= 0x00020000) && ($v <= 0x0002FFFD)) return true;
if (($v >= 0x00030000) && ($v <= 0x0003FFFD)) return true;
if (($v >= 0x00040000) && ($v <= 0x0004FFFD)) return true;
if (($v >= 0x00050000) && ($v <= 0x0005FFFD)) return true;
if (($v >= 0x00060000) && ($v <= 0x0006FFFD)) return true;
if (($v >= 0x00070000) && ($v <= 0x0007FFFD)) return true;
if (($v >= 0x00080000) && ($v <= 0x0008FFFD)) return true;
if (($v >= 0x00090000) && ($v <= 0x0009FFFD)) return true;
if (($v >= 0x000A0000) && ($v <= 0x000AFFFD)) return true;
if (($v >= 0x000B0000) && ($v <= 0x000BFFFD)) return true;
if (($v >= 0x000C0000) && ($v <= 0x000CFFFD)) return true;
if (($v >= 0x000D0000) && ($v <= 0x000DFFFD)) return true;
if (($v >= 0x000E1000) && ($v <= 0x000EFFFD)) return true;
function UnicodeLabelValid(arc: string): boolean;
var
i: integer;
firstchar, lastchar: boolean;
begin
if arc = '' then
begin
UnicodeLabelValid := false;
Exit;
end;
 
// Note: Rec. ITU-T X.660, clause 7.5.3 would also forbid ranges which are marked
// in ISO/IEC 10646 as "(This position shall not be used)"
// But tool implementers should be tolerate them, since these limitations can be removed in future.
if (Copy(arc, 3, 2) = '--') then (* see Rec. ITU-T X.660, clause 7.5.4 *)
begin
UnicodeLabelValid := false;
Exit;
end;
 
return false;
}
for i := 1 to Length(arc) do
begin
firstchar := i = 1;
lastchar := i = Length(arc);
if not IriCharValid(arc[i], firstchar, lastchar) then
begin
UnicodeLabelValid := false;
Exit;
end;
end;
 
function iri_arc_valid($arc, $allow_numeric=true) {
if ($arc == '') return false;
 
$m = array();
if ($allow_numeric && preg_match('@^(\\d+)$@', $arc, $m)) return true; # numeric arc
 
// Question: Should we strip RTL/LTR characters?
 
if (mb_substr($arc, 2, 2) == '--') return false; // see Rec. ITU-T X.660, clause 7.5.4
 
$array = array();
preg_match_all('/./u', $arc, $array, PREG_SET_ORDER);
$len = count($array);
foreach ($array as $i => $char) {
if (!iri_char_valid($char[0], $i==0, $i==$len-1)) return false;
}
 
return true;
}
 
 
*)
UnicodeLabelValid := true;
end;
 
end.
/trunk_dos/VTSFUNCS.PAS
3,7 → 3,7
(************************************************)
(* VTSFUNCS.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-20 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - Various functions *)
29,7 → 29,9
function DeleteFile(filename: string): boolean;
function FileExists(filename: string): boolean;
 
function StripLeadingZeros(s: string): string;
function IsPositiveIntegerOrZero(s: string): boolean;
function IsBase36String(s: string): boolean;
function StrToInt(s: string): Integer;
function IntToStr(Value: Integer): string;
 
208,6 → 210,14
end;
end;
 
function StripLeadingZeros(s: string): string;
begin
while (s <> '0') and (Copy(s,1,1) = '0') do
Delete(s,1,1);
 
StripLeadingZeros := s;
end;
 
function IsPositiveIntegerOrZero(s: string): boolean;
var
i: integer;
215,7 → 225,7
IsPositiveIntegerOrZero := false;
 
if Length(s) = 0 then exit;
if (s[1] = '0') and (s <> '0') then exit;
(*if (s[1] = '0') and (s <> '0') then exit;*)
for i := 1 to Length(s) do
begin
if not (s[i] in ['0'..'9']) then exit;
224,6 → 234,22
IsPositiveIntegerOrZero := true;
end;
 
function IsBase36String(s: string): boolean;
var
i: integer;
begin
IsBase36String := false;
 
if Length(s) = 0 then exit;
(*if (s[1] = '0') and (s <> '0') then exit;*)
for i := 1 to Length(s) do
begin
if not (s[i] in ['0'..'9', 'A'..'Z']) then exit;
end;
 
IsBase36String := true;
end;
 
function StrToInt(s: string): Integer;
var
i, Error: Integer;
366,7 → 392,7
end;
end;
len := newlen;
res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *)
res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)
until newlen = 0;
base_convert_bigint := res;
end;
/trunk_dos/WEID.PAS
79,7 → 79,7
wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10));
end;
 
(* At the end, $wrkstr should only contain digits! Verify it! *)
(* 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
/trunk_dos/WEID_Delphi.pas
1,4 → 1,4
unit WEID;
unit WEID_Delphi;
 
(*
* WEID<=>OID Converter for Delphi
56,11 → 56,11
begin
if S[i] = Chr then
begin
LastCharPos := i;
result := i;
Exit;
end;
end;
LastCharPos := 0;
result := 0;
Exit;
end;
 
94,7 → 94,7
end;
 
len := Length(numstring);
base_convert_bigint := '';
result := '';
number := numstring; (* this is a fake "Int8" array (implemented with chars) *)
for i := 0 to len-1 do
begin
120,9 → 120,9
end;
end;
len := newlen;
res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *)
res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *)
until newlen = 0;
base_convert_bigint := res;
result := res;
end;
 
function weLuhnGetCheckDigit(s: string): integer;
156,12 → 156,12
wrkstr := StringReplace(wrkstr, c, IntToStr(Ord(c)-Ord('A')+10), [rfReplaceAll]);
end;
 
(* At the end, $wrkstr should only contain digits! Verify it! *)
(* 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;
result := -1;
exit;
end;
end;
179,9 → 179,9
end;
 
if sum mod 10 = 0 then
weLuhnGetCheckDigit := 0
result := 0
else
weLuhnGetCheckDigit := 10 - (sum mod 10);
result := 10 - (sum mod 10);
end;
 
function WeidToOid(var weid: string): string;
219,7 → 219,7
else
begin
(* Wrong namespace *)
WeidToOid := '';
result := '';
Exit;
end;
 
237,7 → 237,7
begin
if actual_checksum <> IntToStr(expected_checksum) then
begin
WeidToOid := ''; (* wrong checksum *)
result := ''; (* wrong checksum *)
Exit;
end;
end
262,7 → 262,7
 
weid := namespace + weid; (* add namespace again *)
 
WeidToOid := oidstr;
result := oidstr;
end;
 
function OidToWeid(oid: string): string;
318,7 → 318,7
cd := weLuhnGetCheckDigit(weidstr);
if cd < 0 then
begin
OidToWeid := weidstr;
result := weidstr;
exit;
end;
checksum := IntToStr(cd);
341,7 → 341,7
else
begin
(* should not happen *)
OidToWeid := '';
result := '';
Exit;
end;
 
350,7 → 350,7
res := res + checksum
else
res := res + weidstr + '-' + checksum;
OidToWeid := res;
result := res;
end;
 
end.
/trunk_dos/screenshot.PNG
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream