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 *)
758	daniel-mar	6	(* Revision: 2022-02-27 *)
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
758	daniel-mar	25	VERSIONINFO = 'Revision: 2022-02-27';
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;
746	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;
		389	CursorOff;
		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
733	daniel-mar	774	procedure DisplayOIDFile(filename: string);
		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:'); *)
735	daniel-mar	816	WriteLn(oid^.Description);
733	daniel-mar	817	WriteLn('');
748	daniel-mar	818	end
		819	else
733	daniel-mar	820	begin
748	daniel-mar	821	WriteLn('(No description has been added to this OID.)');
		822	WriteLn('');
733	daniel-mar	823	end;
		824
		825	(* Now prepare the menu entries *)
		826
744	daniel-mar	827	CreateList(subsel); (* Contains the human-readable OID name *)
737	daniel-mar	828	CreateList(subfiles); (* Contains the file name *)
733	daniel-mar	829
745	daniel-mar	830	if oid^.ParentFileId = '' then
733	daniel-mar	831	begin
		832	isRoot := true;
		833	end
		834	else
		835	begin
745	daniel-mar	836	isRoot := oid^.ParentDotNotation = oid^.DotNotation;
733	daniel-mar	837	end;
		838
745	daniel-mar	839	if (oid^.ParentFileId <> '') and not isRoot then
733	daniel-mar	840	begin
745	daniel-mar	841	subfile := oid^.ParentFileId + OID_EXTENSION;
740	daniel-mar	842	if FileExists(subfile) then
		843	begin
		844	CreateOidDef(tmpOID);
744	daniel-mar	845	if not _ReadOidFile(subfile, tmpOID, true) then
		846	begin
745	daniel-mar	847	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (READ ERROR)');
744	daniel-mar	848	ListAppend(subfiles, 'ERROR: '+subfile+' Read error or file invalid');
		849	end
743	daniel-mar	850	else
744	daniel-mar	851	begin
745	daniel-mar	852	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + _ShowASNIds(tmpOID));
744	daniel-mar	853	ListAppend(subfiles, subfile);
		854	end;
740	daniel-mar	855	FreeOidDef(tmpOID);
		856	end
		857	else
		858	begin
745	daniel-mar	859	ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (FILE NOT FOUND)');
744	daniel-mar	860	ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740	daniel-mar	861	end;
733	daniel-mar	862	end;
		863
		864	if isRoot then
		865	begin
735	daniel-mar	866	menuIdExit := ListAppend(subsel, 'Back to main menu');
		867	ListAppend(subfiles, '');
		868	end
		869	else menuIdExit := -99;
733	daniel-mar	870
735	daniel-mar	871	for i := 0 to ListCount(oid^.SubIds)-1 do
733	daniel-mar	872	begin
735	daniel-mar	873	sTmp := ListGetElement(oid^.SubIds, i);
744	daniel-mar	874	subfile := FileIdPart(sTmp) + OID_EXTENSION;
740	daniel-mar	875	if FileExists(subfile) then
		876	begin
		877	CreateOidDef(tmpOID);
744	daniel-mar	878	if not _ReadOidFile(subfile, tmpOID, true) then
		879	begin
		880	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (READ ERROR)');
		881	ListAppend(subfiles, 'ERROR: Read error at file '+subfile+', or file is invalid.');
		882	end
745	daniel-mar	883	else if (tmpOID^.ParentFileId <> oid^.FileId) or
		884	(tmpOID^.ParentDotNotation <> oid^.DotNotation) then
744	daniel-mar	885	begin
		886	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (BAD BACKREF)');
		887	ListAppend(subfiles, 'ERROR: File '+subfile+' has a wrong back-reference.');
		888	end
743	daniel-mar	889	else
744	daniel-mar	890	begin
		891	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + _ShowASNIds(tmpOID));
		892	ListAppend(subfiles, subfile);
		893	end;
740	daniel-mar	894	FreeOidDef(tmpOID);
		895	end
		896	else
		897	begin
		898	ListAppend(subsel, 'Go to child ' + DotNotationPart(sTmp) + ' (FILE NOT FOUND)');
744	daniel-mar	899	ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740	daniel-mar	900	end;
733	daniel-mar	901	end;
		902
735	daniel-mar	903	if oid^.DotNotation <> '' then
733	daniel-mar	904	begin
748	daniel-mar	905	menuIdAsnEdit := ListAppend(subsel, 'View/Edit ASN.1 identifiers');
735	daniel-mar	906	ListAppend(subfiles, '');
		907	end
		908	else menuIdAsnEdit := -99;
