Subversion Repositories oidplus

Compare Revisions

No changes between revisions

Regard whitespace Rev 748 → Rev 747

/trunk_dos/WEID_Delphi.pas
File deleted
/trunk_dos/WEID.PAS
File deleted
/trunk_dos/OIDFILE.PAS
3,7 → 3,7
(************************************************)
(* OIDFILE.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-15 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - Functions to handle an OID ASCII format *)
20,7 → 20,6
FileId: string;
DotNotation: string;
ASNIds: PStringList;
UnicodeLabels: PStringList;
Description: string;
SubIds: PStringList; (* first 8 chars are FileId, followed by DotNotation *)
ParentFileId: string;
40,7 → 39,7
implementation
 
uses
VtsFuncs, OidUtils, Crt;
VtsFuncs, OidUtils;
 
const
WANT_VERS = '2022';
47,11 → 46,7
 
procedure CreateOidDef(var oid: POid);
begin
oid := nil;
GetMem(oid, SizeOf(TOID));
 
if oid <> nil then
begin
oid^.FileId := '';
oid^.DotNotation := '';
oid^.Description := '';
58,34 → 53,15
oid^.ParentFileId := '';
oid^.ParentDotNotation := '';
CreateList(oid^.ASNIds);
CreateList(oid^.UnicodeLabels);
CreateList(oid^.SubIds);
end
else
begin
Beep;
WriteLn('CreateOidDef failed! (GetMem returned nil)');
ReadKey;
end;
end;
 
procedure FreeOidDef(oid: POid);
begin
if oid <> nil then
begin
FreeList(oid^.ASNIds);
FreeList(oid^.UnicodeLabels);
FreeList(oid^.SubIds);
FreeMem(oid, SizeOf(TOID));
oid := nil;
end
else
begin
Beep;
WriteLn('FreeOidDef failed! (Argument is nil)');
ReadKey;
end;
end;
 
procedure ClearOidDef(oid: POid);
begin
95,7 → 71,6
oid^.ParentFileId := '';
oid^.ParentDotNotation := '';
ListClear(oid^.ASNIds);
ListClear(oid^.UnicodeLabels);
ListClear(oid^.SubIds);
end;
 
167,12 → 142,6
WriteLn(f, 'ASN1' + sTmp);
end;
 
for i := 0 to ListCount(oid^.UnicodeLabels)-1 do
begin
sTmp := ListGetElement(oid^.UnicodeLabels, i);
WriteLn(f, 'UNIL' + sTmp);
end;
 
desc := Trim(oid^.Description);
if desc <> '' then
begin
245,11 → 214,6
ListAppend(oid^.ASNIds, line);
end;
 
if cmd = 'UNIL' then
begin
ListAppend(oid^.UnicodeLabels, line);
end;
 
if cmd = 'DESC' then
begin
oid^.Description := oid^.Description + line + #13#10;
/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-16 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - "OIDplus for DOS" program *)
18,11 → 18,10
(* Instead, use the tool "TPPATCH" by Andreas Bauer. *)
 
uses
Dos, Crt, Drivers, StrList, VtsFuncs, VtsCui, OidFile, OidUtils,
Weid;
Dos, Crt, Drivers, StrList, VtsFuncs, VtsCui, OidFile, OidUtils;
 
const
VERSIONINFO = 'Revision: 2022-02-19';
VERSIONINFO = 'Revision: 2022-02-16';
DEFAULT_STATUSBAR = '(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.';
TITLEBAR_LEFT_TEXT = 'OIDplus';
DISKIO_SOUND_DEBUGGING = false;
254,144 → 253,6
until false;
end;
 
function UnicodeLabelAlreadyExisting(oid: POID; unicodeLabel: string): boolean;
begin
UnicodeLabelAlreadyExisting := ListContains(oid^.UnicodeLabels, unicodeLabel);
end;
 
function IriEditor(oid: POID): boolean;
var
iriList: PStringList;
i: integer;
x, y, w, h: integer;
res: integer;
sInput: string;
menuIdNew, menuIdSave, menuIdExit: integer;
begin
IriEditor := false;
 
repeat
CreateList(iriList);
 
for i := 0 to ListCount(oid^.UnicodeLabels)-1 do
begin
ListAppend(iriList, ListGetElement(oid^.UnicodeLabels, i));
end;
menuIdNew := ListAppend(iriList, '<NEW>');
menuIdSave := ListAppend(iriList, '<SAVE>');
menuIdExit := ListAppend(iriList, '<CANCEL>');
 
