WebSVN – oidplus – Blame – /trunk_dos/OIDPLUS.PAS

Rev	Author	Line No.	Line
733	daniel-mar	1	program OIDPLUS;
		2
		3	(************************************************)
		4	(* OIDPLUS.PAS *)
		5	(* Author: Daniel Marschall *)
992	daniel-mar	6	(* Revision: 2022-10-10 *)
733	daniel-mar	7	(* License: Apache 2.0 *)
		8	(* This file contains: *)
		9	(* - "OIDplus for DOS" program *)
		10	(************************************************)
		11
741	daniel-mar	12	(* IMPORTANT: *)
		13	(* When you compile this code with Turbo Pascal 7.01, *)
		14	(* it won't run on fast PCs (Runtime Error 200). *)
		15	(* The built EXE file needs to be patched. *)
		16	(* The program "PatchCRT" by Kennedy Software *)
		17	(* WON'T work because it somehow breaks our "_Pause" function. *)
		18	(* Instead, use the tool "TPPATCH" by Andreas Bauer. *)
		19
733	daniel-mar	20	uses
748	daniel-mar	21	Dos, Crt, Drivers, StrList, VtsFuncs, VtsCui, OidFile, OidUtils,
		22	Weid;
733	daniel-mar	23
		24	const
992	daniel-mar	25	VERSIONINFO = 'Revision: 2022-10-10';
740	daniel-mar	26	TITLEBAR_LEFT_TEXT = 'OIDplus';
733	daniel-mar	27	DISKIO_SOUND_DEBUGGING = false;
735	daniel-mar	28	DISKIO_SOUND_DELAY = 500;
		29	ASNEDIT_LINES = 10;
		30	DESCEDIT_LINES = 10;
		31	DESCEDIT_PADDING = 3;
		32	ACTIONMENU_SIZE = 5;
		33	MAINMENU_WIDTH = 15;
		34	MAINMENU_HEIGHT = 3;
		35	MAINMENU_ALLOW_ESC = false;
740	daniel-mar	36	TREEVIEW_INDENT = 0;
		37	TREEVIEW_INCLUDE_DESC = true;
		38	TREEVIEW_WIDTH = 80;
744	daniel-mar	39	OID_EXTENSION = '.OID';
		40	TREEVIEW_FILENAME = 'OIDTREE.TXT';
733	daniel-mar	41
743	daniel-mar	42	procedure _Pause;
733	daniel-mar	43	begin
743	daniel-mar	44	DrawStatusBar('Press any key to continue');
746	daniel-mar	45	CursorOn;
743	daniel-mar	46	ReadKey;
746	daniel-mar	47	CursorOff;
749	daniel-mar	48	DrawStatusBar('');
743	daniel-mar	49	end;
		50
		51	function _WriteOidFile(filename: string; oid: POid; ShowErrorMessage: boolean): boolean;
		52	var
		53	res: boolean;
		54	begin
733	daniel-mar	55	DrawStatusBar('Write file ' + filename + '...');
743	daniel-mar	56	res := WriteOidFile(filename, oid);
733	daniel-mar	57	if DISKIO_SOUND_DEBUGGING then
		58	begin
		59	Sound(70);
		60	Delay(DISKIO_SOUND_DELAY - 10);
		61	NoSound;
		62	Delay(10);
		63	end;
749	daniel-mar	64	DrawStatusBar('');
733	daniel-mar	65
743	daniel-mar	66	_WriteOidFile := res;
		67
		68	if ShowErrorMessage and not res then
		69	begin
		70	ShowMessage('Cannot write to file ' + filename, 'ERROR', true);
		71	_Pause;
		72	end;
733	daniel-mar	73	end;
		74
743	daniel-mar	75	function _ReadOidFile(filename: string; oid: POid; ShowErrorMessage: boolean): boolean;
		76	var
		77	res: boolean;
733	daniel-mar	78	begin
		79	DrawStatusBar('Read file ' + filename + '...');
743	daniel-mar	80	res := ReadOidFile(filename, oid);
733	daniel-mar	81	if DISKIO_SOUND_DEBUGGING then
		82	begin
		83	Sound(50);
		84	Delay(DISKIO_SOUND_DELAY - 10);
		85	NoSound;
		86	Delay(10);
		87	end;
749	daniel-mar	88	DrawStatusBar('');
733	daniel-mar	89
743	daniel-mar	90	_ReadOidFile := res;
		91
		92	if ShowErrorMessage and not res then
		93	begin
		94	ShowMessage('Cannot read file ' + filename, 'ERROR', true);
		95	_Pause;
		96	end;
733	daniel-mar	97	end;
		98
740	daniel-mar	99	function _ShowASNIds(childOID: POID): string;
733	daniel-mar	100	var
		101	j, jmax: integer;
		102	sTmp: string;
		103	begin
		104	sTmp := '';
735	daniel-mar	105	jmax := ListCount(childOID^.ASNIds)-1;
733	daniel-mar	106	for j := 0 to jmax do
		107	begin
		108	if j = 0 then sTmp := sTmp + ' (';
735	daniel-mar	109	sTmp := sTmp + ListGetElement(childOID^.ASNIds, j);
733	daniel-mar	110	if j = jmax then
		111	sTmp := sTmp + ')'
		112	else
		113	sTmp := sTmp + ', ';
		114	end;
		115	_ShowASNIds := sTmp;
		116	end;
		117
		118	function AsnAlreadyExisting(oid: POID; asnid: string): boolean;
		119	begin
741	daniel-mar	120	AsnAlreadyExisting := ListContains(oid^.AsnIds, asnid);
733	daniel-mar	121	end;
		122
		123	function AsnEditor(oid: POID): boolean;
		124	var
		125	asnList: PStringList;
		126	i: integer;
		127	x, y, w, h: integer;
		128	res: integer;
		129	sInput: string;
735	daniel-mar	130	menuIdNew, menuIdSave, menuIdExit: integer;
733	daniel-mar	131	begin
		132	AsnEditor := false;
		133
		134	repeat
735	daniel-mar	135	CreateList(asnList);
733	daniel-mar	136
		137	for i := 0 to ListCount(oid^.ASNIds)-1 do
		138	begin
		139	ListAppend(asnList, ListGetElement(oid^.ASNIDs, i));
		140	end;
735	daniel-mar	141	menuIdNew := ListAppend(asnList, '<NEW>');
		142	menuIdSave := ListAppend(asnList, '<SAVE>');
		143	menuIdExit := ListAppend(asnList, '<CANCEL>');
733	daniel-mar	144
749	daniel-mar	145	DrawStatusBar('');
733	daniel-mar	146	x := SINGLE_LINE_BOX_PADDING;
		147	y := ScreenHeight div 2 - ASNEDIT_LINES div 2;
		148	w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2;
		149	h := ASNEDIT_LINES;
		150	res := DrawSelectionList(x, y, w, h,
		151	asnList, true,
		152	'EDIT ASN.1 IDENTIFIERS',
		153	2);
735	daniel-mar	154	FreeList(asnList);
733	daniel-mar	155
		156	(* Change double-border to thin-border *)
		157	DrawThinBorder(x-1, y-1, w+2, h+2);
		158	GoToXY(x+1, y-1);
		159	Write('EDIT ASN.1 IDENTIFIERS');
		160
		161	if res = -1 then
		162	begin
		163	exit;
		164	end
735	daniel-mar	165	else if res = menuIdNew then
733	daniel-mar	166	begin
		167	(* "NEW" item was selected *)
		168	sInput := '';
746	daniel-mar	169	CursorOn;
733	daniel-mar	170	repeat
		171	if QueryVal(sInput,
		172	SINGLE_LINE_BOX_PADDING_INNER,
		173	ScreenHeight div 2,
		174	ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
		175	1,
		176	'ADD SINGLE ASN.1 ID',
		177	2) then
		178	begin
		179	if sInput = '' then continue;
		180	if not ASN1IDValid(sInput) then
		181	begin
		182	ShowMessage('Invalid ASN1.ID! (Require -, a..z, A..Z, 0..9, begin with a-z)', 'ERROR', true);
		183	_Pause;
		184	end
		185	else if AsnAlreadyExisting(oid, sInput) then
		186	begin
		187	ShowMessage('ASN.1 identifier is already existing on this arc', 'ERROR', true);
		188	_Pause;
		189	end
		190	else
		191	begin
		192	ListAppend(oid^.ASNIDs, sInput);
		193	break;
		194	end;
		195	end
		196	else break;
		197	until false;
746	daniel-mar	198	CursorOff;
733	daniel-mar	199	end
735	daniel-mar	200	else if res = menuIdSave then
733	daniel-mar	201	begin
		202	(* "SAVE" item was selected *)
		203	AsnEditor := true;
		204	Exit;
		205	end
735	daniel-mar	206	else if res = menuIdExit then
733	daniel-mar	207	begin
		208	(* "CANCEL" item was selected *)
		209	AsnEditor := false;
		210	Exit;
		211	end
		212	else
		213	begin
		214	DrawStatusBar('Note: Remove the text to delete the ASN.1 identifier');
		215	sInput := ListGetElement(oid^.ASNIDs, res);
746	daniel-mar	216	CursorOn;
733	daniel-mar	217	repeat
		218	if QueryVal(sInput,
		219	SINGLE_LINE_BOX_PADDING_INNER,
		220	ScreenHeight div 2,
		221	ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
		222	1,
		223	'EDIT SINGLE ASN.1 ID',
		224	2) then
		225	begin
		226	if sInput = '' then
		227	begin
		228	(* Empty input = Delete ASN.1 ID *)
737	daniel-mar	229	ListDeleteElementByIndex(oid^.ASNIDs, res);
733	daniel-mar	230	break;
		231	end
		232	else if not ASN1IDValid(sInput) then
		233	begin
		234	ShowMessage('Invalid ASN1.ID! (Require -, a..z, A..Z, 0..9, begin with a-z)', 'ERROR', true);
		235	_Pause;
		236	end
		237	else if AsnAlreadyExisting(oid, sInput) and
		238	not (ListGetElement(oid^.ASNIDs, res) = sInput) then
		239	begin
		240	ShowMessage('ASN.1 identifier is already existing on this arc', 'ERROR', true);
		241	_Pause;
		242	end
		243	else
		244	begin
		245	ListSetElement(oid^.ASNIDs, res, sInput);
		246	break;
		247	end;
		248	end
		249	else break;
		250	until false;
992	daniel-mar	251	CursorOff;
733	daniel-mar	252	end;
		253	until false;
		254	end;
		255
748	daniel-mar	256	function UnicodeLabelAlreadyExisting(oid: POID; unicodeLabel: string): boolean;
		257	begin
		258	UnicodeLabelAlreadyExisting := ListContains(oid^.UnicodeLabels, unicodeLabel);
		259	end;
		260
		261	function IriEditor(oid: POID): boolean;
		262	var
		263	iriList: PStringList;
		264	i: integer;
		265	x, y, w, h: integer;
		266	res: integer;
		267	sInput: string;
		268	menuIdNew, menuIdSave, menuIdExit: integer;
		269	begin
		270	IriEditor := false;
		271
		272	repeat
		273	CreateList(iriList);
		274
		275	for i := 0 to ListCount(oid^.UnicodeLabels)-1 do
		276	begin
		277	ListAppend(iriList, ListGetElement(oid^.UnicodeLabels, i));
		278	end;
		279	menuIdNew := ListAppend(iriList, '<NEW>');
		280	menuIdSave := ListAppend(iriList, '<SAVE>');
		281	menuIdExit := ListAppend(iriList, '<CANCEL>');
		282
749	daniel-mar	283	DrawStatusBar('');
748	daniel-mar	284	x := SINGLE_LINE_BOX_PADDING;
		285	y := ScreenHeight div 2 - ASNEDIT_LINES div 2;
		286	w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2;
		287	h := ASNEDIT_LINES;
		288	res := DrawSelectionList(x, y, w, h,
		289	iriList, true,
		290	'EDIT UNICODE LABELS',
		291	2);
		292	FreeList(iriList);
		293
		294	(* Change double-border to thin-border *)
		295	DrawThinBorder(x-1, y-1, w+2, h+2);
		296	GoToXY(x+1, y-1);
		297	Write('EDIT UNICODE LABELS');
		298
		299	if res = -1 then
		300	begin
		301	exit;
		302	end
		303	else if res = menuIdNew then
		304	begin
		305	(* "NEW" item was selected *)
		306	sInput := '';
		307	CursorOn;
		308	repeat
		309	if QueryVal(sInput,
		310	SINGLE_LINE_BOX_PADDING_INNER,
		311	ScreenHeight div 2,
		312	ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
		313	1,
		314	'ADD SINGLE UNICODE LABEL',
		315	2) then
		316	begin
		317	if sInput = '' then continue;
		318	if not UnicodeLabelValid(sInput) then
		319	begin
		320	ShowMessage('Invalid Unicode Label!', 'ERROR', true);
		321	_Pause;
		322	end
		323	else if UnicodeLabelAlreadyExisting(oid, sInput) then
		324	begin
		325	ShowMessage('Unicode Label is already existing on this arc', 'ERROR', true);
		326	_Pause;
		327	end
		328	else
		329	begin
		330	ListAppend(oid^.UnicodeLabels, sInput);
		331	break;
		332	end;
		333	end
		334	else break;
		335	until false;
		336	CursorOff;
		337	end
		338	else if res = menuIdSave then
		339	begin
		340	(* "SAVE" item was selected *)
		341	IriEditor := true;
		342	Exit;
		343	end
		344	else if res = menuIdExit then
		345	begin
		346	(* "CANCEL" item was selected *)
		347	IriEditor := false;
		348	Exit;
		349	end
		350	else
		351	begin
		352	DrawStatusBar('Note: Remove the text to delete the Unicode Label');
		353	sInput := ListGetElement(oid^.UnicodeLabels, res);
		354	CursorOn;
		355	repeat
		356	if QueryVal(sInput,
		357	SINGLE_LINE_BOX_PADDING_INNER,
		358	ScreenHeight div 2,
		359	ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
		360	1,
		361	'EDIT SINGLE UNICODE LABEL',
		362	2) then
		363	begin
		364	if sInput = '' then
		365	begin
		366	(* Empty input = Delete Unicode label *)
		367	ListDeleteElementByIndex(oid^.UnicodeLabels, res);
		368	break;
		369	end
		370	else if not UnicodeLabelValid(sInput) then
		371	begin
		372	ShowMessage('Invalid Unicode Label!', 'ERROR', true);
		373	_Pause;
		374	end
		375	else if UnicodeLabelAlreadyExisting(oid, sInput) and
		376	not (ListGetElement(oid^.UnicodeLabels, res) = sInput) then
		377	begin
		378	ShowMessage('Unicode Label is already existing on this arc', 'ERROR', true);
		379	_Pause;
		380	end
		381	else
		382	begin
		383	ListSetElement(oid^.UnicodeLabels, res, sInput);
		384	break;
		385	end;
		386	end
		387	else break;
		388	until false;
992	daniel-mar	389	CursorOff;
748	daniel-mar	390	end;
		391	until false;
		392	end;
		393
733	daniel-mar	394	function DescEditor(oid: POID): boolean;
		395	var
		396	sInput: string;
		397	begin
		398	DescEditor := false;
		399
		400	DrawStatusBar('Note: Press Ctrl+Return for a line-break.');
		401	sInput := oid^.description;
746	daniel-mar	402	CursorOn;
733	daniel-mar	403	if QueryVal(sInput,
		404	DESCEDIT_PADDING,
		405	ScreenHeight div 2 - DESCEDIT_LINES div 2,
		406	ScreenWidth - (DESCEDIT_PADDING-1)*2,
		407	DESCEDIT_LINES,
		408	'EDIT DESCRIPTION',
		409	2) then
		410	begin
		411	oid^.description := sInput;
740	daniel-mar	412	DescEditor := true; (* request caller to save <oid> *)
733	daniel-mar	413	end;
746	daniel-mar	414	CursorOff;
733	daniel-mar	415	end;
		416
		417	function NextPossibleFileID: string;
		418	var
		419	DirInfo: SearchRec;
		420	list: PStringList;
		421	iId: LongInt;
		422	sId: string;
		423	begin
		424	(* Put all found files into a list *)
735	daniel-mar	425	CreateList(list);
744	daniel-mar	426	FindFirst(RepeatStr('?',8)+OID_EXTENSION, Archive, DirInfo);
733	daniel-mar	427	while DosError = 0 do
		428	begin
		429	sId := Copy(DirInfo.Name, 1, 8);
		430	ListAppend(list, sId);
		431	FindNext(DirInfo);
		432	end;
		433
		434	(* Search for the first non existing item in the list *)
		435	sId := '';
		436	for iId := 0 to 99999999 do
		437	begin
		438	sId := ZeroPad(iId, 8);
		439	if not ListContains(list, sId) then break;
		440	end;
		441	NextPossibleFileId := sId;
		442	FreeList(list);
		443	end;
		444
749	daniel-mar	445	function NumIdAlreadyExisting(parentOID: POID; arcval: string): boolean;
733	daniel-mar	446	var
		447	searchDotNotation: string;
		448	sTmp: string;
		449	i: integer;
		450	begin
		451	if parentOID^.DotNotation = '' then
749	daniel-mar	452	searchDotNotation := arcval
733	daniel-mar	453	else
749	daniel-mar	454	searchDotNotation := parentOID^.DotNotation + '.' + arcval;
733	daniel-mar	455	for i := 0 to ListCount(parentOID^.SubIds)-1 do
		456	begin
		457	sTmp := ListGetElement(parentOID^.SubIds, i);
735	daniel-mar	458	if DotNotationPart(sTmp) = searchDotNotation then
733	daniel-mar	459	begin
		460	NumIdAlreadyExisting := true;
		461	exit;
		462	end;
		463	end;
		464	NumIdAlreadyExisting := false;
		465	end;
		466
		467	function NumIdEditor(oid: POID; parentOID: POID): boolean;
		468	var
		469	sInput: string;
749	daniel-mar	470	title: string;
		471	base36mode: boolean;
		472	arcval: string;
733	daniel-mar	473	begin
		474	NumIdEditor := false;
		475	sInput := '';
		476
749	daniel-mar	477	base36mode := false;
746	daniel-mar	478	CursorOn;
733	daniel-mar	479	repeat
749	daniel-mar	480	if base36mode then
		481	begin
		482	DrawStatusBar('Press ESC to cancel');
		483	title := 'ENTER BASE36 ID'
		484	end
		485	else
		486	begin
		487	DrawStatusBar('Enter "WEID" to enter a Base36 instead of Base10; press ESC to cancel');
		488	title := 'ENTER NUMERIC ID';
		489	end;
733	daniel-mar	490	if QueryVal(sInput,
		491	SINGLE_LINE_BOX_PADDING_INNER,
		492	ScreenHeight div 2,
		493	ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
		494	1,
749	daniel-mar	495	title,
733	daniel-mar	496	2) then
		497	begin
		498	if sInput = '' then continue;
749	daniel-mar	499	if not base36mode and (sInput = 'WEID') then
733	daniel-mar	500	begin
749	daniel-mar	501	sInput := '';
		502	base36mode := true;
733	daniel-mar	503	end
749	daniel-mar	504	else if not base36mode and not IsPositiveIntegerOrZero(sInput) then
733	daniel-mar	505	begin
749	daniel-mar	506	ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true);
733	daniel-mar	507	_Pause;
		508	end
749	daniel-mar	509	else if base36mode and not IsBase36String(sInput) then
733	daniel-mar	510	begin
749	daniel-mar	511	ShowMessage('Invalid base36 ID (must be 0..9, A..Z)', 'ERROR', true);
733	daniel-mar	512	_Pause;
		513	end
		514	else
		515	begin
749	daniel-mar	516	if base36mode then
		517	arcval := base_convert_bigint(sInput, 36, 10)
733	daniel-mar	518	else
749	daniel-mar	519	arcval := sInput;
		520	arcval := StripLeadingZeros(arcval);
		521
		522	if (parentOID^.DotNotation='') and (arcval <> '0') and (arcval <> '1') and (arcval <> '2') then
		523	begin
		524	ShowMessage('Invalid numeric ID (root arc can only be 0, 1, or 2)', 'ERROR', true);
		525	_Pause;
		526	end
		527	else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and
		528	((Length(arcval)>2) or (StrToInt(arcval) > 39)) then
		529	begin
		530	ShowMessage('Invalid numeric ID (root 0 and 1 must have sub-arc of 0..39)', 'ERROR', true);
		531	_Pause;
		532	end
		533	else if NumIdAlreadyExisting(parentOID, arcval) then
		534	begin
		535	ShowMessage('This numeric ID is already used in this arc', 'ERROR', true);
		536	_Pause;
		537	end
		538	else
		539	begin
		540	if parentOID^.DotNotation = '' then
		541	oid^.DotNotation := arcval
		542	else
		543	oid^.DotNotation := parentOID^.DotNotation + '.' + arcval;
		544	NumIdEditor := true; (* request caller to save <oid> *)
		545	Break;
		546	end;
733	daniel-mar	547	end;
		548	end
		549	else
		550	begin
749	daniel-mar	551	(* User pressed ESC *)
746	daniel-mar	552	Break;
733	daniel-mar	553	end;
		554	until false;
746	daniel-mar	555	CursorOff;
733	daniel-mar	556	end;
		557
		558	function NewOidEditor(oid: POID): boolean;
		559	var
		560	newfilename: string;
735	daniel-mar	561	newOID: POID;
733	daniel-mar	562	begin
		563	NewOidEditor := false;
		564
735	daniel-mar	565	CreateOidDef(newOID);
		566	newOID^.FileId := NextPossibleFileID;
745	daniel-mar	567	newOID^.ParentFileId := oid^.FileId;
		568	newOID^.ParentDotNotation := oid^.DotNotation;
735	daniel-mar	569	if NumIdEditor(newOID, oid) and
		570	AsnEditor(newOID) and
748	daniel-mar	571	IriEditor(newOID) and
735	daniel-mar	572	DescEditor(newOID) then
734	daniel-mar	573	begin
744	daniel-mar	574	newfilename := newOID^.FileId + OID_EXTENSION;
743	daniel-mar	575	if _WriteOidFile(newfilename, newOID, true) then
		576	begin
		577	(* Add link to original file and enable the saving of it *)
		578	ListAppend(oid^.SubIds, newOID^.FileId + newOID^.DotNotation);
		579	NewOidEditor := true; (* request caller to save <oid> *)
		580	end;
734	daniel-mar	581	end;
735	daniel-mar	582	FreeOidDef(newOID);
733	daniel-mar	583	end;
		584
		585	procedure DeleteChildrenRecursive(oid: POID);
		586	var
		587	i: integer;
735	daniel-mar	588	childOID: POID;
733	daniel-mar	589	filenameChild: string;
		590	begin
		591	for i := 0 to ListCount(oid^.SubIds)-1 do
		592	begin
744	daniel-mar	593	filenameChild := FileIdPart(ListGetElement(oid^.SubIds, i)) + OID_EXTENSION;
740	daniel-mar	594	if FileExists(filenameChild) then
		595	begin
		596	CreateOidDef(childOID);
744	daniel-mar	597	if _ReadOidFile(filenameChild, childOID, false) and
745	daniel-mar	598	(childOID^.ParentFileId = oid^.FileId) and
		599	(childOID^.ParentDotNotation = oid^.DotNotation) then
743	daniel-mar	600	begin
		601	DeleteChildrenRecursive(childOID);
		602	end;
740	daniel-mar	603	FreeOidDef(childOID);
		604	DeleteFile(filenameChild);
		605	end;
733	daniel-mar	606	end;
		607	ListClear(oid^.SubIds);
		608	end;
		609
		610	procedure DeleteOidRecursive(selfOID: POID);
		611	var
		612	i: integer;
735	daniel-mar	613	parentOID: POID;
733	daniel-mar	614	filenameSelf, filenameParent: string;
		615	begin
		616	(* Remove all children and their files recursively *)
		617	DeleteChildrenRecursive(selfOID);
		618
		619	(* Remove forward reference in parent OID *)
743	daniel-mar	620	(* (this is the most important part) *)
745	daniel-mar	621	filenameParent := selfOID^.ParentFileId + OID_EXTENSION;
740	daniel-mar	622	if FileExists(filenameParent) then
733	daniel-mar	623	begin
740	daniel-mar	624	CreateOidDef(parentOID);
743	daniel-mar	625	if _ReadOidFile(filenameParent, parentOID, true) then
740	daniel-mar	626	begin
743	daniel-mar	627	if ListDeleteElementByValue(parentOID^.SubIds, selfOID^.FileId + selfOID^.DotNotation) then
		628	begin
		629	_WriteOidFile(filenameParent, parentOID, true);
		630	end;
740	daniel-mar	631	end;
		632	FreeOidDef(parentOID);
733	daniel-mar	633	end;
		634
		635	(* Delete own file *)
744	daniel-mar	636	filenameSelf := selfOID^.FileId + OID_EXTENSION;
740	daniel-mar	637	if FileExists(filenameSelf) then
		638	begin
		639	DeleteFile(filenameSelf);
		640	end;
733	daniel-mar	641	end;
		642
735	daniel-mar	643	function _DeleteConfirmation: boolean;
		644	var
		645	sc: Char;
		646	begin
		647	repeat
		648	ShowMessage('Are you sure you want to delete this OID? (Y/N)', 'DELETE OID', true);
737	daniel-mar	649	DrawStatusBar('Y=Yes, N=No');
735	daniel-mar	650
746	daniel-mar	651	CursorOn;
735	daniel-mar	652	sc := ReadKey;
746	daniel-mar	653	CursorOff;
735	daniel-mar	654	if sc = #0 then
		655	begin
		656	(* Extended key. Nothing we care about. *)
		657	ReadKey;
		658	continue;
		659	end;
		660
		661	if UpCase(sc) = 'Y' then
		662	begin
		663	_DeleteConfirmation := true;
		664	break;
737	daniel-mar	665	end
		666	else if UpCase(sc) = 'N' then
735	daniel-mar	667	begin
		668	_DeleteConfirmation := false;
		669	break;
		670	end;
		671	until false;
		672	end;
		673
737	daniel-mar	674	procedure _DrawOidTitleBar(filename: string; oid: POID);
		675	begin
		676	if oid^.DotNotation = '' then
738	daniel-mar	677	DrawTitleBar('OID ROOT', TITLEBAR_LEFT_TEXT, filename)
737	daniel-mar	678	else
738	daniel-mar	679	DrawTitleBar('OID ' + oid^.DotNotation, TITLEBAR_LEFT_TEXT, filename);
737	daniel-mar	680	end;
		681
748	daniel-mar	682	function DotNotation(oid: POid): string;
		683	var
		684	res: string;
		685	begin
		686	res := oid^.DotNotation;
		687	if res = '' then res := '.'; (* root *)
		688	DotNotation := res;
		689	end;
		690
		691	function OidLastArc(oid: POid): string;
		692	var
		693	s: string;
		694	p: integer;
		695	begin
		696	s := oid^.DotNotation;
		697
		698	while true do
		699	begin
		700	p := Pos('.', s);
		701	if p = 0 then break;
		702	Delete(s, 1, p);
		703	end;
		704
		705	OidLastArc := s;
		706	end;
		707
		708	function AsnNotation(oid: POid): string;
		709	var
		710	prevOid, curOid: POid;
		711	res: string;
		712	begin
		713	CreateOidDef(curOid);
		714	prevOid := oid;
		715	res := '';
		716
		717	while true do
		718	begin
		719	(* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
		720	ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
		721	if curOid^.ParentFileId = '' then break;
		722	if curOid^.ParentFileId = curOid^.FileId then break;
		723	if ListCount(curOid^.AsnIds) > 0 then
		724	res := ListGetElement(curOid^.AsnIds, 0) + '('+OidLastArc(curOid)+') ' + res
		725	else
		726	res := OidLastArc(curOid) + ' ' + res;
		727	prevOid := curOid;
		728	end;
		729	FreeOidDef(curOid);
		730	if ListCount(oid^.AsnIds) > 0 then
		731	res := res + ListGetElement(oid^.AsnIds, 0) + '('+OidLastArc(oid)+')'
		732	else
		733	res := res + OidLastArc(oid);
		734	if res = '' then
		735	AsnNotation := ''
		736	else
		737	AsnNotation := '{ ' + res + ' }';
		738	end;
		739
		740	function IriNotation(oid: POid): string;
		741	var
		742	prevOid, curOid: POid;
		743	res: string;
		744	begin
		745	CreateOidDef(curOid);
		746	prevOid := oid;
		747	res := '';
		748
		749	while true do
		750	begin
		751	(* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
		752	ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
		753	if curOid^.ParentFileId = '' then break;
		754	if curOid^.ParentFileId = curOid^.FileId then break;
		755	if ListCount(curOid^.UnicodeLabels) > 0 then
		756	res := ListGetElement(curOid^.UnicodeLabels, 0) + '/' + res
		757	else
		758	res := OidLastArc(curOid) + '/' + res;
		759	prevOid := curOid;
		760	end;
		761	FreeOidDef(curOid);
		762	if ListCount(oid^.UnicodeLabels) > 0 then
		763	res := res + ListGetElement(oid^.UnicodeLabels, 0)
		764	else
		765	res := res + OidLastArc(oid);
		766	IriNotation := '/' + res;
		767	end;
		768
		769	function WeidNotation(oid: POid): string;
		770	begin
		771	WeidNotation := OidToWeid(oid^.DotNotation);
		772	end;
		773
965	daniel-mar	774	procedure DisplayOIDFile(filename, from: string);
733	daniel-mar	775	var
		776	isRoot: boolean;
740	daniel-mar	777	oid, tmpOID: POID;
748	daniel-mar	778	i: integer;
733	daniel-mar	779	sTmp, subfile: string;
		780	subsel, subfiles: PStringList;
		781	subselres: integer;
735	daniel-mar	782	exitRequest: boolean;
748	daniel-mar	783	menuIdExit, menuIdAsnEdit, menuIdIriEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer;
		784	menuX, menuY: integer;
733	daniel-mar	785	begin
735	daniel-mar	786	exitRequest := false;
733	daniel-mar	787	repeat
743	daniel-mar	788	CreateOidDef(oid);
		789
		790	if not _ReadOidFile(filename, oid, true) then
740	daniel-mar	791	begin
743	daniel-mar	792	FreeOidDef(oid);
740	daniel-mar	793	exit;
		794	end;
		795
733	daniel-mar	796	(* Print OID information *)
		797
		798	ClrScr;
737	daniel-mar	799	_DrawOidTitleBar(filename, oid);
749	daniel-mar	800	DrawStatusBar('');
733	daniel-mar	801	GotoXY(1,2);
		802
749	daniel-mar	803	Write('Dot notation: ');
		804	WriteLnKeepX(DotNotation(oid));
		805	Write('ASN.1 notation: ');
		806	WriteLnKeepX(AsnNotation(oid));
		807	Write('OID-IRI: ');
		808	WriteLnKeepX(IriNotation(oid));
		809	Write('WEID notation: ');
		810	WriteLnKeepX(WeidNotation(oid));
		811	WriteLn('');
733	daniel-mar	812
735	daniel-mar	813	if Trim(oid^.Description) <> '' then
733	daniel-mar	814	begin
748	daniel-mar	815	(* WriteLn('Description:'); *)
992	daniel-mar	816	(* TODO: We should avoid that this is more than 10 lines *)
735	daniel-mar	817	WriteLn(oid^.Description);
733	daniel-mar	818	WriteLn('');
748	daniel-mar	819	end
		820	else
733	daniel-mar	821	begin
748	daniel-mar	822	WriteLn('(No description has been added to this OID.)');
		823	WriteLn('');
733	daniel-mar	824	end;
		825
		826	(* Now prepare the menu entries *)
		827
744	daniel-mar	828	CreateList(subsel); (* Contains the human-readable OID name *)
737	daniel-mar	829	CreateList(subfiles); (* Contains the file name *)
733	daniel-mar	830
745	daniel-mar	831	if oid^.ParentFileId = '' then
733	daniel-mar	832	begin
		833	isRoot := true;
		834	end
		835	else
		836	begin
745	daniel-mar	837	isRoot := oid^.ParentDotNotation = oid^.DotNotation;
733	daniel-mar	838	end;
		839
745	daniel-mar	840	if (oid^.ParentFileId <> '') and not isRoot then
733	daniel-mar	841	begin
745	daniel-mar	842	subfile := oid^.ParentFileId + OID_EXTENSION;
740	daniel-mar	843	if FileExists(subfile) then
		844	begin
		845	CreateOidDef(tmpOID);
744	daniel-mar	846	if not _ReadOidFile(subfile, tmpOID, true) then
		847	begin
745	daniel-mar	848	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (READ ERROR)');
744	daniel-mar	849	ListAppend(subfiles, 'ERROR: '+subfile+' Read error or file invalid');
		850	end
743	daniel-mar	851	else
744	daniel-mar	852	begin
745	daniel-mar	853	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + _ShowASNIds(tmpOID));
744	daniel-mar	854	ListAppend(subfiles, subfile);
		855	end;
740	daniel-mar	856	FreeOidDef(tmpOID);
		857	end
		858	else
		859	begin
745	daniel-mar	860	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (FILE NOT FOUND)');
744	daniel-mar	861	ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740	daniel-mar	862	end;
733	daniel-mar	863	end;
		864
		865	if isRoot then
		866	begin
965	daniel-mar	867	menuIdExit := ListAppend(subsel, 'Back to '+from);
735	daniel-mar	868	ListAppend(subfiles, '');
		869	end
		870	else menuIdExit := -99;
733	daniel-mar	871
735	daniel-mar	872	for i := 0 to ListCount(oid^.SubIds)-1 do
733	daniel-mar	873	begin
735	daniel-mar	874	sTmp := ListGetElement(oid^.SubIds, i);
744	daniel-mar	875	subfile := FileIdPart(sTmp) + OID_EXTENSION;
740	daniel-mar	876	if FileExists(subfile) then
		877	begin
		878	CreateOidDef(tmpOID);
744	daniel-mar	879	if not _ReadOidFile(subfile, tmpOID, true) then
		880	begin
		881	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (READ ERROR)');
		882	ListAppend(subfiles, 'ERROR: Read error at file '+subfile+', or file is invalid.');
		883	end
745	daniel-mar	884	else if (tmpOID^.ParentFileId <> oid^.FileId) or
		885	(tmpOID^.ParentDotNotation <> oid^.DotNotation) then
744	daniel-mar	886	begin
		887	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (BAD BACKREF)');
		888	ListAppend(subfiles, 'ERROR: File '+subfile+' has a wrong back-reference.');
		889	end
743	daniel-mar	890	else
744	daniel-mar	891	begin
		892	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + _ShowASNIds(tmpOID));
		893	ListAppend(subfiles, subfile);
		894	end;
740	daniel-mar	895	FreeOidDef(tmpOID);
		896	end
		897	else
		898	begin
		899	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (FILE NOT FOUND)');
744	daniel-mar	900	ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740	daniel-mar	901	end;
733	daniel-mar	902	end;
		903
735	daniel-mar	904	if oid^.DotNotation <> '' then
733	daniel-mar	905	begin
748	daniel-mar	906	menuIdAsnEdit := ListAppend(subsel, 'View/Edit ASN.1 identifiers');
735	daniel-mar	907	ListAppend(subfiles, '');
		908	end
		909	else menuIdAsnEdit := -99;
733	daniel-mar	910
748	daniel-mar	911	if oid^.DotNotation <> '' then
		912	begin
749	daniel-mar	913	menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels (OID-IRI)');
748	daniel-mar	914	ListAppend(subfiles, '');
		915	end
		916	else menuIdIriEdit := -99;
		917
735	daniel-mar	918	menuIdDescEdit := ListAppend(subsel, 'Edit description');
		919	ListAppend(subfiles, '');
733	daniel-mar	920
735	daniel-mar	921	menuIdAdd := ListAppend(subsel, 'Add child');
		922	ListAppend(subfiles, '');
733	daniel-mar	923
		924	if not isRoot then
		925	begin
735	daniel-mar	926	menuIdDelete := ListAppend(subsel, 'Delete OID');
		927	ListAppend(subfiles, '');
		928	end
		929	else menuIdDelete := -99;
733	daniel-mar	930
734	daniel-mar	931	(* Show menu *)
		932
748	daniel-mar	933	menuX := WhereX + 1;
		934	menuY := ScreenHeight - ACTIONMENU_SIZE - 1;
733	daniel-mar	935	subselres := DrawSelectionList(menuX, menuY,
		936	ScreenWidth-2,
735	daniel-mar	937	ACTIONMENU_SIZE,
733	daniel-mar	938	subsel,
		939	true,
		940	'SELECT ACTION',
		941	1);
734	daniel-mar	942
		943	(* Process user selection *)
		944
733	daniel-mar	945	if subselres = -1 then
		946	begin
735	daniel-mar	947	exitRequest := true;
733	daniel-mar	948	end
735	daniel-mar	949	else if subselres = menuIdAsnEdit then
733	daniel-mar	950	begin
735	daniel-mar	951	if AsnEditor(oid) then
743	daniel-mar	952	_WriteOidFile(filename, oid, true);
735	daniel-mar	953	end
748	daniel-mar	954	else if subselres = menuIdIriEdit then
		955	begin
		956	if IriEditor(oid) then
		957	_WriteOidFile(filename, oid, true);
		958	end
735	daniel-mar	959	else if subselres = menuIdDescEdit then
		960	begin
		961	if DescEditor(oid) then
743	daniel-mar	962	_WriteOidFile(filename, oid, true);
735	daniel-mar	963	end
		964	else if subselres = menuIdAdd then
		965	begin
		966	if NewOidEditor(oid) then
743	daniel-mar	967	_WriteOidFile(filename, oid, true);
735	daniel-mar	968	end
		969	else if subselres = menuIdDelete then
		970	begin
		971	if _DeleteConfirmation then
733	daniel-mar	972	begin
745	daniel-mar	973	sTmp := oid^.ParentFileId + OID_EXTENSION;
735	daniel-mar	974	DeleteOidRecursive(oid);
740	daniel-mar	975	if FileExists(sTmp) then
		976	begin
		977	filename := sTmp;
		978	end
		979	else
		980	begin
744	daniel-mar	981	ShowMessage('Parent file ' + sTmp + ' was not found', 'ERROR', true);
740	daniel-mar	982	_Pause;
		983	exitRequest := true;
		984	end;
733	daniel-mar	985	end;
735	daniel-mar	986	end
		987	else if subselres = menuIdExit then
		988	begin
		989	exitRequest := true;
		990	end
		991	else
		992	begin
		993	(* Normal OID *)
744	daniel-mar	994	(* Above we already checked if the files are valild and existing *)
740	daniel-mar	995	sTmp := ListGetElement(subfiles, subselres);
744	daniel-mar	996	if Copy(sTmp, 1, Length('ERROR: ')) = 'ERROR: ' then
740	daniel-mar	997	begin
744	daniel-mar	998	Delete(sTmp, 1, Length('ERROR: '));
		999	ShowMessage(sTmp, 'ERROR', true);
		1000	_Pause;
740	daniel-mar	1001	end
		1002	else
		1003	begin
744	daniel-mar	1004	filename := sTmp;
740	daniel-mar	1005	end;
733	daniel-mar	1006	end;
		1007	FreeList(subsel);
		1008	FreeList(subfiles);
		1009
735	daniel-mar	1010	FreeOidDef(oid);
		1011	until exitRequest;
733	daniel-mar	1012	end;
		1013
743	daniel-mar	1014	function CreateRootOIDFile(filename: string; ShowErrorMessage: boolean): boolean;
733	daniel-mar	1015	var
735	daniel-mar	1016	oid: POID;
733	daniel-mar	1017	begin
735	daniel-mar	1018	CreateOidDef(oid);
745	daniel-mar	1019	oid^.Description := 'This is the root of the OID tree.' +#13#10 +
		1020	#13#10 +
		1021	'Valid subsequent arcs are per definition:' + #13#10 +
		1022	'- 0 (itu-t)' + #13#10 +
		1023	'- 1 (iso)' + #13#10 +
		1024	'- 2 (joint-iso-itu-t)';
		1025	oid^.FileId := ZeroPad(0, 8);
		1026	oid^.DotNotation := '';
		1027	oid^.ParentFileId := ZeroPad(0, 8);
		1028	oid^.ParentDotNotation := '';
743	daniel-mar	1029	CreateRootOIDFile := _WriteOidFile(filename, oid, ShowErrorMessage);
735	daniel-mar	1030	FreeOidDef(oid);
733	daniel-mar	1031	end;
		1032
742	daniel-mar	1033	function _GetRootFile(ShowErrorMessage: boolean): string;
735	daniel-mar	1034	var
742	daniel-mar	1035	rootFile: string;
733	daniel-mar	1036	begin
744	daniel-mar	1037	rootFile := ZeroPad(0, 8) + OID_EXTENSION;
743	daniel-mar	1038	_GetRootFile := rootFile;
742	daniel-mar	1039	if not FileExists(rootFile) then
733	daniel-mar	1040	begin
743	daniel-mar	1041	if not CreateRootOIDFile(rootFile, ShowErrorMessage) then
742	daniel-mar	1042	begin
743	daniel-mar	1043	_GetRootFile := '';
742	daniel-mar	1044	end;
		1045	end;
733	daniel-mar	1046	end;
		1047
740	daniel-mar	1048	procedure OP_ManageOIDs;
742	daniel-mar	1049	var
		1050	rootfile: string;
740	daniel-mar	1051	begin
		1052	ClrScr;
		1053	DrawTitleBar('Manage Object Identifiers', TITLEBAR_LEFT_TEXT, '');
		1054	DrawStatusBar('Loading data... please wait...');
		1055
742	daniel-mar	1056	(* This will try creating a new root file if it does not exist *)
		1057	rootfile := _GetRootFile(true);
		1058	if rootfile = '' then Exit;
		1059
965	daniel-mar	1060	DisplayOIDFile(rootfile, 'main menu');
740	daniel-mar	1061	end;
		1062
733	daniel-mar	1063	procedure OP_ReturnToMSDOS;
		1064	begin
747	daniel-mar	1065	(* Note: These two lines don't seem to be necessary if you use DoneVideo *)
		1066	ResetDefaultDosColors;
746	daniel-mar	1067	ClrScr; (Important, so that the DOS command prompt is also LightGray )
		1068
741	daniel-mar	1069	WriteLn('Thank you for using OIDplus for DOS.');
743	daniel-mar	1070	WriteLn('');
733	daniel-mar	1071	end;
		1072
741	daniel-mar	1073	function _GetTreeViewLine(oid: POID; indent: integer): string;
740	daniel-mar	1074	var
		1075	i: integer;
747	daniel-mar	1076	sTmp, sTmp2: string;
740	daniel-mar	1077	begin
		1078	(* Build line *)
		1079	sTmp := RepeatStr(' ', indent*TREEVIEW_INDENT);
		1080	if oid^.DotNotation = '' then
		1081	sTmp := sTmp + 'Object Identifiers'
		1082	else
		1083	sTmp := sTmp + oid^.DotNotation;
		1084	sTmp := sTmp + _ShowAsnIds(oid);
		1085	if TREEVIEW_INCLUDE_DESC then
		1086	begin
		1087	if Trim(oid^.Description) <> '' then
		1088	begin
		1089	sTmp := sTmp + ': ' + oid^.Description;
		1090	end;
		1091	end;
747	daniel-mar	1092
		1093	sTmp := StringReplace(sTmp, #13#10, ' ');
		1094	repeat
		1095	sTmp2 := sTmp;
		1096	sTmp := StringReplace(sTmp, ' ', ' ');
		1097	until sTmp = sTmp2;
		1098
744	daniel-mar	1099	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
741	daniel-mar	1100	_GetTreeViewLine := sTmp;
740	daniel-mar	1101	end;
		1102
758	daniel-mar	1103	procedure _RecTreeExport(oid: POID; visList, targetList: PStringList; indent: integer);
740	daniel-mar	1104	var
		1105	i: integer;
		1106	sTmp: string;
		1107	suboid: POID;
		1108	childFilename: string;
		1109	begin
741	daniel-mar	1110	sTmp := _GetTreeViewLine(oid, indent);
740	daniel-mar	1111	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1112	ListAppend(visList, sTmp);
		1113	ListAppend(targetList, oid^.FileID);
740	daniel-mar	1114
		1115	(* Recursively call children *)
		1116	for i := 0 to ListCount(oid^.SubIds)-1 do
		1117	begin
		1118	sTmp := ListGetElement(oid^.SubIds, i);
		1119	CreateOidDef(suboid);
744	daniel-mar	1120	childFilename := FileIdPart(sTmp) + OID_EXTENSION;
743	daniel-mar	1121	if not FileExists(childFilename) then
740	daniel-mar	1122	begin
744	daniel-mar	1123	sTmp := 'ERROR: MISSING ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
743	daniel-mar	1124	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1125	ListAppend(visList, sTmp);
		1126	ListAppend(targetList, 'ERROR');
740	daniel-mar	1127	end
743	daniel-mar	1128	else if not _ReadOidFile(childFilename, suboid, false) then
740	daniel-mar	1129	begin
744	daniel-mar	1130	sTmp := 'ERROR: READ ERROR AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
740	daniel-mar	1131	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1132	ListAppend(visList, sTmp);
		1133	ListAppend(targetList, 'ERROR');
743	daniel-mar	1134	end
745	daniel-mar	1135	else if (suboid^.ParentFileId <> oid^.FileId) or
		1136	(suboid^.ParentDotNotation <> oid^.DotNotation) then
744	daniel-mar	1137	begin
		1138	(* This can happen if a file is missing, and then another OID gets this filename since the number seems to be free *)
		1139	sTmp := 'ERROR: BAD BACKREF AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
		1140	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1141	ListAppend(visList, sTmp);
		1142	ListAppend(targetList, 'ERROR');
744	daniel-mar	1143	end
743	daniel-mar	1144	else
		1145	begin
758	daniel-mar	1146	_RecTreeExport(suboid, visList, targetList, indent+1);
743	daniel-mar	1147	FreeOidDef(suboid);
		1148	end
740	daniel-mar	1149	end;
		1150	end;
		1151
758	daniel-mar	1152	procedure TreeViewPreview(visList, targetList: PStringList);
747	daniel-mar	1153	var
758	daniel-mar	1154	res: integer;
		1155	sTmp: string;
747	daniel-mar	1156	begin
748	daniel-mar	1157	ClrScr;
		1158	DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, TREEVIEW_FILENAME);
758	daniel-mar	1159	DrawStatusBar('Press ESC to return to the main menu. Enter to jump to OID.');
748	daniel-mar	1160
758	daniel-mar	1161	while true do
		1162	begin
		1163	res := DrawSelectionList(2, 3, ScreenWidth-2, ScreenHeight-4,
		1164	visList, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2);
		1165	if res > -1 then
		1166	begin
		1167	(* Jump to selected OID or show error *)
		1168	sTmp := ListGetElement(targetList, res);
		1169	if sTmp = 'ERROR' then
		1170	begin
		1171	ShowMessage(ListGetElement(visList, res), 'ERROR', true);
		1172	_Pause;
		1173	end
		1174	else
		1175	begin
965	daniel-mar	1176	DisplayOidFile(sTmp + '.OID', 'TreeView Export');
758	daniel-mar	1177	end;
		1178	end
		1179	else
		1180	begin
		1181	break;
		1182	end;
		1183	end;
747	daniel-mar	1184
749	daniel-mar	1185	DrawStatusBar('');
747	daniel-mar	1186	end;
		1187
740	daniel-mar	1188	procedure OP_TreeView;
		1189	var
		1190	F: Text;
		1191	rootoid: POID;
742	daniel-mar	1192	rootfile: string;
743	daniel-mar	1193	res: boolean;
758	daniel-mar	1194	visList, targetList: PStringList;
740	daniel-mar	1195	begin
		1196	ClrScr;
		1197	DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, '');
		1198	DrawStatusBar('Exporting data... please wait...');
		1199
742	daniel-mar	1200	(* This will try creating a new root file if it does not exist *)
743	daniel-mar	1201	rootfile := _GetRootFile(true);
		1202	if rootfile = '' then
		1203	begin
749	daniel-mar	1204	DrawStatusBar('');
743	daniel-mar	1205	Exit;
		1206	end;
742	daniel-mar	1207
758	daniel-mar	1208	CreateList(visList);
		1209	CreateList(targetList);
		1210
		1211	(* First check if the disk is read-only *)
744	daniel-mar	1212	Assign(F, TREEVIEW_FILENAME);
743	daniel-mar	1213	{$I-}
740	daniel-mar	1214	Rewrite(F);
743	daniel-mar	1215	{$I+}
		1216	if IoResult <> 0 then
		1217	begin
		1218	(* Can happen if disk is read-only (Runtime Error 150) *)
744	daniel-mar	1219	ShowMessage('Cannot open '+TREEVIEW_FILENAME+' for writing.', 'ERROR', true);
743	daniel-mar	1220	_Pause;
749	daniel-mar	1221	DrawStatusBar('');
743	daniel-mar	1222	Exit;
		1223	end;
758	daniel-mar	1224	Close(F);
740	daniel-mar	1225
758	daniel-mar	1226	(* Now do the export *)
743	daniel-mar	1227	res := false;
740	daniel-mar	1228	CreateOidDef(rootoid);
743	daniel-mar	1229	if _ReadOidFile(rootfile, rootoid, true) then
		1230	begin
758	daniel-mar	1231	_RecTreeExport(rootoid, visList, targetList, 0);
743	daniel-mar	1232	res := true;
		1233	end;
740	daniel-mar	1234	FreeOidDef(rootoid);
		1235
758	daniel-mar	1236	(* Save the list (visual part only) *)
		1237	ListSaveToFile(visList, TREEVIEW_FILENAME);
743	daniel-mar	1238
749	daniel-mar	1239	DrawStatusBar('');
743	daniel-mar	1240	if res then
		1241	begin
744	daniel-mar	1242	ShowMessage('TreeView successfully exported as '+TREEVIEW_FILENAME, 'TREEVIEW EXPORT', true);
743	daniel-mar	1243	_Pause;
		1244	end;
747	daniel-mar	1245
758	daniel-mar	1246	TreeViewPreview(visList, targetList);
		1247
		1248	FreeList(visList);
		1249	FreeList(targetList);
740	daniel-mar	1250	end;
		1251
733	daniel-mar	1252	procedure OP_MainMenu;
		1253	var
		1254	menu: PStringList;
		1255	menuRes, menuLeft, menuTop: integer;
747	daniel-mar	1256	menuIdOID, menuIdTree, menuIdExit: integer;
733	daniel-mar	1257	begin
		1258	repeat
		1259	ClrScr;
		1260
738	daniel-mar	1261	DrawTitleBar('Welcome to OIDplus for DOS', '', '');
749	daniel-mar	1262	DrawStatusBar('(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.');
733	daniel-mar	1263	GoToXY(ScreenWidth-Length(VERSIONINFO), ScreenHeight-1);
		1264	Write(VERSIONINFO);
		1265
735	daniel-mar	1266	CreateList(menu);
		1267
		1268	menuIdOID := ListAppend(menu, 'Manage OIDs');
740	daniel-mar	1269	menuIdTree := ListAppend(menu, 'Export TreeView');
735	daniel-mar	1270	menuIdExit := ListAppend(menu, 'Return to DOS');
		1271
		1272	menuLeft := round(ScreenWidth/2 -MAINMENU_WIDTH/2);
		1273	menuTop := round(ScreenHeight/2-MAINMENU_HEIGHT/2);
		1274	menuRes := DrawSelectionList(menuLeft, menuTop,
		1275	MAINMENU_WIDTH, MAINMENU_HEIGHT,
		1276	menu, true, 'MAIN MENU', 2);
733	daniel-mar	1277	FreeList(menu);
		1278
735	daniel-mar	1279	if menuRes = menuIdOID then
733	daniel-mar	1280	begin
		1281	OP_ManageOIDs;
735	daniel-mar	1282	end
740	daniel-mar	1283	else if menuRes = menuIdTree then
		1284	begin
		1285	OP_Treeview;
733	daniel-mar	1286	end;
735	daniel-mar	1287	until (menuRes = menuIdExit) or (MAINMENU_ALLOW_ESC and (menuRes = -1));
733	daniel-mar	1288
		1289	OP_ReturnToMSDOS;
		1290	end;
		1291
		1292	begin
746	daniel-mar	1293	InitVideo; (* sets ScreenWidth and ScreenHeight *)
		1294	CursorOff;
733	daniel-mar	1295	OP_MainMenu;
747	daniel-mar	1296	CursorOn;
746	daniel-mar	1297	DoneVideo;
733	daniel-mar	1298	end.

Subversion Repositories oidplus

oidplus/trunk_dos/OIDPLUS.PAS @ 995 – Rev 992