733	daniel-mar	909
748	daniel-mar	910	if oid^.DotNotation <> '' then
		911	begin
749	daniel-mar	912	menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels (OID-IRI)');
748	daniel-mar	913	ListAppend(subfiles, '');
		914	end
		915	else menuIdIriEdit := -99;
		916
735	daniel-mar	917	menuIdDescEdit := ListAppend(subsel, 'Edit description');
		918	ListAppend(subfiles, '');
733	daniel-mar	919
735	daniel-mar	920	menuIdAdd := ListAppend(subsel, 'Add child');
		921	ListAppend(subfiles, '');
733	daniel-mar	922
		923	if not isRoot then
		924	begin
735	daniel-mar	925	menuIdDelete := ListAppend(subsel, 'Delete OID');
		926	ListAppend(subfiles, '');
		927	end
		928	else menuIdDelete := -99;
733	daniel-mar	929
734	daniel-mar	930	(* Show menu *)
		931
748	daniel-mar	932	menuX := WhereX + 1;
		933	menuY := ScreenHeight - ACTIONMENU_SIZE - 1;
733	daniel-mar	934	subselres := DrawSelectionList(menuX, menuY,
		935	ScreenWidth-2,
735	daniel-mar	936	ACTIONMENU_SIZE,
733	daniel-mar	937	subsel,
		938	true,
		939	'SELECT ACTION',
		940	1);
734	daniel-mar	941
		942	(* Process user selection *)
		943
733	daniel-mar	944	if subselres = -1 then
		945	begin
735	daniel-mar	946	exitRequest := true;
733	daniel-mar	947	end
735	daniel-mar	948	else if subselres = menuIdAsnEdit then
733	daniel-mar	949	begin
735	daniel-mar	950	if AsnEditor(oid) then
743	daniel-mar	951	_WriteOidFile(filename, oid, true);
735	daniel-mar	952	end
748	daniel-mar	953	else if subselres = menuIdIriEdit then
		954	begin
		955	if IriEditor(oid) then
		956	_WriteOidFile(filename, oid, true);
		957	end
735	daniel-mar	958	else if subselres = menuIdDescEdit then
		959	begin
		960	if DescEditor(oid) then
743	daniel-mar	961	_WriteOidFile(filename, oid, true);
735	daniel-mar	962	end
		963	else if subselres = menuIdAdd then
		964	begin
		965	if NewOidEditor(oid) then
743	daniel-mar	966	_WriteOidFile(filename, oid, true);
735	daniel-mar	967	end
		968	else if subselres = menuIdDelete then
		969	begin
		970	if _DeleteConfirmation then
733	daniel-mar	971	begin
745	daniel-mar	972	sTmp := oid^.ParentFileId + OID_EXTENSION;
735	daniel-mar	973	DeleteOidRecursive(oid);
740	daniel-mar	974	if FileExists(sTmp) then
		975	begin
		976	filename := sTmp;
		977	end
		978	else
		979	begin
744	daniel-mar	980	ShowMessage('Parent file ' + sTmp + ' was not found', 'ERROR', true);
740	daniel-mar	981	_Pause;
		982	exitRequest := true;
		983	end;
733	daniel-mar	984	end;
735	daniel-mar	985	end
		986	else if subselres = menuIdExit then
		987	begin
		988	exitRequest := true;
		989	end
		990	else
		991	begin
		992	(* Normal OID *)
744	daniel-mar	993	(* Above we already checked if the files are valild and existing *)
740	daniel-mar	994	sTmp := ListGetElement(subfiles, subselres);
744	daniel-mar	995	if Copy(sTmp, 1, Length('ERROR: ')) = 'ERROR: ' then
740	daniel-mar	996	begin
744	daniel-mar	997	Delete(sTmp, 1, Length('ERROR: '));
		998	ShowMessage(sTmp, 'ERROR', true);
		999	_Pause;
740	daniel-mar	1000	end
		1001	else
		1002	begin
744	daniel-mar	1003	filename := sTmp;
740	daniel-mar	1004	end;
733	daniel-mar	1005	end;
		1006	FreeList(subsel);
		1007	FreeList(subfiles);
		1008
735	daniel-mar	1009	FreeOidDef(oid);
		1010	until exitRequest;
733	daniel-mar	1011	end;
		1012
743	daniel-mar	1013	function CreateRootOIDFile(filename: string; ShowErrorMessage: boolean): boolean;
733	daniel-mar	1014	var
735	daniel-mar	1015	oid: POID;
733	daniel-mar	1016	begin
735	daniel-mar	1017	CreateOidDef(oid);
745	daniel-mar	1018	oid^.Description := 'This is the root of the OID tree.' +#13#10 +
		1019	#13#10 +
		1020	'Valid subsequent arcs are per definition:' + #13#10 +
		1021	'- 0 (itu-t)' + #13#10 +
		1022	'- 1 (iso)' + #13#10 +
		1023	'- 2 (joint-iso-itu-t)';
		1024	oid^.FileId := ZeroPad(0, 8);
		1025	oid^.DotNotation := '';
		1026	oid^.ParentFileId := ZeroPad(0, 8);
		1027	oid^.ParentDotNotation := '';
743	daniel-mar	1028	CreateRootOIDFile := _WriteOidFile(filename, oid, ShowErrorMessage);
735	daniel-mar	1029	FreeOidDef(oid);
733	daniel-mar	1030	end;
		1031
742	daniel-mar	1032	function _GetRootFile(ShowErrorMessage: boolean): string;
735	daniel-mar	1033	var
742	daniel-mar	1034	rootFile: string;
733	daniel-mar	1035	begin
744	daniel-mar	1036	rootFile := ZeroPad(0, 8) + OID_EXTENSION;
743	daniel-mar	1037	_GetRootFile := rootFile;
742	daniel-mar	1038	if not FileExists(rootFile) then
733	daniel-mar	1039	begin
743	daniel-mar	1040	if not CreateRootOIDFile(rootFile, ShowErrorMessage) then
742	daniel-mar	1041	begin
743	daniel-mar	1042	_GetRootFile := '';
742	daniel-mar	1043	end;
		1044	end;
733	daniel-mar	1045	end;
		1046
740	daniel-mar	1047	procedure OP_ManageOIDs;
742	daniel-mar	1048	var
		1049	rootfile: string;
740	daniel-mar	1050	begin
		1051	ClrScr;
		1052	DrawTitleBar('Manage Object Identifiers', TITLEBAR_LEFT_TEXT, '');
		1053	DrawStatusBar('Loading data... please wait...');
		1054
742	daniel-mar	1055	(* This will try creating a new root file if it does not exist *)
		1056	rootfile := _GetRootFile(true);
		1057	if rootfile = '' then Exit;
		1058
		1059	DisplayOIDFile(rootfile);
740	daniel-mar	1060	end;
		1061
733	daniel-mar	1062	procedure OP_ReturnToMSDOS;
		1063	begin
