/trunk_dos/OIDFILE.PAS |
---|
3,7 → 3,7 |
(************************************************) |
(* OIDFILE.PAS *) |
(* Author: Daniel Marschall *) |
(* Revision: 2022-02-15 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - Functions to handle an OID ASCII format *) |
20,6 → 20,7 |
FileId: string; |
DotNotation: string; |
ASNIds: PStringList; |
UnicodeLabels: PStringList; |
Description: string; |
SubIds: PStringList; (* first 8 chars are FileId, followed by DotNotation *) |
ParentFileId: string; |
39,7 → 40,7 |
implementation |
uses |
VtsFuncs, OidUtils; |
VtsFuncs, OidUtils, Crt; |
const |
WANT_VERS = '2022'; |
46,7 → 47,11 |
procedure CreateOidDef(var oid: POid); |
begin |
oid := nil; |
GetMem(oid, SizeOf(TOID)); |
if oid <> nil then |
begin |
oid^.FileId := ''; |
oid^.DotNotation := ''; |
oid^.Description := ''; |
53,15 → 58,34 |
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 |
71,6 → 95,7 |
oid^.ParentFileId := ''; |
oid^.ParentDotNotation := ''; |
ListClear(oid^.ASNIds); |
ListClear(oid^.UnicodeLabels); |
ListClear(oid^.SubIds); |
end; |
142,6 → 167,12 |
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 |
214,6 → 245,11 |
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-16 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - "OIDplus for DOS" program *) |
18,10 → 18,11 |
(* Instead, use the tool "TPPATCH" by Andreas Bauer. *) |
uses |
Dos, Crt, Drivers, StrList, VtsFuncs, VtsCui, OidFile, OidUtils; |
Dos, Crt, Drivers, StrList, VtsFuncs, VtsCui, OidFile, OidUtils, |
Weid; |
const |
VERSIONINFO = 'Revision: 2022-02-16'; |
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; |
253,6 → 254,144 |
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; |
395,6 → 534,7 |
newOID^.ParentDotNotation := oid^.DotNotation; |
if NumIdEditor(newOID, oid) and |
AsnEditor(newOID) and |
IriEditor(newOID) and |
DescEditor(newOID) then |
begin |
newfilename := newOID^.FileId + OID_EXTENSION; |
505,17 → 645,109 |
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, menuX, menuY: integer; |
linesLeft, linesRequired: integer; |
i: integer; |
sTmp, subfile: string; |
subsel, subfiles: PStringList; |
subselres: integer; |
exitRequest: boolean; |
menuIdExit, menuIdAsnEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer; |
menuIdExit, menuIdAsnEdit, menuIdIriEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer; |
menuX, menuY: integer; |
begin |
exitRequest := false; |
repeat |
534,50 → 766,30 |
DrawStatusBar(DEFAULT_STATUSBAR); |
GotoXY(1,2); |
if oid^.DotNotation <> '' then |
(*if oid^.DotNotation <> '' then*) |
begin |
WriteLn('Dot-Notation:'); |
WriteLn(oid^.DotNotation); |
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 |
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 |
(* 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('(No description has been added to this OID.)'); |
WriteLn(''); |
end; |
end; |
(* Now prepare the menu entries *) |
659,11 → 871,18 |
if oid^.DotNotation <> '' then |
begin |
menuIdAsnEdit := ListAppend(subsel, 'Edit ASN.1 identifiers'); |
menuIdAsnEdit := ListAppend(subsel, 'View/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, ''); |
679,6 → 898,8 |
(* Show menu *) |
menuX := WhereX + 1; |
menuY := ScreenHeight - ACTIONMENU_SIZE - 1; |
subselres := DrawSelectionList(menuX, menuY, |
ScreenWidth-2, |
ACTIONMENU_SIZE, |
698,6 → 919,11 |
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 |
891,9 → 1117,12 |
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-14 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - Various OID functions *) |
18,6 → 18,7 |
function CompareOID(a, b: string): integer; |
procedure ListBubbleSortOID(list: PStringList); |
function ASN1IDValid(asn1id: string): boolean; |
function UnicodeLabelValid(unicodeLabel: string): boolean; |
implementation |
73,6 → 74,8 |
OIDtoArcList(a, la); |
OIDtoArcList(b, lb); |
CompareOID := CompareOIDArcList(la, lb); |
FreeList(la); |
FreeList(lb); |
end; |
procedure ListBubbleSortOID(list: PStringList); |
126,4 → 129,77 |
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-16 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - StringList implementation for Turbo Pascal *) |
194,8 → 194,11 |
tmp: PStringList; |
i: integer; |
begin |
if idx < 0 then exit; |
if idx > ListCount(list)-1 then exit; |
if (idx < 0) or (idx > ListCount(list)-1) then |
begin |
ListGetElement := ''; |
Exit; |
end; |
tmp := list; |
i := 0; |
/trunk_dos/VTSCUI.PAS |
---|
3,7 → 3,7 |
(************************************************) |
(* VTSCUI.PAS *) |
(* Author: Daniel Marschall *) |
(* Revision: 2022-02-16 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - ViaThinkSoft CUI (Console User Interface) *) |
37,6 → 37,7 |
procedure CursorOn; |
procedure CursorOff; |
procedure ResetDefaultDosColors; |
procedure WriteLnKeepX(s: string); |
implementation |
603,4 → 604,25 |
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-16 *) |
(* Revision: 2022-02-19 *) |
(* License: Apache 2.0 *) |
(* This file contains: *) |
(* - Various functions *) |
35,6 → 35,10 |
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 |
241,8 → 245,16 |
i: integer; |
output: string; |
begin |
if s = '' then exit; |
if search = '' then exit; (* invalid arg *) |
if s = '' then |
begin |
StringReplace := ''; |
Exit; |
end; |
if search = '' then |
begin |
StringReplace := s; |
exit; (* invalid arg *) |
end; |
output := ''; |
while s <> '' do |
262,4 → 274,101 |
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/WEID.PAS |
---|
0,0 → 1,279 |
unit WEID; |
(* |
* WEID<=>OID Converter for TurboPascal |
* (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 |
VtsFuncs; |
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); |
s := StringReplace(s, '-0', '-'); |
end; |
s := StringReplace(s, #1, '-0-'); |
s := Copy(s, 2, Length(s)-2); |
(* remove separators of the WEID string *) |
wrkstr := StringReplace(s, '-', ''); |
(* 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)); |
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 |
weLuhnGetCheckDigit := -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 |
weLuhnGetCheckDigit := 0 |
else |
weLuhnGetCheckDigit := 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 *) |
WeidToOid := ''; |
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 |
WeidToOid := ''; (* 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)); |
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 *) |
WeidToOid := 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 |
OidToWeid := 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 *) |
OidToWeid := ''; |
Exit; |
end; |
res := namespace; |
if weidstr = '' then |
res := res + checksum |
else |
res := res + weidstr + '-' + checksum; |
OidToWeid := res; |
end; |
end. |
/trunk_dos/WEID_Delphi.pas |
---|
0,0 → 1,356 |
unit WEID; |
(* |
* 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 |
LastCharPos := i; |
Exit; |
end; |
end; |
LastCharPos := 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); |
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; |
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 |
weLuhnGetCheckDigit := -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 |
weLuhnGetCheckDigit := 0 |
else |
weLuhnGetCheckDigit := 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 *) |
WeidToOid := ''; |
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 |
WeidToOid := ''; (* 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 *) |
WeidToOid := 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 |
OidToWeid := 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 *) |
OidToWeid := ''; |
Exit; |
end; |
res := namespace; |
if weidstr = '' then |
res := res + checksum |
else |
res := res + weidstr + '-' + checksum; |
OidToWeid := res; |
end; |
end. |
/trunk_dos/screenshot.PNG |
---|
Cannot display: file marked as a binary type. |
svn:mime-type = application/octet-stream |