DrawStatusBar(DEFAULT_STATUSBAR);
x := SINGLE_LINE_BOX_PADDING;
y := ScreenHeight div 2 - ASNEDIT_LINES div 2;
w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2;
h := ASNEDIT_LINES;
res := DrawSelectionList(x, y, w, h,
iriList, true,
'EDIT UNICODE LABELS',
2);
FreeList(iriList);
 
(* Change double-border to thin-border *)
DrawThinBorder(x-1, y-1, w+2, h+2);
GoToXY(x+1, y-1);
Write('EDIT UNICODE LABELS');
 
if res = -1 then
begin
exit;
end
else if res = menuIdNew then
begin
(* "NEW" item was selected *)
sInput := '';
CursorOn;
repeat
if QueryVal(sInput,
SINGLE_LINE_BOX_PADDING_INNER,
ScreenHeight div 2,
ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
1,
'ADD SINGLE UNICODE LABEL',
2) then
begin
if sInput = '' then continue;
if not UnicodeLabelValid(sInput) then
begin
ShowMessage('Invalid Unicode Label!', 'ERROR', true);
_Pause;
end
else if UnicodeLabelAlreadyExisting(oid, sInput) then
begin
ShowMessage('Unicode Label is already existing on this arc', 'ERROR', true);
_Pause;
end
else
begin
ListAppend(oid^.UnicodeLabels, sInput);
break;
end;
end
else break;
until false;
CursorOff;
end
else if res = menuIdSave then
begin
(* "SAVE" item was selected *)
IriEditor := true;
Exit;
end
else if res = menuIdExit then
begin
(* "CANCEL" item was selected *)
IriEditor := false;
Exit;
end
else
begin
DrawStatusBar('Note: Remove the text to delete the Unicode Label');
sInput := ListGetElement(oid^.UnicodeLabels, res);
CursorOn;
repeat
if QueryVal(sInput,
SINGLE_LINE_BOX_PADDING_INNER,
ScreenHeight div 2,
ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
1,
'EDIT SINGLE UNICODE LABEL',
2) then
begin
if sInput = '' then
begin
(* Empty input = Delete Unicode label *)
ListDeleteElementByIndex(oid^.UnicodeLabels, res);
break;
end
else if not UnicodeLabelValid(sInput) then
begin
ShowMessage('Invalid Unicode Label!', 'ERROR', true);
_Pause;
end
else if UnicodeLabelAlreadyExisting(oid, sInput) and
not (ListGetElement(oid^.UnicodeLabels, res) = sInput) then
begin
ShowMessage('Unicode Label is already existing on this arc', 'ERROR', true);
_Pause;
end
else
begin
ListSetElement(oid^.UnicodeLabels, res, sInput);
break;
end;
end
else break;
until false;
CursorOff;
end;
until false;
end;
 
function DescEditor(oid: POID): boolean;
var
sInput: string;
534,7 → 395,6
newOID^.ParentDotNotation := oid^.DotNotation;
if NumIdEditor(newOID, oid) and
AsnEditor(newOID) and
IriEditor(newOID) and
DescEditor(newOID) then
begin
newfilename := newOID^.FileId + OID_EXTENSION;
645,109 → 505,17
DrawTitleBar('OID ' + oid^.DotNotation, TITLEBAR_LEFT_TEXT, filename);
end;
 
function DotNotation(oid: POid): string;
var
res: string;
begin
res := oid^.DotNotation;
if res = '' then res := '.'; (* root *)
DotNotation := res;
end;
 
function OidLastArc(oid: POid): string;
var
s: string;
p: integer;
begin
s := oid^.DotNotation;
 
while true do
begin
p := Pos('.', s);
if p = 0 then break;
Delete(s, 1, p);
end;
 
OidLastArc := s;
end;
 
function AsnNotation(oid: POid): string;
var
prevOid, curOid: POid;
res: string;
begin
CreateOidDef(curOid);
prevOid := oid;
res := '';
 
while true do
begin
(* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
if curOid^.ParentFileId = '' then break;
if curOid^.ParentFileId = curOid^.FileId then break;
if ListCount(curOid^.AsnIds) > 0 then
res := ListGetElement(curOid^.AsnIds, 0) + '('+OidLastArc(curOid)+') ' + res
else
res := OidLastArc(curOid) + ' ' + res;
prevOid := curOid;
end;
FreeOidDef(curOid);
if ListCount(oid^.AsnIds) > 0 then
res := res + ListGetElement(oid^.AsnIds, 0) + '('+OidLastArc(oid)+')'
else
res := res + OidLastArc(oid);
if res = '' then
AsnNotation := ''
else
AsnNotation := '{ ' + res + ' }';
end;
 
function IriNotation(oid: POid): string;
var
prevOid, curOid: POid;
res: string;
begin
CreateOidDef(curOid);
prevOid := oid;
res := '';
 
while true do
begin
(* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
if curOid^.ParentFileId = '' then break;
if curOid^.ParentFileId = curOid^.FileId then break;
if ListCount(curOid^.UnicodeLabels) > 0 then
res := ListGetElement(curOid^.UnicodeLabels, 0) + '/' + res
else
res := OidLastArc(curOid) + '/' + res;
prevOid := curOid;
end;
FreeOidDef(curOid);
if ListCount(oid^.UnicodeLabels) > 0 then
res := res + ListGetElement(oid^.UnicodeLabels, 0)
else
res := res + OidLastArc(oid);
IriNotation := '/' + res;
end;
 
function WeidNotation(oid: POid): string;
begin
WeidNotation := OidToWeid(oid^.DotNotation);
end;
 
procedure DisplayOIDFile(filename: string);
var
isRoot: boolean;
oid, tmpOID: POID;
i: integer;
i, menuX, menuY: integer;
linesLeft, linesRequired: integer;
sTmp, subfile: string;
subsel, subfiles: PStringList;
subselres: integer;
exitRequest: boolean;
menuIdExit, menuIdAsnEdit, menuIdIriEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer;
menuX, menuY: integer;
menuIdExit, menuIdAsnEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer;
begin
exitRequest := false;
repeat
766,30 → 534,50
DrawStatusBar(DEFAULT_STATUSBAR);
GotoXY(1,2);
 
(*if oid^.DotNotation <> '' then*)
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('Dot-Notation:');
WriteLn(oid^.DotNotation);
WriteLn('');
end;
 
if Trim(oid^.Description) <> '' then
begin
(* WriteLn('Description:'); *)
WriteLn('Description:');
WriteLn(oid^.Description);
WriteLn('');
end;
 
menuX := WhereX + 1;
menuY := ScreenHeight - ACTIONMENU_SIZE - 1;
 
if ListCount(oid^.ASNIDs) > 0 then
begin
linesLeft := menuY - WhereY - 1;
linesRequired := 1 + ListCount(oid^.ASNIds);
 
if LinesLeft < LinesRequired then
begin
(* Compact display of ASN.1 identifiers *)
Write('ASN.1-Identifiers: ');
for i := 0 to ListCount(oid^.ASNIds)-1 do
begin
if i > 0 then Write(', ');
Write(ListGetElement(oid^.ASNIds, i));
end;
WriteLn('');
end
else
begin
WriteLn('(No description has been added to this OID.)');
(* Long display of ASN.1 identifiers *)
WriteLn('ASN.1-Identifiers:');
for i := 0 to ListCount(oid^.ASNIds)-1 do
begin
WriteLn('- '+ListGetElement(oid^.ASNIds, i));
end;
WriteLn('');
end;
end;
 
(* Now prepare the menu entries *)
 
871,18 → 659,11
 
if oid^.DotNotation <> '' then
begin
menuIdAsnEdit := ListAppend(subsel, 'View/Edit ASN.1 identifiers');
menuIdAsnEdit := ListAppend(subsel, 'Edit ASN.1 identifiers');
ListAppend(subfiles, '');
end
else menuIdAsnEdit := -99;
 
if oid^.DotNotation <> '' then
begin
menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels');
ListAppend(subfiles, '');
end
else menuIdIriEdit := -99;
 
menuIdDescEdit := ListAppend(subsel, 'Edit description');
ListAppend(subfiles, '');
 
898,8 → 679,6
 
(* Show menu *)
 
menuX := WhereX + 1;
menuY := ScreenHeight - ACTIONMENU_SIZE - 1;
subselres := DrawSelectionList(menuX, menuY,
ScreenWidth-2,
ACTIONMENU_SIZE,
919,11 → 698,6
if AsnEditor(oid) then
_WriteOidFile(filename, oid, true);
end
else if subselres = menuIdIriEdit then
begin
if IriEditor(oid) then
_WriteOidFile(filename, oid, true);
end
else if subselres = menuIdDescEdit then
begin
if DescEditor(oid) then
1117,12 → 891,9
var
list: PStringList;
begin
ClrScr;
DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, TREEVIEW_FILENAME);
DrawStatusBar('Press ESC to return to the main menu');
 
CreateList(list);
 
DrawStatusBar('Press ESC to return to the main menu');
ListLoadFromFile(list, TREEVIEW_FILENAME);
DrawSelectionList(2, 3, ScreenWidth-2, ScreenHeight-4,
list, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2);
/trunk_dos/OIDUTILS.PAS
3,7 → 3,7
(************************************************)
(* OIDUTILS.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-14 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - Various OID functions *)
18,7 → 18,6
function CompareOID(a, b: string): integer;
procedure ListBubbleSortOID(list: PStringList);
function ASN1IDValid(asn1id: string): boolean;
function UnicodeLabelValid(unicodeLabel: string): boolean;
 
implementation
 
74,8 → 73,6
OIDtoArcList(a, la);
OIDtoArcList(b, lb);
CompareOID := CompareOIDArcList(la, lb);
FreeList(la);
FreeList(lb);
end;
 
procedure ListBubbleSortOID(list: PStringList);
129,77 → 126,4
ASN1IDValid := true;
end;
 
function UnicodeLabelValid(unicodeLabel: string): boolean;
begin
UnicodeLabelValid := true;
(* TODO: Implement *)
(*
 
 
function iri_char_valid($c, $firstchar, $lastchar) {
// see Rec. ITU-T X.660, clause 7.5
 
if (($firstchar || $lastchar) && ($c == '-')) return false;
 
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;
 
$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;
 
// 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.
 
return false;
}
 
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;
}
 
 
*)
end;
 
end.
/trunk_dos/STRLIST.PAS
3,7 → 3,7
(************************************************)
(* STRLIST.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-16 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - StringList implementation for Turbo Pascal *)
194,11 → 194,8
tmp: PStringList;
i: integer;
begin
if (idx < 0) or (idx > ListCount(list)-1) then
begin
ListGetElement := '';
Exit;
end;
if idx < 0 then exit;
if idx > ListCount(list)-1 then exit;
 
tmp := list;
i := 0;
/trunk_dos/VTSCUI.PAS
3,7 → 3,7
(************************************************)
(* VTSCUI.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-16 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - ViaThinkSoft CUI (Console User Interface) *)
37,7 → 37,6
procedure CursorOn;
procedure CursorOff;
procedure ResetDefaultDosColors;
procedure WriteLnKeepX(s: string);
 
implementation
 
604,25 → 603,4
TextColor(LightGray);
end;
 
procedure WriteLnKeepX(s: string);
var
i: integer;
initX: integer;
bytesToWrite: integer;
pNewLine: integer;
begin
initX := WhereX;
while Length(s) > 0 do
begin
pNewLine := Pos(#13#10, s);
GoToXy(initX, WhereY);
bytesToWrite := ScreenWidth - initX + 1;
if (pNewLine > 0) and (pNewLine < bytesToWrite) then
bytesToWrite := pNewLine;
Write(Copy(s, 1, bytesToWrite)); (* No WriteLn because there is automatic scrolling *)
Delete(s, 1, bytesToWrite);
end;
WriteLn('');
end;
 
end.
/trunk_dos/VTSFUNCS.PAS
3,7 → 3,7
(************************************************)
(* VTSFUNCS.PAS *)
(* Author: Daniel Marschall *)
(* Revision: 2022-02-19 *)
(* Revision: 2022-02-16 *)
(* License: Apache 2.0 *)
(* This file contains: *)
(* - Various functions *)
35,10 → 35,6
 
function StringReplace(s, search, replace: string): string;
 
function LastCharPos(const S: string; const Chr: char): integer;
function LowerCase(s: string): string;
function base_convert_bigint(numstring: string; frombase, tobase: integer): string;
 
implementation
 
uses
245,16 → 241,8
i: integer;
output: string;
begin
if s = '' then
begin
StringReplace := '';
Exit;
end;
if search = '' then
begin
StringReplace := s;
exit; (* invalid arg *)
end;
if s = '' then exit;
if search = '' then exit; (* invalid arg *)
 
output := '';
while s <> '' do
274,101 → 262,4
StringReplace := output;
end;
 
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
LastCharPos := i;
Exit;
end;
end;
LastCharPos := 0;
Exit;
end;
 
function LowerCase(s: string): string;
var
res: string;
i: integer;
begin
res := '';
for i := 1 to Length(s) do
begin
if s[i] in ['A'..'Z'] then
begin
res := res + Chr(Ord('a')+(Ord(s[i])-Ord('A')));
end
else
begin
res := res + s[i];
end;
end;
LowerCase := res;
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);
base_convert_bigint := '';
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 % $tobase (i.e. the new character) *)
until newlen = 0;
base_convert_bigint := res;
end;
 
end.
/trunk_dos/screenshot.PNG
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream