/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-20 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - "OIDplus for DOS" program *) |
22,7 → 22,8 |
Weid; |
const |
VERSIONINFO = 'Revision: 2022-02-20'; |
VERSIONINFO = 'Revision: 2022-02-19'; |
DEFAULT_STATUSBAR = '(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.'; |
TITLEBAR_LEFT_TEXT = 'OIDplus'; |
DISKIO_SOUND_DEBUGGING = false; |
DISKIO_SOUND_DELAY = 500; |
45,7 → 46,7 |
CursorOn; |
ReadKey; |
CursorOff; |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
end; |
function _WriteOidFile(filename: string; oid: POid; ShowErrorMessage: boolean): boolean; |
61,7 → 62,7 |
NoSound; |
Delay(10); |
end; |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
_WriteOidFile := res; |
85,7 → 86,7 |
NoSound; |
Delay(10); |
end; |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
_ReadOidFile := res; |
142,7 → 143,7 |
menuIdSave := ListAppend(asnList, '<SAVE>'); |
menuIdExit := ListAppend(asnList, '<CANCEL>'); |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
x := SINGLE_LINE_BOX_PADDING; |
y := ScreenHeight div 2 - ASNEDIT_LINES div 2; |
w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2; |
280,7 → 281,7 |
menuIdSave := ListAppend(iriList, '<SAVE>'); |
menuIdExit := ListAppend(iriList, '<CANCEL>'); |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
x := SINGLE_LINE_BOX_PADDING; |
y := ScreenHeight div 2 - ASNEDIT_LINES div 2; |
w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2; |
442,7 → 443,7 |
FreeList(list); |
end; |
function NumIdAlreadyExisting(parentOID: POID; arcval: string): boolean; |
function NumIdAlreadyExisting(parentOID: POID; sInput: string): boolean; |
var |
searchDotNotation: string; |
sTmp: string; |
449,9 → 450,9 |
i: integer; |
begin |
if parentOID^.DotNotation = '' then |
searchDotNotation := arcval |
searchDotNotation := sInput |
else |
searchDotNotation := parentOID^.DotNotation + '.' + arcval; |
searchDotNotation := parentOID^.DotNotation + '.' + sInput; |
for i := 0 to ListCount(parentOID^.SubIds)-1 do |
begin |
sTmp := ListGetElement(parentOID^.SubIds, i); |
467,88 → 468,53 |
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, |
title, |
'ENTER NUMERIC ID', |
2) then |
begin |
if sInput = '' then continue; |
if not base36mode and (sInput = 'WEID') then |
if not IsPositiveIntegerOrZero(sInput) then |
begin |
sInput := ''; |
base36mode := true; |
ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true); |
_Pause; |
end |
else if not base36mode and not IsPositiveIntegerOrZero(sInput) then |
else if (parentOID^.DotNotation='') and (StrToInt(sInput) > 2) then |
begin |
ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true); |
ShowMessage('Invalid numeric ID (root arc can only be 0, 1, or 2)', 'ERROR', true); |
_Pause; |
end |
else if base36mode and not IsBase36String(sInput) then |
else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and (StrToInt(sInput) > 39) then |
begin |
ShowMessage('Invalid base36 ID (must be 0..9, A..Z)', 'ERROR', true); |
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 |
begin |
ShowMessage('This numeric ID is already used in this arc', 'ERROR', true); |
_Pause; |
end |
else |
begin |
if base36mode then |
arcval := base_convert_bigint(sInput, 36, 10) |
if parentOID^.DotNotation = '' then |
oid^.DotNotation := sInput |
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 |
((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, arcval) then |
begin |
ShowMessage('This numeric ID is already used in this arc', 'ERROR', true); |
_Pause; |
end |
else |
begin |
if parentOID^.DotNotation = '' then |
oid^.DotNotation := arcval |
else |
oid^.DotNotation := parentOID^.DotNotation + '.' + arcval; |
NumIdEditor := true; (* request caller to save <oid> *) |
Break; |
end; |
oid^.DotNotation := parentOID^.DotNotation + '.' + sInput; |
NumIdEditor := true; (* request caller to save <oid> *) |
Break; |
end; |
end |
else |
begin |
(* User pressed ESC *) |
Break; |
end; |
until false; |
797,18 → 763,21 |
ClrScr; |
_DrawOidTitleBar(filename, oid); |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
GotoXY(1,2); |
Write('Dot notation: '); |
WriteLnKeepX(DotNotation(oid)); |
Write('ASN.1 notation: '); |
WriteLnKeepX(AsnNotation(oid)); |
Write('OID-IRI: '); |
WriteLnKeepX(IriNotation(oid)); |
Write('WEID notation: '); |
WriteLnKeepX(WeidNotation(oid)); |
WriteLn(''); |
(*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('WEID notation: '); |
WriteLnKeepX(WeidNotation(oid)); |
WriteLn(''); |
end; |
if Trim(oid^.Description) <> '' then |
begin |
909,7 → 878,7 |
if oid^.DotNotation <> '' then |
begin |
menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels (OID-IRI)'); |
menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels'); |
ListAppend(subfiles, ''); |
end |
else menuIdIriEdit := -99; |
1159,7 → 1128,7 |
list, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2); |
(* TODO: Jump to selected OID *) |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
FreeList(list); |
end; |
1179,7 → 1148,7 |
rootfile := _GetRootFile(true); |
if rootfile = '' then |
begin |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
Exit; |
end; |
1192,7 → 1161,7 |
(* Can happen if disk is read-only (Runtime Error 150) *) |
ShowMessage('Cannot open '+TREEVIEW_FILENAME+' for writing.', 'ERROR', true); |
_Pause; |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
Exit; |
end; |
1207,7 → 1176,7 |
Close(F); |
DrawStatusBar(''); |
DrawStatusBar(DEFAULT_STATUSBAR); |
if res then |
begin |
ShowMessage('TreeView successfully exported as '+TREEVIEW_FILENAME, 'TREEVIEW EXPORT', true); |
1227,7 → 1196,7 |
ClrScr; |
DrawTitleBar('Welcome to OIDplus for DOS', '', ''); |
DrawStatusBar('(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.'); |
DrawStatusBar(DEFAULT_STATUSBAR); |
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(arc: string): boolean; |
function UnicodeLabelValid(unicodeLabel: string): boolean; |
implementation |
129,89 → 129,77 |
ASN1IDValid := true; |
end; |
(* 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; |
function UnicodeLabelValid(unicodeLabel: string): boolean; |
begin |
(* see Rec. ITU-T X.660, clause 7.5 *) |
UnicodeLabelValid := true; |
(* TODO: Implement *) |
(* |
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; |
UnicodeLabelValid := true; |
$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; |
} |
*) |
end; |
end. |
/trunk_dos/VTSFUNCS.PAS |
---|
3,7 → 3,7 |
(************************************************) |
(* VTSFUNCS.PAS *) |
(* Author: Daniel Marschall *) |
(* Revision: 2022-02-20 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - Various functions *) |
29,9 → 29,7 |
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; |
210,14 → 208,6 |
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; |
225,7 → 215,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; |
234,22 → 224,6 |
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; |
392,7 → 366,7 |
end; |
end; |
len := newlen; |
res := tobase_str[divide+1] + res; (* Divide is basically "numstring mod tobase" (i.e. the new character) *) |
res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $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_Delphi; |
unit WEID; |
(* |
* WEID<=>OID Converter for Delphi |
56,11 → 56,11 |
begin |
if S[i] = Chr then |
begin |
result := i; |
LastCharPos := i; |
Exit; |
end; |
end; |
result := 0; |
LastCharPos := 0; |
Exit; |
end; |
94,7 → 94,7 |
end; |
len := Length(numstring); |
result := ''; |
base_convert_bigint := ''; |
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 mod tobase" (i.e. the new character) *) |
res := tobase_str[divide+1] + res; (* Divide is basically $numstring % $tobase (i.e. the new character) *) |
until newlen = 0; |
result := res; |
base_convert_bigint := 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 |
result := -1; |
weLuhnGetCheckDigit := -1; |
exit; |
end; |
end; |
179,9 → 179,9 |
end; |
if sum mod 10 = 0 then |
result := 0 |
weLuhnGetCheckDigit := 0 |
else |
result := 10 - (sum mod 10); |
weLuhnGetCheckDigit := 10 - (sum mod 10); |
end; |
function WeidToOid(var weid: string): string; |
219,7 → 219,7 |
else |
begin |
(* Wrong namespace *) |
result := ''; |
WeidToOid := ''; |
Exit; |
end; |
237,7 → 237,7 |
begin |
if actual_checksum <> IntToStr(expected_checksum) then |
begin |
result := ''; (* wrong checksum *) |
WeidToOid := ''; (* wrong checksum *) |
Exit; |
end; |
end |
262,7 → 262,7 |
weid := namespace + weid; (* add namespace again *) |
result := oidstr; |
WeidToOid := oidstr; |
end; |
function OidToWeid(oid: string): string; |
318,7 → 318,7 |
cd := weLuhnGetCheckDigit(weidstr); |
if cd < 0 then |
begin |
result := weidstr; |
OidToWeid := weidstr; |
exit; |
end; |
checksum := IntToStr(cd); |
341,7 → 341,7 |
else |
begin |
(* should not happen *) |
result := ''; |
OidToWeid := ''; |
Exit; |
end; |
350,7 → 350,7 |
res := res + checksum |
else |
res := res + weidstr + '-' + checksum; |
result := res; |
OidToWeid := res; |
end; |
end. |
/trunk_dos/screenshot.PNG |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |