Subversion Repositories oidplus

Rev

Rev 992 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
733 daniel-mar 1
program OIDPLUS;
2
 
3
(************************************************)
4
(* OIDPLUS.PAS                                  *)
5
(* Author:   Daniel Marschall                   *)
995 daniel-mar 6
(* Revision: 2022-10-11                         *)
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;
995 daniel-mar 420
  iId, imax: LongInt;
733 daniel-mar 421
  sId: string;
422
begin
744 daniel-mar 423
  FindFirst(RepeatStr('?',8)+OID_EXTENSION, Archive, DirInfo);
995 daniel-mar 424
  imax := -1;
733 daniel-mar 425
  while DosError = 0 do
426
  begin
427
    sId := Copy(DirInfo.Name, 1, 8);
995 daniel-mar 428
    if IsPositiveIntegerOrZero(sId) then
429
    begin
430
      iId := StrToInt(sId);
431
      if iId > iMax then iMax := iId;
432
    end;
733 daniel-mar 433
    FindNext(DirInfo);
434
  end;
995 daniel-mar 435
  NextPossibleFileId := ZeroPad(iMax+1, 8);
733 daniel-mar 436
end;
437
 
749 daniel-mar 438
function NumIdAlreadyExisting(parentOID: POID; arcval: string): boolean;
733 daniel-mar 439
var
440
  searchDotNotation: string;
441
  sTmp: string;
442
  i: integer;
443
begin
444
  if parentOID^.DotNotation = '' then
749 daniel-mar 445
    searchDotNotation := arcval
733 daniel-mar 446
  else
749 daniel-mar 447
    searchDotNotation := parentOID^.DotNotation + '.' + arcval;
733 daniel-mar 448
  for i := 0 to ListCount(parentOID^.SubIds)-1 do
449
  begin
450
    sTmp := ListGetElement(parentOID^.SubIds, i);
735 daniel-mar 451
    if DotNotationPart(sTmp) = searchDotNotation then
733 daniel-mar 452
    begin
453
      NumIdAlreadyExisting := true;
454
      exit;
455
    end;
456
  end;
457
  NumIdAlreadyExisting := false;
458
end;
459
 
460
function NumIdEditor(oid: POID; parentOID: POID): boolean;
461
var
462
  sInput: string;
749 daniel-mar 463
  title: string;
464
  base36mode: boolean;
465
  arcval: string;
733 daniel-mar 466
begin
467
  NumIdEditor := false;
468
  sInput := '';
469
 
749 daniel-mar 470
  base36mode := false;
746 daniel-mar 471
  CursorOn;
733 daniel-mar 472
  repeat
749 daniel-mar 473
    if base36mode then
474
    begin
475
      DrawStatusBar('Press ESC to cancel');
476
      title := 'ENTER BASE36 ID'
477
    end
478
    else
479
    begin
480
      DrawStatusBar('Enter "WEID" to enter a Base36 instead of Base10; press ESC to cancel');
481
      title := 'ENTER NUMERIC ID';
482
    end;
733 daniel-mar 483
    if QueryVal(sInput,
484
                SINGLE_LINE_BOX_PADDING_INNER,
485
                ScreenHeight div 2,
486
                ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2,
487
                1,
749 daniel-mar 488
                title,
733 daniel-mar 489
                2) then
490
    begin
491
      if sInput = '' then continue;
749 daniel-mar 492
      if not base36mode and (sInput = 'WEID') then
733 daniel-mar 493
      begin
749 daniel-mar 494
        sInput := '';
495
        base36mode := true;
733 daniel-mar 496
      end
749 daniel-mar 497
      else if not base36mode and not IsPositiveIntegerOrZero(sInput) then
733 daniel-mar 498
      begin
749 daniel-mar 499
        ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true);
733 daniel-mar 500
        _Pause;
501
      end
749 daniel-mar 502
      else if base36mode and not IsBase36String(sInput) then
733 daniel-mar 503
      begin
749 daniel-mar 504
        ShowMessage('Invalid base36 ID (must be 0..9, A..Z)', 'ERROR', true);
733 daniel-mar 505
        _Pause;
506
      end
507
      else
508
      begin
749 daniel-mar 509
        if base36mode then
510
          arcval := base_convert_bigint(sInput, 36, 10)
733 daniel-mar 511
        else
749 daniel-mar 512
          arcval := sInput;
513
        arcval := StripLeadingZeros(arcval);
514
 
515
        if (parentOID^.DotNotation='') and (arcval <> '0') and (arcval <> '1') and (arcval <> '2') then
516
        begin
517
          ShowMessage('Invalid numeric ID (root arc can only be 0, 1, or 2)', 'ERROR', true);
518
          _Pause;
519
        end
520
        else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and
521
                ((Length(arcval)>2) or (StrToInt(arcval) > 39)) then
522
        begin
523
          ShowMessage('Invalid numeric ID (root 0 and 1 must have sub-arc of 0..39)', 'ERROR', true);
524
          _Pause;
525
        end
526
        else if NumIdAlreadyExisting(parentOID, arcval) then
527
        begin