747	daniel-mar	1064	(* Note: These two lines don't seem to be necessary if you use DoneVideo *)
		1065	ResetDefaultDosColors;
746	daniel-mar	1066	ClrScr; (Important, so that the DOS command prompt is also LightGray )
		1067
741	daniel-mar	1068	WriteLn('Thank you for using OIDplus for DOS.');
743	daniel-mar	1069	WriteLn('');
733	daniel-mar	1070	end;
		1071
741	daniel-mar	1072	function _GetTreeViewLine(oid: POID; indent: integer): string;
740	daniel-mar	1073	var
		1074	i: integer;
747	daniel-mar	1075	sTmp, sTmp2: string;
740	daniel-mar	1076	begin
		1077	(* Build line *)
		1078	sTmp := RepeatStr(' ', indent*TREEVIEW_INDENT);
		1079	if oid^.DotNotation = '' then
		1080	sTmp := sTmp + 'Object Identifiers'
		1081	else
		1082	sTmp := sTmp + oid^.DotNotation;
		1083	sTmp := sTmp + _ShowAsnIds(oid);
		1084	if TREEVIEW_INCLUDE_DESC then
		1085	begin
		1086	if Trim(oid^.Description) <> '' then
		1087	begin
		1088	sTmp := sTmp + ': ' + oid^.Description;
		1089	end;
		1090	end;
747	daniel-mar	1091
		1092	sTmp := StringReplace(sTmp, #13#10, ' ');
		1093	repeat
		1094	sTmp2 := sTmp;
		1095	sTmp := StringReplace(sTmp, ' ', ' ');
		1096	until sTmp = sTmp2;
		1097
744	daniel-mar	1098	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
741	daniel-mar	1099	_GetTreeViewLine := sTmp;
740	daniel-mar	1100	end;
		1101
758	daniel-mar	1102	procedure _RecTreeExport(oid: POID; visList, targetList: PStringList; indent: integer);
740	daniel-mar	1103	var
		1104	i: integer;
		1105	sTmp: string;
		1106	suboid: POID;
		1107	childFilename: string;
		1108	begin
741	daniel-mar	1109	sTmp := _GetTreeViewLine(oid, indent);
740	daniel-mar	1110	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1111	ListAppend(visList, sTmp);
		1112	ListAppend(targetList, oid^.FileID);
740	daniel-mar	1113
		1114	(* Recursively call children *)
		1115	for i := 0 to ListCount(oid^.SubIds)-1 do
		1116	begin
		1117	sTmp := ListGetElement(oid^.SubIds, i);
		1118	CreateOidDef(suboid);
744	daniel-mar	1119	childFilename := FileIdPart(sTmp) + OID_EXTENSION;
743	daniel-mar	1120	if not FileExists(childFilename) then
740	daniel-mar	1121	begin
744	daniel-mar	1122	sTmp := 'ERROR: MISSING ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
743	daniel-mar	1123	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1124	ListAppend(visList, sTmp);
		1125	ListAppend(targetList, 'ERROR');
740	daniel-mar	1126	end
743	daniel-mar	1127	else if not _ReadOidFile(childFilename, suboid, false) then
740	daniel-mar	1128	begin
744	daniel-mar	1129	sTmp := 'ERROR: READ ERROR AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
740	daniel-mar	1130	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1131	ListAppend(visList, sTmp);
		1132	ListAppend(targetList, 'ERROR');
743	daniel-mar	1133	end
745	daniel-mar	1134	else if (suboid^.ParentFileId <> oid^.FileId) or
		1135	(suboid^.ParentDotNotation <> oid^.DotNotation) then
744	daniel-mar	1136	begin
		1137	(* This can happen if a file is missing, and then another OID gets this filename since the number seems to be free *)
		1138	sTmp := 'ERROR: BAD BACKREF AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
		1139	sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758	daniel-mar	1140	ListAppend(visList, sTmp);
		1141	ListAppend(targetList, 'ERROR');
744	daniel-mar	1142	end
743	daniel-mar	1143	else
		1144	begin
758	daniel-mar	1145	_RecTreeExport(suboid, visList, targetList, indent+1);
743	daniel-mar	1146	FreeOidDef(suboid);
		1147	end
740	daniel-mar	1148	end;
		1149	end;
		1150
758	daniel-mar	1151	procedure TreeViewPreview(visList, targetList: PStringList);
747	daniel-mar	1152	var
758	daniel-mar	1153	res: integer;
		1154	sTmp: string;
747	daniel-mar	1155	begin
748	daniel-mar	1156	ClrScr;
		1157	DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, TREEVIEW_FILENAME);
758	daniel-mar	1158	DrawStatusBar('Press ESC to return to the main menu. Enter to jump to OID.');
748	daniel-mar	1159
758	daniel-mar	1160	while true do
		1161	begin
		1162	res := DrawSelectionList(2, 3, ScreenWidth-2, ScreenHeight-4,
		1163	visList, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2);
		1164	if res > -1 then
		1165	begin
		1166	(* Jump to selected OID or show error *)
		1167	sTmp := ListGetElement(targetList, res);
		1168	if sTmp = 'ERROR' then
		1169	begin
		1170	ShowMessage(ListGetElement(visList, res), 'ERROR', true);
		1171	_Pause;
		1172	end
		1173	else
		1174	begin
		1175	DisplayOidFile(sTmp + '.OID');
		1176	end;
		1177	end
		1178	else
		1179	begin
		1180	break;
		1181	end;
		1182	end;
747	daniel-mar	1183
749	daniel-mar	1184	DrawStatusBar('');
747	daniel-mar	1185	end;
		1186
740	daniel-mar	1187	procedure OP_TreeView;
		1188	var
		1189	F: Text;
		1190	rootoid: POID;
742	daniel-mar	1191	rootfile: string;
743	daniel-mar	1192	res: boolean;
758	daniel-mar	1193	visList, targetList: PStringList;
740	daniel-mar	1194	begin
		1195	ClrScr;
		1196	DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, '');
		1197	DrawStatusBar('Exporting data... please wait...');
		1198
742	daniel-mar	1199	(* This will try creating a new root file if it does not exist *)
743	daniel-mar	1200	rootfile := _GetRootFile(true);
		1201	if rootfile = '' then
		1202	begin
749	daniel-mar	1203	DrawStatusBar('');
743	daniel-mar	1204	Exit;
		1205	end;
742	daniel-mar	1206
758	daniel-mar	1207	CreateList(visList);
		1208	CreateList(targetList);
		1209
		1210	(* First check if the disk is read-only *)
