| /trunk_dos/LICENSE |
|---|
| 0,0 → 1,202 |
| Apache License |
| Version 2.0, January 2004 |
| http://www.apache.org/licenses/ |
| TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION |
| 1. Definitions. |
| "License" shall mean the terms and conditions for use, reproduction, |
| and distribution as defined by Sections 1 through 9 of this document. |
| "Licensor" shall mean the copyright owner or entity authorized by |
| the copyright owner that is granting the License. |
| "Legal Entity" shall mean the union of the acting entity and all |
| other entities that control, are controlled by, or are under common |
| control with that entity. For the purposes of this definition, |
| "control" means (i) the power, direct or indirect, to cause the |
| direction or management of such entity, whether by contract or |
| otherwise, or (ii) ownership of fifty percent (50%) or more of the |
| outstanding shares, or (iii) beneficial ownership of such entity. |
| "You" (or "Your") shall mean an individual or Legal Entity |
| exercising permissions granted by this License. |
| "Source" form shall mean the preferred form for making modifications, |
| including but not limited to software source code, documentation |
| source, and configuration files. |
| "Object" form shall mean any form resulting from mechanical |
| transformation or translation of a Source form, including but |
| not limited to compiled object code, generated documentation, |
| and conversions to other media types. |
| "Work" shall mean the work of authorship, whether in Source or |
| Object form, made available under the License, as indicated by a |
| copyright notice that is included in or attached to the work |
| (an example is provided in the Appendix below). |
| "Derivative Works" shall mean any work, whether in Source or Object |
| form, that is based on (or derived from) the Work and for which the |
| editorial revisions, annotations, elaborations, or other modifications |
| represent, as a whole, an original work of authorship. For the purposes |
| of this License, Derivative Works shall not include works that remain |
| separable from, or merely link (or bind by name) to the interfaces of, |
| the Work and Derivative Works thereof. |
| "Contribution" shall mean any work of authorship, including |
| the original version of the Work and any modifications or additions |
| to that Work or Derivative Works thereof, that is intentionally |
| submitted to Licensor for inclusion in the Work by the copyright owner |
| or by an individual or Legal Entity authorized to submit on behalf of |
| the copyright owner. For the purposes of this definition, "submitted" |
| means any form of electronic, verbal, or written communication sent |
| to the Licensor or its representatives, including but not limited to |
| communication on electronic mailing lists, source code control systems, |
| and issue tracking systems that are managed by, or on behalf of, the |
| Licensor for the purpose of discussing and improving the Work, but |
| excluding communication that is conspicuously marked or otherwise |
| designated in writing by the copyright owner as "Not a Contribution." |
| "Contributor" shall mean Licensor and any individual or Legal Entity |
| on behalf of whom a Contribution has been received by Licensor and |
| subsequently incorporated within the Work. |
| 2. Grant of Copyright License. Subject to the terms and conditions of |
| this License, each Contributor hereby grants to You a perpetual, |
| worldwide, non-exclusive, no-charge, royalty-free, irrevocable |
| copyright license to reproduce, prepare Derivative Works of, |
| publicly display, publicly perform, sublicense, and distribute the |
| Work and such Derivative Works in Source or Object form. |
| 3. Grant of Patent License. Subject to the terms and conditions of |
| this License, each Contributor hereby grants to You a perpetual, |
| worldwide, non-exclusive, no-charge, royalty-free, irrevocable |
| (except as stated in this section) patent license to make, have made, |
| use, offer to sell, sell, import, and otherwise transfer the Work, |
| where such license applies only to those patent claims licensable |
| by such Contributor that are necessarily infringed by their |
| Contribution(s) alone or by combination of their Contribution(s) |
| with the Work to which such Contribution(s) was submitted. If You |
| institute patent litigation against any entity (including a |
| cross-claim or counterclaim in a lawsuit) alleging that the Work |
| or a Contribution incorporated within the Work constitutes direct |
| or contributory patent infringement, then any patent licenses |
| granted to You under this License for that Work shall terminate |
| as of the date such litigation is filed. |
| 4. Redistribution. You may reproduce and distribute copies of the |
| Work or Derivative Works thereof in any medium, with or without |
| modifications, and in Source or Object form, provided that You |
| meet the following conditions: |
| (a) You must give any other recipients of the Work or |
| Derivative Works a copy of this License; and |
| (b) You must cause any modified files to carry prominent notices |
| stating that You changed the files; and |
| (c) You must retain, in the Source form of any Derivative Works |
| that You distribute, all copyright, patent, trademark, and |
| attribution notices from the Source form of the Work, |
| excluding those notices that do not pertain to any part of |
| the Derivative Works; and |
| (d) If the Work includes a "NOTICE" text file as part of its |
| distribution, then any Derivative Works that You distribute must |
| include a readable copy of the attribution notices contained |
| within such NOTICE file, excluding those notices that do not |
| pertain to any part of the Derivative Works, in at least one |
| of the following places: within a NOTICE text file distributed |
| as part of the Derivative Works; within the Source form or |
| documentation, if provided along with the Derivative Works; or, |
| within a display generated by the Derivative Works, if and |
| wherever such third-party notices normally appear. The contents |
| of the NOTICE file are for informational purposes only and |
| do not modify the License. You may add Your own attribution |
| notices within Derivative Works that You distribute, alongside |
| or as an addendum to the NOTICE text from the Work, provided |
| that such additional attribution notices cannot be construed |
| as modifying the License. |
| You may add Your own copyright statement to Your modifications and |
| may provide additional or different license terms and conditions |
| for use, reproduction, or distribution of Your modifications, or |
| for any such Derivative Works as a whole, provided Your use, |
| reproduction, and distribution of the Work otherwise complies with |
| the conditions stated in this License. |
| 5. Submission of Contributions. Unless You explicitly state otherwise, |
| any Contribution intentionally submitted for inclusion in the Work |
| by You to the Licensor shall be under the terms and conditions of |
| this License, without any additional terms or conditions. |
| Notwithstanding the above, nothing herein shall supersede or modify |
| the terms of any separate license agreement you may have executed |
| with Licensor regarding such Contributions. |
| 6. Trademarks. This License does not grant permission to use the trade |
| names, trademarks, service marks, or product names of the Licensor, |
| except as required for reasonable and customary use in describing the |
| origin of the Work and reproducing the content of the NOTICE file. |
| 7. Disclaimer of Warranty. Unless required by applicable law or |
| agreed to in writing, Licensor provides the Work (and each |
| Contributor provides its Contributions) on an "AS IS" BASIS, |
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or |
| implied, including, without limitation, any warranties or conditions |
| of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A |
| PARTICULAR PURPOSE. You are solely responsible for determining the |
| appropriateness of using or redistributing the Work and assume any |
| risks associated with Your exercise of permissions under this License. |
| 8. Limitation of Liability. In no event and under no legal theory, |
| whether in tort (including negligence), contract, or otherwise, |
| unless required by applicable law (such as deliberate and grossly |
| negligent acts) or agreed to in writing, shall any Contributor be |
| liable to You for damages, including any direct, indirect, special, |
| incidental, or consequential damages of any character arising as a |
| result of this License or out of the use or inability to use the |
| Work (including but not limited to damages for loss of goodwill, |
| work stoppage, computer failure or malfunction, or any and all |
| other commercial damages or losses), even if such Contributor |
| has been advised of the possibility of such damages. |
| 9. Accepting Warranty or Additional Liability. While redistributing |
| the Work or Derivative Works thereof, You may choose to offer, |
| and charge a fee for, acceptance of support, warranty, indemnity, |
| or other liability obligations and/or rights consistent with this |
| License. However, in accepting such obligations, You may act only |
| on Your own behalf and on Your sole responsibility, not on behalf |
| of any other Contributor, and only if You agree to indemnify, |
| defend, and hold each Contributor harmless for any liability |
| incurred by, or claims asserted against, such Contributor by reason |
| of your accepting any such warranty or additional liability. |
| END OF TERMS AND CONDITIONS |
| APPENDIX: How to apply the Apache License to your work. |
| To apply the Apache License to your work, attach the following |
| boilerplate notice, with the fields enclosed by brackets "[]" |
| replaced with your own identifying information. (Don't include |
| the brackets!) The text should be enclosed in the appropriate |
| comment syntax for the file format. We also recommend that a |
| file or class name and description of purpose be included on the |
| same "printed page" as the copyright notice for easier |
| identification within third-party archives. |
| Copyright 2018 Daniel Marschall, ViaThinkSoft |
| Licensed under the Apache License, Version 2.0 (the "License"); |
| you may not use this file except in compliance with the License. |
| You may obtain a copy of the License at |
| http://www.apache.org/licenses/LICENSE-2.0 |
| Unless required by applicable law or agreed to in writing, software |
| distributed under the License is distributed on an "AS IS" BASIS, |
| WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| See the License for the specific language governing permissions and |
| limitations under the License. |
| /trunk_dos/LISTTEST.PAS |
|---|
| 0,0 → 1,52 |
| program LISTTEST; |
| (************************************************) |
| (* LISTTEST.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2020-09-09 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - Example how to use lists and selection CUI *) |
| (************************************************) |
| uses |
| Crt, StrList, VtsCui; |
| var |
| items: PStringList; |
| i, itemIndex: integer; |
| sTmp: string; |
| begin |
| InitList(items); |
| (* Fill the list for testing *) |
| for i := 1 to 5 do |
| begin |
| str(i, sTmp); |
| ListAppend(items, 'list item '+sTmp); |
| end; |
| (* Do inserts and deletions to test their functionality *) |
| ListInsert(items, 'TEST', 0); |
| ListDeleteElement(items, 0); |
| ListDeleteElement(items, 0); |
| ListInsert(items, 'FirstElement', 0); |
| (* Test the selection GUI unit *) |
| ClrScr; |
| itemIndex := DrawSelectionList(3, 5, 15, 10, items, true, 0); |
| ClrScr; |
| if itemIndex = -1 then |
| begin |
| WriteLn('Nothing was selected.'); |
| end |
| else |
| begin |
| WriteLn('Following element was selected: "'+ListGetElement(items,itemIndex)+'"'); |
| end; |
| WriteLn('Press RETURN to return to DOS.'); |
| FreeList(items); |
| ReadLn; |
| end. |
| /trunk_dos/OIDFILE.PAS |
|---|
| 0,0 → 1,167 |
| unit OIDFILE; |
| (************************************************) |
| (* OIDFILE.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2022-02-13 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - Functions to handle an OID ASCII format *) |
| (************************************************) |
| interface |
| uses |
| StrList; |
| type |
| POID = ^TOID; |
| TOID = record |
| FileId: string; |
| DotNotation: string; |
| ASNIds: PStringList; |
| Description: string; |
| SubIds: PStringList; |
| Parent: string; |
| end; |
| procedure FreeOidDef(oid: POid); |
| procedure WriteOidFile(filename: string; oid: POid); |
| procedure InitOidDef(oid: POid); |
| procedure ReadOidFile(filename: string; oid: POid); |
| implementation |
| uses |
| VtsFuncs; |
| const |
| WANT_VERS = '2022'; |
| procedure FreeOidDef(oid: POid); |
| begin |
| FreeList(oid^.ASNIds); |
| FreeList(oid^.SubIds); |
| end; |
| procedure WriteOidFile(filename: string; oid: POid); |
| var |
| f: Text; |
| i: integer; |
| lines: PStringList; |
| sTmp: string; |
| desc: string; |
| begin |
| Assign(f, filename); |
| Rewrite(f); |
| WriteLn(f,'VERS' + WANT_VERS); |
| WriteLn(f,'SELF' + oid^.FileId + oid^.DotNotation); |
| WriteLn(f,'SUPR' + oid^.Parent); |
| for i := 0 to ListCount(oid^.SubIds)-1 do |
| begin |
| sTmp := ListGetElement(oid^.SubIds, i); |
| WriteLn(f, 'CHLD' + sTmp); |
| end; |
| for i := 0 to ListCount(oid^.AsnIds)-1 do |
| begin |
| sTmp := ListGetElement(oid^.AsnIds, i); |
| WriteLn(f, 'ASN1' + sTmp); |
| end; |
| desc := Trim(oid^.Description); |
| if desc <> '' then |
| begin |
| InitList(lines); |
| SplitStrToList(desc, lines, #13#10); |
| for i := 0 to ListCount(lines)-1 do |
| begin |
| sTmp := ListGetElement(lines, i); |
| WriteLn(f, 'DESC' + sTmp); |
| end; |
| FreeList(lines); |
| end; |
| Close(f); |
| end; |
| procedure InitOidDef(oid: POid); |
| begin |
| oid^.FileId := ''; |
| oid^.DotNotation := ''; |
| oid^.Description := ''; |
| oid^.Parent := ''; |
| InitList(oid^.ASNIds); |
| InitList(oid^.SubIds); |
| end; |
| procedure ReadOidFile(filename: string; oid: POid); |
| var |
| f: Text; |
| line, cmd: string; |
| version: string; |
| begin |
| FreeOidDef(oid); |
| InitOidDef(oid); |
| version := ''; |
| Assign(f, filename); |
| Reset(f); |
| while not EOF(f) do |
| begin |
| ReadLn(f, line); |
| cmd := Copy(line,1,4); |
| Delete(line,1,4); |
| if cmd = 'VERS' then |
| begin |
| version := line; |
| end; |
| if cmd = 'SELF' then |
| begin |
| oid^.FileId := Copy(line,1,8); |
| Delete(line,1,8); |
| oid^.DotNotation := line; |
| end; |
| if cmd = 'SUPR' then |
| begin |
| oid^.Parent := line; |
| end; |
| if cmd = 'CHLD' then |
| begin |
| ListAppend(oid^.SubIds, line); |
| end; |
| if cmd = 'ASN1' then |
| begin |
| ListAppend(oid^.ASNIds, line); |
| end; |
| if cmd = 'DESC' then |
| begin |
| oid^.Description := oid^.Description + line + #13#10; |
| end; |
| end; |
| (* Remove last CRLF *) |
| oid^.Description := Copy(oid^.Description, 1, Length(oid^.Description)-Length(#13#10)); |
| (* Check if something is not correct *) |
| if (version <> WANT_VERS) or (oid^.FileId = '') then |
| begin |
| (* Invalidate everything *) |
| FreeOidDef(oid); |
| InitOidDef(oid); |
| end; |
| Close(f); |
| end; |
| end. |
| /trunk_dos/OIDPLUS.EXE |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /trunk_dos/OIDPLUS.PAS |
|---|
| 0,0 → 1,724 |
| program OIDPLUS; |
| (************************************************) |
| (* OIDPLUS.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2022-02-13 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - "OIDplus for DOS" program *) |
| (************************************************) |
| uses |
| Dos, Crt, StrList, VtsFuncs, VtsCui, OidFile, OidUtils; |
| const |
| VERSIONINFO = 'Revision: 2022-02-13'; |
| DEFAULT_STATUSBAR = '(C)2020-2022 ViaThinkSoft. Licensed under the terms of the Apache 2.0 license.'; |
| DISKIO_SOUND_DEBUGGING = false; |
| DISKIO_SOUND_DELAY = 500; |
| ASNEDIT_LINES = 10; |
| DESCEDIT_LINES = 10; |
| DESCEDIT_PADDING = 3; |
| procedure _WriteOidFile(filename: string; oid: POid); |
| begin |
| DrawStatusBar('Write file ' + filename + '...'); |
| WriteOidFile(filename, oid); |
| if DISKIO_SOUND_DEBUGGING then |
| begin |
| Sound(70); |
| Delay(DISKIO_SOUND_DELAY - 10); |
| NoSound; |
| Delay(10); |
| end; |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| end; |
| procedure _ReadOidFile(filename: string; oid: POid); |
| begin |
| DrawStatusBar('Read file ' + filename + '...'); |
| ReadOidFile(filename, oid); |
| if DISKIO_SOUND_DEBUGGING then |
| begin |
| Sound(50); |
| Delay(DISKIO_SOUND_DELAY - 10); |
| NoSound; |
| Delay(10); |
| end; |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| end; |
| procedure _Pause; |
| var |
| bakX, bakY: integer; |
| begin |
| bakX := WhereX; |
| bakY := WhereY; |
| DrawStatusBar('Press any key to continue'); |
| GoToXY(bakX, bakY); |
| ReadKey; |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| end; |
| function _ShowASNIds(subfile: string): string; |
| var |
| coid: TOID; |
| j, jmax: integer; |
| sTmp: string; |
| begin |
| sTmp := ''; |
| InitOidDef(@coid); |
| _ReadOidFile(subfile, @coid); |
| jmax := ListCount(coid.ASNIds)-1; |
| for j := 0 to jmax do |
| begin |
| if j = 0 then sTmp := sTmp + ' ('; |
| sTmp := sTmp + ListGetElement(coid.ASNIds, j); |
| if j = jmax then |
| sTmp := sTmp + ')' |
| else |
| sTmp := sTmp + ', '; |
| end; |
| FreeOidDef(@coid); |
| _ShowASNIds := sTmp; |
| end; |
| function AsnAlreadyExisting(oid: POID; asnid: string): boolean; |
| var |
| sTmp: string; |
| i: integer; |
| begin |
| for i := 0 to ListCount(oid^.AsnIds)-1 do |
| begin |
| sTmp := ListGetElement(oid^.AsnIds, i); |
| if sTmp = asnid then |
| begin |
| AsnAlreadyExisting := true; |
| exit; |
| end; |
| end; |
| AsnAlreadyExisting := false; |
| end; |
| function AsnEditor(oid: POID): boolean; |
| var |
| asnList: PStringList; |
| i: integer; |
| x, y, w, h: integer; |
| res: integer; |
| sInput: string; |
| begin |
| AsnEditor := false; |
| repeat |
| InitList(asnList); |
| for i := 0 to ListCount(oid^.ASNIds)-1 do |
| begin |
| ListAppend(asnList, ListGetElement(oid^.ASNIDs, i)); |
| end; |
| ListAppend(asnList, '<NEW>'); |
| ListAppend(asnList, '<SAVE>'); |
| ListAppend(asnList, '<CANCEL>'); |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| x := SINGLE_LINE_BOX_PADDING; |
| y := ScreenHeight div 2 - ASNEDIT_LINES div 2; |
| w := ScreenWidth - (SINGLE_LINE_BOX_PADDING-1)*2; |
| h := ASNEDIT_LINES; |
| res := DrawSelectionList(x, y, w, h, |
| asnList, true, |
| 'EDIT ASN.1 IDENTIFIERS', |
| 2); |
| (* Change double-border to thin-border *) |
| DrawThinBorder(x-1, y-1, w+2, h+2); |
| GoToXY(x+1, y-1); |
| Write('EDIT ASN.1 IDENTIFIERS'); |
| if res = -1 then |
| begin |
| exit; |
| end |
| else if res = ListCount(oid^.ASNIDs) then |
| begin |
| (* "NEW" item was selected *) |
| sInput := ''; |
| repeat |
| if QueryVal(sInput, |
| SINGLE_LINE_BOX_PADDING_INNER, |
| ScreenHeight div 2, |
| ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2, |
| 1, |
| 'ADD SINGLE ASN.1 ID', |
| 2) then |
| begin |
| if sInput = '' then continue; |
| if not ASN1IDValid(sInput) then |
| begin |
| ShowMessage('Invalid ASN1.ID! (Require -, a..z, A..Z, 0..9, begin with a-z)', 'ERROR', true); |
| _Pause; |
| end |
| else if AsnAlreadyExisting(oid, sInput) then |
| begin |
| ShowMessage('ASN.1 identifier is already existing on this arc', 'ERROR', true); |
| _Pause; |
| end |
| else |
| begin |
| ListAppend(oid^.ASNIDs, sInput); |
| break; |
| end; |
| end |
| else break; |
| until false; |
| end |
| else if res = ListCount(oid^.ASNIDs)+1 then |
| begin |
| (* "SAVE" item was selected *) |
| AsnEditor := true; |
| Exit; |
| end |
| else if res = ListCount(oid^.ASNIDs)+2 then |
| begin |
| (* "CANCEL" item was selected *) |
| AsnEditor := false; |
| Exit; |
| end |
| else |
| begin |
| DrawStatusBar('Note: Remove the text to delete the ASN.1 identifier'); |
| sInput := ListGetElement(oid^.ASNIDs, res); |
| repeat |
| if QueryVal(sInput, |
| SINGLE_LINE_BOX_PADDING_INNER, |
| ScreenHeight div 2, |
| ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2, |
| 1, |
| 'EDIT SINGLE ASN.1 ID', |
| 2) then |
| begin |
| if sInput = '' then |
| begin |
| (* Empty input = Delete ASN.1 ID *) |
| ListDeleteElement(oid^.ASNIDs, res); |
| break; |
| end |
| else if not ASN1IDValid(sInput) then |
| begin |
| ShowMessage('Invalid ASN1.ID! (Require -, a..z, A..Z, 0..9, begin with a-z)', 'ERROR', true); |
| _Pause; |
| end |
| else if AsnAlreadyExisting(oid, sInput) and |
| not (ListGetElement(oid^.ASNIDs, res) = sInput) then |
| begin |
| ShowMessage('ASN.1 identifier is already existing on this arc', 'ERROR', true); |
| _Pause; |
| end |
| else |
| begin |
| ListSetElement(oid^.ASNIDs, res, sInput); |
| break; |
| end; |
| end |
| else break; |
| until false; |
| end; |
| until false; |
| end; |
| function DescEditor(oid: POID): boolean; |
| var |
| sInput: string; |
| begin |
| DescEditor := false; |
| DrawStatusBar('Note: Press Ctrl+Return for a line-break.'); |
| sInput := oid^.description; |
| if QueryVal(sInput, |
| DESCEDIT_PADDING, |
| ScreenHeight div 2 - DESCEDIT_LINES div 2, |
| ScreenWidth - (DESCEDIT_PADDING-1)*2, |
| DESCEDIT_LINES, |
| 'EDIT DESCRIPTION', |
| 2) then |
| begin |
| oid^.description := sInput; |
| DescEditor := true; (* enable write file *) |
| end; |
| end; |
| function NextPossibleFileID: string; |
| var |
| DirInfo: SearchRec; |
| list: PStringList; |
| iId: LongInt; |
| sId: string; |
| begin |
| (* Put all found files into a list *) |
| InitList(list); |
| FindFirst('????????.OID', Archive, DirInfo); |
| while DosError = 0 do |
| begin |
| sId := Copy(DirInfo.Name, 1, 8); |
| ListAppend(list, sId); |
| FindNext(DirInfo); |
| end; |
| (* Search for the first non existing item in the list *) |
| sId := ''; |
| for iId := 0 to 99999999 do |
| begin |
| sId := ZeroPad(iId, 8); |
| if not ListContains(list, sId) then break; |
| end; |
| NextPossibleFileId := sId; |
| FreeList(list); |
| end; |
| function NumIdAlreadyExisting(parentOID: POID; sInput: string): boolean; |
| var |
| searchDotNotation: string; |
| sTmp: string; |
| i: integer; |
| begin |
| if parentOID^.DotNotation = '' then |
| searchDotNotation := sInput |
| else |
| searchDotNotation := parentOID^.DotNotation + '.' + sInput; |
| for i := 0 to ListCount(parentOID^.SubIds)-1 do |
| begin |
| sTmp := ListGetElement(parentOID^.SubIds, i); |
| Delete(sTmp, 1, 8); |
| if sTmp = searchDotNotation then |
| begin |
| NumIdAlreadyExisting := true; |
| exit; |
| end; |
| end; |
| NumIdAlreadyExisting := false; |
| end; |
| function NumIdEditor(oid: POID; parentOID: POID): boolean; |
| var |
| sInput: string; |
| begin |
| NumIdEditor := false; |
| sInput := ''; |
| repeat |
| if QueryVal(sInput, |
| SINGLE_LINE_BOX_PADDING_INNER, |
| ScreenHeight div 2, |
| ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2, |
| 1, |
| 'ENTER NUMERIC ID', |
| 2) then |
| begin |
| if sInput = '' then continue; |
| if not IsNumeric(sInput) then |
| begin |
| ShowMessage('Invalid numeric ID (must be a positive integer)', 'ERROR', true); |
| _Pause; |
| end |
| else if (parentOID^.DotNotation='') and (StrToInt(sInput) > 2) then |
| begin |
| ShowMessage('Invalid numeric ID (root arc can only be 0, 1, or 2)', 'ERROR', true); |
| _Pause; |
| end |
| else if ((parentOID^.DotNotation='0') or (parentOID^.DotNotation='1')) and (StrToInt(sInput) > 39) then |
| begin |
| ShowMessage('Invalid numeric ID (root 0 and 1 must have sub-arc of 0..39)', 'ERROR', true); |
| _Pause; |
| end |
| else if NumIdAlreadyExisting(parentOID, sInput) then |
| begin |
| ShowMessage('This numeric ID is already used in this arc', 'ERROR', true); |
| _Pause; |
| end |
| else |
| begin |
| if parentOID^.DotNotation = '' then |
| oid^.DotNotation := sInput |
| else |
| oid^.DotNotation := parentOID^.DotNotation + '.' + sInput; |
| NumIdEditor := true; |
| Exit; |
| end; |
| end |
| else |
| begin |
| Exit; |
| end; |
| until false; |
| end; |
| function NewOidEditor(oid: POID): boolean; |
| var |
| newfilename: string; |
| newoid: TOID; |
| begin |
| NewOidEditor := false; |
| InitOidDef(@newoid); |
| newoid.FileId := NextPossibleFileID; |
| newoid.Parent := oid^.FileId + oid^.DotNotation; |
| if not NumIdEditor(@newoid, oid) then exit; |
| if not AsnEditor(@newoid) then exit; |
| if not DescEditor(@newoid) then exit; |
| newfilename := newoid.FileId + '.OID'; |
| _WriteOidFile(newfilename, @newoid); |
| (* Add link to original file and enable the saving of it *) |
| ListAppend(oid^.SubIds, newoid.FileId + newoid.DotNotation); |
| NewOidEditor := true; |
| end; |
| procedure DeleteChildrenRecursive(oid: POID); |
| var |
| i: integer; |
| childOID: TOID; |
| filenameChild: string; |
| begin |
| for i := 0 to ListCount(oid^.SubIds)-1 do |
| begin |
| filenameChild := Copy(ListGetElement(oid^.SubIds, i), 1, 8) + '.OID'; |
| InitOidDef(@childOID); |
| _ReadOidFile(filenameChild, @childOID); |
| DeleteChildrenRecursive(@childOID); |
| FreeOidDef(@childOID); |
| DeleteFile(filenameChild); |
| end; |
| ListClear(oid^.SubIds); |
| end; |
| procedure DeleteOidRecursive(selfOID: POID); |
| var |
| i: integer; |
| parentOID: TOID; |
| filenameSelf, filenameParent: string; |
| fileIdToDelete: string; |
| begin |
| (* Remove all children and their files recursively *) |
| DeleteChildrenRecursive(selfOID); |
| (* Remove forward reference in parent OID *) |
| filenameParent := Copy(selfOID^.Parent, 1, 8)+'.OID'; |
| InitOidDef(@parentOID); |
| _ReadOidFile(filenameParent, @parentOID); |
| for i := 0 to ListCount(parentOID.SubIds)-1 do |
| begin |
| if Copy(ListGetElement(parentOID.SubIds, i), 1, 8) = selfOID^.FileId then |
| begin |
| ListDeleteElement(parentOID.SubIds, i); |
| _WriteOidFile(filenameParent, @parentOID); |
| break; |
| end; |
| end; |
| FreeOidDef(@parentOID); |
| (* Delete own file *) |
| fileIdToDelete := selfOID^.FileId; |
| filenameSelf := fileIdToDelete+'.OID'; |
| DeleteFile(filenameSelf); |
| end; |
| procedure DisplayOIDFile(filename: string); |
| const |
| ID_EXIT = '?EXIT'; |
| ID_ASNEDIT = '?ASN1'; |
| ID_DESCEDIT = '?DESC'; |
| ID_ADDCHILD = '?ADDC'; |
| ID_DELETE = '?DELE'; |
| NAVBAR_SIZE = 5; |
| var |
| isRoot: boolean; |
| f: Text; |
| line, cmd: string; |
| oid: TOID; |
| i, menuX, menuY: integer; |
| linesLeft, linesRequired: integer; |
| sTmp, subfile: string; |
| sAsn: string; |
| subsel, subfiles: PStringList; |
| subselres: integer; |
| sTmp1: string; |
| begin |
| repeat |
| InitOidDef(@oid); |
| _ReadOidFile(filename, @oid); |
| (* Print OID information *) |
| ClrScr; |
| if oid.DotNotation = '' then |
| DrawTitleBar('OID ROOT') |
| else |
| DrawTitleBar('OID ' + oid.DotNotation); |
| GotoXY(ScreenWidth-Length(filename)+1,1); |
| TextBackground(White); |
| TextColor(Black); |
| WriteLn(filename); |
| TextBackground(Black); |
| TextColor(White); |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| GotoXY(1,2); |
| if oid.DotNotation <> '' then |
| begin |
| WriteLn('Dot-Notation:'); |
| WriteLn(oid.DotNotation); |
| WriteLn(''); |
| end; |
| if Trim(oid.Description) <> '' then |
| begin |
| WriteLn('Description:'); |
| WriteLn(oid.Description); |
| WriteLn(''); |
| end; |
| menuX := WhereX + 1; |
| menuY := ScreenHeight - NAVBAR_SIZE - 1; |
| if ListCount(oid.ASNIDs) > 0 then |
| begin |
| linesLeft := menuY - WhereY - 1; |
| linesRequired := 1 + ListCount(oid.ASNIds); |
| if LinesLeft < LinesRequired then |
| begin |
| (* Compact display of ASN.1 identifiers *) |
| Write('ASN.1-Identifiers: '); |
| for i := 0 to ListCount(oid.ASNIds)-1 do |
| begin |
| if i > 0 then Write(', '); |
| Write(ListGetElement(oid.ASNIds, i)); |
| end; |
| WriteLn(''); |
| end |
| else |
| begin |
| (* Long display of ASN.1 identifiers *) |
| WriteLn('ASN.1-Identifiers:'); |
| for i := 0 to ListCount(oid.ASNIds)-1 do |
| begin |
| WriteLn('- '+ListGetElement(oid.ASNIds, i)); |
| end; |
| WriteLn(''); |
| end; |
| end; |
| (* Now prepare the menu entries *) |
| InitList(subsel); |
| InitList(subfiles); |
| sTmp := oid.Parent; |
| if sTmp = '' then |
| begin |
| isRoot := true; |
| end |
| else |
| begin |
| Delete(sTmp, 1, 8); |
| isRoot := sTmp = oid.DotNotation; |
| end; |
| if (oid.Parent <> '') and not isRoot then |
| begin |
| sTmp := oid.Parent; |
| subfile := Copy(sTmp, 1, 8)+'.OID'; |
| Delete(sTmp, 1, 8); |
| sTmp := sTmp + _ShowASNIds(subfile); |
| ListAppend(subsel, 'Go to parent ' + sTmp); |
| ListAppend(subfiles, subfile); |
| end; |
| if isRoot then |
| begin |
| ListAppend(subsel, 'Back to main menu'); |
| ListAppend(subfiles, ID_EXIT); |
| end; |
| for i := 0 to ListCount(oid.SubIds)-1 do |
| begin |
| sTmp := ListGetElement(oid.SubIds, i); |
| subfile := Copy(sTmp, 1, 8)+'.OID'; |
| Delete(sTmp, 1, 8); |
| sTmp := sTmp + _ShowASNIds(subfile); |
| ListAppend(subsel, 'Go to child ' + sTmp); |
| ListAppend(subfiles, subfile); |
| end; |
| if oid.DotNotation <> '' then |
| begin |
| ListAppend(subsel, 'Edit ASN.1 identifiers'); |
| ListAppend(subfiles, ID_ASNEDIT); |
| end; |
| ListAppend(subsel, 'Edit description'); |
| ListAppend(subfiles, ID_DESCEDIT); |
| ListAppend(subsel, 'Add child'); |
| ListAppend(subfiles, ID_ADDCHILD); |
| if not isRoot then |
| begin |
| ListAppend(subsel, 'Delete OID'); |
| ListAppend(subfiles, ID_DELETE); |
| end; |
| subselres := DrawSelectionList(menuX, menuY, |
| ScreenWidth-2, |
| NAVBAR_SIZE, |
| subsel, |
| true, |
| 'SELECT ACTION', |
| 1); |
| if subselres = -1 then |
| begin |
| exit; |
| end |
| else |
| begin |
| sTmp1 := ListGetElement(subfiles, subselres); |
| if sTmp1 = ID_ASNEDIT then |
| begin |
| if AsnEditor(@oid) then |
| _WriteOidFile(filename, @oid); |
| end |
| else if sTmp1 = ID_DESCEDIT then |
| begin |
| if DescEditor(@oid) then |
| _WriteOidFile(filename, @oid); |
| end |
| else if sTmp1 = ID_ADDCHILD then |
| begin |
| if NewOidEditor(@oid) then |
| begin |
| _WriteOidFile(filename, @oid); |
| end; |
| end |
| else if sTmp1 = ID_DELETE then |
| begin |
| ShowMessage('Are you sure you want to delete this OID?', 'DELETE OID', true); |
| DrawStatusBar('Y = Yes; any other key = No'); |
| if UpCase(ReadKey) = 'Y' then |
| begin |
| filename := Copy(oid.Parent,1,8)+'.OID'; |
| DeleteOidRecursive(@oid); |
| end; |
| end |
| else if sTmp1 = ID_EXIT then |
| begin |
| exit; |
| end |
| else |
| begin |
| filename := sTmp1; |
| end; |
| end; |
| FreeList(subsel); |
| FreeList(subfiles); |
| FreeOidDef(@oid); |
| until false; |
| end; |
| procedure CreateInitOIDFile(filename: string); |
| var |
| oid: TOID; |
| begin |
| InitOidDef(@oid); |
| oid.Description := 'This is the root of the OID tree.' +#13#10 + |
| #13#10 + |
| 'Valid subsequent arcs are per definition:' + #13#10 + |
| '- 0 (itu-t)' + #13#10 + |
| '- 1 (iso)' + #13#10 + |
| '- 2 (joint-iso-itu-t)'; |
| oid.FileId := '00000000'; |
| oid.DotNotation := ''; |
| oid.Parent := '00000000'; |
| _WriteOidFile(filename, @oid); |
| FreeOidDef(@oid); |
| end; |
| procedure OP_ManageOIDs; |
| begin |
| ClrScr; |
| DrawTitleBar('Manage Object Identifiers'); |
| DrawStatusBar(''); |
| if not FileExists('00000000.OID') then |
| begin |
| CreateInitOIDFile('00000000.OID'); |
| end; |
| DisplayOIDFile('00000000.OID'); |
| end; |
| procedure OP_ManageRAs; |
| begin |
| ClrScr; |
| DrawTitleBar('Manage Registration Authorities'); |
| DrawStatusBar(''); |
| (* TODO: Implement "Manage RAs" feature *) |
| ShowMessage('This feature has not yet been implemented!', 'NOTICE', true); |
| _Pause; |
| end; |
| procedure OP_ReturnToMSDOS; |
| begin |
| ClrScr; |
| end; |
| procedure OP_MainMenu; |
| const |
| MenuWidth = 15; |
| MenuHeight = 3; |
| var |
| menu: PStringList; |
| menuRes, menuLeft, menuTop: integer; |
| begin |
| repeat |
| ClrScr; |
| DrawTitleBar('Welcome to OIDplus for DOS'); |
| DrawStatusBar(DEFAULT_STATUSBAR); |
| GoToXY(ScreenWidth-Length(VERSIONINFO), ScreenHeight-1); |
| Write(VERSIONINFO); |
| InitList(menu); |
| ListAppend(menu, 'Manage OIDs'); |
| ListAppend(menu, 'Manage RAs'); |
| ListAppend(menu, 'Return to DOS'); |
| menuLeft := round(ScreenWidth/2 -MenuWidth/2); |
| menuTop := round(ScreenHeight/2-MenuHeight/2); |
| menuRes := DrawSelectionList(menuLeft, menuTop, MenuWidth, MenuHeight, menu, true, 'MAIN MENU', 2); |
| FreeList(menu); |
| if menuRes = 0 then |
| begin |
| OP_ManageOIDs; |
| end; |
| if menuRes = 1 then |
| begin |
| OP_ManageRAs; |
| end; |
| until (menuRes = 2) or (menuRes = -1); |
| OP_ReturnToMSDOS; |
| end; |
| begin |
| OP_MainMenu; |
| end. |
| /trunk_dos/OIDUTILS.PAS |
|---|
| 0,0 → 1,125 |
| unit OIDUTILS; |
| (************************************************) |
| (* OIDUTILS.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2022-02-12 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - Various OID functions *) |
| (************************************************) |
| interface |
| uses |
| StrList; |
| function CompareOIDArcList(a, b: PStringList): integer; |
| function CompareOID(a, b: string): integer; |
| procedure ListBubbleSortOID(list: PStringList); |
| function ASN1IDValid(asn1id: string): boolean; |
| implementation |
| uses |
| VtsFuncs; |
| function CompareOIDArcList(a, b: PStringList): integer; |
| var |
| x, y: PStringList; |
| tmp: integer; |
| begin |
| x := a; |
| y := b; |
| repeat |
| if (x = nil) and (y <> nil) then |
| begin |
| CompareOIDArcList := -1; |
| exit; |
| end; |
| if (x <> nil) and (y = nil) then |
| begin |
| CompareOIDArcList := 1; |
| exit; |
| end; |
| if (x = nil) and (y = nil) then |
| begin |
| CompareOIDArcList := 0; |
| exit; |
| end; |
| tmp := CompareNumericString(x^.element, y^.element); |
| if tmp <> 0 then |
| begin |
| CompareOIDArcList := tmp; |
| exit; |
| end; |
| x := x^.next; |
| y := y^.next; |
| until false; |
| end; |
| function CompareOID(a, b: string): integer; |
| var |
| la, lb: PStringList; |
| begin |
| InitList(la); |
| InitList(lb); |
| OIDtoArcList(a, la); |
| OIDtoArcList(b, lb); |
| CompareOID := CompareOIDArcList(la, lb); |
| end; |
| procedure ListBubbleSortOID(list: PStringList); |
| var |
| n, i: integer; |
| a, b: string; |
| begin |
| n := ListCount(list); |
| while n>1 do |
| begin |
| i := 0; |
| while i<n-1 do |
| begin |
| a := ListGetElement(list, i); |
| b := ListGetElement(list, i+1); |
| if CompareOID(a, b) > 0 then |
| begin |
| ListSwapElement(list, i, i+1); |
| end; |
| Inc(i); |
| end; |
| Dec(n); |
| end; |
| end; |
| function ASN1IDValid(asn1id: string): boolean; |
| var |
| i: integer; |
| lastChar: char; |
| begin |
| (* see Rec. ITU-T X.660 | ISO/IEC 9834-1, clause 7.7 *) |
| (* and Rec. ITU-T X.680 | ISO/IEC 8824-1, clause 12.3 *) |
| ASN1IDValid := false; |
| if Length(asn1id) = 0 then exit; (* may not be empty *) |
| if not (asn1id[1] in ['a'..'z']) then exit; (* first char must be lowercase *) |
| lastChar := #0; |
| for i := 1 to Length(asn1id) do |
| begin |
| if (lastChar = '-') and (asn1id[i] = '-') then exit; (* may not contain '--' *) |
| if not (asn1id[i] in ['a'..'z', 'A'..'Z', '0'..'9', '-']) then exit; |
| lastChar := asn1id[i]; |
| end; |
| if lastChar = '-' then exit; (* may not end with '-' *) |
| ASN1IDValid := true; |
| end; |
| end. |
| /trunk_dos/Readme.md |
|---|
| 0,0 → 1,7 |
| OIDplus for MS-DOS |
| ================== |
| This is a retro-coding product of OIDplus, written in TurboPascal, aiming for DOS. |
| It is just a small gimmick / fun-project and should not be used for productive use! |
| Please use [the official version of OIDplus](https://github.com/danielmarschall/oidplus) |
| /trunk_dos/STRLIST.PAS |
|---|
| 0,0 → 1,279 |
| unit STRLIST; |
| (************************************************) |
| (* STRLIST.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2020-09-11 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - StringList implementation for Turbo Pascal *) |
| (************************************************) |
| interface |
| type |
| PStringList = ^TStringList; |
| TStringList = record |
| init: boolean; |
| element: string; |
| next: PStringList; |
| end; |
| procedure InitList(var list: PStringList); |
| procedure FreeList(list: PStringList); |
| function ListContains(list: PStringList; val: string): boolean; |
| procedure ListClear(list: PStringList); |
| procedure ListAppend(list: PStringList; str: string); |
| function ListCount(list: PStringList): integer; |
| procedure ListDeleteElement(list: PStringlist; idx: integer); |
| function ListGetElement(list: PStringList; idx: integer): string; |
| procedure ListSetElement(list: PStringList; idx: integer; value: string); |
| procedure ListInsert(list: PStringlist; str: string; idx: integer); |
| procedure ListSwapElement(list: PStringList; i, j: integer); |
| procedure SplitStrToList(str: string; list: PStringList; separator: string); |
| procedure OIDtoArcList(oid: string; list: PStringList); |
| procedure ListBubbleSortNumericString(list: PStringList); |
| implementation |
| uses |
| VtsFuncs; |
| procedure InitList(var list: PStringList); |
| begin |
| GetMem(list, SizeOf(TStringList)); |
| list^.init := false; |
| list^.element := ''; |
| list^.next := nil; |
| end; |
| procedure FreeList(list: PStringList); |
| begin |
| if list^.next <> nil then |
| FreeMem(list^.next, SizeOf(TStringList)); |
| FreeMem(list, SizeOf(TStringList)); |
| end; |
| function ListContains(list: PStringList; val: string): boolean; |
| var |
| i: integer; |
| begin |
| ListContains := false; |
| for i := 0 to ListCount(list)-1 do |
| begin |
| if ListGetElement(list, i) = val then |
| begin |
| ListContains := true; |
| break; |
| end; |
| end; |
| end; |
| procedure ListClear(list: PStringList); |
| begin |
| while ListCount(list) > 0 do |
| begin |
| ListDeleteElement(list, 0); |
| end; |
| end; |
| procedure ListAppend(list: PStringList; str: string); |
| var |
| new: PStringList; |
| tmp: PStringList; |
| begin |
| if not list^.init then |
| begin |
| list^.element := str; |
| list^.init := true; |
| end |
| else |
| begin |
| GetMem(new, sizeof(TStringList)); |
| new^.element := str; |
| new^.next := nil; |
| new^.init := true; |
| tmp := list; |
| while tmp^.next <> nil do |
| begin |
| tmp := tmp^.next; |
| end; |
| tmp^.next := new; |
| end; |
| end; |
| function ListCount(list: PStringList): integer; |
| var |
| cnt: integer; |
| tmp: PStringList; |
| begin |
| tmp := list; |
| cnt := 0; |
| if tmp^.init then |
| begin |
| repeat |
| Inc(cnt); |
| tmp := tmp^.next; |
| until tmp = nil; |
| end; |
| ListCount := cnt; |
| end; |
| procedure ListDeleteElement(list: PStringlist; idx: integer); |
| var |
| tmp, tmp2, prev: PStringList; |
| i: integer; |
| begin |
| if idx < 0 then exit; |
| if idx > ListCount(list)-1 then exit; |
| tmp := list; |
| prev := nil; |
| i := 0; |
| while i < idx do |
| begin |
| prev := tmp; |
| tmp := tmp^.next; |
| inc(i); |
| end; |
| if prev = nil then |
| begin |
| if tmp^.next = nil then |
| begin |
| tmp^.init := false; |
| end |
| else |
| begin |
| tmp^.init := true; |
| tmp^.element := tmp^.next^.element; |
| tmp2 := tmp^.next; |
| tmp^.next := tmp^.next^.next; |
| FreeMem(tmp2, SizeOf(TStringList)); |
| end; |
| end |
| else |
| begin |
| prev^.next := tmp^.next; |
| FreeMem(tmp, SizeOf(TStringList)); |
| end; |
| end; |
| function ListGetElement(list: PStringList; idx: integer): string; |
| var |
| tmp: PStringList; |
| i: integer; |
| begin |
| if idx < 0 then exit; |
| if idx > ListCount(list)-1 then exit; |
| tmp := list; |
| i := 0; |
| while i < idx do |
| begin |
| tmp := tmp^.next; |
| inc(i); |
| end; |
| ListGetElement := tmp^.element; |
| end; |
| procedure ListSetElement(list: PStringList; idx: integer; value: string); |
| var |
| tmp: PStringList; |
| i: integer; |
| begin |
| if idx < 0 then exit; |
| if idx > ListCount(list)-1 then exit; |
| tmp := list; |
| i := 0; |
| while i < idx do |
| begin |
| tmp := tmp^.next; |
| inc(i); |
| end; |
| tmp^.element := value; |
| end; |
| procedure ListInsert(list: PStringlist; str: string; idx: integer); |
| var |
| tmp, new: PStringList; |
| i: integer; |
| begin |
| if idx < 0 then exit; |
| if idx > ListCount(list)-1 then exit; |
| tmp := list; |
| i := 0; |
| while i < idx do |
| begin |
| tmp := tmp^.next; |
| inc(i); |
| end; |
| GetMem(new, sizeof(TStringList)); |
| new^.init := true; |
| new^.next := tmp^.next; |
| new^.element := tmp^.element; |
| tmp^.element := str; |
| tmp^.next := new; |
| tmp^.init := true; |
| end; |
| procedure ListSwapElement(list: PStringList; i, j: integer); |
| var |
| a, b: string; |
| begin |
| a := ListGetElement(list, i); |
| b := ListGetElement(list, j); |
| ListSetElement(list, i, b); |
| ListSetElement(list, j, a); |
| end; |
| procedure SplitStrToList(str: string; list: PStringList; separator: string); |
| var |
| p: integer; |
| begin |
| str := str + separator; |
| repeat |
| p := Pos(separator, str); |
| ListAppend(list, Copy(str, 1, p-1)); |
| str := copy(str, p+Length(separator), Length(str)-p); |
| until str = ''; |
| end; |
| procedure OIDtoArcList(oid: string; list: PStringList); |
| begin |
| SplitStrToList(oid, list, '.'); |
| end; |
| procedure ListBubbleSortNumericString(list: PStringList); |
| var |
| n, i: integer; |
| a, b: string; |
| begin |
| n := ListCount(list); |
| while n>1 do |
| begin |
| i := 0; |
| while i<n-1 do |
| begin |
| a := ListGetElement(list, i); |
| b := ListGetElement(list, i+1); |
| if CompareNumericString(a, b) > 0 then |
| begin |
| ListSwapElement(list, i, i+1); |
| end; |
| Inc(i); |
| end; |
| Dec(n); |
| end; |
| end; |
| end. |
| /trunk_dos/TODO.TXT |
|---|
| 0,0 → 1,4 |
| TODO: |
| * see "TODO" entries in the *.pas files |
| * Implement RAs and Create/Update Timestamps |
| /trunk_dos/VTSCUI.PAS |
|---|
| 0,0 → 1,542 |
| unit VTSCUI; |
| (************************************************) |
| (* VTSCUI.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2022-02-12 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - ViaThinkSoft CUI (Console User Interface) *) |
| (************************************************) |
| interface |
| uses |
| StrList; |
| const |
| ScreenWidth = 80; |
| ScreenHeight = 25; |
| SINGLE_LINE_BOX_PADDING = 3; |
| SINGLE_LINE_BOX_PADDING_INNER = 10; |
| procedure DrawThinBorder(x, y, width, height: integer); |
| procedure DrawDoubleBorder(x, y, width, height: integer); |
| procedure DrawTextBar(str: string; line: integer); |
| procedure DrawTitleBar(str: string); |
| procedure DrawStatusBar(str: string); |
| function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
| items: PStringList; allowESC: boolean; |
| Title: string; borderStrength: integer): integer; |
| procedure ClearSection(x, y, width, height: integer); |
| function QueryVal(var s: string; initX, initY, width, height: integer; |
| Title: string; borderStrength: integer): boolean; |
| procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
| implementation |
| uses |
| Crt, Drivers, VtsFuncs; |
| type |
| TCharDefs = array[0..7] of char; |
| const |
| ThinLineChars: TCharDefs = |
| ( #$DA, #$C4, #$BF, |
| #$B3, #$B3, |
| #$C0, #$C4, #$D9 |
| ); |
| DoubleLineChars: TCharDefs = |
| ( #$C9, #$CD, #$BB, |
| #$BA, #$BA, |
| #$C8, #$CD, #$BC |
| ); |
| function FillRight(str: string; len: integer; c: char): string; |
| var |
| s: string; |
| i: integer; |
| begin |
| s := str; |
| for i := Length(str) to len-1 do |
| begin |
| s := s + c; |
| end; |
| FillRight := s; |
| end; |
| procedure DrawBorder(x, y, width, height, thickness: integer); |
| var |
| ix,iy: integer; |
| chars: TCharDefs; |
| begin |
| if thickness = 1 then |
| chars := ThinLineChars; |
| if thickness = 2 then |
| chars := DoubleLineChars; |
| (* Top line *) |
| if y >= 1 then |
| begin |
| (* Top left corner *) |
| if x >= 1 then |
| begin |
| GotoXY(x,y); |
| Write(chars[0]); |
| end |
| else |
| begin |
| GotoXY(1,y); |
| end; |
| (* Top edge *) |
| for ix := 1 to width-2 do |
| Write(chars[1]); |
| (* Top right corner *) |
| if x+width-1 <= ScreenWidth then |
| Write(chars[2]); |
| end; |
| (* Left edge *) |
| for iy := 1 to height-2 do |
| begin |
| if (x >= 1) and (x <= ScreenWidth) and |
| (y+iy >= 1) and (y+iy <= ScreenHeight) then |
| begin |
| GotoXY(x,y+iy); |
| Write(chars[3]); |
| end; |
| end; |
| (* Right edge *) |
| for iy := 1 to height-2 do |
| begin |
| if (x+width-1 >= 1) and (x+width-1 <= ScreenWidth) and |
| (y+iy >= 1) and (y+iy <= ScreenHeight) then |
| begin |
| GotoXY(x+width-1,y+iy); |
| Write(chars[4]); |
| end; |
| end; |
| (* Bottom line *) |
| if y+height-1 <= ScreenHeight then |
| begin |
| (* Bottom left corner *) |
| if x >= 1 then |
| begin |
| GotoXY(x,y+height-1); |
| Write(chars[5]); |
| end |
| else |
| begin |
| GotoXY(1,y+height-1); |
| end; |
| (* Bottom edge *) |
| for ix := 1 to width-2 do |
| Write(chars[6]); |
| (* Bottom right corner *) |
| if x+width-1 <= ScreenWidth then |
| Write(chars[7]); |
| end; |
| end; |
| procedure DrawThinBorder(x, y, width, height: integer); |
| begin |
| DrawBorder(x, y, width, height, 1); |
| end; |
| procedure DrawDoubleBorder(x, y, width, height: integer); |
| begin |
| DrawBorder(x, y, width, height, 2); |
| end; |
| procedure DrawTextBar(str: string; line: integer); |
| var |
| i, left, right: integer; |
| len: integer; |
| begin |
| GotoXY(1,line); |
| TextBackground(White); |
| TextColor(Black); |
| len := Length(str); |
| left := round((ScreenWidth-len)/2); |
| right := ScreenWidth - left - len; |
| for i := 1 to left do |
| begin |
| Write(' '); |
| end; |
| Write(str); |
| (* TODO: If we do "for i := 1 to right", then the console will scroll *) |
| (* since the char in the right bottom corner is written! *) |
| for i := 1 to right-1 do |
| begin |
| Write(' '); |
| end; |
| TextBackground(Black); |
| TextColor(White); |
| end; |
| procedure DrawTitleBar(str: string); |
| begin |
| DrawTextBar(str, 1); |
| end; |
| procedure DrawStatusBar(str: string); |
| begin |
| DrawTextBar(str, ScreenHeight); |
| end; |
| function DrawSelectionList(X, Y, ListWidth, ListHeight: integer; |
| items: PStringList; allowESC: boolean; |
| Title: string; borderStrength: integer): integer; |
| var |
| i: integer; |
| itemIndex: integer; |
| sc: char; |
| iStartScope, iEndScope: integer; |
| label |
| doAgain; |
| begin |
| if borderStrength = 1 then |
| begin |
| DrawThinBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
| end; |
| if borderStrength = 2 then |
| begin |
| DrawDoubleBorder(X-1, Y-1, ListWidth+2, ListHeight+2); |
| end; |
| if Title <> '' then |
| begin |
| if borderStrength > 0 then |
| GoToXY(X+1, Y-1) |
| else |
| GoToXY(X, Y-1); |
| Write(Title); |
| end; |
| (*CursorOff;*) |
| itemIndex := 0; |
| iStartScope := itemIndex; |
| iEndScope := itemIndex + ListHeight; |
| doAgain: |
| if itemIndex < 0 then |
| itemIndex := 0; |
| if itemIndex > ListCount(items)-1 then |
| itemIndex := ListCount(items)-1; |
| if itemIndex < iStartScope then |
| begin |
| Dec(iEndScope); |
| Dec(iStartScope); |
| end; |
| if itemIndex > iEndScope-1 then |
| begin |
| Inc(iEndScope); |
| Inc(iStartScope); |
| end; |
| if borderStrength > 0 then |
| begin |
| (* Show scroll arrows *) |
| GotoXY(X+ListWidth, Y); |
| if iStartScope > 0 then |
| begin |
| TextBackground(White); |
| TextColor(Black); |
| WriteLn(#$18(*ArrowUp*)); |
| TextBackground(Black); |
| TextColor(White); |
| end |
| else if borderStrength = 1 then |
| WriteLn(ThinLineChars[4]) |
| else if borderStrength = 2 then |
| WriteLn(DoubleLineChars[4]); |
| GotoXY(X+ListWidth, Y+ListHeight-1); |
| if ListCount(items) > iEndScope then |
| begin |
| TextBackground(White); |
| TextColor(Black); |
| WriteLn(#$19(*ArrowDown*)); |
| TextBackground(Black); |
| TextColor(White); |
| end |
| else if borderStrength = 1 then |
| WriteLn(ThinLineChars[4]) |
| else if borderStrength = 2 then |
| WriteLn(DoubleLineChars[4]); |
| end; |
| for i := iStartScope to iEndScope-1 do |
| begin |
| if itemIndex = i then |
| begin |
| TextColor(Black); |
| TextBackground(White); |
| end |
| else |
| begin |
| TextColor(White); |
| TextBackground(Black); |
| end; |
| GotoXY(x,y+i-iStartScope); |
| if i > ListCount(items)-1 then |
| Write(FillRight('', ListWidth, ' ')) |
| else |
| Write(FillRight(ListGetElement(items, i), ListWidth, ' ')); |
| TextColor(White); |
| TextBackground(Black); |
| end; |
| repeat |
| GotoXY(ScreenWidth, ScreenHeight); |
| sc := ReadKey; |
| if sc = #$00(*ExtendedKeyCode*) then |
| begin |
| sc := ReadKey; |
| if sc = #$48(*UpKey*) then |
| begin |
| dec(itemIndex); |
| goto doAgain; |
| end |
| else if sc = #$50(*DownKey*) then |
| begin |
| inc(itemIndex); |
| goto doAgain; |
| end |
| else if sc = #$47(*POS1*) then |
| begin |
| itemIndex := 0; |
| goto doAgain; |
| end |
| else if sc = #$4F(*END*) then |
| begin |
| itemIndex := ListCount(items); |
| goto doAgain; |
| end; |
| end; |
| if sc = #13(*Return*) then |
| begin |
| DrawSelectionList := itemIndex; |
| break; |
| end; |
| if allowESC and (sc = #27(*ESC*)) then |
| begin |
| DrawSelectionList := -1; |
| break; |
| end; |
| until false; |
| (*CursorOn;*) |
| end; |
| procedure ClearSection(x, y, width, height: integer); |
| var |
| ix, iy: integer; |
| begin |
| for iy := y to y+height-1 do |
| begin |
| for ix := x to x+width-1 do |
| begin |
| GoToXY(ix,iy); |
| Write(' '); |
| end; |
| end; |
| end; |
| function QueryVal(var s: string; initX, initY, width, height: integer; |
| Title: string; borderStrength: integer): boolean; |
| var |
| x, y: integer; |
| i, j: integer; |
| sc: char; |
| stmp: string; |
| begin |
| if borderStrength = 1 then |
| DrawThinBorder(initX-1,initY-1,width+2,height+2); |
| if borderStrength = 2 then |
| DrawDoubleBorder(initX-1,initY-1,width+2,height+2); |
| if title <> '' then |
| begin |
| if borderStrength > 0 then |
| GoToXY(initX+1, initY-1) |
| else |
| GoToXY(initX, initY-1); |
| Write(title); |
| end; |
| ClearSection(initX,initY,width,height); |
| x := initX; |
| y := initY; |
| (* Write existing string value and set cursor *) |
| stmp := s; |
| s := ''; |
| for i := 1 to Length(stmp) do |
| begin |
| if stmp[i] = #10 then |
| begin |
| s := s + stmp[i]; |
| continue; |
| end; |
| GoToXY(x,y); |
| s := s + stmp[i]; |
| Write(stmp[i]); |
| Inc(x); |
| if (x=initX+width-1) and (y=initY+height-1) then |
| begin |
| (* Attention: Data following after this will be lost! *) |
| break; |
| end; |
| if stmp[i] = #13 then |
| begin |
| if y=initY+height-1 then |
| begin |
| (* Attention: Data following after this will be lost! *) |
| s := Copy(s, 1, Length(s)-1); |
| Dec(x); |
| break; |
| end; |
| x := initX; |
| Inc(y); |
| continue; |
| end; |
| if x=initX+width then |
| begin |
| Inc(y); |
| x := initX; |
| end; |
| end; |
| repeat |
| GotoXY(x, y); |
| sc := ReadKey; |
| if sc = #0 then |
| begin |
| (* Extended key code *) |
| sc := ReadKey; |
| (* TODO: Implement keys like DEL, END, POS1, and ArrowKeys *) |
| Beep; |
| continue; |
| end |
| else if sc = #8(*Backspace*) then |
| begin |
| if x <= initX then |
| begin |
| if y = initY then |
| begin |
| Beep; |
| continue; |
| end; |
| Dec(y); |
| (* Find out length of previous line *) |
| j := Length(s)-2(*CRLF*); |
| while (j >= 0) do |
| begin |
| if (s[j]=#13) or (s[j]=#10) then break; |
| Dec(j); |
| end; |
| j := Length(s)-2(*CRLF*)-j; |
| x := initX + j; |
| s := Copy(s, 1, Length(s)-1); (* Remove #10 now. #13 will be removed below *) |
| end |
| else |
| begin |
| Dec(x); |
| end; |
| GotoXY(x, y); |
| Write(' '); |
| GotoXY(x, y); |
| s := Copy(s, 1, Length(s)-1); |
| continue; |
| end |
| else if sc = #13(*Return*) then |
| begin |
| if GetShiftState and kbRightShift <> 0 then |
| begin |
| if y=initY+height-1 then |
| begin |
| Beep; |
| continue; |
| end; |
| s := s + #13 + #10; |
| x := initX; |
| Inc(y); |
| end |
| else |
| begin |
| QueryVal := true; |
| exit; |
| end; |
| end |
| else if sc = #27(*ESC*) then |
| begin |
| QueryVal := false; |
| exit; |
| end |
| else |
| begin |
| if (x=initX+width-1) and (y=initY+height-1) then |
| begin |
| Beep; |
| continue; |
| end; |
| s := s + sc; |
| Write(sc); |
| Inc(x); |
| if x >= initX+width then |
| begin |
| Inc(y); |
| x := initX; |
| end; |
| end; |
| until false; |
| end; |
| procedure ShowMessage(msg: string; title: string; dobeep: boolean); |
| var |
| x, y, w, h: integer; |
| begin |
| x := SINGLE_LINE_BOX_PADDING_INNER; |
| y := ScreenHeight div 2 - 1; |
| w := ScreenWidth - (SINGLE_LINE_BOX_PADDING_INNER-1)*2; |
| h := 1; |
| DrawDoubleBorder(x-1, y, w+2, h+2); |
| ClearSection(x, y+1, w-2, h); |
| if title <> '' then |
| begin |
| GoToXY(x+1, y); |
| Write(title); |
| end; |
| GoToXY(x, y+1); |
| Write(msg); |
| if DoBeep then Beep; |
| end; |
| end. |
| /trunk_dos/VTSFUNCS.PAS |
|---|
| 0,0 → 1,184 |
| unit VTSFUNCS; |
| (************************************************) |
| (* VTSFUNCS.PAS *) |
| (* Author: Daniel Marschall *) |
| (* Revision: 2022-02-13 *) |
| (* License: Apache 2.0 *) |
| (* This file contains: *) |
| (* - Various functions *) |
| (************************************************) |
| interface |
| function CompareEqualLengthString(a, b: string): integer; |
| function CompareNumericString(a, b: string): integer; |
| procedure Beep; |
| function Trim(s: string): string; |
| function IsNumeric(s: string): boolean; |
| function ZeroPad(i: LongInt; n: integer): string; |
| procedure DeleteFile(filename: string); |
| function FileExists(filename: string): boolean; |
| function StrToInt(s: string): Integer; |
| function IntToStr(Value: Integer): string; |
| implementation |
| uses |
| Crt; |
| function CompareEqualLengthString(a, b: string): integer; |
| var |
| ao, bo, i: integer; |
| begin |
| CompareEqualLengthString := 0; |
| for i := 1 to Length(a) do |
| begin |
| ao := Ord(a[i]); |
| bo := Ord(b[i]); |
| if ao > bo then |
| begin |
| CompareEqualLengthString := 1; |
| break; |
| end; |
| if ao < bo then |
| begin |
| CompareEqualLengthString := -1; |
| break; |
| end; |
| end; |
| end; |
| function CompareNumericString(a, b: string): integer; |
| var |
| i, maxlen: integer; |
| prefix_a, prefix_b: string; |
| begin |
| maxlen := Length(a); |
| if Length(b) > maxlen then maxlen := Length(b); |
| prefix_a := ''; |
| for i := 1 to maxlen-Length(a) do |
| begin |
| prefix_a := prefix_a + '0'; |
| end; |
| prefix_b := ''; |
| for i := 1 to maxlen-Length(b) do |
| begin |
| prefix_b := prefix_b + '0'; |
| end; |
| CompareNumericString := CompareEqualLengthString(prefix_a+a, prefix_b+b); |
| end; |
| procedure Beep; |
| begin |
| Sound(220); (*220Hz*) |
| Delay(200); (*200ms*) |
| NoSound; |
| end; |
| function Trim(s: string): string; |
| begin |
| while Length(s) > 0 do |
| begin |
| if s[1] in [#9,#10,#13,' '] then |
| Delete(s,1,1) |
| else |
| break; |
| end; |
| while Length(s) > 0 do |
| begin |
| if s[Length(s)] in [#9,#10,#13,' '] then |
| Delete(s,Length(s),1) |
| else |
| break; |
| end; |
| Trim := s; |
| end; |
| function IsNumeric(s: string): boolean; |
| var |
| i: integer; |
| begin |
| IsNumeric := false; |
| if Length(s) = 0 then exit; |
| if (s[1] = '0') and (s <> '0') then exit; |
| for i := 1 to Length(s) do |
| begin |
| if not (s[i] in ['0'..'9']) then exit; |
| end; |
| IsNumeric := true; |
| end; |
| function ZeroPad(i: LongInt; n: integer): string; |
| var |
| s: string; |
| begin |
| Str(i, s); |
| while Length(s) < n do |
| begin |
| s := '0' + s; |
| end; |
| ZeroPad := s; |
| end; |
| procedure DeleteFile(filename: string); |
| var |
| F: file; |
| Ch: Char; |
| begin |
| { Get file to delete from command line } |
| Assign(F, filename); |
| {$I-} |
| Reset(F); |
| {$I+} |
| (* |
| if IOResult <> 0 then |
| Writeln('Cannot find ', filename) |
| else |
| begin |
| *) |
| Close(F); |
| (* |
| Write('Erase ', filename, '? '); |
| Readln(Ch); |
| if UpCase(CH) = 'Y' then |
| *) |
| Erase(F); |
| (* |
| end; |
| *) |
| end; |
| function FileExists(filename: string): boolean; |
| var |
| F: Text; |
| begin |
| Assign(F, filename); |
| {$I-} |
| Reset(F); |
| {$I+} |
| FileExists := IoResult = 0; |
| end; |
| function StrToInt(s: string): Integer; |
| var |
| i, Error: Integer; |
| begin |
| Val(s, i, Error); |
| StrToInt := i; |
| end; |
| function IntToStr(Value: Integer): string; |
| var |
| s: string; |
| begin |
| Str(Value, s); |
| IntToStr := s; |
| end; |
| end. |
| /trunk_dos/screenshot.PNG |
|---|
| Cannot display: file marked as a binary type. |
| svn:mime-type = application/octet-stream |
| Property changes: |
| Added: svn:mime-type |
| +application/octet-stream |
| \ No newline at end of property |
| /trunk_dos/. |
|---|
| Property changes: |
| Added: svn:ignore |
| +*.$$$ |
| +*.TPU |
| +*.BAK |
| +*.OID |
| +PATCHCRT.EXE |