528
          ShowMessage('This numeric ID is already used in this arc', 'ERROR', true);
529
          _Pause;
530
        end
531
        else
532
        begin
533
          if parentOID^.DotNotation = '' then
534
            oid^.DotNotation := arcval
535
          else
536
            oid^.DotNotation := parentOID^.DotNotation + '.' + arcval;
537
          NumIdEditor := true; (* request caller to save <oid> *)
538
          Break;
539
        end;
733 daniel-mar 540
      end;
541
    end
542
    else
543
    begin
749 daniel-mar 544
      (* User pressed ESC *)
746 daniel-mar 545
      Break;
733 daniel-mar 546
    end;
547
  until false;
746 daniel-mar 548
  CursorOff;
733 daniel-mar 549
end;
550
 
551
function NewOidEditor(oid: POID): boolean;
552
var
553
  newfilename: string;
735 daniel-mar 554
  newOID: POID;
733 daniel-mar 555
begin
556
  NewOidEditor := false;
557
 
735 daniel-mar 558
  CreateOidDef(newOID);
559
  newOID^.FileId := NextPossibleFileID;
745 daniel-mar 560
  newOID^.ParentFileId := oid^.FileId;
561
  newOID^.ParentDotNotation := oid^.DotNotation;
735 daniel-mar 562
  if NumIdEditor(newOID, oid) and
563
     AsnEditor(newOID) and
748 daniel-mar 564
     IriEditor(newOID) and
735 daniel-mar 565
     DescEditor(newOID) then
734 daniel-mar 566
  begin
744 daniel-mar 567
    newfilename := newOID^.FileId + OID_EXTENSION;
743 daniel-mar 568
    if _WriteOidFile(newfilename, newOID, true) then
569
    begin
570
      (* Add link to original file and enable the saving of it *)
571
      ListAppend(oid^.SubIds, newOID^.FileId + newOID^.DotNotation);
572
      NewOidEditor := true; (* request caller to save <oid> *)
573
    end;
734 daniel-mar 574
  end;
735 daniel-mar 575
  FreeOidDef(newOID);
733 daniel-mar 576
end;
577
 
578
procedure DeleteChildrenRecursive(oid: POID);
579
var
580
  i: integer;
735 daniel-mar 581
  childOID: POID;
733 daniel-mar 582
  filenameChild: string;
583
begin
584
  for i := 0 to ListCount(oid^.SubIds)-1 do
585
  begin
744 daniel-mar 586
    filenameChild := FileIdPart(ListGetElement(oid^.SubIds, i)) + OID_EXTENSION;
740 daniel-mar 587
    if FileExists(filenameChild) then
588
    begin
589
      CreateOidDef(childOID);
744 daniel-mar 590
      if _ReadOidFile(filenameChild, childOID, false) and
745 daniel-mar 591
         (childOID^.ParentFileId = oid^.FileId) and
592
         (childOID^.ParentDotNotation = oid^.DotNotation) then
743 daniel-mar 593
      begin
594
        DeleteChildrenRecursive(childOID);
595
      end;
740 daniel-mar 596
      FreeOidDef(childOID);
597
      DeleteFile(filenameChild);
598
    end;
733 daniel-mar 599
  end;
600
  ListClear(oid^.SubIds);
601
end;
602
 
603
procedure DeleteOidRecursive(selfOID: POID);
604
var
605
  i: integer;
735 daniel-mar 606
  parentOID: POID;
733 daniel-mar 607
  filenameSelf, filenameParent: string;
608
begin
609
  (* Remove all children and their files recursively *)
610
  DeleteChildrenRecursive(selfOID);
611
 
612
  (* Remove forward reference in parent OID *)
743 daniel-mar 613
  (* (this is the most important part)      *)
745 daniel-mar 614
  filenameParent := selfOID^.ParentFileId + OID_EXTENSION;
740 daniel-mar 615
  if FileExists(filenameParent) then
733 daniel-mar 616
  begin
740 daniel-mar 617
    CreateOidDef(parentOID);
743 daniel-mar 618
    if _ReadOidFile(filenameParent, parentOID, true) then
740 daniel-mar 619
    begin
743 daniel-mar 620
      if ListDeleteElementByValue(parentOID^.SubIds, selfOID^.FileId + selfOID^.DotNotation) then
621
      begin
622
        _WriteOidFile(filenameParent, parentOID, true);
623
      end;
740 daniel-mar 624
    end;
625
    FreeOidDef(parentOID);
733 daniel-mar 626
  end;
627
 
628
  (* Delete own file *)
744 daniel-mar 629
  filenameSelf := selfOID^.FileId + OID_EXTENSION;
740 daniel-mar 630
  if FileExists(filenameSelf) then
631
  begin
632
    DeleteFile(filenameSelf);
633
  end;
733 daniel-mar 634
end;
635
 
735 daniel-mar 636
function _DeleteConfirmation: boolean;
637
var
638
  sc: Char;
639
begin
640
  repeat
641
    ShowMessage('Are you sure you want to delete this OID? (Y/N)', 'DELETE OID', true);
737 daniel-mar 642
    DrawStatusBar('Y=Yes, N=No');
735 daniel-mar 643
 
746 daniel-mar 644
    CursorOn;
735 daniel-mar 645
    sc := ReadKey;
746 daniel-mar 646
    CursorOff;
735 daniel-mar 647
    if sc = #0 then
648
    begin
649
      (* Extended key. Nothing we care about. *)
650
      ReadKey;
651
      continue;
652
    end;
653
 
654
    if UpCase(sc) = 'Y' then
655
    begin
656
      _DeleteConfirmation := true;
657
      break;
737 daniel-mar 658
    end
659
    else if UpCase(sc) = 'N' then
735 daniel-mar 660
    begin
661
      _DeleteConfirmation := false;
662
      break;
663
    end;
664
  until false;
665
end;
666
 
737 daniel-mar 667
procedure _DrawOidTitleBar(filename: string; oid: POID);
668
begin
669
  if oid^.DotNotation = '' then
738 daniel-mar 670
    DrawTitleBar('OID ROOT', TITLEBAR_LEFT_TEXT, filename)
737 daniel-mar 671
  else
738 daniel-mar 672
    DrawTitleBar('OID ' + oid^.DotNotation, TITLEBAR_LEFT_TEXT, filename);
737 daniel-mar 673
end;
674
 
748 daniel-mar 675
function DotNotation(oid: POid): string;
676
var
677
  res: string;
678
begin
679
  res := oid^.DotNotation;
680
  if res = '' then res := '.'; (* root *)
681
  DotNotation := res;
682
end;
683
 
684
function OidLastArc(oid: POid): string;
685
var
686
  s: string;
687
  p: integer;
688
begin
689
  s := oid^.DotNotation;
690
 
691
  while true do
692
  begin
693
    p := Pos('.', s);
694
    if p = 0 then break;
695
    Delete(s, 1, p);
696
  end;
697
 
698
  OidLastArc := s;
699
end;
700
 
701
function AsnNotation(oid: POid): string;
702
var
703
  prevOid, curOid: POid;
704
  res: string;
705
begin
706
  CreateOidDef(curOid);
707
  prevOid := oid;
708
  res := '';
709
 
710
  while true do
711
  begin
712
    (* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
713
    ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
714
    if curOid^.ParentFileId = '' then break;
715
    if curOid^.ParentFileId = curOid^.FileId then break;
716
    if ListCount(curOid^.AsnIds) > 0 then
717
      res := ListGetElement(curOid^.AsnIds, 0) + '('+OidLastArc(curOid)+') ' + res
718
    else
719
      res := OidLastArc(curOid) + ' ' + res;
720
    prevOid := curOid;
721
  end;
722
  FreeOidDef(curOid);
723
  if ListCount(oid^.AsnIds) > 0 then
724
    res := res + ListGetElement(oid^.AsnIds, 0) + '('+OidLastArc(oid)+')'
725
  else
726
    res := res + OidLastArc(oid);
727
  if res = '' then
728
    AsnNotation := ''
729
  else
730
    AsnNotation := '{ ' + res + ' }';
731
end;
732
 
733
function IriNotation(oid: POid): string;
734
var
735
  prevOid, curOid: POid;
736
  res: string;
737
begin
738
  CreateOidDef(curOid);
739
  prevOid := oid;
740
  res := '';
741
 
742
  while true do
743
  begin
744
    (* Note: BackRef is not checked yet! Infinite loop is possible! (TODO) *)
745
    ReadOidFile(prevOid^.ParentFileId + '.OID', curOid);
746
    if curOid^.ParentFileId = '' then break;
747
    if curOid^.ParentFileId = curOid^.FileId then break;
748
    if ListCount(curOid^.UnicodeLabels) > 0 then
749
      res := ListGetElement(curOid^.UnicodeLabels, 0) + '/' + res
750
    else
751
      res := OidLastArc(curOid) + '/' + res;
752
    prevOid := curOid;
753
  end;
754
  FreeOidDef(curOid);
755
  if ListCount(oid^.UnicodeLabels) > 0 then
756
    res := res + ListGetElement(oid^.UnicodeLabels, 0)
757
  else
758
    res := res + OidLastArc(oid);
759
  IriNotation := '/' + res;
760
end;
761
 
762
function WeidNotation(oid: POid): string;
763
begin
764
  WeidNotation := OidToWeid(oid^.DotNotation);
765
end;
766
 
965 daniel-mar 767
procedure DisplayOIDFile(filename, from: string);
733 daniel-mar 768
var
769
  isRoot: boolean;
740 daniel-mar 770
  oid, tmpOID: POID;
748 daniel-mar 771
  i: integer;
733 daniel-mar 772
  sTmp, subfile: string;
773
  subsel, subfiles: PStringList;
774
  subselres: integer;
735 daniel-mar 775
  exitRequest: boolean;
748 daniel-mar 776
  menuIdExit, menuIdAsnEdit, menuIdIriEdit, menuIdDescEdit, menuIdAdd, menuIdDelete: integer;
777
  menuX, menuY: integer;
733 daniel-mar 778
begin
735 daniel-mar 779
  exitRequest := false;
733 daniel-mar 780
  repeat
743 daniel-mar 781
    CreateOidDef(oid);
782
 
783
    if not _ReadOidFile(filename, oid, true) then
740 daniel-mar 784
    begin
743 daniel-mar 785
      FreeOidDef(oid);
740 daniel-mar 786
      exit;
787
    end;
788
 
733 daniel-mar 789
    (* Print OID information *)
790
 
791
    ClrScr;
737 daniel-mar 792
    _DrawOidTitleBar(filename, oid);
749 daniel-mar 793
    DrawStatusBar('');
733 daniel-mar 794
    GotoXY(1,2);
795
 
749 daniel-mar 796
    Write('Dot notation:   ');
797
    WriteLnKeepX(DotNotation(oid));
798
    Write('ASN.1 notation: ');
799
    WriteLnKeepX(AsnNotation(oid));
800
    Write('OID-IRI:        ');
801
    WriteLnKeepX(IriNotation(oid));
802
    Write('WEID notation:  ');
803
    WriteLnKeepX(WeidNotation(oid));
804
    WriteLn('');
733 daniel-mar 805
 
735 daniel-mar 806
    if Trim(oid^.Description) <> '' then
733 daniel-mar 807
    begin
748 daniel-mar 808
      (* WriteLn('Description:'); *)
992 daniel-mar 809
      (* TODO: We should avoid that this is more than 10 lines *)
735 daniel-mar 810
      WriteLn(oid^.Description);
733 daniel-mar 811
      WriteLn('');
748 daniel-mar 812
    end
813
    else
733 daniel-mar 814
    begin
748 daniel-mar 815
      WriteLn('(No description has been added to this OID.)');
816
      WriteLn('');
733 daniel-mar 817
    end;
818
 
819
    (* Now prepare the menu entries *)
820
 
744 daniel-mar 821
    CreateList(subsel);   (* Contains the human-readable OID name *)
737 daniel-mar 822
    CreateList(subfiles); (* Contains the file name               *)
733 daniel-mar 823
 
745 daniel-mar 824
    if oid^.ParentFileId = '' then
733 daniel-mar 825
    begin
826
      isRoot := true;
827
    end
828
    else
829
    begin
745 daniel-mar 830
      isRoot := oid^.ParentDotNotation = oid^.DotNotation;
733 daniel-mar 831
    end;
832
 
745 daniel-mar 833
    if (oid^.ParentFileId <> '') and not isRoot then
733 daniel-mar 834
    begin
745 daniel-mar 835
      subfile := oid^.ParentFileId + OID_EXTENSION;
740 daniel-mar 836
      if FileExists(subfile) then
837
      begin
838
        CreateOidDef(tmpOID);
744 daniel-mar 839
        if not _ReadOidFile(subfile, tmpOID, true) then
840
        begin
745 daniel-mar 841
          ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (READ ERROR)');
744 daniel-mar 842
          ListAppend(subfiles, 'ERROR: '+subfile+' Read error or file invalid');
843
        end
743 daniel-mar 844
        else
744 daniel-mar 845
        begin
745 daniel-mar 846
          ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + _ShowASNIds(tmpOID));
744 daniel-mar 847
          ListAppend(subfiles, subfile);
848
        end;
740 daniel-mar 849
        FreeOidDef(tmpOID);
850
      end
851
      else
852
      begin
745 daniel-mar 853
        ListAppend(subsel, 'Go to parent ' + oid^.ParentDotNotation + ' (FILE NOT FOUND)');
744 daniel-mar 854
        ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740 daniel-mar 855
      end;
733 daniel-mar 856
    end;
857
 
858
    if isRoot then
859
    begin
965 daniel-mar 860
      menuIdExit := ListAppend(subsel, 'Back to '+from);
735 daniel-mar 861
      ListAppend(subfiles, '');
862
    end
863
    else menuIdExit := -99;
733 daniel-mar 864
 
735 daniel-mar 865
    for i := 0 to ListCount(oid^.SubIds)-1 do
733 daniel-mar 866
    begin
735 daniel-mar 867
      sTmp := ListGetElement(oid^.SubIds, i);
744 daniel-mar 868
      subfile := FileIdPart(sTmp) + OID_EXTENSION;
740 daniel-mar 869
      if FileExists(subfile) then
870
      begin
871
        CreateOidDef(tmpOID);
744 daniel-mar 872
        if not _ReadOidFile(subfile, tmpOID, true) then
873
        begin
874
          ListAppend(subsel, 'Go to child  ' + DotNotationPart(sTmp) + ' (READ ERROR)');
875
          ListAppend(subfiles, 'ERROR: Read error at file '+subfile+', or file is invalid.');
876
        end
745 daniel-mar 877
        else if (tmpOID^.ParentFileId <> oid^.FileId) or
878
                (tmpOID^.ParentDotNotation <> oid^.DotNotation) then
744 daniel-mar 879
        begin
880
          ListAppend(subsel, 'Go to child  ' + DotNotationPart(sTmp) + ' (BAD BACKREF)');