744	daniel-mar	1211	Assign(F, TREEVIEW_FILENAME);
743	daniel-mar	1212	{$I-}
740	daniel-mar	1213	Rewrite(F);
743	daniel-mar	1214	{$I+}
		1215	if IoResult <> 0 then
		1216	begin
		1217	(* Can happen if disk is read-only (Runtime Error 150) *)
744	daniel-mar	1218	ShowMessage('Cannot open '+TREEVIEW_FILENAME+' for writing.', 'ERROR', true);
743	daniel-mar	1219	_Pause;
749	daniel-mar	1220	DrawStatusBar('');
743	daniel-mar	1221	Exit;
		1222	end;
758	daniel-mar	1223	Close(F);
740	daniel-mar	1224
758	daniel-mar	1225	(* Now do the export *)
743	daniel-mar	1226	res := false;
740	daniel-mar	1227	CreateOidDef(rootoid);
743	daniel-mar	1228	if _ReadOidFile(rootfile, rootoid, true) then
		1229	begin
758	daniel-mar	1230	_RecTreeExport(rootoid, visList, targetList, 0);
743	daniel-mar	1231	res := true;
		1232	end;
740	daniel-mar	1233	FreeOidDef(rootoid);
		1234
758	daniel-mar	1235	(* Save the list (visual part only) *)
		1236	ListSaveToFile(visList, TREEVIEW_FILENAME);
743	daniel-mar	1237
749	daniel-mar	1238	DrawStatusBar('');
743	daniel-mar	1239	if res then
		1240	begin
744	daniel-mar	1241	ShowMessage('TreeView successfully exported as '+TREEVIEW_FILENAME, 'TREEVIEW EXPORT', true);
743	daniel-mar	1242	_Pause;
		1243	end;
747	daniel-mar	1244
758	daniel-mar	1245	TreeViewPreview(visList, targetList);
		1246
		1247	FreeList(visList);
		1248	FreeList(targetList);
740	daniel-mar	1249	end;
		1250
733	daniel-mar	1251	procedure OP_MainMenu;
		1252	var
		1253	menu: PStringList;
		1254	menuRes, menuLeft, menuTop: integer;
747	daniel-mar	1255	menuIdOID, menuIdTree, menuIdExit: integer;
733	daniel-mar	1256	begin
		1257	repeat
		1258	ClrScr;
		1259
738	daniel-mar	1260	DrawTitleBar('Welcome to OIDplus for DOS', '', '');
749	daniel-mar	1261	DrawStatusBar('(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.');
733	daniel-mar	1262	GoToXY(ScreenWidth-Length(VERSIONINFO), ScreenHeight-1);
		1263	Write(VERSIONINFO);
		1264
735	daniel-mar	1265	CreateList(menu);
		1266
		1267	menuIdOID := ListAppend(menu, 'Manage OIDs');
740	daniel-mar	1268	menuIdTree := ListAppend(menu, 'Export TreeView');
735	daniel-mar	1269	menuIdExit := ListAppend(menu, 'Return to DOS');
		1270
		1271	menuLeft := round(ScreenWidth/2 -MAINMENU_WIDTH/2);
		1272	menuTop := round(ScreenHeight/2-MAINMENU_HEIGHT/2);
		1273	menuRes := DrawSelectionList(menuLeft, menuTop,
		1274	MAINMENU_WIDTH, MAINMENU_HEIGHT,
		1275	menu, true, 'MAIN MENU', 2);
733	daniel-mar	1276	FreeList(menu);
		1277
735	daniel-mar	1278	if menuRes = menuIdOID then
733	daniel-mar	1279	begin
		1280	OP_ManageOIDs;
735	daniel-mar	1281	end
740	daniel-mar	1282	else if menuRes = menuIdTree then
		1283	begin
		1284	OP_Treeview;
733	daniel-mar	1285	end;
735	daniel-mar	1286	until (menuRes = menuIdExit) or (MAINMENU_ALLOW_ESC and (menuRes = -1));
733	daniel-mar	1287
		1288	OP_ReturnToMSDOS;
		1289	end;
		1290
		1291	begin
746	daniel-mar	1292	InitVideo; (* sets ScreenWidth and ScreenHeight *)
		1293	CursorOff;
733	daniel-mar	1294	OP_MainMenu;
747	daniel-mar	1295	CursorOn;
746	daniel-mar	1296	DoneVideo;
733	daniel-mar	1297	end.

Subversion Repositories oidplus

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