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