881
          ListAppend(subfiles, 'ERROR: File '+subfile+' has a wrong back-reference.');
882
        end
743 daniel-mar 883
        else
744 daniel-mar 884
        begin
885
          ListAppend(subsel, 'Go to child  ' + DotNotationPart(sTmp) + _ShowASNIds(tmpOID));
886
          ListAppend(subfiles, subfile);
887
        end;
740 daniel-mar 888
        FreeOidDef(tmpOID);
889
      end
890
      else
891
      begin
892
        ListAppend(subsel, 'Go to child  ' + DotNotationPart(sTmp) + ' (FILE NOT FOUND)');
744 daniel-mar 893
        ListAppend(subfiles, 'ERROR: File '+subfile+' was not found');
740 daniel-mar 894
      end;
733 daniel-mar 895
    end;
896
 
735 daniel-mar 897
    if oid^.DotNotation <> '' then
733 daniel-mar 898
    begin
748 daniel-mar 899
      menuIdAsnEdit := ListAppend(subsel, 'View/Edit ASN.1 identifiers');
735 daniel-mar 900
      ListAppend(subfiles, '');
901
    end
902
    else menuIdAsnEdit := -99;
733 daniel-mar 903
 
748 daniel-mar 904
    if oid^.DotNotation <> '' then
905
    begin
749 daniel-mar 906
      menuIdIriEdit := ListAppend(subsel, 'View/Edit Unicode Labels (OID-IRI)');
748 daniel-mar 907
      ListAppend(subfiles, '');
908
    end
909
    else menuIdIriEdit := -99;
910
 
735 daniel-mar 911
    menuIdDescEdit := ListAppend(subsel, 'Edit description');
912
    ListAppend(subfiles, '');
733 daniel-mar 913
 
735 daniel-mar 914
    menuIdAdd := ListAppend(subsel, 'Add child');
915
    ListAppend(subfiles, '');
733 daniel-mar 916
 
917
    if not isRoot then
918
    begin
735 daniel-mar 919
      menuIdDelete := ListAppend(subsel, 'Delete OID');
920
      ListAppend(subfiles, '');
921
    end
922
    else menuIdDelete := -99;
733 daniel-mar 923
 
734 daniel-mar 924
    (* Show menu *)
925
 
748 daniel-mar 926
    menuX := WhereX + 1;
927
    menuY := ScreenHeight - ACTIONMENU_SIZE - 1;
733 daniel-mar 928
    subselres := DrawSelectionList(menuX, menuY,
929
                                   ScreenWidth-2,
735 daniel-mar 930
                                   ACTIONMENU_SIZE,
733 daniel-mar 931
                                   subsel,
932
                                   true,
933
                                   'SELECT ACTION',
934
                                   1);
734 daniel-mar 935
 
936
    (* Process user selection *)
937
 
733 daniel-mar 938
    if subselres = -1 then
939
    begin
735 daniel-mar 940
      exitRequest := true;
733 daniel-mar 941
    end
735 daniel-mar 942
    else if subselres = menuIdAsnEdit then
733 daniel-mar 943
    begin
735 daniel-mar 944
      if AsnEditor(oid) then
743 daniel-mar 945
        _WriteOidFile(filename, oid, true);
735 daniel-mar 946
    end
748 daniel-mar 947
    else if subselres = menuIdIriEdit then
948
    begin
949
      if IriEditor(oid) then
950
        _WriteOidFile(filename, oid, true);
951
    end
735 daniel-mar 952
    else if subselres = menuIdDescEdit then
953
    begin
954
      if DescEditor(oid) then
743 daniel-mar 955
        _WriteOidFile(filename, oid, true);
735 daniel-mar 956
    end
957
    else if subselres = menuIdAdd then
958
    begin
959
      if NewOidEditor(oid) then
743 daniel-mar 960
        _WriteOidFile(filename, oid, true);
735 daniel-mar 961
    end
962
    else if subselres = menuIdDelete then
963
    begin
964
      if _DeleteConfirmation then
733 daniel-mar 965
      begin
745 daniel-mar 966
        sTmp := oid^.ParentFileId + OID_EXTENSION;
735 daniel-mar 967
        DeleteOidRecursive(oid);
740 daniel-mar 968
        if FileExists(sTmp) then
969
        begin
970
          filename := sTmp;
971
        end
972
        else
973
        begin
744 daniel-mar 974
          ShowMessage('Parent file ' + sTmp + ' was not found', 'ERROR', true);
740 daniel-mar 975
          _Pause;
976
          exitRequest := true;
977
        end;
733 daniel-mar 978
      end;
735 daniel-mar 979
    end
980
    else if subselres = menuIdExit then
981
    begin
982
      exitRequest := true;
983
    end
984
    else
985
    begin
986
      (* Normal OID *)
744 daniel-mar 987
      (* Above we already checked if the files are valild and existing *)
740 daniel-mar 988
      sTmp := ListGetElement(subfiles, subselres);
744 daniel-mar 989
      if Copy(sTmp, 1, Length('ERROR: ')) = 'ERROR: ' then
740 daniel-mar 990
      begin
744 daniel-mar 991
        Delete(sTmp, 1, Length('ERROR: '));
992
        ShowMessage(sTmp, 'ERROR', true);
993
        _Pause;
740 daniel-mar 994
      end
995
      else
996
      begin
744 daniel-mar 997
        filename := sTmp;
740 daniel-mar 998
      end;
733 daniel-mar 999
    end;
1000
    FreeList(subsel);
1001
    FreeList(subfiles);
1002
 
735 daniel-mar 1003
    FreeOidDef(oid);
1004
  until exitRequest;
733 daniel-mar 1005
end;
1006
 
743 daniel-mar 1007
function CreateRootOIDFile(filename: string; ShowErrorMessage: boolean): boolean;
733 daniel-mar 1008
var
735 daniel-mar 1009
  oid: POID;
733 daniel-mar 1010
begin
735 daniel-mar 1011
  CreateOidDef(oid);
745 daniel-mar 1012
  oid^.Description  := 'This is the root of the OID tree.' +#13#10 +
1013
                       #13#10 +
1014
                       'Valid subsequent arcs are per definition:' + #13#10 +
1015
                       '- 0 (itu-t)' + #13#10 +
1016
                       '- 1 (iso)' + #13#10 +
1017
                       '- 2 (joint-iso-itu-t)';
1018
  oid^.FileId       := ZeroPad(0, 8);
1019
  oid^.DotNotation  := '';
1020
  oid^.ParentFileId := ZeroPad(0, 8);
1021
  oid^.ParentDotNotation := '';
743 daniel-mar 1022
  CreateRootOIDFile := _WriteOidFile(filename, oid, ShowErrorMessage);
735 daniel-mar 1023
  FreeOidDef(oid);
733 daniel-mar 1024
end;
1025
 
742 daniel-mar 1026
function _GetRootFile(ShowErrorMessage: boolean): string;
735 daniel-mar 1027
var
742 daniel-mar 1028
  rootFile: string;
733 daniel-mar 1029
begin
744 daniel-mar 1030
  rootFile := ZeroPad(0, 8) + OID_EXTENSION;
743 daniel-mar 1031
  _GetRootFile := rootFile;
742 daniel-mar 1032
  if not FileExists(rootFile) then
733 daniel-mar 1033
  begin
743 daniel-mar 1034
    if not CreateRootOIDFile(rootFile, ShowErrorMessage) then
742 daniel-mar 1035
    begin
743 daniel-mar 1036
      _GetRootFile := '';
742 daniel-mar 1037
    end;
1038
  end;
733 daniel-mar 1039
end;
1040
 
740 daniel-mar 1041
procedure OP_ManageOIDs;
742 daniel-mar 1042
var
1043
  rootfile: string;
740 daniel-mar 1044
begin
1045
  ClrScr;
1046
  DrawTitleBar('Manage Object Identifiers', TITLEBAR_LEFT_TEXT, '');
1047
  DrawStatusBar('Loading data... please wait...');
1048
 
742 daniel-mar 1049
  (* This will try creating a new root file if it does not exist *)
1050
  rootfile := _GetRootFile(true);
1051
  if rootfile = '' then Exit;
1052
 
965 daniel-mar 1053
  DisplayOIDFile(rootfile, 'main menu');
740 daniel-mar 1054
end;
1055
 
733 daniel-mar 1056
procedure OP_ReturnToMSDOS;
1057
begin
747 daniel-mar 1058
  (* Note: These two lines don't seem to be necessary if you use DoneVideo *)
1059
  ResetDefaultDosColors;
746 daniel-mar 1060
  ClrScr; (*Important, so that the DOS command prompt is also LightGray *)
1061
 
741 daniel-mar 1062
  WriteLn('Thank you for using OIDplus for DOS.');
743 daniel-mar 1063
  WriteLn('');
733 daniel-mar 1064
end;
1065
 
741 daniel-mar 1066
function _GetTreeViewLine(oid: POID; indent: integer): string;
740 daniel-mar 1067
var
1068
  i: integer;
747 daniel-mar 1069
  sTmp, sTmp2: string;
740 daniel-mar 1070
begin
1071
  (* Build line *)
1072
  sTmp := RepeatStr(' ', indent*TREEVIEW_INDENT);
1073
  if oid^.DotNotation = '' then
1074
    sTmp := sTmp + 'Object Identifiers'
1075
  else
1076
    sTmp := sTmp + oid^.DotNotation;
1077
  sTmp := sTmp + _ShowAsnIds(oid);
1078
  if TREEVIEW_INCLUDE_DESC then
1079
  begin
1080
    if Trim(oid^.Description) <> '' then
1081
    begin
1082
      sTmp := sTmp + ': ' + oid^.Description;
1083
    end;
1084
  end;
747 daniel-mar 1085
 
1086
  sTmp := StringReplace(sTmp, #13#10, ' ');
1087
  repeat
1088
    sTmp2 := sTmp;
1089
    sTmp := StringReplace(sTmp, '  ', ' ');
1090
  until sTmp = sTmp2;
1091
 
744 daniel-mar 1092
  sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
741 daniel-mar 1093
  _GetTreeViewLine := sTmp;
740 daniel-mar 1094
end;
1095
 
758 daniel-mar 1096
procedure _RecTreeExport(oid: POID; visList, targetList: PStringList; indent: integer);
740 daniel-mar 1097
var
1098
  i: integer;
1099
  sTmp: string;
1100
  suboid: POID;
1101
  childFilename: string;
1102
begin
741 daniel-mar 1103
  sTmp := _GetTreeViewLine(oid, indent);
740 daniel-mar 1104
  sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758 daniel-mar 1105
  ListAppend(visList, sTmp);
1106
  ListAppend(targetList, oid^.FileID);
740 daniel-mar 1107
 
1108
  (* Recursively call children *)
1109
  for i := 0 to ListCount(oid^.SubIds)-1 do
1110
  begin
1111
    sTmp := ListGetElement(oid^.SubIds, i);
1112
    CreateOidDef(suboid);
744 daniel-mar 1113
    childFilename := FileIdPart(sTmp) + OID_EXTENSION;
743 daniel-mar 1114
    if not FileExists(childFilename) then
740 daniel-mar 1115
    begin
744 daniel-mar 1116
      sTmp := 'ERROR: MISSING ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
743 daniel-mar 1117
      sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758 daniel-mar 1118
      ListAppend(visList, sTmp);
1119
      ListAppend(targetList, 'ERROR');
740 daniel-mar 1120
    end
743 daniel-mar 1121
    else if not _ReadOidFile(childFilename, suboid, false) then
740 daniel-mar 1122
    begin
744 daniel-mar 1123
      sTmp := 'ERROR: READ ERROR AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
740 daniel-mar 1124
      sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758 daniel-mar 1125
      ListAppend(visList, sTmp);
1126
      ListAppend(targetList, 'ERROR');
743 daniel-mar 1127
    end
745 daniel-mar 1128
    else if (suboid^.ParentFileId <> oid^.FileId) or
1129
            (suboid^.ParentDotNotation <> oid^.DotNotation) then
744 daniel-mar 1130
    begin
1131
      (* This can happen if a file is missing, and then another OID gets this filename since the number seems to be free *)
1132
      sTmp := 'ERROR: BAD BACKREF AT ' + childFilename + ' (SHALL CONTAIN ' + DotNotationPart(sTmp) + ')!';
1133
      sTmp := TrimLineToWidth(sTmp, TREEVIEW_WIDTH);
758 daniel-mar 1134
      ListAppend(visList, sTmp);
1135
      ListAppend(targetList, 'ERROR');
744 daniel-mar 1136
    end
743 daniel-mar 1137
    else
1138
    begin
758 daniel-mar 1139
      _RecTreeExport(suboid, visList, targetList, indent+1);
743 daniel-mar 1140
      FreeOidDef(suboid);
1141
    end
740 daniel-mar 1142
  end;
1143
end;
1144
 
758 daniel-mar 1145
procedure TreeViewPreview(visList, targetList: PStringList);
747 daniel-mar 1146
var
758 daniel-mar 1147
  res: integer;
1148
  sTmp: string;
747 daniel-mar 1149
begin
748 daniel-mar 1150
  ClrScr;
1151
  DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, TREEVIEW_FILENAME);
758 daniel-mar 1152
  DrawStatusBar('Press ESC to return to the main menu. Enter to jump to OID.');
748 daniel-mar 1153
 
758 daniel-mar 1154
  while true do
1155
  begin
1156
    res := DrawSelectionList(2, 3, ScreenWidth-2, ScreenHeight-4,
1157
                             visList, true, 'PREVIEW OF '+TREEVIEW_FILENAME, 2);
1158
    if res > -1 then
1159
    begin
1160
      (* Jump to selected OID or show error *)
1161
      sTmp := ListGetElement(targetList, res);
1162
      if sTmp = 'ERROR' then
1163
      begin
1164
        ShowMessage(ListGetElement(visList, res), 'ERROR', true);
1165
        _Pause;
1166
      end
1167
      else
1168
      begin
965 daniel-mar 1169
        DisplayOidFile(sTmp + '.OID', 'TreeView Export');
758 daniel-mar 1170
      end;
1171
    end
1172
    else
1173
    begin
1174
      break;
1175
    end;
1176
  end;
747 daniel-mar 1177
 
749 daniel-mar 1178
  DrawStatusBar('');
747 daniel-mar 1179
end;
1180
 
740 daniel-mar 1181
procedure OP_TreeView;
1182
var
1183
  F: Text;
1184
  rootoid: POID;
742 daniel-mar 1185
  rootfile: string;
743 daniel-mar 1186
  res: boolean;
758 daniel-mar 1187
  visList, targetList: PStringList;
740 daniel-mar 1188
begin
1189
  ClrScr;
1190
  DrawTitleBar('TreeView Export', TITLEBAR_LEFT_TEXT, '');
1191
  DrawStatusBar('Exporting data... please wait...');
1192
 
742 daniel-mar 1193
  (* This will try creating a new root file if it does not exist *)
743 daniel-mar 1194
  rootfile := _GetRootFile(true);
1195
  if rootfile = '' then
1196
  begin
749 daniel-mar 1197
    DrawStatusBar('');
743 daniel-mar 1198
    Exit;
1199
  end;
742 daniel-mar 1200
 
758 daniel-mar 1201
  CreateList(visList);
1202
  CreateList(targetList);
1203
 
1204
  (* First check if the disk is read-only *)
744 daniel-mar 1205
  Assign(F, TREEVIEW_FILENAME);
743 daniel-mar 1206
  {$I-}
740 daniel-mar 1207
  Rewrite(F);
743 daniel-mar 1208
  {$I+}
1209
  if IoResult <> 0 then
1210
  begin
1211
    (* Can happen if disk is read-only (Runtime Error 150) *)
744 daniel-mar 1212
    ShowMessage('Cannot open '+TREEVIEW_FILENAME+' for writing.', 'ERROR', true);
743 daniel-mar 1213
    _Pause;
749 daniel-mar 1214
    DrawStatusBar('');
743 daniel-mar 1215
    Exit;
1216
  end;
758 daniel-mar 1217
  Close(F);
740 daniel-mar 1218
 
758 daniel-mar 1219
  (* Now do the export *)
743 daniel-mar 1220
  res := false;
740 daniel-mar 1221
  CreateOidDef(rootoid);
743 daniel-mar 1222
  if _ReadOidFile(rootfile, rootoid, true) then
1223
  begin
758 daniel-mar 1224
    _RecTreeExport(rootoid, visList, targetList, 0);
743 daniel-mar 1225
    res := true;
1226
  end;
740 daniel-mar 1227
  FreeOidDef(rootoid);
1228
 
758 daniel-mar 1229
  (* Save the list (visual part only) *)
1230
  ListSaveToFile(visList, TREEVIEW_FILENAME);
743 daniel-mar 1231
 
749 daniel-mar 1232
  DrawStatusBar('');
743 daniel-mar 1233
  if res then
1234
  begin
744 daniel-mar 1235
    ShowMessage('TreeView successfully exported as '+TREEVIEW_FILENAME, 'TREEVIEW EXPORT', true);
743 daniel-mar 1236
    _Pause;
1237
  end;
747 daniel-mar 1238
 
758 daniel-mar 1239
  TreeViewPreview(visList, targetList);
1240
 
1241
  FreeList(visList);
1242
  FreeList(targetList);
740 daniel-mar 1243
end;
1244
 
733 daniel-mar 1245
procedure OP_MainMenu;
1246
var
1247
  menu: PStringList;
1248
  menuRes, menuLeft, menuTop: integer;
747 daniel-mar 1249
  menuIdOID, menuIdTree, menuIdExit: integer;
733 daniel-mar 1250
begin
1251
  repeat
1252
    ClrScr;
1253
 
738 daniel-mar 1254
    DrawTitleBar('Welcome to OIDplus for DOS', '', '');
749 daniel-mar 1255
    DrawStatusBar('(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.');
733 daniel-mar 1256
    GoToXY(ScreenWidth-Length(VERSIONINFO), ScreenHeight-1);
1257
    Write(VERSIONINFO);
1258
 
735 daniel-mar 1259
    CreateList(menu);
1260
 
1261
    menuIdOID  := ListAppend(menu, 'Manage OIDs');
740 daniel-mar 1262
    menuIdTree := ListAppend(menu, 'Export TreeView');
735 daniel-mar 1263
    menuIdExit := ListAppend(menu, 'Return to DOS');
1264
 
1265
    menuLeft := round(ScreenWidth/2 -MAINMENU_WIDTH/2);
1266
    menuTop  := round(ScreenHeight/2-MAINMENU_HEIGHT/2);
1267
    menuRes  := DrawSelectionList(menuLeft, menuTop,
1268
                                  MAINMENU_WIDTH, MAINMENU_HEIGHT,
1269
                                  menu, true, 'MAIN MENU', 2);
733 daniel-mar 1270
    FreeList(menu);
1271
 
735 daniel-mar 1272
    if menuRes = menuIdOID then
733 daniel-mar 1273
    begin
1274
      OP_ManageOIDs;
735 daniel-mar 1275
    end
740 daniel-mar 1276
    else if menuRes = menuIdTree then
1277
    begin
1278
      OP_Treeview;
733 daniel-mar 1279
    end;
735 daniel-mar 1280
  until (menuRes = menuIdExit) or (MAINMENU_ALLOW_ESC and (menuRes = -1));
733 daniel-mar 1281
 
1282
  OP_ReturnToMSDOS;
1283
end;
1284
 
1285
begin
746 daniel-mar 1286
  InitVideo; (* sets ScreenWidth and ScreenHeight *)
1287
  CursorOff;
733 daniel-mar 1288
  OP_MainMenu;
747 daniel-mar 1289
  CursorOn;
746 daniel-mar 1290
  DoneVideo;
733 daniel-mar 1291
end.