DeltaLima/Xpacket
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

initial commit

Browse source
This commit is contained in:
Marcus Hanisch DLM274 2019-05-15 00:31:19 +02:00
commit c0f9ca4017
64 changed files with 47368 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

674
LICENSE Executable file
View file

@ -0,0 +1,674 @@
GNU GENERAL PUBLIC LICENSE
Version 3, 29 June 2007
Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The GNU General Public License is a free, copyleft license for
software and other kinds of works.
The licenses for most software and other practical works are designed
to take away your freedom to share and change the works. By contrast,
the GNU General Public License is intended to guarantee your freedom to
share and change all versions of a program--to make sure it remains free
software for all its users. We, the Free Software Foundation, use the
GNU General Public License for most of our software; it applies also to
any other work released this way by its authors. You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
them if you wish), that you receive source code or can get it if you
want it, that you can change the software or use pieces of it in new
free programs, and that you know you can do these things.
To protect your rights, we need to prevent others from denying you
these rights or asking you to surrender the rights. Therefore, you have
certain responsibilities if you distribute copies of the software, or if
you modify it: responsibilities to respect the freedom of others.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must pass on to the recipients the same
freedoms that you received. You must make sure that they, too, receive
or can get the source code. And you must show them these terms so they
know their rights.
Developers that use the GNU GPL protect your rights with two steps:
(1) assert copyright on the software, and (2) offer you this License
giving you legal permission to copy, distribute and/or modify it.
For the developers' and authors' protection, the GPL clearly explains
that there is no warranty for this free software. For both users' and
authors' sake, the GPL requires that modified versions be marked as
changed, so that their problems will not be attributed erroneously to
authors of previous versions.
Some devices are designed to deny users access to install or run
modified versions of the software inside them, although the manufacturer
can do so. This is fundamentally incompatible with the aim of
protecting users' freedom to change the software. The systematic
pattern of such abuse occurs in the area of products for individuals to
use, which is precisely where it is most unacceptable. Therefore, we
have designed this version of the GPL to prohibit the practice for those
products. If such problems arise substantially in other domains, we
stand ready to extend this provision to those domains in future versions
of the GPL, as needed to protect the freedom of users.
Finally, every program is threatened constantly by software patents.
States should not allow patents to restrict development and use of
software on general-purpose computers, but in those that do, we wish to
avoid the special danger that patents applied to a free program could
make it effectively proprietary. To prevent this, the GPL assures that
patents cannot be used to render the program non-free.
The precise terms and conditions for copying, distribution and
modification follow.
TERMS AND CONDITIONS
0. Definitions.
"This License" refers to version 3 of the GNU General Public License.
"Copyright" also means copyright-like laws that apply to other kinds of
works, such as semiconductor masks.
"The Program" refers to any copyrightable work licensed under this
License. Each licensee is addressed as "you". "Licensees" and
"recipients" may be individuals or organizations.
To "modify" a work means to copy from or adapt all or part of the work
in a fashion requiring copyright permission, other than the making of an
exact copy. The resulting work is called a "modified version" of the
earlier work or a work "based on" the earlier work.
A "covered work" means either the unmodified Program or a work based
on the Program.
To "propagate" a work means to do anything with it that, without
permission, would make you directly or secondarily liable for
infringement under applicable copyright law, except executing it on a
computer or modifying a private copy. Propagation includes copying,
distribution (with or without modification), making available to the
public, and in some countries other activities as well.
To "convey" a work means any kind of propagation that enables other
parties to make or receive copies. Mere interaction with a user through
a computer network, with no transfer of a copy, is not conveying.
An interactive user interface displays "Appropriate Legal Notices"
to the extent that it includes a convenient and prominently visible
feature that (1) displays an appropriate copyright notice, and (2)
tells the user that there is no warranty for the work (except to the
extent that warranties are provided), that licensees may convey the
work under this License, and how to view a copy of this License. If
the interface presents a list of user commands or options, such as a
menu, a prominent item in the list meets this criterion.
1. Source Code.
The "source code" for a work means the preferred form of the work
for making modifications to it. "Object code" means any non-source
form of a work.
A "Standard Interface" means an interface that either is an official
standard defined by a recognized standards body, or, in the case of
interfaces specified for a particular programming language, one that
is widely used among developers working in that language.
The "System Libraries" of an executable work include anything, other
than the work as a whole, that (a) is included in the normal form of
packaging a Major Component, but which is not part of that Major
Component, and (b) serves only to enable use of the work with that
Major Component, or to implement a Standard Interface for which an
implementation is available to the public in source code form. A
"Major Component", in this context, means a major essential component
(kernel, window system, and so on) of the specific operating system
(if any) on which the executable work runs, or a compiler used to
produce the work, or an object code interpreter used to run it.
The "Corresponding Source" for a work in object code form means all
the source code needed to generate, install, and (for an executable
work) run the object code and to modify the work, including scripts to
control those activities. However, it does not include the work's
System Libraries, or general-purpose tools or generally available free
programs which are used unmodified in performing those activities but
which are not part of the work. For example, Corresponding Source
includes interface definition files associated with source files for
the work, and the source code for shared libraries and dynamically
linked subprograms that the work is specifically designed to require,
such as by intimate data communication or control flow between those
subprograms and other parts of the work.
The Corresponding Source need not include anything that users
can regenerate automatically from other parts of the Corresponding
Source.
The Corresponding Source for a work in source code form is that
same work.
2. Basic Permissions.
All rights granted under this License are granted for the term of
copyright on the Program, and are irrevocable provided the stated
conditions are met. This License explicitly affirms your unlimited
permission to run the unmodified Program. The output from running a
covered work is covered by this License only if the output, given its
content, constitutes a covered work. This License acknowledges your
rights of fair use or other equivalent, as provided by copyright law.
You may make, run and propagate covered works that you do not
convey, without conditions so long as your license otherwise remains
in force. You may convey covered works to others for the sole purpose
of having them make modifications exclusively for you, or provide you
with facilities for running those works, provided that you comply with
the terms of this License in conveying all material for which you do
not control copyright. Those thus making or running the covered works
for you must do so exclusively on your behalf, under your direction
and control, on terms that prohibit them from making any copies of
your copyrighted material outside their relationship with you.
Conveying under any other circumstances is permitted solely under
the conditions stated below. Sublicensing is not allowed; section 10
makes it unnecessary.
3. Protecting Users' Legal Rights From Anti-Circumvention Law.
No covered work shall be deemed part of an effective technological
measure under any applicable law fulfilling obligations under article
11 of the WIPO copyright treaty adopted on 20 December 1996, or
similar laws prohibiting or restricting circumvention of such
measures.
When you convey a covered work, you waive any legal power to forbid
circumvention of technological measures to the extent such circumvention
is effected by exercising rights under this License with respect to
the covered work, and you disclaim any intention to limit operation or
modification of the work as a means of enforcing, against the work's
users, your or third parties' legal rights to forbid circumvention of
technological measures.
4. Conveying Verbatim Copies.
You may convey verbatim copies of the Program's source code as you
receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice;
keep intact all notices stating that this License and any
non-permissive terms added in accord with section 7 apply to the code;
keep intact all notices of the absence of any warranty; and give all
recipients a copy of this License along with the Program.
You may charge any price or no price for each copy that you convey,
and you may offer support or warranty protection for a fee.
5. Conveying Modified Source Versions.
You may convey a work based on the Program, or the modifications to
produce it from the Program, in the form of source code under the
terms of section 4, provided that you also meet all of these conditions:
a) The work must carry prominent notices stating that you modified
it, and giving a relevant date.
b) The work must carry prominent notices stating that it is
released under this License and any conditions added under section
7. This requirement modifies the requirement in section 4 to
"keep intact all notices".
c) You must license the entire work, as a whole, under this
License to anyone who comes into possession of a copy. This
License will therefore apply, along with any applicable section 7
additional terms, to the whole of the work, and all its parts,
regardless of how they are packaged. This License gives no
permission to license the work in any other way, but it does not
invalidate such permission if you have separately received it.
d) If the work has interactive user interfaces, each must display
Appropriate Legal Notices; however, if the Program has interactive
interfaces that do not display Appropriate Legal Notices, your
work need not make them do so.
A compilation of a covered work with other separate and independent
works, which are not by their nature extensions of the covered work,
and which are not combined with it such as to form a larger program,
in or on a volume of a storage or distribution medium, is called an
"aggregate" if the compilation and its resulting copyright are not
used to limit the access or legal rights of the compilation's users
beyond what the individual works permit. Inclusion of a covered work
in an aggregate does not cause this License to apply to the other
parts of the aggregate.
6. Conveying Non-Source Forms.
You may convey a covered work in object code form under the terms
of sections 4 and 5, provided that you also convey the
machine-readable Corresponding Source under the terms of this License,
in one of these ways:
a) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by the
Corresponding Source fixed on a durable physical medium
customarily used for software interchange.
b) Convey the object code in, or embodied in, a physical product
(including a physical distribution medium), accompanied by a
written offer, valid for at least three years and valid for as
long as you offer spare parts or customer support for that product
model, to give anyone who possesses the object code either (1) a
copy of the Corresponding Source for all the software in the
product that is covered by this License, on a durable physical
medium customarily used for software interchange, for a price no
more than your reasonable cost of physically performing this
conveying of source, or (2) access to copy the
Corresponding Source from a network server at no charge.
c) Convey individual copies of the object code with a copy of the
written offer to provide the Corresponding Source. This
alternative is allowed only occasionally and noncommercially, and
only if you received the object code with such an offer, in accord
with subsection 6b.
d) Convey the object code by offering access from a designated
place (gratis or for a charge), and offer equivalent access to the
Corresponding Source in the same way through the same place at no
further charge. You need not require recipients to copy the
Corresponding Source along with the object code. If the place to
copy the object code is a network server, the Corresponding Source
may be on a different server (operated by you or a third party)
that supports equivalent copying facilities, provided you maintain
clear directions next to the object code saying where to find the
Corresponding Source. Regardless of what server hosts the
Corresponding Source, you remain obligated to ensure that it is
available for as long as needed to satisfy these requirements.
e) Convey the object code using peer-to-peer transmission, provided
you inform other peers where the object code and Corresponding
Source of the work are being offered to the general public at no
charge under subsection 6d.
A separable portion of the object code, whose source code is excluded
from the Corresponding Source as a System Library, need not be
included in conveying the object code work.
A "User Product" is either (1) a "consumer product", which means any
tangible personal property which is normally used for personal, family,
or household purposes, or (2) anything designed or sold for incorporation
into a dwelling. In determining whether a product is a consumer product,
doubtful cases shall be resolved in favor of coverage. For a particular
product received by a particular user, "normally used" refers to a
typical or common use of that class of product, regardless of the status
of the particular user or of the way in which the particular user
actually uses, or expects or is expected to use, the product. A product
is a consumer product regardless of whether the product has substantial
commercial, industrial or non-consumer uses, unless such uses represent
the only significant mode of use of the product.
"Installation Information" for a User Product means any methods,
procedures, authorization keys, or other information required to install
and execute modified versions of a covered work in that User Product from
a modified version of its Corresponding Source. The information must
suffice to ensure that the continued functioning of the modified object
code is in no case prevented or interfered with solely because
modification has been made.
If you convey an object code work under this section in, or with, or
specifically for use in, a User Product, and the conveying occurs as
part of a transaction in which the right of possession and use of the
User Product is transferred to the recipient in perpetuity or for a
fixed term (regardless of how the transaction is characterized), the
Corresponding Source conveyed under this section must be accompanied
by the Installation Information. But this requirement does not apply
if neither you nor any third party retains the ability to install
modified object code on the User Product (for example, the work has
been installed in ROM).
The requirement to provide Installation Information does not include a
requirement to continue to provide support service, warranty, or updates
for a work that has been modified or installed by the recipient, or for
the User Product in which it has been modified or installed. Access to a
network may be denied when the modification itself materially and
adversely affects the operation of the network or violates the rules and
protocols for communication across the network.
Corresponding Source conveyed, and Installation Information provided,
in accord with this section must be in a format that is publicly
documented (and with an implementation available to the public in
source code form), and must require no special password or key for
unpacking, reading or copying.
7. Additional Terms.
"Additional permissions" are terms that supplement the terms of this
License by making exceptions from one or more of its conditions.
Additional permissions that are applicable to the entire Program shall
be treated as though they were included in this License, to the extent
that they are valid under applicable law. If additional permissions
apply only to part of the Program, that part may be used separately
under those permissions, but the entire Program remains governed by
this License without regard to the additional permissions.
When you convey a copy of a covered work, you may at your option
remove any additional permissions from that copy, or from any part of
it. (Additional permissions may be written to require their own
removal in certain cases when you modify the work.) You may place
additional permissions on material, added by you to a covered work,
for which you have or can give appropriate copyright permission.
Notwithstanding any other provision of this License, for material you
add to a covered work, you may (if authorized by the copyright holders of
that material) supplement the terms of this License with terms:
a) Disclaiming warranty or limiting liability differently from the
terms of sections 15 and 16 of this License; or
b) Requiring preservation of specified reasonable legal notices or
author attributions in that material or in the Appropriate Legal
Notices displayed by works containing it; or
c) Prohibiting misrepresentation of the origin of that material, or
requiring that modified versions of such material be marked in
reasonable ways as different from the original version; or
d) Limiting the use for publicity purposes of names of licensors or
authors of the material; or
e) Declining to grant rights under trademark law for use of some
trade names, trademarks, or service marks; or
f) Requiring indemnification of licensors and authors of that
material by anyone who conveys the material (or modified versions of
it) with contractual assumptions of liability to the recipient, for
any liability that these contractual assumptions directly impose on
those licensors and authors.
All other non-permissive additional terms are considered "further
restrictions" within the meaning of section 10. If the Program as you
received it, or any part of it, contains a notice stating that it is
governed by this License along with a term that is a further
restriction, you may remove that term. If a license document contains
a further restriction but permits relicensing or conveying under this
License, you may add to a covered work material governed by the terms
of that license document, provided that the further restriction does
not survive such relicensing or conveying.
If you add terms to a covered work in accord with this section, you
must place, in the relevant source files, a statement of the
additional terms that apply to those files, or a notice indicating
where to find the applicable terms.
Additional terms, permissive or non-permissive, may be stated in the
form of a separately written license, or stated as exceptions;
the above requirements apply either way.
8. Termination.
You may not propagate or modify a covered work except as expressly
provided under this License. Any attempt otherwise to propagate or
modify it is void, and will automatically terminate your rights under
this License (including any patent licenses granted under the third
paragraph of section 11).
However, if you cease all violation of this License, then your
license from a particular copyright holder is reinstated (a)
provisionally, unless and until the copyright holder explicitly and
finally terminates your license, and (b) permanently, if the copyright
holder fails to notify you of the violation by some reasonable means
prior to 60 days after the cessation.
Moreover, your license from a particular copyright holder is
reinstated permanently if the copyright holder notifies you of the
violation by some reasonable means, this is the first time you have
received notice of violation of this License (for any work) from that
copyright holder, and you cure the violation prior to 30 days after
your receipt of the notice.
Termination of your rights under this section does not terminate the
licenses of parties who have received copies or rights from you under
this License. If your rights have been terminated and not permanently
reinstated, you do not qualify to receive new licenses for the same
material under section 10.
9. Acceptance Not Required for Having Copies.
You are not required to accept this License in order to receive or
run a copy of the Program. Ancillary propagation of a covered work
occurring solely as a consequence of using peer-to-peer transmission
to receive a copy likewise does not require acceptance. However,
nothing other than this License grants you permission to propagate or
modify any covered work. These actions infringe copyright if you do
not accept this License. Therefore, by modifying or propagating a
covered work, you indicate your acceptance of this License to do so.
10. Automatic Licensing of Downstream Recipients.
Each time you convey a covered work, the recipient automatically
receives a license from the original licensors, to run, modify and
propagate that work, subject to this License. You are not responsible
for enforcing compliance by third parties with this License.
An "entity transaction" is a transaction transferring control of an
organization, or substantially all assets of one, or subdividing an
organization, or merging organizations. If propagation of a covered
work results from an entity transaction, each party to that
transaction who receives a copy of the work also receives whatever
licenses to the work the party's predecessor in interest had or could
give under the previous paragraph, plus a right to possession of the
Corresponding Source of the work from the predecessor in interest, if
the predecessor has it or can get it with reasonable efforts.
You may not impose any further restrictions on the exercise of the
rights granted or affirmed under this License. For example, you may
not impose a license fee, royalty, or other charge for exercise of
rights granted under this License, and you may not initiate litigation
(including a cross-claim or counterclaim in a lawsuit) alleging that
any patent claim is infringed by making, using, selling, offering for
sale, or importing the Program or any portion of it.
11. Patents.
A "contributor" is a copyright holder who authorizes use under this
License of the Program or a work on which the Program is based. The
work thus licensed is called the contributor's "contributor version".
A contributor's "essential patent claims" are all patent claims
owned or controlled by the contributor, whether already acquired or
hereafter acquired, that would be infringed by some manner, permitted
by this License, of making, using, or selling its contributor version,
but do not include claims that would be infringed only as a
consequence of further modification of the contributor version. For
purposes of this definition, "control" includes the right to grant
patent sublicenses in a manner consistent with the requirements of
this License.
Each contributor grants you a non-exclusive, worldwide, royalty-free
patent license under the contributor's essential patent claims, to
make, use, sell, offer for sale, import and otherwise run, modify and
propagate the contents of its contributor version.
In the following three paragraphs, a "patent license" is any express
agreement or commitment, however denominated, not to enforce a patent
(such as an express permission to practice a patent or covenant not to
sue for patent infringement). To "grant" such a patent license to a
party means to make such an agreement or commitment not to enforce a
patent against the party.
If you convey a covered work, knowingly relying on a patent license,
and the Corresponding Source of the work is not available for anyone
to copy, free of charge and under the terms of this License, through a
publicly available network server or other readily accessible means,
then you must either (1) cause the Corresponding Source to be so
available, or (2) arrange to deprive yourself of the benefit of the
patent license for this particular work, or (3) arrange, in a manner
consistent with the requirements of this License, to extend the patent
license to downstream recipients. "Knowingly relying" means you have
actual knowledge that, but for the patent license, your conveying the
covered work in a country, or your recipient's use of the covered work
in a country, would infringe one or more identifiable patents in that
country that you have reason to believe are valid.
If, pursuant to or in connection with a single transaction or
arrangement, you convey, or propagate by procuring conveyance of, a
covered work, and grant a patent license to some of the parties
receiving the covered work authorizing them to use, propagate, modify
or convey a specific copy of the covered work, then the patent license
you grant is automatically extended to all recipients of the covered
work and works based on it.
A patent license is "discriminatory" if it does not include within
the scope of its coverage, prohibits the exercise of, or is
conditioned on the non-exercise of one or more of the rights that are
specifically granted under this License. You may not convey a covered
work if you are a party to an arrangement with a third party that is
in the business of distributing software, under which you make payment
to the third party based on the extent of your activity of conveying
the work, and under which the third party grants, to any of the
parties who would receive the covered work from you, a discriminatory
patent license (a) in connection with copies of the covered work
conveyed by you (or copies made from those copies), or (b) primarily
for and in connection with specific products or compilations that
contain the covered work, unless you entered into that arrangement,
or that patent license was granted, prior to 28 March 2007.
Nothing in this License shall be construed as excluding or limiting
any implied license or other defenses to infringement that may
otherwise be available to you under applicable patent law.
12. No Surrender of Others' Freedom.
If conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot convey a
covered work so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you may
not convey it at all. For example, if you agree to terms that obligate you
to collect a royalty for further conveying from those to whom you convey
the Program, the only way you could satisfy both those terms and this
License would be to refrain entirely from conveying the Program.
13. Use with the GNU Affero General Public License.
Notwithstanding any other provision of this License, you have
permission to link or combine any covered work with a work licensed
under version 3 of the GNU Affero General Public License into a single
combined work, and to convey the resulting work. The terms of this
License will continue to apply to the part which is the covered work,
but the special requirements of the GNU Affero General Public License,
section 13, concerning interaction through a network will apply to the
combination as such.
14. Revised Versions of this License.
The Free Software Foundation may publish revised and/or new versions of
the GNU General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the
Program specifies that a certain numbered version of the GNU General
Public License "or any later version" applies to it, you have the
option of following the terms and conditions either of that numbered
version or of any later version published by the Free Software
Foundation. If the Program does not specify a version number of the
GNU General Public License, you may choose any version ever published
by the Free Software Foundation.
If the Program specifies that a proxy can decide which future
versions of the GNU General Public License can be used, that proxy's
public statement of acceptance of a version permanently authorizes you
to choose that version for the Program.
Later license versions may give you additional or different
permissions. However, no additional obligations are imposed on any
author or copyright holder as a result of your choosing to follow a
later version.
15. Disclaimer of Warranty.
THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
16. Limitation of Liability.
IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
SUCH DAMAGES.
17. Interpretation of Sections 15 and 16.
If the disclaimer of warranty and limitation of liability provided
above cannot be given local legal effect according to their terms,
reviewing courts shall apply local law that most closely approximates
an absolute waiver of all civil liability in connection with the
Program, unless a warranty or assumption of liability accompanies a
copy of the Program in return for a fee.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
state the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>.
Also add information on how to contact you by electronic and paper mail.
If the program does terminal interaction, make it output a short
notice like this when it starts in an interactive mode:
<program> Copyright (C) <year> <name of author>
This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, your program's commands
might be different; for a GUI interface, you would use an "about box".
You should also get your employer (if you work as a programmer) or school,
if any, to sign a "copyright disclaimer" for the program, if necessary.
For more information on this, and how to apply and follow the GNU GPL, see
<https://www.gnu.org/licenses/>.
The GNU General Public License does not permit incorporating your program
into proprietary programs. If your program is a subroutine library, you
may consider it more useful to permit linking proprietary applications with
the library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License. But first, please read
<https://www.gnu.org/licenses/why-not-lgpl.html>.

323
OVERXMS.ASM Executable file
View file

@ -0,0 +1,323 @@
TITLE Turbo Pascal XMS support for loading overlays - By Wilbert van Leijen
PAGE 65, 132
LOCALS @@
Data SEGMENT Word Public
ASSUME DS:Data
; XMS block move record
XmsMoveType STRUC
BlkSize DD ?
SrcHandle DW ?
SrcOffset DD ?
DestHandle DW ?
DestOffset DD ?
XmsMoveType ENDS
; TP overlay manager record
OvrHeader STRUC
ReturnAddr DD ? ; Virtual return address
FileOfs DD ? ; Offset into overlay file
CodeSize DW ? ; Size of overlay
FixupSize DW ? ; Size of fixup table
EntryPts DW ? ; Number of procedures
CodeListNext DW ? ; Segment of next overlay
LoadSeg DW ? ; Start segment in memory
Reprieved DW ? ; Loaded in memory flag
LoadListNext DW ? ; Segment of next in load list
XmsOffset DD ? ; Offset into allocated XMS block
UserData DW 3 DUP(?)
OvrHeader ENDS
XmsDriver DD ? ; Entry point of XMS driver
ExitSave DD ? ; Pointer to previous exit proc
XmsMove XmsMoveType <>
OvrXmsHandle DW ? ; Returned by XMS driver
Extrn PrefixSeg : Word
Extrn ExitProc : DWord
Extrn OvrResult : Word
Extrn OvrCodeList : Word
Extrn OvrDosHandle : Word
Extrn OvrHeapOrg : Word
Extrn OvrReadBuf : DWord
Data ENDS
Code SEGMENT Byte Public
ASSUME CS:Code
Public OvrInitXMS
ovrIOError EQU -4
ovrNoXMSDriver EQU -7
ovrNoXMSMemory EQU -8
OvrXmsExit PROC
; Release handle and XMS memory
MOV DX, [OvrXmsHandle]
MOV AH, 10
CALL [XmsDriver]
; Restore pointer to previous exit procedure
LES AX, [ExitSave]
MOV Word Ptr [ExitProc], AX
MOV Word Ptr [ExitProc+2], ES
RETF
OvrXmsExit ENDP
AllocateXms PROC
; Determine the size of the XMS block to allocate:
; Walk the CodeListNext chain
; Store the total codesize in DX:AX
XOR AX, AX
XOR DX, DX
MOV BX, [OvrCodeList]
@@1: ADD BX, [PrefixSeg]
ADD BX, 10h
MOV ES, BX
ADD AX, ES:[OvrHeader.CodeSize]
ADC DX, 0
MOV BX, ES:[OvrHeader.CodeListNext]
OR BX, BX
JNZ @@1
; Obtain number of kilobytes to allocate
MOV BX, 1024
DIV BX
XCHG DX, AX
INC DX
; Allocate the block
MOV AH, 9
CALL [XmsDriver]
OR AX, AX
JZ @@2
MOV [OvrXmsHandle], DX
@@2: RETN
AllocateXms ENDP
; Function XmsReadFunc(OvrSeg : Word) : Integer; Far;
XmsReadFunc PROC
; Swap the code from XMS to the heap
PUSH BP
MOV BP, SP
MOV ES, [BP+6]
MOV AX, ES:[OvrHeader.CodeSize]
MOV Word Ptr [XmsMove.BlkSize], AX
XOR AX, AX
MOV Word Ptr [XmsMove.BlkSize+2], AX
MOV AX, [OvrXmsHandle]
MOV [XmsMove.SrcHandle], AX
MOV AX, Word Ptr ES:[OvrHeader.XmsOffset]
MOV Word Ptr [XmsMove.SrcOffset], AX
MOV AX, Word Ptr ES:[OvrHeader.XmsOffset+2]
MOV Word Ptr [XmsMove.SrcOffset+2], AX
XOR AX, AX
MOV [XmsMove.DestHandle], AX
MOV Word Ptr [XmsMove.DestOffset], AX
MOV AX, ES:[OvrHeader.LoadSeg]
MOV Word Ptr [XmsMove.DestOffset+2], AX
MOV AH, 11
LEA SI, XmsMove
CALL [XmsDriver]
OR AX, AX
JZ @@1
DEC AX
JMP @@2
@@1: MOV AX, ovrIOError
@@2: POP BP
RETF 2
XmsReadFunc ENDP
; Copy an overlaid unit from the heap to XMS
; If successful, carry flag is cleared
; In/Out:
; BX:DI = offset into XMS memory block
CopyUnitToXms PROC
; XMS requires that an even number of bytes is moved
MOV DX, ES:[OvrHeader.CodeSize]
TEST DX, 1
JZ @@1
INC DX
INC ES:[OvrHeader.CodeSize]
; Get the fields of the XMS block move structure
@@1: MOV Word Ptr [XmsMove.BlkSize], DX
XOR AX, AX
MOV Word Ptr [XmsMove.BlkSize+2], AX
MOV [XmsMove.SrcHandle], AX
MOV Word Ptr [XmsMove.SrcOffset], AX
MOV AX, [OvrHeapOrg]
MOV Word Ptr [XmsMove.SrcOffset+2], AX
MOV AX, [OvrXmsHandle]
MOV [XmsMove.DestHandle], AX
MOV Word Ptr [XmsMove.DestOffset], DI
MOV Word Ptr [XmsMove.DestOffset+2], BX
MOV AH, 11
LEA SI, XmsMove
CALL [XmsDriver]
; Bump code size
ADD DI, DX
ADC BX, 0
; Check return code from XMS driver
OR AX, AX
JZ @@2
CLC
RETN
@@2: STC
RETN
CopyUnitToXms ENDP
OvrXmsLoad PROC
PUSH BP
MOV BP, SP
; Walk the CodeList chain
; First segment is PrefixSeg+10h+OvrCodeList
; Push each element of overlaid unit list on the stack
; Keep the size of the linked list in CX
MOV AX, [OvrCodeList]
XOR CX, CX
@@1: ADD AX, [PrefixSeg]
ADD AX, 10h
MOV ES, AX
PUSH AX
INC CX
MOV AX, ES:[OvrHeader.CodeListNext]
OR AX, AX
JNZ @@1
; Loop:
; Pop each element of the overlaid unit list from the stack
XOR BX, BX
XOR DI, DI
@@2: POP ES
PUSH CX
MOV AX, [OvrHeapOrg]
MOV ES:[OvrHeader.LoadSeg], AX
MOV Word Ptr ES:[OvrHeader.XmsOffset+2], BX
MOV Word Ptr ES:[OvrHeader.XmsOffset], DI
; Load overlay from disk
PUSH BX
PUSH DI
PUSH ES
PUSH ES
CALL [OvrReadBuf]
POP ES
POP DI
POP BX
; Flag unit as 'unloaded'; check return code
MOV ES:[OvrHeader.LoadSeg], 0
NEG AX
JC @@3
CALL CopyUnitToXms
JC @@3
POP CX
LOOP @@2
@@3: MOV SP, BP
POP BP
RETN
OvrXMSLoad ENDP
OvrInitXMS PROC
; Make sure the file's been opened
XOR AX, AX
CMP AX, [OvrDOSHandle]
JNE @@1
DEC AX ; ovrError
JMP @@5
; Check presence of XMS driver
@@1: MOV AX, 4300h
INT 2Fh
CMP AL, 80h
JE @@2
MOV AX, ovrNoXmsDriver
JMP @@5
; Get XMS driver's entry point
@@2: MOV AX, 4310h
INT 2Fh
MOV Word Ptr [XmsDriver], BX
MOV Word Ptr [XmsDriver+2], ES
CALL AllocateXms
JNZ @@3
MOV AX, ovrNoXMSMemory
JMP @@5
; Load the overlay into XMS
@@3: CALL OvrXmsLoad
JNC @@4
; An error occurred. Release handle and XMS memory
MOV DX, [OvrXmsHandle]
MOV AH, 10
CALL [XmsDriver]
MOV AX, ovrIOError
JMP @@5
; Close file
@@4: MOV BX, [OvrDOSHandle]
MOV AH, 3Eh
INT 21h
; OvrReadBuf := XmsReadFunc
MOV Word Ptr [OvrReadBuf], Offset XmsReadFunc
MOV Word Ptr [OvrReadBuf+2], CS
; ExitSave := ExitProc
; ExitProc := OvrXmsExit
LES AX, [ExitProc]
MOV Word Ptr [ExitSave], AX
MOV Word Ptr [ExitSave+2], ES
MOV Word Ptr [ExitProc], Offset OvrXmsExit
MOV Word Ptr [ExitProc+2], CS
; Return result of initialisation
XOR AX, AX
@@5: MOV [OvrResult], AX
RETF
OvrInitXMS ENDP
Code ENDS
END

21
OVERXMS.PAS Executable file
View file

@ -0,0 +1,21 @@
{ OVERXMS - Loads overlays in XMS. Written by Wilbert van Leijen }
Unit OverXMS;
{$O-}
Interface
uses Overlay;
Const
ovrNoXMSDriver = -7; { No XMS driver installed }
ovrNoXMSMemory = -8; { Insufficient XMS memory available }
Procedure OvrInitXMS;
Implementation
Procedure OvrInitXMS; External;
{$L OVERXMS.OBJ}
end. { OverXMS }

4
README.md Executable file
View file

@ -0,0 +1,4 @@
# xpacket
Xpacket - the porpular Packet-Radio Terminal
These are the original Sources from dl6ib. The original homepage of xpacket is http://www.dl6ib.de/xpacket In late 2008 the idea came up to port xpacket to modern operating systems and make it os independent. Badly nobody had the time. Xpacket is written in TurboPascal - Maybe it compiles with FreePascal. 73 de DLM274

223
XP7PL.PAS Executable file
View file

@ -0,0 +1,223 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ Primaryfile: X P . P A S ³
³ ³
³ ³
³ Routinen fuer den Empfang von 7Plusfiles ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Open_Close_7Plus (* Kanal : Byte; Zeile : Str80 *);
Const Cnt = 'CNT';
Var i,i1 : Byte;
Result : Word;
Sstr : String[8];
Nstr : String[12];
Vstr : String[80];
Suf : String[3];
Flag : Boolean;
f : Text;
Begin
with K[Kanal]^ do
begin
if SplSave then
begin
Vstr := FName_aus_FVar(SplFile);
SplSave := false;
Spl_COR_ERR := false;
FiResult := CloseBin(SplFile);
Umlaut := Spl_UmlMerk;
Vstr := copy(Vstr,1,pos(Pkt,Vstr)) + Cnt;
Assign(f,Vstr);
if RewriteTxt(f) = 0 then
begin
Writeln(f,Spl_gCount);
FiResult := CloseTxt(f);
end;
end else
begin
if MldOk = 11 then (* 7PL .. P0X *)
begin
Spl_Time := Uhrzeit;
Spl_tCount := 0;
Spl_tLaenge := str_int('$' + ParmStr(7,B1,Zeile));
Spl_tLaenge := (Spl_tLaenge div 64) + 2;
i1 := str_int(ParmStr(4,B1,Zeile));
Spl_gLaenge := str_int(ParmStr(6,B1,Zeile));
Spl_gLaenge := (Spl_gLaenge div 62) + 2 * i1;
if Spl_gLaenge mod 62 > 0 then inc(Spl_gLaenge);
Spl_gLaenge := Spl_gLaenge * 69;
Spl_tLaenge := Spl_tLaenge * 69;
Nstr := copy(Zeile,20,8);
i := pos(Pkt,Nstr);
if i > 0 then Nstr := copy(Nstr,1,i-1);
KillEndBlanks(Nstr);
if Nstr = '' then
begin
Nstr := Call;
Strip(Nstr);
end;
if i1 = 1 then Suf := '7PL'
else Suf := 'P' + Hex(str_int(ParmStr(2,B1,Zeile)),2);
Nstr := Nstr + Pkt + Suf;
end;
if MldOk = 14 then (* COR und ERR-File *)
begin
Spl_COR_ERR := true;
Nstr := ParmStr(2,B1,Zeile);
i := 0;
While Exists(Konfig.SplVerz + copy(Nstr,1,pos(Pkt,Nstr)-1) + BS + Nstr) do
begin
inc(i);
delete(Nstr,length(Nstr)-1,2);
Nstr := Nstr + SFillStr(2,'0',Hex(i,2));
end;
end;
if MldOk = 41 then (* INF-File *)
begin
Spl_COR_ERR := true;
Nstr := ParmStr(2,B1,Zeile);
i := 0;
While Exists(Konfig.SplVerz + copy(Nstr,1,pos(Pkt,Nstr)-1) + BS + Nstr) do
begin
inc(i);
delete(Nstr,length(Nstr)-1,2);
Nstr := Nstr + SFillStr(2,'0',Hex(i,2));
end;
end;
Vstr := copy(Nstr,1,pos(Pkt,Nstr)-1);
if MkSub(Konfig.SplVerz + Vstr) then
begin
if not Exists(Konfig.SplVerz + Vstr + BS + Nstr) then
begin
Vstr := Konfig.SplVerz + Vstr + BS + Nstr;
Assign(SplFile,Vstr);
Result := RewriteBin(SplFile,T);
end else
begin
i := 0;
Repeat
inc(i);
Sstr := Call;
Strip(Sstr);
Sstr := int_str(i) + Sstr;
Flag := not Exists(Konfig.SplVerz + Vstr + BS + Sstr + BS + Nstr);
Until Flag or (i > 250);
if Flag then
begin
if MkSub(Konfig.SplVerz + Vstr + BS + Sstr) then
begin
Vstr := konfig.SplVerz + Vstr + BS + Sstr + BS + Nstr;
Assign(SplFile,Vstr);
Result := RewriteBin(SplFile,T);
end else Result := 1;
end else Result := 1;
end;
if Result = 0 then
begin
SplSave := true;
Spl_UmlMerk := Umlaut;
Umlaut := 0;
Vstr := copy(Vstr,1,pos(Pkt,Vstr)) + Cnt;
Assign(f,Vstr);
if ResetTxt(f) = 0 then
begin
Readln(f,Spl_gCount);
FiResult := CloseTxt(f);
end else Spl_gCount := 0;
end else
begin
Triller;
MldOk := 0;
end;
end else
begin
Triller;
MldOk := 0;
end;
end;
SetzeFlags(Kanal);
end;
End;
Procedure Close_7Plus (* Kanal : Byte *);
Begin
with K[Kanal]^ do
begin
if SplSave then
begin
SplSave := false;
Spl_COR_ERR := false;
FiResult := CloseBin(SplFile);
Umlaut := Spl_UmlMerk;
end;
end;
End;
Procedure Write_SplFile (* Kanal : Byte; Zeile : String *);
Type FPtr = Array [1..500] of Char;
Var i : Byte;
Result : Word;
Count : Word;
ch : Char;
Feld : ^FPtr;
Begin
with K[Kanal]^ do
begin
GetMem(Feld,SizeOf(Feld^));
FillChar(Feld^,SizeOf(Feld^),0);
Count := 0;
for i := 1 to length(Zeile) do
Begin
ch := Zeile[i];
case ch of
{ #32..#41,
#43..#126,
#128..#144,
#146,
#148..#252 : (ALT! bis 1.71)}
#32..#126,
#128..#254:
begin
inc(Count);
Feld^[Count] := ch;
if not Spl_COR_ERR then
begin
inc(Spl_gCount);
inc(Spl_tCount);
end;
end;
M1 : begin
inc(Count);
Feld^[Count] := #13;
inc(Count);
Feld^[Count] := #10;
end;
end;
End;
BlockWrite(SplFile,Feld^,Count,Result);
FreeMem(Feld,SizeOf(Feld^));
if not Spl_COR_ERR then
FileInfo(Kanal,2,Spl_gLaenge,Spl_gCount,Spl_tLaenge,Spl_tCount);
end;
End;

314
XPACKET.PAS Executable file
View file

@ -0,0 +1,314 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ Primaryfile: X P . P A S ³
³ ³
³ ³
³ XP ist ein auf TOP 1.50-Routinen aufgebautes Programm. ³
³ TOP ist eine Weiterentwicklung des schon bekannten Terminalprogramms ³
³ THP 2.6 von DL1BHO . Es gelten auch hier die gleichen Kriterien wie ³
³ bei THP. Das heiát: ³
³ ³
³ Das Programm ist ausdruecklich PUBLIC DOMAIN, koennen also an jeden ³
³ interessierten Funkamateur zur NICHT-KOMMERZIELLEN NUTZUNG weiterge- ³
³ geben werden. ³
³ ³
³ ³
³ A C H T U N G : ³
³ ³
³ Dieses Programm ist ein reines Hobby-Produkt! ³
³ ³
³ F<>r Fehler, insbesondere f<>r eventuelle Datenverluste, kann ³
³ KEINERLEI HAFTUNG <20>bernommen werden! ³
³ ³
³ ³
³ ³
³ ³
³ Compiliert wird mit TURBO-PASCAL 7.0 ³
³ ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
{ XPLOAD nach 101 suchen, um die richtige versi zu erstellen }
PROGRAM Packet_HOSTMODE_Terminal(Input,Output);
{$M 22000,0,655360}
{$F+}
{-$DEFINE extovl} {**Zum Start in TP aktivieren}
{-$DEFINE code} {** Aktiv f<>r Code-Fassung, Deaktiv f<>r offizielle
auch XPACT, XPOVR6}
{-$DEFINE Sound} {**Wenn aktiv, wird SB-Unterst<73>tzung mit
compilliert, ist es deaktiv, nicht
auch XPACT, XPACT1, XPOVR, XPOVR4, XPOVR6, XPDEFS}
{-$DEFINE no_Netrom} {**Wenn aktiv wird keine NetRom-Unterstuetzung
mit compiliert //db1ras}
{-$DEFINE no_Bake} {**Wenn aktiv, alle Bakenfunktionen deaktiviert //db1ras}
{-$DEFINE ReadOldMemo} {**Wenn aktiv, kann XP auch die Vorgaengerversion der
memo.xp lesen (waehrend der Uebergangsphase wichtig),
die alte Version wird als memo.<versionsnummer>
gesichert, geschrieben wird immer die neue Version
//db1ras}
USES OVERLAY,
CRT,
DOS,
{ GRAPH,}
XPEMS,
XPXMS,
XPDEFS,
XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
XPOVR4,
XPOVR5,
XPOVR6,
OVERXMS;
{$O XPOVR}
{$O XPOVR1}
{$O XPOVR2}
{$O XPOVR3}
{$O XPOVR4}
{$O XPOVR5}
Var i : Integer;
spf:dirstr..dirstr;
BEGIN (**** H A U P T P R O G R A M M ****)
Check_Loaded; {Ueberprueft, ob XP schon geladen ist}
Old_IntMask := Port[$21];
Inline($FA);
FillChar(neue_Table,SizeOf(neue_Table),$FF);
alte_Table := Ptr(PrefixSeg,$18);
move(alte_Table^[1],neue_Table[1],20);
TabAdresse := Ptr(PrefixSeg,$34);
TabAdresse^ := @neue_Table[1];
TabLaenge := Ptr(PrefixSeg,$32);
TabLaenge^ := maxTable;
Inline($FB);
{ SPf := Dir;}
SysPfad:=UpCaseStr(ParamStr(0)); { Pfad f<>r Config-Dateien }
OvrDatei := SysPfad;
{$IFDEF extovl}
OVRDatei := 'XPACKET.OVR';
{$ENDIF}
While (length(SysPfad) > 0) and (SysPfad[length(SysPfad)] <> BS)
do delete(SysPfad,length(SysPfad),1);
if (Length(SysPfad) > 0) and (SysPfad[Length(SysPfad)] <> BS)
then SysPfad := SysPfad + BS;
Sys1Pfad := SysPfad;
OvrInit(OvrDatei);
if OvrResult <> 0 then
begin
Writeln;
Writeln('Failure with ',OvrDatei,' !');
PRG_Stoppen(0);
end;
ParamZeile := Ptr(PrefixSeg,$80);
UebergabeAuswert;
if Nutze_XMS then Init_XMS;
if Nutze_EMS then Init_EMS;
if Nutze_XMS and OVRtoXMS then
begin
OvrInitXMS;
i := OvrResult;
OVRtoEMS:=false;
if i = 0 then Mstr := EmsStr + OvrDatei + B1 + 'load into XMS'
else Mstr := EmsStr + OvrDatei + B1 + 'F-Nr.' + GL + int_str(i);
end;
if Nutze_EMS and OVRtoEMS then
begin
OvrInitEMS;
i := OvrResult;
if i = 0 then Mstr := EmsStr + OvrDatei + B1 + 'load into EMS'
else Mstr := EmsStr + OvrDatei + B1 + 'F-Nr.' + GL + int_str(i);
end;
OrigExit := ExitProc;
ExitProc := @Exit_XP;
FreeRam := $A0000 - Adr_absolut(Ptr(PrefixSeg,0));
GetMem(G,SizeOf(G^));
FillChar(G^,SizeOf(G^),0);
CheckBreak := false; { kein Abbruch durch ctrl-C }
GetCBreak(BreakStatus); { Break-Status holen und retten }
SetCBreak(false); { Break off }
CheckSnow := false;
GetVideoMode;
StartVideoMode := LastMode; { derzeitigen VideoMode merken }
LastModeStore := StartVideoMode;
if Hercules then maxZ := 25
else maxZ := WindMax div 256 + 1;
Cursor_aus;
TextAttr := StartColor;
ClrScr;
GenCrcTab;
Mstr := ParamStr(0);
if CRC_PR_EXE then
begin
NormVideo;
ClrScr;
SetzeCursor(1,25);
Mstr := ParamStr(0);
CRC_Datei(Mstr);
Writeln(Mstr);
Writeln;
PRG_Stoppen(0);
end;
Var_Init(99); { Erstmal nur globale Variablen initialisieren }
getdate(Jahr_,Monat_, Tag_, woTag_);
LastLTCheck:=0;
Cursor_aus;
Emblem_zeigen;
{$IFNDEF Sound}
writeln('NoSound-Version'); {//db1ras}
{$ENDIF}
LastLTCheck:=SizeOf(lokalptr);
LastLTCheck:=SizeOf(Kanalptr);
LastLTCheck:=SizeOf(TNC_Typ);
LastLTCheck:=0;
ConfigLesen;
{ GetNetRom;}
(* Konfig.WavOut:=true; {************************ L™SCHEN}*)
{$IFDEF Sound}
if (konfig.wavout) or (konfig.wavsprach) then
begin
FindBlaster;
assign (SoundFile, 'TEST.WAV');
end;
{$ENDIF}
{ Mstr := ParamStr(0);
GetNetRom (Mstr);}
Infos_Lesen;
Strings_Lesen;
Merker_Conn_Lesen;
Merker_File_Lesen;
Fenster_Berechnen;
V24_Init;
AttributFile_Lesen;
ESC_Lesen;
QRG_Lesen;
REM_Lesen;
PWD_Lesen;
HELP_Lesen;
if (SSAV > 0) then Puffer_lesen;
max_path_ermitteln;
Switch_VGA_Mono;
ColorItensity(HighCol);
maxZ := WindMax div 256 + 1;
Cursor_aus;
show := 0;
for i := 1 to 4 do StatusOut(0,1,i,Attrib[9],ConstStr(B1,20),1);
Neu_Bild;
VorCurEnd;
M_aus(Attrib[28],^J, 0);
Ini_Start_Tnc;
if MhKill then FillChar(MH^,SizeOf(MH^),0);
K[0]^.TncNummer := 1;
SwitchChannel(FirstConCh);
if Exists(Konfig.makverz + AutoExecFile) then
begin
MakroInit;
Makro_aktivieren(konfig.makverz + AutoExecFile);
end;
if klingel<>(not quiet) then
begin
Klingel:=not Quiet;
setzeFlags(show);
end;
UserAnwesend;
{for i:=1 to maxlink do } {//db1ras}
{ if (not K[i]^.connected) and (not K[i]^.Mo.MonActive) then }
{ K[i]^.ignore:=false; }
Repeat (**** H A U P T S C H L E I F E ****)
Check_Keyboard;
Uhr_aus;
If Idle then
begin
if (Idle_TCount > 0) and (Idle_TMerk <> TimerTick) then
begin
Idle_TMerk := TimerTick;
dec(Idle_TCount);
end;
if Idle_Count > 0 then dec(Idle_Count);
if (Idle_TCount = 0) and ((Idle_Pos and (Idle_Count = 0)) or
(not Idle_Pos and (Idle_Count > 0))) then
begin
IdleDOS;
if Idle_Pos then Idle_Count := Idle_Anz;
end;
end;
if not Idle or
Idle and (Idle_Pos or
(not Idle_Pos and (Idle_Count = 0) and (Idle_TCount = 0))) then
begin
if Idle and not Idle_Pos then Idle_Count := Idle_Anz;
if polling then TNCs_Pollen;
set_Hardwarecursor(show);
end;
Until QRT; (* E N D E der H A U P T S C H L E I F E *)
TschuessFenster;
TncIni(1);
Abschluss_XP;
Init_HardDrive;
ExitProc := OrigExit;
End.

4561
XPACKSET.PAS Executable file
View file

File diff suppressed because it is too large Load diff

109
XPACT.PAS Executable file
View file

@ -0,0 +1,109 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P A C T . P A S ³
³ ³
³ Programmcode, der staendig im RAM des Rechners geladen ist ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Unit XPACT;
{$F+}
{-$DEFINE Sound}
{-$DEFINE code}
Interface
Uses CRT,
DOS,
OVERLAY,
MEMORY,
XPDEFS,
XPEMS,
XPXMS;
(* Proceduren und Funtionen der XPIO.PAS *)
Procedure Screen_aus(Art : Byte);
Procedure Uhr_aus;
Procedure GetTNC(Kanal : Byte);
Procedure S_PAC(Kanal,Art : Byte; All : Boolean; Zeile : String);
Procedure TxRxTNC(Kanal,Art : Byte; Zeile : String);
Procedure SendTNC(Var Kanal : Byte; Art : Byte; Zeile : String);
Procedure Moni_Off(Art : Byte);
Procedure Moni_On;
Procedure Check_Mld(Kanal: Byte; Zeile : Str80);
Procedure TNC_Info(Kanal,Attr : Byte; Zeile : String);
Procedure Comp_Sammler(Kanal,Attr : Byte; FrEnd : Boolean; Zeile : String);
Function XComp_Sammler (Kanal: Byte; Zeile : String) : String;
Procedure Connect_Info(Kanal,Attr : Byte; FrEnd : Boolean; Zeile : String);
Function FreiePuffer(Kanal : Byte) : Word;
Procedure Mon_Header_Auswerten;
Procedure TNCs_Pollen;
Procedure Kanal_Pollen(Kanal : Byte);
Procedure Get_Linkstatus(Kanal : Byte);
Procedure Check_Keyboard;
Procedure Rufz_TNC_init(Kanal : Byte);
Function QuerCheck(Zeile : String) : Word;
Procedure MH_Check(TNC_Nr : Byte; Zeile : Str128);
Procedure TickerOut;
Function FormMonFr(TNr : Byte; Hstr : Str5; Zeile : String) : String;
(* Proceduren und Funtionen der XPV24.PAS *)
Procedure IRQsLock;
Procedure IRQsFree;
Procedure get_Chr_TFPC;
Procedure get_Chr_Hs (V24Nr : Byte);
Procedure V24_Init;
Procedure WriteAux (V24Nr : Byte; Zeile : String);
Procedure V24_Close;
Procedure Switch_TNC (TNr : Byte);
Function ReSync (V24Nr : Byte) : Boolean;
Procedure Wait_Read (V24Nr : Byte);
Procedure ClearV24Buffer;
Procedure get_Response (Kanal : Byte);
Procedure BufToResp (Kanal : Byte);
(* Proceduren und Funtionen der XPKEY.PAS *)
Procedure _ReadKey(var SK : Sondertaste; var VC : char);
Function _KeyPressed : Boolean;
Procedure MakroKey(var SK : Sondertaste; var VC : char);
(* Proceduren und Funtionen der XPAUS.PAS *)
Procedure Scroll(Art : str2; Aufruf,Y1,Y2 : Byte);
Procedure _aus(Attr,Kanal : Byte; Zeile : String);
Procedure M_aus(Attr : Byte; Zeile : String; Kanal : Byte);
Procedure Write_Notiz(Kanal : Byte);
Procedure Write_Notstr(Kanal : Byte; ch : Char);
Procedure Write_BoxStr(Kanal,Art : Byte);
Procedure Morse(Kanal : Byte; Zeile : str80);
Function Compress (Zeile : String; Kanal : Byte) : String;
Function DeCompress (Zeile : String; Kanal : Byte) : String;
Function SPCompress (Zeile : String; Kanal : Byte) : String;
Function SPDeCompress (Zeile : String; Kanal : Byte) : String;
Implementation
Uses XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
XPOVR4,
xpovr5,
xpovr6;
{$I XPIO}
{$I XPV24}
{$I XPKEY}
{$I XPAUS}
End.

162
XPACT1.PAS Executable file
View file

@ -0,0 +1,162 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P A C T 1 . P A S ³
³ ³
³ Programmcode, der staendig im RAM des Rechners geladen ist ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Unit XPACT1;
{$F+}
{-$DEFINE Sound}
Interface
Uses CRT,
DOS,
OVERLAY,
MEMORY,
XPDEFS,
XPEMS,
XPXMS;
(* Proceduren und Funtionen der XPSTR.PAS *)
Function str_int(Zeile : Str10) : LongInt;
Function int_str(i : LongInt) : str10;
Function ConstStr(VC : Char; L : Byte) : Str80;
Function RetStr(Zeile : String) : String;
Function CutStr(Zeile : String) : String;
Function RestStr(Zeile : String) : String;
Function UpCaseStr (Zeile : String) : String;
Procedure KillEndBlanks(var Zeile : String);
Procedure KillStartBlanks(Var Zeile : String); (* f<>hrende Leerz. l”schen *)
Function ParmStr(Nr : Byte; VC : Char; Zeile : String) : String;
Function SFillStr(Anz : Byte; VC : Char; Zeile : String) : String;
Function EFillStr (Anz : Byte; VC : Char; Zeile : String) : String;
Function CEFillStr (Anz : Byte; VC : Char; Zeile : String) : String; {gleich wie efill, nur wird bei <20>berl„nge abgeschnitten}
Function ZFillStr (Anz : Byte; VC : Char; Zeile : String) : String;
Function Hex(Dezimal : LongInt; Stellenzahl : Byte) : Str8;
Function Adr_absolut(Zeiger : Pointer) : LongInt;
Function Pointer_Str(Zeiger : Pointer) : Str9;
Function FormByte(Zeile : str11) : str11;
Function Bin(Dezimal : LongInt ; Stellenzahl : Byte) : Str32;
Procedure Strip(Var Call: str9); (* SSID entfernen *)
(* Proceduren und Funtionen der XPLIB.PAS *)
Procedure Fenster (H:Byte);
Procedure clrFenster;
Procedure Neu_Bild;
Procedure Status2;
Procedure Triller;
Procedure Bimmel(kan:byte);
Procedure C_Bell(call:str9; kan:byte);
Procedure D_Bell(kan:byte);
Procedure Daten_Bell;
Procedure Cursor_aus;
Procedure Cursor_ein;
Procedure Beep(Ton,Laenge : Word);
Function Datum : Str11;
Procedure GetTime_ (VAR Hr, Mn, Sk, Sk100 : Word);
Function Uhrzeit : Str8;
Function Channel_ID (Kanal : Byte) : Str8;
Procedure Warten;
Procedure Alarm;
Procedure StatusOut(Kanal,x,Nr,Attr : Byte ; Zeile : str80; StZ : Byte);
Procedure NodeConnect(Kanal : Byte; Zeile : Str80);
Function Exists(name : Str80) : Boolean;
Procedure Teil_Bild_Loesch(y,y1,Attr : Byte);
Procedure InfoOut(Kanal,AL,NewPic : Byte; Zeile : Str80);
Function InfoZeile(Nr : Word) : Str80;
Procedure max_path_ermitteln;
Procedure WritePage(Kanal,X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80);
Procedure WriteRam(X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80);
Procedure WriteTxt(X_Pos,Y_Pos,Attr : Byte ; Zeile : Str80);
Procedure WriteBios(Kanal,X_Pos,Y_Pos,Attr,Aufruf : Byte ; Zeile : Str80);
Procedure WriteAttr(X_Pos,Y_Pos,Count,Attr,Aufruf : Byte);
Function KanalFrei(Kanal : Byte) : Byte;
Function Line_convert(Kanal,Art : Byte; Zeile : String) : String;
Procedure SetzeCursor(X,Y : ShortInt);
Procedure InitCursor(X,Y : ShortInt);
Procedure SetzeFlags(Kanal : Byte);
Procedure ScreenFill;
Procedure Check_Eig_Mail(von,bis : Byte);
Procedure EMS_Seite_einblenden(Kanal : Byte; Art : Byte);
Procedure Open_Scroll(Kanal : Byte);
Procedure Close_Scroll(Kanal : Byte);
Function PhantasieCall : str9;
Procedure set_Hardwarecursor(Kanal : Byte);
Procedure SwitchChannel(Kanal : Byte);
Procedure SwitchKanal(VC : Char);
Procedure SwitchMonitor;
Function FreeStr(Lw : char) : str11;
Function V24(Kanal : Byte) : Byte;
Procedure ReInstall;
Procedure ColorItensity(CFlag : Boolean);
Function ChAttr(Attr : Byte) : Byte;
Procedure Init_HardDrive;
Procedure New2BVec(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP: Word); Interrupt;
Procedure Check_Loaded;
Procedure Exit_XP;
Procedure PRG_Stoppen(Nr : Byte);
Function BackScroll(Kanal : Byte) : Boolean;
Procedure Call_DOS(Zeile : Str128);
Function AppendTxt(Var f : Text) : Integer;
Function ResetTxt(Var f : Text) : Integer;
Function ResetBin(Var f : File; Fpos : LongInt) : Integer;
Function RewriteTxt(Var f : Text) : Integer;
Function RewriteBin(Var f : File; Fpos : LongInt) : Integer;
Function CloseTxt(Var f : Text) : Integer;
Function CloseBin(Var f : File) : Integer;
Function EraseTxt(Var f : Text) : Integer;
Function EraseBin(Var f : File) : Integer;
Procedure IdleDOS;
Procedure Verzoegern(Wert : Word);
Procedure LockIntFlag(Art : Byte);
Procedure Sound_ (Tonh, Lang : Integer);
Procedure Sprachwav;
Procedure StopWave_;
(* Proceduren und Funtionen der XPCHR.PAS *)
Procedure Chr_Darstell(Kanal : Byte; KC : Sondertaste; VC : char);
Procedure Chr_Cmd_Show(Kanal : Byte; KC : Sondertaste; VC : char);
Procedure Chr_Vor_Show(Kanal : Byte; KC : Sondertaste; VC : char);
Procedure ChangeXYST(Kanal,Art : Byte; Var X1,Y1,st : Byte);
Procedure Vor_Feld_Scroll(Kanal : Byte);
Procedure Vor_Dn_Scroll(Kanal : Byte);
Procedure Neu_BildVor(Kanal : Byte);
Procedure Soft_Cursor(Kanal : Byte);
Procedure Set_st_Szeile(Kanal,Art,st : Byte);
Procedure TX_Out(Kanal : Byte; All : Boolean);
Procedure Del_Wort(Var Zeile : Str80; X1 : Byte);
Procedure Cur_Wort(Zeile : Str80; KC : Sondertaste; Var X1 : Byte; XM : Byte);
(* Proceduren und Funtionen der XPTAST.PAS *)
Function ESC_Auswert(Zeile : Str9) : Byte;
Procedure Auswert_CMD(Kanal : Byte; InputZeile : Str80);
Procedure Key_Active(Kanal : Byte; KC : Sondertaste; VC : char);
Implementation
Uses XPACT,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
XPOVR4,
xpovr5,
xpovr6;
{$I XPSTR}
{$I XPLIB}
{$I XPCHR}
{$I XPTAST}
End.

1185
XPAUS.PAS Executable file
View file

File diff suppressed because it is too large Load diff

296
XPAUTO.PAS Executable file
View file

@ -0,0 +1,296 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P A U T O . P A S ³
³ ³
³ Routinen f<>r die Abarbeitung der automatischen CMD-Dateien. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Auto_Init (* Kanal : Byte *);
Begin
with K[Kanal]^ do
begin
{
Werte f<>r CSelf:
----------------
1 = Auto startet zu einer bestimmten Zeit.
2 = Auto startet alle X Minuten.
3 = Bedingung 1 oder 2 sind erf<72>llt.
4 = Auto befindet sich im Wartestadium und wartet X Minuten ab.
5 = Auto erwartet den Empfang der Abfragezeile (einfache Pr<50>fung)
6 = Auto erwartet den Empfang der Abfragezeile (strenge Pr<50>fung,
die Abfragezeile muá mit Return beendet sein).
7 = Bedingung 5 oder 6 sind erf<72>llt.
8 = Auto hat Gleichheit zwischen Auto1Zeile und eintreffender
Zeile festgestellt.
9 = Das Terminal ist momentan im Backscrollmode und eine ESC-Zeile
aus dem Autofile kann deswegen nicht bedient werden. Erst wenn
der Backscroll verlassen wird, wird die ESC-Zeile bearbeitet.
10 = kurze Ruhephase f<>r Auto.
}
Cself := 0;
AutoZeile := '';
Auto1Zeile := '';
AutoTime := '';
AutoWait := 0;
AutoChMerk := 0;
AutoZaehl := 0;
AutoJump := 0;
AutoZyCount := 0;
AutoToCount := 0;
AutoToConst := 0;
AutoToAnz := 0;
AutoToMax := 0;
AutoToAnzJmp := 0;
AutoArt := 0;
AutoJmpPtr := 1;
FillChar(AutoJmpRet,SizeOf(AutoJmpRet),0);
if AutoZyConst > 0 then CSelf := 2;
SetzeFlags(Kanal);
end;
End;
Procedure Autozeile_Holen (* Kanal : Byte *);
Var Hstr : String[80];
w : Word;
Flag,
EFlag,
TxFlag : Boolean;
Begin
with K[Kanal]^ do
begin
Flag := false;
EFlag := false;
Hstr := Konfig.MakVerz + AutoDatei + SFillStr(3,'0',int_str(Kanal));
Assign(G^.AutoFile,Hstr);
if ResetTxt(G^.AutoFile) = 0 then
begin
for w := 1 to AutoZaehl do Readln(G^.AutoFile);
if not Eof(G^.AutoFile) then
begin
TxFlag := false;
CSelf := 11;
Repeat
inc(AutoZaehl);
Readln(G^.AutoFile,AutoZeile);
KillEndBlanks(AutoZeile);
if pos('* ',AutoZeile) = 1 then
begin
CSelf := 9;
if BackScroll(show) then dec(AutoZaehl)
else Auswert_CMD(Kanal,AutoZeile);
EFlag := true;
end else
if pos('? ',AutoZeile) = 1 then
begin
AutoZeile := UpCaseStr(RestStr(AutoZeile));
AutoToCount := AutoToConst;
CSelf := 5;
EFlag := true;
end else
if pos('?G ',AutoZeile) = 1 then
begin
AutoZeile := RestStr(AutoZeile);
AutoJump := AutoJmpZnNr(Kanal,CutStr(AutoZeile));
Auto1Zeile := UpCaseStr(RestStr(AutoZeile));
end else
if pos('?L ',AutoZeile) = 1 then
begin
Auto1Zeile := UpCaseStr(RestStr(AutoZeile));
AutoArt := 1;
end else
begin
AutoZeile := Line_convert(Kanal,1,AutoZeile);
NodeConnect(Kanal,UpCaseStr(AutoZeile));
EigFlag := Echo in [1,3,5,7];
S_PAC(Kanal,NU,false,AutoZeile + M1);
EigFlag := false;
TxFlag := true;
end;
Until EFlag or Eof(G^.AutoFile);
if TxFlag then S_PAC(Kanal,NU,true,'');
end else Flag := true;
FiResult := CloseTxt(G^.AutoFile);
end;
if Flag then Auto_Init(Kanal)
else SetzeFlags(Kanal);
end;
End;
Procedure Auto_Aktivieren (* Kanal : Byte; Zeile : Str60 *);
Var Hstr : String[80];
Begin
with K[Kanal]^ do
begin
Zeile := UpCaseStr(RestStr(Zeile));
if CSelf = 0 then
begin
Hstr := Konfig.MakVerz + AutoDatei + SFillStr(3,'0',int_str(Kanal));
if Exists(Hstr) then
begin
Hstr := CutStr(Zeile);
if (length(Zeile) = 5) and (pos(DP,Zeile) = 3) then
begin
AutoTime := Zeile;
CSelf := 1;
InfoOut(Kanal,0,1,InfoZeile(294) + B1 + AutoTime);
end else
if Hstr = 'Z' then
begin
AutoZyConst := Word(str_int(RestStr(Zeile)));
if AutoZyConst > 0 then
begin
CSelf := 2;
AutoZyCount := 0;
InfoOut(Kanal,0,1,InfoZeile(275) + B1 + RestStr(Zeile) + B1 + 'min');
end;
end else
begin
Autozeile_Holen(Kanal);
AutoToAnz := AutoToMax;
end;
end else InfoOut(Kanal,1,1,InfoZeile(293) + B1 + Hstr);
end else
begin
Hstr := CutStr(Zeile);
if Hstr = 'A' then
begin
AutoToMax := Word(str_int(ParmStr(2,B1,Zeile)));
AutoToAnzJmp := AutoJmpZnNr(Kanal,ParmStr(3,B1,Zeile));
AutoToAnz := AutoToMax;
end else
if Hstr = 'E' then
begin
AutoZeile := '';
CSelf := 9;
end else
if Hstr = 'G' then
begin
AutoJmpRet[AutoJmpPtr] := AutoZaehl;
inc(AutoJmpPtr);
if AutoJmpPtr > maxAutoJmpPtr then AutoJmpPtr := 1;
AutoZaehl := AutoJmpZnNr(Kanal,RestStr(Zeile));
CSelf := 3;
end else
if Hstr = 'J' then
begin
AutoZaehl := AutoJmpZnNr(Kanal,RestStr(Zeile));
CSelf := 3;
end else
if Hstr = 'K' then
begin
Auto1Zeile := '';
end else
if Hstr = 'L' then
begin
if AutoArt = 2 then
begin
AutoJmpRet[AutoJmpPtr] := AutoZaehl;
inc(AutoJmpPtr);
if AutoJmpPtr > maxAutoJmpPtr then AutoJmpPtr := 1;
AutoZaehl := AutoJmpZnNr(Kanal,RestStr(Zeile));
AutoArt := 0;
end;
CSelf := 3;
end else
if Hstr = 'R' then
begin
dec(AutoJmpPtr);
if AutoJmpPtr = 0 then AutoJmpPtr := maxAutoJmpPtr;
AutoZaehl := AutoJmpRet[AutoJmpPtr];
CSelf := 3;
end else
if Hstr = 'S' then
begin
InfoOut(Kanal,0,1,AutoZeile);
end else
if Hstr = 'T' then
begin
AutoToConst := Word(str_int(RestStr(Zeile)));
end else
if Hstr = 'W' then
begin
AutoWait := Word(str_int(RestStr(Zeile)));
if AutoWait > 0 then CSelf := 4;
end else
if Hstr = 'Y' then
begin
dec(AutoJmpPtr);
if AutoJmpPtr = 0 then AutoJmpPtr := 1;
AutoJmpRet[AutoJmpPtr] := 0;
CSelf := 3;
end else
if Hstr = '+' then
begin
AutoChMerk := show;
SwitchChannel(Kanal);
end else
if Hstr = '-' then
begin
SwitchChannel(AutoChMerk);
end else
begin
AutoZyConst := 0;
Auto_Init(Kanal);
InfoOut(Kanal,0,1,InfoZeile(274));
end;
end;
SetzeFlags(Kanal);
end;
End;
Function AutoJmpZnNr (* Kanal : Byte; Zeile : Str40) : Word *);
Var w : Word;
Hstr : String[80];
Flag : Boolean;
Begin
w := 0;
Flag := false;
Zeile := UpCaseStr(Zeile);
Hstr := Konfig.MakVerz + AutoDatei + SFillStr(3,'0',int_str(Kanal));
Assign(G^.TFile,Hstr);
if ResetTxt(G^.TFile) = 0 then
begin
While not (Flag or Eof(G^.TFile)) do
begin
inc(w);
Readln(G^.TFile,Hstr);
Flag := UpCaseStr(CutStr(Hstr)) = (DP + Zeile);
end;
if Flag then AutoJmpZnNr := w
else AutoJmpZnNr := 0;
FiResult := CloseTxt(G^.TFile);
end else AutoJmpZnNr := 0;
End;

123
XPBUF.PAS Executable file
View file

@ -0,0 +1,123 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P B U F . P A S ³
³ ³
³ Routinen fuer das Pufferfilehandling ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure OpenBufferFile (* Kanal : Byte *);
Var Ex : String[3];
Begin
with K[Kanal]^ do
{ if (not node) or ((node) and (Test)) then}
begin
Ex := SFillStr(3,'0',int_str(Kanal));
if Vdisk_Exists and (DiskFree(ord(VDisk[1])-64) > minFreeVdisk)
then Assign(BufFile,VDisk + BufDatei + Ex)
else Assign(BufFile,Konfig.TempVerz + BufDatei + Ex);
if RewriteBin(BufFile,T) = 0 then BufExists := true;
end;
End;
Procedure WriteBuffer (* Kanal : Byte; Zeile : String *);
var Result : Word;
Begin
with K[Kanal]^ do if BufExists then
begin
Seek(BufFile,FileSize(BufFile));
BlockWrite(BufFile,Zeile[1],length(Zeile),Result);
end;
End;
Procedure SendBuffer (* Kanal : Byte *);
Var Result : Word;
Zeile : String;
BufTill : LongInt;
BufStr : String[10];
Begin
with K[Kanal]^ do if BufExists then
begin
Seek(BufFile,BufPos);
BlockRead(BufFile,Zeile[1],PacLen,Result);
BufPos := FilePos(BufFile);
BufStr := '';
BufTill := FileSize(BufFile) - BufPos;
if BufTill > 9999 then
begin
BufTill := BufTill div 1024;
BufStr := 'K';
end;
if BufTill > 9999 then
begin
BufTill := BufTill div 1024;
BufStr := 'M';
end;
BufStr := int_str(BufTill) + BufStr;
StatusOut(Kanal,6,4,Attrib[7],SFillStr(5,B1,BufStr),2);
if Result > 0 then
begin
Zeile[0] := chr(Result);
TxRxTNC(Kanal,0,Zeile);
end else EraseBufferFile(Kanal);
end;
End;
Procedure EraseBufferFile (* Kanal : Byte *);
Begin
with K[Kanal]^ do
begin
FiResult:=CloseBin(BufFile);
FiResult := EraseBin(BufFile);
BufExists := false;
WishBuf := false;
BufPos := 0;
SetzeFlags(Kanal);
end;
{ with K[Kanal]^ do if BufExists then
begin
if CloseBin(BufFile) = 0 then
begin
FiResult := EraseBin(BufFile);
BufExists := false;
WishBuf := false;
BufPos := 0;
SetzeFlags(Kanal);
end;
end; }
End;
Procedure SendTestBuffer (* Kanal : Byte *);
Var Result : Word;
Zeile : String;
Begin
with K[Kanal]^ do if BufExists then
begin
Seek(BufFile,0);
Repeat
BlockRead(BufFile,Zeile[1],PacLen,Result);
if Result > 0 then
begin
Zeile[0] := chr(Result);
if (SPComp) and (Test) and (RXComp) then
begin
while Zeile[length(Zeile)]=#0 do
delete(Zeile, Length(Zeile), 1);
Zeile[0]:=chr(length(Zeile));
end;
TNC_Info(TestMerk,Attrib[18],Zeile);
end else EraseBufferFile(Kanal);
Until not BufExists;
end;
End;

730
XPCHR.PAS Executable file
View file

@ -0,0 +1,730 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P C H R . P A S ³
³ ³
³ Routinen f<>r den Vorschreib-Bildschirm ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Chr_Darstell (* Kanal : Byte; KC : Sondertaste; VC : char *);
Begin
if K[Kanal]^.Cmd then Chr_Cmd_Show(Kanal,KC,VC)
else Chr_Vor_Show(Kanal,KC,VC);
End;
Procedure Chr_Cmd_Show (* Kanal : Byte; KC : Sondertaste; VC : char *);
var i,i1,
XLV,XH,
VAnz : Byte;
Neben,
NeuPage : Boolean;
Begin
with K[Kanal]^ do
Begin
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
NeuPage := true;
VAnz := VEnd - VBeg + 1;
if VAnz > VorCmdZeilen then VAnz := VorCmdZeilen;
XLV := length(VorWrite[Kanal]^[stC]);
Case KC of
_Andere : Case VC of
#1..#7,#11,#12, #14..#19, #21..#24, #26..#31, #32..#254
: if XLV < 79 then
begin
NeuPage := false;
if Gross then VC := UpCase(VC);
if not insert_ON then delete(VorWrite[Kanal]^[stC],X1C,1);
insert(VC,VorWrite[Kanal]^[stC],X1C);
inc(X1C);
end else Alarm;
^J : Alarm;
^T : if X1C <= XLV then
begin
Del_Wort(VorWrite[Kanal]^[stC],X1C);
NeuPage := false;
end else Alarm;
^Y : begin
VorWrite[Kanal]^[stC] := CvCh;
X1C := 3;
end;
#255: ;
End;
_Ret : begin
Auswert_CMD(Kanal,VorWrite[Kanal]^[stC]);
Vor_Feld_Scroll(Kanal);
Cmd := false;
end;
_Back : begin
NeuPage := false;
if X1C > 3 then
begin
delete(VorWrite[Kanal]^[stC],X1C-1,1);
dec(X1C);
end else Alarm;
end;
_AltK : Gross := not Gross;
_AltY : begin (* ALT-Y *)
for i := stC to (VorZeilen - 1) do
VorWrite[Kanal]^[i] := VorWrite[Kanal]^[i+1];
VorWrite[Kanal]^[VorZeilen] := CvCh;
X1C := 3;
end;
_Del : if (XLV > 0) and (X1C <= XLV) then (* DEL *)
begin
delete(VorWrite[Kanal]^[stC],X1C,1);
NeuPage := false;
end else Alarm;
_Up : begin (* Cursor Up *)
dec(stC); dec(Y1C);
if Y1C < 1 then Y1C := 1;
if stC < ((VorZeilen - VorCmdZeilen) + 1) then
begin
stC := (VorZeilen - VorCmdZeilen) + 1;
Alarm;
end;
if length(VorWrite[Kanal]^[stC]) < X1C then X1C := length(VorWrite[Kanal]^[stC]) + 1;
end;
_Dn : begin (* Cursor Dn *)
inc(Y1C); inc(stC);
if Y1C > VAnz then Y1C := VAnz;
if stC > VorZeilen then
begin
stC := VorZeilen;
if VorWrite[Kanal]^[stC] <> CvCh then Vor_Feld_Scroll(Kanal)
else Alarm;
end;
if length(VorWrite[Kanal]^[stC]) < X1C then
X1C := length(VorWrite[Kanal]^[stC]) + 1;
end;
_Left : begin (* Cursor left *)
if X1C > 3 then dec(X1C) else Alarm;
NeuPage := false;
end;
_Right : begin (* Cursor right *)
if X1C <= XLV then inc(X1C) else Alarm;
NeuPage := false;
end;
_Home : begin (* Home *)
X1C := 3;
NeuPage := false;
end;
_Ins : begin (* Ins *)
Insert_ON := not Insert_ON;
NeuPage := false;
end;
_End : begin (* END *)
X1C := XLV + 1;
NeuPage := false;
end;
_CtrlLeft,
_CtrlRight: begin
Cur_Wort(VorWrite[Kanal]^[stC],KC,X1C,3);
NeuPage := false;
end;
_CtrlPgUp : begin (* Ctrl-Page-Up *)
stC := (VorZeilen - VorCmdZeilen) + 1;
X1C := 3; Y1C := 1;
end;
_CtrlPgDn : begin (* Ctrl-Page-Dn *)
i := VorZeilen;
While (copy(VorWrite[Kanal]^[i],3,77) = '') and
(i > VorZeilen-VorCmdZeilen+1) do dec(i);
stC := i;
if i < VorZeilen - VorCmdZeilen + VAnz
then Y1C := i - (VorZeilen - VorCmdZeilen)
else Y1C := VAnz;
X1C := length(VorWrite[Kanal]^[stC]) + 1;
end;
_Esc : Cmd := false;
_Nix :;
else Alarm;
end; {case KC of}
if show = Kanal then if NeuPage
then Neu_BildVor(Kanal)
else WritePage(Kanal,1,Y1C+Vofs,Attrib[23],0,VorWrite[Kanal]^[stC] + G^.Leer);
Soft_Cursor(Kanal);
end; {with Kanal}
End;
Procedure Chr_Vor_Show (* Kanal : Byte; KC : Sondertaste; VC : char *);
var i,i1,XH,
XLV,VAnz : Byte;
Hstr : String[80];
Flag,
Umbruch,
Neben,
NeuPage,
ZWechsel : Boolean;
Begin
with K[Kanal]^ do
Begin
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
Hstr := '';
Umbruch := false;
NeuPage := true;
VAnz := VEnd - VBeg + 1;
XLV := length(VorWrite[Kanal]^[stV]);
if (vc=^J) and ((SPComp) or (G^.ZeilenwTX)) then KC:=_RET;
Case KC of
_Andere : Begin
if (VC in [#1..#7,#11,#12, #14..#19, #21..#24, #26..#31, #32..#254])
or AltQFlag then if (not FileSend) then
begin
if not((XLV >= 79) and (X1V < 79)) then
begin
NeuPage := false;
if ((TxByte + length(VorWrite[Kanal]^[stV])) > 254) then
begin
Tx_Out(Kanal,false);
NeuPage := true;
end;
if not insert_ON then delete(VorWrite[Kanal]^[stV],X1V,1);
insert(VC,VorWrite[Kanal]^[stV],X1V);
inc(X1V);
if (X1V > 79) then
begin
i := 1;
i1 := 79;
While (not(VorWrite[Kanal]^[stV][i1] in UmMenge)) and (i1 > 0) and (i < 79) do
begin
inc(i);
dec(i1);
end;
if (i > 1) and (i1 > 1) then
begin
Hstr := copy(VorWrite[Kanal]^[stV],i1+1,i-1);
delete(VorWrite[Kanal]^[stV],i1+1,i-1);
Umbruch := true;
end else ZWechsel := True;
KillEndBlanks(VorWrite[Kanal]^[stV]);
Set_st_Szeile(Kanal,0,stV);
Vor_Feld_Scroll(Kanal);
if VorWrite[Kanal]^[stV] > '' then Vor_Dn_Scroll(Kanal);
if Umbruch then VorWrite[Kanal]^[stV] := Hstr
else VorWrite[Kanal]^[stV] := '';
X1V := length(VorWrite[Kanal]^[stV]) + 1;
if ((umbruch) or (ZWechsel)) and ((SPComp) or (G^.ZeilenwTX)) then
begin
{VorWrite[Kanal]^[stV];}
Tx_Out(Kanal,true);
Set_St_SZeile(Kanal,1,1);
end;
ZWechsel:=False;
NeuPage := true;
end;
end else Alarm;
end else
begin
Alarm;
if FileSend then InfoOut(Kanal,1,1,InfoZeile(25));
if KompressUpd then InfoOut(Kanal,1,1,InfoZeile(399));
end;
if AltQFlag then VC := #255;
AltQFlag := false;
case VC of
^J : begin
KillEndBlanks(VorWrite[Kanal]^[stV]);
if X1V > XLV then
begin
if (TxByte + XLV) > 254 then TX_Out(Kanal,false);
Set_st_Szeile(Kanal,0,stV);
Vor_Feld_Scroll(Kanal);
X1V := length(VorWrite[Kanal]^[stV]) + 1;
end else
begin
Hstr := copy(VorWrite[Kanal]^[stV],X1V,(XLV-X1V)+1);
delete(VorWrite[Kanal]^[stV],X1V,(XLV-X1V)+1);
Set_st_Szeile(Kanal,0,stV);
Vor_Feld_Scroll(Kanal);
if VorWrite[Kanal]^[stV] > '' then Vor_Dn_Scroll(Kanal);
VorWrite[Kanal]^[stV] := Hstr;
X1V := length(VorWrite[Kanal]^[stV]) + 1;
end;
end;
^T : if X1V <= XLV then
begin
Del_Wort(VorWrite[Kanal]^[stV],X1V);
NeuPage := false;
end else Alarm;
^Y : begin
VorWrite[Kanal]^[stV] := '';
X1V := 1;
end;
#255: ;
end;
End;
{(FileSend) or (SPlSave) or (RX_bin>1)}
_Ret : if ((not FileSend)) and (not KompressUpd) then
begin
KillEndBlanks(VorWrite[Kanal]^[stV]);
if (TxByte + length(VorWrite[Kanal]^[stV])) > 254
then Tx_Out(Kanal,false);
Set_st_Szeile(Kanal,0,stV);
Tx_Out(Kanal,true);
Set_st_Szeile(Kanal,1,1);
Vor_Feld_Scroll(Kanal);
end else
begin
if (FileSend) or (SPlSave) or (RX_bin>1) then InfoOut(Kanal,1,1,InfoZeile(25));
if KompressUpd then InfoOut(Kanal,1,1,InfoZeile(399));
end;
_Back : begin
NeuPage := false;
if X1V > 1 then
begin
delete(VorWrite[Kanal]^[stV],X1V-1,1);
dec(X1V);
end else Alarm;
end;
_Alt7 : begin
Set_st_Szeile(Kanal,1,1);
Vor_Feld_Scroll(Kanal);
VorWrite[Kanal]^[stV] := '';
X1V := 1;
end;
_Alt8 : begin
Set_st_Szeile(Kanal,1,1);
end;
_Alt9 : begin
Tx_Out(Kanal,false);
NeuPage := true;
end;
_AltY : begin
for i := stV to (VorZeilen - VorCmdZeilen)-1 do
VorWrite[Kanal]^[i] := VorWrite[Kanal]^[i+1];
VorWrite[Kanal]^[VorZeilen - VorCmdZeilen] := '';
X1V := 1;
end;
_Del : if (XLV > 0) and (X1V <= XLV) then
begin
delete(VorWrite[Kanal]^[stV],X1V,1);
NeuPage := false;
end else
begin
if (X1V > XLV) and (X1V < 79) and (
stV < (VorZeilen - VorCmdZeilen)) then
begin
i1 := 79 - X1V;
Hstr := copy(VorWrite[Kanal]^[stV+1],1,i1);
VorWrite[Kanal]^[stV] := VorWrite[Kanal]^[stV] + Hstr;
delete(VorWrite[Kanal]^[stV+1],1,i1);
if VorWrite[Kanal]^[stV+1] = '' then
begin
for i := stV+1 to (VorZeilen - VorCmdZeilen)-1 do
VorWrite[Kanal]^[i] := VorWrite[Kanal]^[i+1];
VorWrite[Kanal]^[VorZeilen - VorCmdZeilen] := '';
end;
end else Alarm;
end;
_Up : begin (* Cursor Up *)
dec(stV); dec(Y1V);
if Y1V < 1 then Y1V := 1;
Set_st_Szeile(Kanal,1,1);
if stV < 1 then
begin
stV := 1;
Alarm;
end;
if length(VorWrite[Kanal]^[stV]) < X1V then X1V := length(VorWrite[Kanal]^[stV]) + 1;
end;
_Dn : begin (* Cursor Dn *)
Set_st_Szeile(Kanal,1,1);
inc(stV); inc(Y1V);
if Y1V > VAnz then Y1V := VAnz;
if stV > (VorZeilen - VorCmdZeilen) then
begin
stV := VorZeilen - VorCmdZeilen;
if VorWrite[Kanal]^[stV] > '' then Vor_Feld_Scroll(Kanal)
else Alarm;
end;
if length(VorWrite[Kanal]^[stV]) < X1V then X1V := length(VorWrite[Kanal]^[stV]) + 1;
end;
_Left : begin (* Cursor left *)
if X1V > 1 then dec(X1V) else Alarm;
NeuPage := false;
end;
_Right : begin (* Cursor right *)
if X1V <= XLV then inc(X1V) else Alarm;
NeuPage := false;
end;
_Home : begin (* Home *)
X1V := 1;
NeuPage := false;
end;
_Ins : begin (* Ins *)
Insert_ON := not Insert_ON;
NeuPage := false;
end;
_End : begin (* END *)
X1V := XLV + 1;
NeuPage := false;
end;
_Tab : begin
Flag := false;
if (stV > 1) and TabFill then Hstr := VorWrite[Kanal]^[stV-1]
else Hstr := '';
if Hstr > '' then
begin
if X1V <= length(Hstr) then
begin
delete(Hstr,1,X1V);
Hstr := ConstStr('#',X1V) + Hstr;
if pos(B1,Hstr) in [X1V..78] then
begin
i := pos(B1,Hstr);
While (Hstr[i] = B1) and (i < length(Hstr)) do inc(i);
if XLV + (i - X1V) > 78 then i := Byte(78 - XLV) + X1V;
if i - X1V = 0 then Alarm;
Insert(ConstStr(B1,i-X1V),VorWrite[Kanal]^[stV],X1V);
X1V := i;
end else Flag := true;
end else Flag := true;
end else Flag := true;
if Flag then
begin
i := length(G^.TabStr);
if (XLV + i) > 78 then i := Byte(78 - XLV);
if i = 0 then Alarm;
Insert(copy(G^.TabStr,1,i),VorWrite[Kanal]^[stV],X1V);
X1V := X1V + i;
end;
end;
_CtrlLeft,
_CtrlRight: begin
Cur_Wort(VorWrite[Kanal]^[stV],KC,X1V,1);
NeuPage := false;
end;
_CtrlPgUp : begin (* Ctrl-Page-Up *)
Set_st_Szeile(Kanal,1,1);
stV := 1; X1V := 1; Y1V := 1;
end;
_CtrlPgDn : begin (* Ctrl-Page-Dn *)
Set_st_Szeile(Kanal,1,1);
i := (VorZeilen - VorCmdZeilen);
While (VorWrite[Kanal]^[i] = '') and (i > 1) do dec(i);
stV := i;
if i < VAnz then Y1V := stV else Y1V := VAnz;
X1V := length(VorWrite[Kanal]^[stV]) + 1;
end;
_Esc : begin
Cmd := true;
X1C := length(VorWrite[Kanal]^[stC]) + 1;
end;
_Nix :;
else Alarm;
end; { case KC of }
if show = Kanal then if NeuPage
then Neu_BildVor(Kanal)
else WritePage(Kanal,1,Y1V+Vofs,Attrib[24],0,VorWrite[Kanal]^[stV] + G^.Leer);
Soft_Cursor(Kanal);
end;
End;
Procedure ChangeXYst (* Kanal,Art : Byte; Var X1,Y1,st : Byte *);
Begin
with K[Kanal]^ do
begin
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
if Art = 0 then
begin
if Cmd then
begin
st := stC; X1 := X1C; Y1 := Y1C;
end else
begin
st := stV; X1 := X1V; Y1 := Y1V;
end;
end;
if Art = 1 then
begin
if Cmd then
begin
stC := st; X1C := X1; Y1C := Y1;
end else
begin
stV := st; X1V := X1; Y1V := Y1;
end;
end;
end;
End;
(* scrollt das Array f<>r den Vorschreibschirm nach oben *)
Procedure Vor_Feld_Scroll (* Kanal : Byte *);
var VAnz : Byte;
i : Integer;
Begin
with K[Kanal]^ do
begin
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
VAnz := VEnd - VBeg + 1;
if Cmd then
begin
X1C := 3;
inc(stC); inc(Y1C);
if Y1C > VorCmdZeilen then Y1C := VorCmdzeilen;
if Y1C > VAnz then Y1C := VAnz;
if stC > VorZeilen then
begin
for i := VorZeilen-VorCmdZeilen+1 to VorZeilen - 1
do VorWrite[Kanal]^[i] := VorWrite[Kanal]^[i+1];
stC := VorZeilen;
VorWrite[Kanal]^[stC][0] := Chr(2);
end;
end else
begin
X1V := 1;
inc(stV); inc(Y1V);
if Y1V > VAnz then Y1V := VAnz;
if (stV > (VorZeilen - VorCmdZeilen)) and (Y1V = VAnz) then
begin
for i := 1 to VorZeilen - VorCmdZeilen - 1 do
begin
VorWrite[Kanal]^[i] := VorWrite[Kanal]^[i+1];
stTX[i] := stTX[i+1];
end;
stV := VorZeilen - VorCmdZeilen;
VorWrite[Kanal]^[stV] := '';
stTX[stV] := false;
end;
end;
end;
End;
(* scrollt das Array f<>r den Vorschreibschirm ab der Position 'st' nach unten *)
Procedure Vor_Dn_Scroll (* Kanal : Byte *);
Var i,i1 : Integer;
X1,Y1,st : Byte;
Begin
with K[Kanal]^ do
begin
ChangeXYst(Kanal,0,X1,Y1,st);
i1 := VorZeilen - VorCmdZeilen;
if st < i1 then for i := 1 to i1 - st do
VorWrite[Kanal]^[i1-i+1] := VorWrite[Kanal]^[i1-i];
ChangeXYst(Kanal,1,X1,Y1,st);
end;
End;
Procedure Neu_BildVor (* Kanal : Byte *);
Var st,X1,Y1,i,i1,
VAnz,Attr,AMerk : Byte;
Begin
with K[Kanal]^ do
begin
ChangeXYst(Kanal,0,X1,Y1,st);
VAnz := VEnd - VBeg + 1;
if Cmd then
begin
Attr := Attrib[23];
if VAnz > VorCmdZeilen then
begin
VAnz := VorCmdZeilen;
Teil_Bild_Loesch(VBeg+VAnz,VEnd,Attr);
end;
end else Attr := Attrib[24];
i1 := st - Y1;
for i := 1 to VAnz do
begin
AMerk := Attr;
if stTX[i1+i] then Attr := Attrib[6];
WritePage(Kanal,1,i+Vofs,Attr,0,VorWrite[Kanal]^[i1+i] + G^.Leer);
Attr := AMerk;
end;
end;
End;
Procedure Soft_Cursor (* Kanal : Byte *);
Var X1,Y1,st,
Xh,Attr : Byte;
Neben : Boolean;
Begin
with K[Kanal]^ do
begin
ChangeXYst(Kanal,0,X1,Y1,st);
if not HardCur then
begin
Neben := false;
Xh := X1;
if Xh > 80 then Xh := 80;
if Xh > length(VorWrite[Kanal]^[st]) then Neben := true;
if Neben then Attr := Attrib[21] else Attr := Attrib[22];
if not Insert_ON then Attr := Attr + 128;
if Neben then WritePage(Kanal,Xh,Y1+Vofs,Attr,0,'Û')
else WriteAttr(Xh,Y1+Vofs,1,Attr,1);
end else InitCursor(X1,Y1+Vofs);
end;
End;
Procedure Set_st_Szeile (* Kanal,Art,st : Byte *);
var i : Byte;
Begin
with K[Kanal]^ do
begin
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
if Art = 0 then
begin
stTX[st] := true;
Einer_st := true;
TxByte := TxByte + length(VorWrite[Kanal]^[st]) + 1;
end else if Art = 1 then
begin
for i := 1 to VorZeilen do stTX[i] := false;
Einer_st := false;
TxByte := 0;
end;
end;
End;
Procedure TX_Out (* Kanal : Byte; All : Boolean *);
Var i : Byte;
Hstr : String[80];
Begin
with K[Kanal]^ do
Begin
Hstr := '';
Auto_CON := false;
if Kanal = 0 then K[0]^.TncNummer := Unproto;
if Vor_im_EMS then EMS_Seite_einblenden(Kanal,Vor);
if Conv.Active and (Kanal = ConvHilfsPort) then Conv_Tx_All(Kanal) else
begin
EigFlag := Echo in [1,3,5,7];
for i := 1 to VorZeilen - VorCmdZeilen do if stTX[i] then
begin
Hstr := Line_convert(Kanal,1,VorWrite[Kanal]^[i]);
if Kanal > 0 then NodeConnect(Kanal,UpCaseStr(Hstr));
S_PAC(Kanal,NU,false,Hstr + M1);
end;
if All then S_PAC(Kanal,NU,true,'');
EigFlag := false;
end;
Set_st_Szeile(Kanal,1,1);
End;
End; (* TX_out *)
Procedure Del_Wort (* Var Zeile : Str80; X1 : Byte *);
Begin
if Zeile[X1] in Menge then delete(Zeile,X1,1) else
begin
Repeat
delete(Zeile,X1,1);
Until (X1 > length(Zeile)) or (Zeile[X1] in Menge);
end;
While (Zeile[X1] = B1) and (X1 <= length(Zeile)) do delete(Zeile,X1,1);
End;
Procedure Cur_Wort (* Zeile : Str80; KC : Sondertaste; Var X1 : Byte; XM : Byte *);
Var XLV : Byte;
Begin
if KC = _CtrlLeft then
begin
if X1 > XM then
begin
Repeat
dec(X1);
Until (X1 < XM ) or (not(Zeile[X1] in Menge));
While (X1 >= XM) and (not(Zeile[X1] in Menge)) do dec(X1);
inc(X1);
end else Alarm;
end else if KC = _CtrlRight then
begin
XLV := length(Zeile);
if X1 <= XLV then
begin
While (X1 <= XLV) and (not(Zeile[X1] in Menge)) do inc(X1);
While (X1 <= XLV) and (Zeile[X1] in Menge) do inc(X1);
end else Alarm;
end;
End;

185
XPCOL.PAS Executable file
View file

@ -0,0 +1,185 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P C O L . P A S ³
³ ³
³ Routinen f<>r die Farbeinstellung ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Color_Einstellung;
Const xb = 5;
ya = 5;
lp = '²' + Chr(16);
rp = Chr(17) + '²';
Cstr = 'Color-Nr = ';
Zstr = 'Zeile: ';
Type ColPtr = Array[1..maxAttr] of String[70];
Var Old_Attrib,
i,yb,ym,yl : Byte;
ch : Char;
KC : Sondertaste;
Merker,
Flag : Boolean;
Hstr : String[3];
ADoc : ^ColPtr;
Procedure Attrib_Read(Art : Byte);
Var i,i1 : Byte;
Begin
FiResult := ResetTxt(G^.TFile);
i1 := ya;
for i := 1 to maxAttr do
begin
Readln(G^.TFile,DZeile);
ADoc^[i] := EFillStr(70,B1,B2 + RestStr(DZeile));
if Art = 1 then Attrib[i] := Byte(str_int(CutStr(DZeile)));
if i1 <= ym then
begin
WriteRam(xb,i1,Attrib[i],0,ADoc^[i]);
inc(i1);
end;
end;
Readln(G^.TFile,DZeile);
HighCol := Byte(str_int(copy(DZeile,1,1))) = 1;
ColorItensity(HighCol);
FiResult := CloseTxt(G^.TFile);
End;
Procedure KillPfeil;
Begin
WriteRam(xb-2,yb,15,0,B2);
WriteRam(xb+70,yb,15,0,B2);
End;
Begin
Assign(G^.TFile,Sys1Pfad + AttrDatei + LngExt);
flag := false;
Merker := true;
Neu_Bild;
Teil_Bild_Loesch(1,maxZ,0);
GetMem(ADoc,SizeOf(ADoc^));
FillChar(ADoc^,SizeOf(ADoc^),0);
i := length(InfoZeile(33));
WriteRam(40-i div 2,1,15,0,InfoZeile(33));
WriteRam(40-i div 2,2,15,0,ConstStr('-',i));
ym := maxZ - 5;
yb := ya;
yl := 1;
Attrib_Read(0);
WriteRam(xb,maxZ-1,15,0,InfoZeile(22));
WriteRam(xb,maxZ,15,0,InfoZeile(23));
Repeat
if Merker then Old_Attrib := Attrib[yl];
WriteRam(xb,maxZ-3,15,0,Cstr +
EFillStr(4,B1,int_str(Attrib[yl])) +
EFillStr(8,B1,'(' + int_str(Old_Attrib) + ')') +
EFillStr(length(Zstr)+3,B1,Zstr + int_str(yl)));
WriteRam(xb,yb,Attrib[yl],0,ADoc^[yl]);
WriteRam(xb-2,yb,15,0,lp);
WriteRam(xb+70,yb,15,0,rp);
_ReadKey(KC,ch);
case KC of
_Ret,
_Esc :;
_AltH : XP_Help(G^.OHelp[6]);
_Up : if (yl > 1) then
begin
KillPfeil;
dec(yl);
if yb > ya then dec(yb) else Scroll(Dn,0,ya,ym);
end else Alarm;
_Dn : if (yl < maxAttr) then
begin
KillPfeil;
inc(yl);
if yb < ym then inc(yb) else Scroll(Up,0,ya,ym);
end else Alarm;
_F1 : begin
yl := 1;
yb := ya;
Teil_Bild_Loesch(ya,ym,0);
Attrib_Read(1);
Flag := false;
end;
_Right : if Attrib[yl] < 255 then inc(Attrib[yl]);
_Left : if Attrib[yl] > 0 then dec(Attrib[yl]);
_F5 : if Attrib[yl] >= 16 then dec(Attrib[yl],16);
_F6 : if Attrib[yl] <= 239 then inc(Attrib[yl],16);
_F7 : begin
dec(Attrib[yl]);
if (Attrib[yl]+1) mod 16 = 0 then inc(Attrib[yl],16);
end;
_F8 : begin
inc(Attrib[yl]);
if Attrib[yl] mod 16 = 0 then dec(Attrib[yl],16);
end;
_F9 : begin
HighCol := not HighCol;
ColorItensity(HighCol);
end;
_F10 : if Attrib[yl] > 127 then Attrib[yl] := Attrib[yl] - 128
else Attrib[yl] := Attrib[yl] + 128;
_Andere : if ch in ['0'..'9'] then
begin
Hstr := ch;
GetString(Hstr,15,3,xb+length(Cstr),maxZ-3,KC,3,Ins);
if KC <> _Esc then
begin
Attrib[yl] := Byte(str_int(Hstr));
Flag := true;
end;
KC := _Nix;
end else Alarm;
else Alarm;
end;
Merker := not(KC in [_F5.._F10,_Right,_Left]);
if (KC in [_F5.._F10,_Right,_Left]) then Flag := true;
Until KC in [_Esc,_Ret];
if Flag then
begin
Teil_Bild_Loesch(ym+1,maxZ,0);
WriteRam(xb,maxZ-1,15,0,InfoZeile(34));
_ReadKey(KC,ch);
if (UpCase(ch) in YesMenge) or (KC in [_Ret]) then
begin
FiResult := RewriteTxt(G^.TFile);
for i := 1 to maxAttr do
Writeln(G^.TFile,EFillStr(3,B1,int_str(Attrib[i])) + ADoc^[i]);
if HighCol then i := 1
else i := 0;
Writeln(G^.TFile,i);
FiResult := CloseTxt(G^.TFile);
end;
Cursor_aus;
end;
FreeMem(ADoc,SizeOf(ADoc^));
Neu_Bild;
End;

298
XPCOMP.PAS Executable file
View file

@ -0,0 +1,298 @@
HTable : Array [0..257] of Table_Typ =
((Tab : $AB2C; Len : 15), (Tab : $AA84; Len : 15), (Tab : $9FC4; Len : 15),
(Tab : $AB3C; Len : 15), (Tab : $AB1C; Len : 15), (Tab : $AAFC; Len : 15),
(Tab : $AAEC; Len : 15), (Tab : $AAD4; Len : 15), (Tab : $AAB4; Len : 15),
(Tab : $F340; Len : 10), (Tab : $AAA4; Len : 15), (Tab : $7D64; Len : 15),
(Tab : $AADC; Len : 15), (Tab : $F400; Len : 7), (Tab : $AA94; Len : 15),
(Tab : $9FF4; Len : 15), (Tab : $9FD4; Len : 15), (Tab : $7D74; Len : 15),
(Tab : $AB44; Len : 15), (Tab : $AB34; Len : 15), (Tab : $AB24; Len : 15),
(Tab : $AB14; Len : 15), (Tab : $AB04; Len : 15), (Tab : $AAF4; Len : 15),
(Tab : $AAE4; Len : 15), (Tab : $AB60; Len : 14), (Tab : $AB0C; Len : 15),
(Tab : $AACC; Len : 15), (Tab : $AABC; Len : 15), (Tab : $AAAC; Len : 15),
(Tab : $AA9C; Len : 15), (Tab : $AA8C; Len : 15), (Tab : $C000; Len : 3),
(Tab : $3A80; Len : 9), (Tab : $ABC0; Len : 10), (Tab : $0060; Len : 11),
(Tab : $7D40; Len : 12), (Tab : $AB5C; Len : 14), (Tab : $0000; Len : 12),
(Tab : $AB58; Len : 14), (Tab : $7C00; Len : 9), (Tab : $3C80; Len : 9),
(Tab : $7D00; Len : 11), (Tab : $0010; Len : 12), (Tab : $1200; Len : 7),
(Tab : $7A00; Len : 7), (Tab : $B800; Len : 6), (Tab : $3200; Len : 7),
(Tab : $2200; Len : 7), (Tab : $F600; Len : 8), (Tab : $3D00; Len : 8),
(Tab : $9E00; Len : 9), (Tab : $BD80; Len : 9), (Tab : $7C80; Len : 9),
(Tab : $0080; Len : 9), (Tab : $AA00; Len : 9), (Tab : $BD00; Len : 9),
(Tab : $9F00; Len : 9), (Tab : $0300; Len : 8), (Tab : $AB78; Len : 13),
(Tab : $AB68; Len : 13), (Tab : $3C00; Len : 9), (Tab : $3000; Len : 9),
(Tab : $0020; Len : 11), (Tab : $7D50; Len : 12), (Tab : $3800; Len : 7),
(Tab : $7800; Len : 7), (Tab : $9C00; Len : 7), (Tab : $FE00; Len : 7),
(Tab : $2400; Len : 6), (Tab : $BC00; Len : 8), (Tab : $0200; Len : 8),
(Tab : $0100; Len : 8), (Tab : $F100; Len : 8), (Tab : $0040; Len : 11),
(Tab : $3100; Len : 8), (Tab : $F200; Len : 8), (Tab : $3400; Len : 7),
(Tab : $1C00; Len : 7), (Tab : $1E00; Len : 7), (Tab : $BE00; Len : 7),
(Tab : $ABA0; Len : 11), (Tab : $3E00; Len : 7), (Tab : $1400; Len : 6),
(Tab : $3600; Len : 7), (Tab : $F380; Len : 9), (Tab : $F080; Len : 9),
(Tab : $2000; Len : 8), (Tab : $FC00; Len : 8), (Tab : $9F80; Len : 10),
(Tab : $9E80; Len : 9), (Tab : $AB90; Len : 12), (Tab : $3B80; Len : 9),
(Tab : $AB80; Len : 12), (Tab : $AB54; Len : 14), (Tab : $3A50; Len : 13),
(Tab : $AB50; Len : 14), (Tab : $A000; Len : 5), (Tab : $1800; Len : 6),
(Tab : $9800; Len : 6), (Tab : $7000; Len : 5), (Tab : $4000; Len : 3),
(Tab : $0400; Len : 6), (Tab : $AC00; Len : 6), (Tab : $F800; Len : 6),
(Tab : $6000; Len : 4), (Tab : $3A00; Len : 10), (Tab : $FD00; Len : 8),
(Tab : $2800; Len : 5), (Tab : $B000; Len : 6), (Tab : $8000; Len : 4),
(Tab : $B400; Len : 6), (Tab : $1000; Len : 7), (Tab : $7D20; Len : 12),
(Tab : $E000; Len : 5), (Tab : $9000; Len : 5), (Tab : $E800; Len : 5),
(Tab : $0800; Len : 5), (Tab : $F700; Len : 8), (Tab : $A800; Len : 7),
(Tab : $7D80; Len : 9), (Tab : $F300; Len : 10), (Tab : $7E00; Len : 7),
(Tab : $AB48; Len : 14), (Tab : $3A48; Len : 13), (Tab : $AB4C; Len : 14),
(Tab : $3A60; Len : 12), (Tab : $9FFC; Len : 15), (Tab : $9FEC; Len : 15),
(Tab : $2100; Len : 8), (Tab : $9FDC; Len : 15), (Tab : $9FCC; Len : 15),
(Tab : $F000; Len : 9), (Tab : $7D7C; Len : 15), (Tab : $7D6C; Len : 15),
(Tab : $3A40; Len : 14), (Tab : $AB40; Len : 15), (Tab : $AB38; Len : 15),
(Tab : $AB30; Len : 15), (Tab : $AB28; Len : 15), (Tab : $AB20; Len : 15),
(Tab : $AB18; Len : 15), (Tab : $AB70; Len : 13), (Tab : $AB10; Len : 15),
(Tab : $AB08; Len : 15), (Tab : $AB00; Len : 15), (Tab : $AAF8; Len : 15),
(Tab : $AAF0; Len : 15), (Tab : $3B00; Len : 9), (Tab : $AAE8; Len : 15),
(Tab : $AAE0; Len : 15), (Tab : $AAD8; Len : 15), (Tab : $AAD0; Len : 15),
(Tab : $AB64; Len : 14), (Tab : $7D30; Len : 12), (Tab : $AAC8; Len : 15),
(Tab : $AAC0; Len : 15), (Tab : $AAB8; Len : 15), (Tab : $AAB0; Len : 15),
(Tab : $AAA8; Len : 15), (Tab : $AAA0; Len : 15), (Tab : $AA98; Len : 15),
(Tab : $AA90; Len : 15), (Tab : $AA88; Len : 15), (Tab : $AA80; Len : 15),
(Tab : $9FF8; Len : 15), (Tab : $9FF0; Len : 15), (Tab : $9FE8; Len : 15),
(Tab : $9FE0; Len : 15), (Tab : $9FD8; Len : 15), (Tab : $9FD0; Len : 15),
(Tab : $9FC8; Len : 15), (Tab : $9FC0; Len : 15), (Tab : $7D78; Len : 15),
(Tab : $7D70; Len : 15), (Tab : $3A58; Len : 13), (Tab : $7D68; Len : 15),
(Tab : $7D60; Len : 15), (Tab : $AB46; Len : 15), (Tab : $AB42; Len : 15),
(Tab : $AB3E; Len : 15), (Tab : $AB3A; Len : 15), (Tab : $AB36; Len : 15),
(Tab : $AB32; Len : 15), (Tab : $AB2E; Len : 15), (Tab : $AB2A; Len : 15),
(Tab : $AB26; Len : 15), (Tab : $AB22; Len : 15), (Tab : $AB1E; Len : 15),
(Tab : $AB1A; Len : 15), (Tab : $AB16; Len : 15), (Tab : $AB12; Len : 15),
(Tab : $AB0E; Len : 15), (Tab : $AB0A; Len : 15), (Tab : $AB06; Len : 15),
(Tab : $AB02; Len : 15), (Tab : $AAFE; Len : 15), (Tab : $AAFA; Len : 15),
(Tab : $AAF6; Len : 15), (Tab : $AAF2; Len : 15), (Tab : $AAEE; Len : 15),
(Tab : $AAEA; Len : 15), (Tab : $AAE6; Len : 15), (Tab : $AAE2; Len : 15),
(Tab : $AADE; Len : 15), (Tab : $AADA; Len : 15), (Tab : $AAD6; Len : 15),
(Tab : $AAD2; Len : 15), (Tab : $AACE; Len : 15), (Tab : $AACA; Len : 15),
(Tab : $AAC6; Len : 15), (Tab : $AAC2; Len : 15), (Tab : $AABE; Len : 15),
(Tab : $AABA; Len : 15), (Tab : $AAB6; Len : 15), (Tab : $AAB2; Len : 15),
(Tab : $AAAE; Len : 15), (Tab : $AAAA; Len : 15), (Tab : $AAA6; Len : 15),
(Tab : $AAA2; Len : 15), (Tab : $AA9E; Len : 15), (Tab : $3A44; Len : 15),
(Tab : $AA9A; Len : 15), (Tab : $AA96; Len : 15), (Tab : $AA92; Len : 15),
(Tab : $3080; Len : 9), (Tab : $AA8E; Len : 15), (Tab : $AA8A; Len : 15),
(Tab : $AA86; Len : 15), (Tab : $AA82; Len : 15), (Tab : $9FFE; Len : 15),
(Tab : $9FFA; Len : 15), (Tab : $9FF6; Len : 15), (Tab : $9FF2; Len : 15),
(Tab : $9FEE; Len : 15), (Tab : $9FEA; Len : 15), (Tab : $9FE6; Len : 15),
(Tab : $9FE2; Len : 15), (Tab : $9FDE; Len : 15), (Tab : $9FDA; Len : 15),
(Tab : $9FD6; Len : 15), (Tab : $9FD2; Len : 15), (Tab : $9FCE; Len : 15),
(Tab : $9FCA; Len : 15), (Tab : $9FC6; Len : 15), (Tab : $9FC2; Len : 15),
(Tab : $7D7E; Len : 15), (Tab : $7D7A; Len : 15), (Tab : $7D76; Len : 15),
(Tab : $7D72; Len : 15), (Tab : $7D6E; Len : 15), (Tab : $7D6A; Len : 15),
(Tab : $7D66; Len : 15), (Tab : $7D62; Len : 15), (Tab : $3A46; Len : 15),
(Tab : $3A70; Len : 12), (Tab : $AAC4; Len : 15), (Tab : $9FE4; Len : 15));
{Kompressionsroutine}
Function Compress (* Zeile : String, Kanal : Byte) : String *);
Var Hs2, Hstr : String;
t : Word;
s : Word;
i : Byte;
a : Integer;
b,c : Byte;
ch,ch2 : Char;
long : Boolean;
lang1,
lang2,
rate,
diff : byte;
s1:string;
Begin
lang2:=length(zeile);
hstr:='';
FillChar(Hstr,SizeOf(Hstr),0);
a := 7;
b := 1;
long := false;
diff:=1;
if K[Kanal]^.KompressUpd then
begin
Zeile:='';
for i:=1 to 127 do
Zeile:=Zeile+chr(K[Kanal]^.Kompression[i]);
end;
i := 0;
While (i < length(Zeile)) and not long do
begin
inc(i);
t := HTable[ord(Zeile[i])].Tab;
s := $8000;
C := 0;
While (C < HTable[ord(Zeile[i])].Len) and not long do
begin
inc(C);
if t and s = s then Hstr[b] := Chr(ord(Hstr[b]) + 1 shl a);
s := s shr 1;
dec(a);
if a < 0 then
begin
a := 7;
inc(b);
if b > 254 then long := true;
end;
end;
Hstr[0] := chr(b);
end;
if (length(Hstr) > length(Zeile)) or long then
begin
Hstr := Zeile[0] + ccoding(kanal, Zeile);
ch := #255;
diff:=2;
end else ch := Chr(length(Hstr));
Hstr := ch + Hstr;
ch2:=ch;
if (K[Kanal]^.CompC) and (not K[kanal]^.KompressUpd) then
begin
Hs2:='';
for i := 3 to length(Hstr) do
begin
Hstr[i] := Chr(Ord(Hstr[i]) xor K[Kanal]^.Kompression[i]);
end;
end;
if K[Kanal]^.KompressUpd then
begin
Hs2:='';
for i := 3 to length(Hstr) do
begin
Hstr[i] := Chr(Ord(Hstr[i]) xor Comp_Key_Tab [I]);
end;
K[Kanal]^.KompressUpd:=false;
k[kanal]^.FileSendWait:=k[kanal]^.fileSendWaitS;
end;
TestCom:=hstr;
Compress:=Hstr;
lang1:=length(hstr)-diff;
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.tXKompRate;
k[kanal]^.tXKompRate:=rate;
SetzeFlags(kanal);
End;
{Dekompressions-Routine}
Function DeCompress (* Zeile : String, Kanal : Byte) : String *);
Var Hstr, Hstr2 : String;
b,i,i1,l : Byte;
a : Integer;
t,t2 : Word;
Bit : LongInt;
ch : Char;
lang1,
rate,
lang2 : Byte;
s2:string;
Begin
lang1:=length(zeile)-1;
Hstr:='';
Hstr2:='';
if kanal=0 then delete(Zeile, Length(Zeile),1);
if K[Kanal]^.KompressUpd then
begin
for i := 3 to length(Zeile) do
begin
Zeile[i] := Chr(Ord(Zeile[i]) xor Comp_Key_Tab[I]);
end;
end else Hstr2:=Zeile;
if (K[Kanal]^.CompC) and (not K[kanal]^.KompressUpd) then
begin
for i := 3 to length(Zeile) do
begin
Zeile[i] := Chr(Ord(Zeile[i]) xor K[Kanal]^.Kompression[I]);
end;
end else Hstr2:=Zeile;
HStr:=''; i:=0;
ch := Zeile[1];
delete(Zeile,1,1);
if ch = #255 then
begin
delete(Zeile,1,1);
if lang1>0 then dec(lang1);
end;
if (ch < #255) and (Zeile[0] > #0) then
begin
Hstr := '';
l := 0;
Bit := 0;
for i := 1 to length(Zeile) do
begin
Bit := (Bit shl 8) or ord(Zeile[i]);
l := Byte(l + 8);
a := 0;
Repeat
b := HTable[a].Len;
if l >= b then
begin
t := HTable[a].Tab;
t2 := Word(Bit shr (l-b)) shl (16-b);
if t = t2 then
begin
Hstr := Hstr + chr(a);
l := l - b;
a := -1;
end;
end;
inc(a);
Until (a > 257) or (l < 3);
end;
end else Hstr := Zeile;
if K[Kanal]^.KompressUpd then
begin
for i:=1 to length(Zeile) do
begin
inc(K[Kanal]^.CompCUpdZahl);
K[Kanal]^.Kompression[K[Kanal]^.CompCUpdZahl]:=ord(Zeile[i]);
if K[Kanal]^.CompCUpdZahl=127 then
begin
k[kanal]^.KompressUpd:=false;
k[kanal]^.FileSendWait:=k[kanal]^.fileSendWaitS;
For i1:=1 to 127 do
k[kanal]^.Kompression[i1+127]:=k[kanal]^.Kompression[i1] xor Comp_Key_Tab[I1];
k[kanal]^.Kompression[255]:=k[kanal]^.Kompression[1];
end;
end;
zeile:='';
Hstr:='';
end;
DeCompress := Hstr;
lang2:=length(hstr);
rate:=CompRate(Lang1, Lang2);
if rate>=100 then rate:=k[kanal]^.RXKompRate;
k[kanal]^.RXKompRate:=rate;
setzeflags(kanal);
End;

435
XPCONV.PAS Executable file
View file

@ -0,0 +1,435 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P C O N V . P A S ³
³ ³
³ Routinen f<>r den Conversmode. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Conv_Tx_All (* Kanal : Byte *);
Var i : Byte;
Begin
with K[Kanal]^ do
begin
for i := 1 to VorZeilen - VorCmdZeilen do if stTX[i] then
begin
ConversTX(Kanal,false,false,VorWrite[Kanal]^[i] + M1);
inc(Conv.Count);
end;
ConversTX(Kanal,true,false,'');
Conv.Count := 0;
end;
End;
Procedure ConversTX (* Kanal : Byte; All,Head : Boolean; Zeile : String *);
Const ML = 8;
MZ = 71;
Var i,i1 : Byte;
Flag : Boolean;
CallStr : String[20];
Bstr,
Hstr : String;
Procedure Send_Blanks(Kanal : Byte);
Begin
with K[Kanal]^ do
begin
if not Flag and (Conv.LLen = 0) then
begin
if Kanal = ConvHilfsPort then _aus(Attrib[18],Kanal,ConstStr(B1,ML))
else S_PAC(Kanal,NU,false,ConstStr(B1,ML));
end;
Flag := false;
end;
End;
Begin
with K[Kanal]^ do if Conv.Active then
begin
CallStr := ConversCall(Kanal);
for i := 1 to maxLink do with K[i]^ do
begin
if (i <> Kanal) and Conv.Active and (Zeile > '') and
(K[Kanal]^.Conv.Chan = Conv.Chan) then
begin
Flag := false;
if (K[Kanal]^.Conv.Count = 0) and
((K[Kanal]^.Call <> Conv.LCall) or not Conv.NoCHead or Head) then
begin
if i = ConvHilfsPort then _aus(Attrib[18],i,CallStr)
else S_PAC(i,NU,false,CallStr);
Flag := true;
end;
Bstr := Line_convert(i,1,Zeile);
KillStartBlanks(Bstr);
KillEndBlanks(Bstr);
While pos(M1,Bstr) > 0 do Bstr[pos(M1,Bstr)] := B1;
While Bstr > '' do
begin
if (length(Bstr) + Conv.LLen) > MZ then
begin
Hstr := copy(Bstr,1,MZ-Conv.LLen);
KillEndBlanks(Hstr);
if ((length(Hstr)+Conv.LLen) = MZ) and
(copy(Bstr,MZ-Conv.LLen+1,1) <> B1) and
(pos(B1,Hstr) > 0) then
begin
i1 := length(Hstr);
While Hstr[i1] <> B1 do dec(i1);
Send_Blanks(i);
if i = ConvHilfsPort
then _aus(Attrib[18],i,copy(Bstr,1,i1-1) + M1)
else S_PAC(i,NU,false,copy(Bstr,1,i1-1) + M1);
Conv.LLen := 0;
delete(Bstr,1,i1);
KillStartBlanks(Bstr);
end else
begin
Send_Blanks(i);
if i = ConvHilfsPort
then _aus(Attrib[18],i,Hstr + M1)
else S_PAC(i,NU,false,Hstr + M1);
Conv.LLen := 0;
delete(Bstr,1,length(Hstr));
KillStartBlanks(Bstr);
end;
end else
begin
Send_Blanks(i);
if i = ConvHilfsPort
then _aus(Attrib[18],i,Bstr)
else S_PAC(i,NU,false,Bstr);
Conv.LLen := Conv.LLen + length(Bstr);
Bstr := '';
end;
end;
end;
if All then
begin
if i = ConvHilfsPort then
begin
if not RxLRet then _aus(Attrib[18],i,M1);
if Conv.Ret then _aus(Attrib[18],i,M1);
end else
begin
if not TxLRet then S_PAC(i,NU,false,M1);
if Conv.Ret then S_PAC(i,NU,false,M1);
S_PAC(i,NU,true,'');
end;
Conv.LLen := 0;
end;
Conv.LCall := K[Kanal]^.Call;
end;
end;
End;
Procedure ConversUser (* Kanal : Byte *);
Var i : Byte;
Hstr : String;
Bstr : String[20];
Begin
S_PAC(Kanal,NU,false,Plus + InfoZeile(314) + M1);
Hstr := '';
for i := 1 to maxLink do with K[i]^ do
begin
if Conv.Active then
begin
if i = ConvHilfsPort then Bstr := OwnCall + '=SYSOP'
else Bstr := Call;
Bstr := '(' + int_str(Conv.Chan) + ')-' + Bstr + B1;
if length(Hstr) > 65 then
begin
KillEndBlanks(Hstr);
S_PAC(Kanal,NU,false,Hstr + M1);
Hstr := '';
end;
Hstr := Hstr + Bstr;
end;
end;
KillEndBlanks(Hstr);
S_PAC(Kanal,NU,true,Hstr + M2);
End;
Procedure ConversRemote (* Kanal : Byte; Zeile : String *);
Var i,ic,afu : Byte;
CoFlag,
Flag : Boolean;
Rstr : String[2];
Cstr,
Vstr,
Hstr,
Bstr : String[6];
Procedure CHeader(Kanal : Byte);
Begin
with K[Kanal]^ do
begin
Cstr := OwnCall;
Strip(Cstr);
if Conv.Ret then Rstr := M2
else Rstr := M1;
end;
End;
Begin
with K[Kanal]^ do
begin
delete(Zeile,1,1);
Vstr := UpCaseStr(CutStr(Zeile));
Zeile := RestStr(Zeile);
if (Vstr = 'Q') or (Vstr = 'D') then
begin
ConversTX(Kanal,true,true,Plus + InfoZeile(244) + M1);
ConversIni(Kanal,false);
if Vstr = 'D' then S_PAC(Kanal,CM,true,'D')
else Send_Prompt(Kanal,FF);
end else
if Vstr = 'C' then
begin
CHeader(Kanal);
i := Byte(str_int(Zeile));
if i in [1..99] then
begin
CoFlag:=false;
ic:=0;
Afu:=Conv.AfuStatus;
while not CoFlag do
begin
inc(ic);
if ic=maxlink then CoFlag:=true;
if (K[ic]^.Conv.Active) and (K[ic]^.Conv.Chan = i) then
begin
CoFlag:=true;
Afu:=K[ic]^.Conv.AfuStatus;
end;
end;
if Afu=Conv.AfuStatus then
begin
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(248) + B1 + int_str(i) + Rstr);
ConversTX(Kanal,true,true,Plus + InfoZeile(247) + B1 + int_str(i) + M1);
Conv.Chan := i;
ConversTX(Kanal,true,true,Plus + InfoZeile(245) + M1);
end else
begin
S_Pac(kanal,nu,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +InfoZeile(442)+m1);
end;
end else
begin
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(249) + B1 + int_str(Conv.Chan) + Rstr);
end;
end else
if Vstr = 'R' then
begin
Conv.Ret := not Conv.Ret;
CHeader(Kanal);
if Conv.Ret
then S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr)+'*'+B1+Plus+InfoZeile(312) + M2)
else S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr)+'*'+B1+Plus+InfoZeile(313) + M1)
end else
if Vstr = 'S' then
begin
Hstr := UpCaseStr(CutStr(Zeile));
Strip(Hstr);
Zeile := RestStr(Zeile);
if Zeile > '' then
begin
i := 0;
Repeat
inc(i);
if i = ConvHilfsPort then Bstr := K[i]^.OwnCall
else Bstr := K[i]^.Call;
Strip(Bstr);
Flag := (i <> Kanal) and K[i]^.Conv.Active and
(Hstr = Bstr) and (K[i]^.Conv.Chan = Conv.Chan);
Until Flag or (i = maxLink);
if Flag then
begin
if K[i]^.Conv.AfuStatus = Conv.AfuStatus then
begin
Hstr := Call;
Strip(Hstr);
if i = ConvHilfsPort then
begin
_aus(Attrib[18],i,EFillStr(6,B1,Hstr) + '*' + B1 + Zeile + M1);
if K[i]^.Conv.Ret then _aus(Attrib[18],i,M1);
CHeader(Kanal);
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(242) + B1 + Hstr + Rstr);
end else
begin
S_PAC(i,NU,false,EFillStr(6,B1,Hstr) + '*' + B1 + Zeile + M1);
if K[i]^.Conv.Ret then S_PAC(i,NU,false,M1);
S_PAC(i,NU,true,'');
CHeader(Kanal);
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(242) + B1 + Hstr + Rstr);
end;
end else
S_Pac(Kanal, NU, true, EFillStr(6,B1,Cstr) + '*' + B1 + Plus +infozeile(442));
end else
begin
CHeader(Kanal);
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(50) + B1 + Hstr + Rstr);
end;
end;
end else
if (Vstr = 'H') or (Vstr = '?') then
begin
WishBuf := true;
Send_Hilfe(Kanal,G^.OHelp[17]);
S_PAC(Kanal,NU,true,'');
end else
if Vstr = 'U' then
begin
ConversUser(Kanal);
end else
if Vstr = 'V' then
begin
CHeader(Kanal);
Conv.NoCHead := not Conv.NoCHead;
if Conv.NoCHead
then S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr)+'*'+B1+Plus+InfoZeile(220) + Rstr)
else S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr)+'*'+B1+Plus+InfoZeile(219) + Rstr);
end else
begin
CHeader(Kanal);
S_PAC(Kanal,NU,true,EFillStr(6,B1,Cstr) + '*' + B1 + Plus +
InfoZeile(280) + B1 + '/' + Vstr + Rstr);
end;
Conv.LCall := '';
end;
End;
Function ConversIni (* Kanal : Byte; INI : Boolean *);
var ic, AfuCSt : Byte;
coflag:boolean;
Begin
COFlag:=False;
with K[Kanal]^ do
begin
if INI then
begin
if TNC[TNCNummer]^.AfuPort then AfuCSt:=1 else AfuCSt:=2;
{if (kanal=25) or (kanal=24) then AfucSt:=1; NUR FšR TESTS!!}
if Conv.AfuStatus=0 then Conv.AfuStatus:=AfuCSt;
ic:=0;
COFlag:=false;
while not coflag do
begin
inc(ic);
if ic=MaxLink then COFlag:=True;
if (K[ic]^.Conv.Active) and (K[ic]^.Conv.Chan=Conv.Chan) then
begin
AfuCSt:=K[ic]^.Conv.AfuStatus;
COFlag:=true;
end;
end;
COFlag:=False;
if Conv.AfuStatus=AfuCSt then
begin
Kanal_Benutz := true;
COFlag:=true;
with Conv do
begin
Active := true;
Ret := false;
NoCHead := false;
LCall := '';
end;
end else Conv.Fehler:=InfoZeile(442); {Conv.AfuStatus}
end else
begin
FillChar(Conv,SizeOf(Conv),0);
Kanal_Benutz := false;
COFlag:=true;
end;
end;
ConversIni:=COFlag;
End;
Procedure ConversAuswert (* Kanal,Nr : Byte *);
Const SYSOP = '(Sysop)';
Var i : Byte;
Begin
with K[Kanal]^ do
begin
if ConvHilfsPort > 0 then
begin
i := ConvHilfsPort;
ConversTX(i,true,true,Plus + InfoZeile(244) + B1 + SYSOP + M1);
S_PAC(i,CM,true,'I ' + K[i]^.OwnCall);
ConversIni(i,false);
ConvHilfsPort := 0;
InfoOut(Kanal,0,T,InfoZeile(258));
end else
begin
i := KanalFrei(0);
if Nr in [1..99] then
begin
if i <> 0 then
begin
ConvHilfsPort := i;
S_PAC(i,CM,true,'I ' + PhantasieCall);
K[i]^.Conv.Chan := Nr;
ConversIni(i,true);
InfoOut(show,0,T,InfoZeile(259) + B1 + '(Port' + B1 + int_str(i) + ')');
ConversTX(i,true,true,Plus + InfoZeile(245) + B1 + SYSOP + M1);
end else InfoOut(Kanal,T,T,InfoZeile(94));
end else InfoOut(Kanal,T,T,InfoZeile(281));
end;
end;
End;
Function ConversCall (* (Kanal : Byte) : Str20 *);
Var Hstr : String[6];
Begin
with K[Kanal]^ do
begin
if Kanal = ConvHilfsPort then Hstr := OwnCall
else Hstr := Call;
Strip(Hstr);
ConversCall := EFillStr(6,B1,Hstr) + DP + B1;
end;
End;
Procedure ConversQuit (* Kanal : Byte *);
Begin
ConversTX(Kanal,true,true,Plus + InfoZeile(244) + M1);
ConversIni(Kanal,false);
End;

126
XPCOPY.PAS Executable file
View file

@ -0,0 +1,126 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P C O P Y . P A S ³
³ ³
³ Filekopier-Routinen ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure FileKopieren (* Var Zeile : String *);
Var i,i1,i2,
Anzahl : Integer;
fq,fz : File;
Par : Array[1..3] of String[80];
Hstr,Joker : String;
srec : SearchRec;
maxPuffer : Word;
Procedure Kopieren(von,nach : String);
Var rResult,
wResult : Word;
Attr : Word;
FTime : LongInt;
Begin
Assign(fq,von);
GetFAttr(fq,Attr);
SetFAttr(fq,$20);
Assign(fz,nach);
if ResetBin(fq,T) = 0 then
begin
GetFTime(fq,FTime);
if RewriteBin(fz,T) = 0 then
begin
Repeat
Blockread(fq,Page^,maxPuffer,rResult);
BlockWrite(fz,Page^,rResult,wResult);
Until Eof(fq);
SetFTime(fz,FTime);
FiResult := CloseBin(fz);
SetFAttr(fz,Attr);
end else dec(Anzahl);
FiResult := CloseBin(fq);
end else dec(Anzahl);
End;
Begin
if MaxAvail > maxNotChBuf then maxPuffer := maxNotChBuf
else maxPuffer := MaxAvail - 1024;
GetMem(Page,maxPuffer);
FillChar(Page^,maxPuffer,0);
for i := 1 to 3 do Par[i] := ParmStr(i,' ',Zeile);
if pos(DP,Par[1]) = 0 then Par[1] := Par[3] + Par[1];
if pos(DP,Par[2]) = 0 then Par[2] := Par[3] + Par[2];
if not (((pos(Pkt ,Par[2]) > 0) and (pos('*',Par[1]) > 0))) then
begin
Joker := '';
i := length(Par[1]);
While (Par[1][length(Par[1])] <> BS) and (length(Par[1]) > 0) do
begin
Joker := Par[1][i] + Joker;
delete(Par[1],length(Par[1]),1);
dec(i);
end;
if pos(Pkt ,Par[2]) = 0 then
begin
if Par[2][length(Par[2])] <> BS then Par[2] := Par[2] + BS;
end;
if PfadOk(1,Par[2]) then
begin
Anzahl := 0;
FindFirst(Par[1] + Joker,AnyFile-Directory,srec);
While DosError = 0 do
begin
inc(Anzahl);
if pos(Pkt ,Par[2]) = 0 then
begin
Hstr := Par[2] + srec.Name;
end else Hstr := Par[2];
if Hstr <> (Par[1] + srec.Name) then Kopieren(Par[1] + srec.Name,Hstr) else
begin
dec(Anzahl);
end;
Hstr := '';
FindNext(srec);
end;
str(Anzahl,Hstr);
Zeile := Hstr + ' ' + InfoZeile(315);
end else Zeile := InfoZeile(316);
end else Zeile := InfoZeile(317);
FreeMem(Page,maxPuffer);
End;
Procedure Delete_Datei (* var Zeile : str80 *);
var Anzahl : Word;
f,fd : Text;
Hstr : String[80];
srec : SearchRec;
Begin
Anzahl := 0;
Hstr := Zeile;
While (length(Hstr) > 3) and (Hstr[length(Hstr)] <> BS)
do delete(Hstr,length(Hstr),1);
if Hstr[length(Hstr)] <> BS then Hstr := '';
FindFirst(Zeile,AnyFile-Directory,srec);
While DosError = 0 do
begin
Assign(fd,Hstr + srec.Name);
if EraseTxt(fd) = 0 then inc(Anzahl);
FindNext(srec);
end;
Zeile := int_str(Anzahl) + B1 + InfoZeile(35);
End;

252
XPCRC.PAS Executable file
View file

@ -0,0 +1,252 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P C R C . P A S ³
³ ³
³ CRC - Ermittlung ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure CRC_Datei (* var Zeile : str80 *);
Const PufferGroesse = $FFD0;
Type PufferPtr = Array[0..Puffergroesse] of Byte;
Var i,Anz,i1 : Integer;
lergebnis,
CRC,Anzahl,
maxPuffer : Word;
Groesse,
absolut,z,
von,bis : LongInt;
Puffer : ^PufferPtr;
Datei : File;
ok : Boolean;
Files,
Hstr : string[80];
PuffPtr,
CrcPtr : Pointer;
Begin
ok := false;
KillEndBlanks(Zeile);
Files := UpCaseStr(ParmStr(1,' ',Zeile));
Anz := ParmAnz;
CRC := 0;
Assign(Datei,Files);
if ResetBin(Datei,T) = 0 then
begin
Puffer := Nil;
if MaxAvail < maxPuffer then maxPuffer := MaxAvail;
GetMem(Puffer,maxPuffer);
FillChar(Puffer^,maxPuffer,#0);
Groesse := Filesize(Datei);
absolut := Groesse;
if Anz = 3 then
begin
Zeile := RestStr(Zeile);
von := str_int(CutStr(Zeile));
bis := str_int(RestStr(Zeile));
if (bis >= von) and (bis < Groesse) and (von >= 0) then
begin
ok := true;
absolut := bis - von + 1;
end;
end else
if Anz = 2 then
begin
von := str_int(RestStr(Zeile));
if (von >= 0) and (von < Groesse) then
begin
ok := true;
bis := Groesse - 1;
absolut := bis - von + 1;
end;
end;
if not ok then
begin
absolut := Groesse;
von := 0;
bis := Groesse - 1;
end else Seek(Datei,von);
z := absolut;
PuffPtr := Addr(Puffer^[0]);
CrcPtr := Addr(G^.CrcFeld[0]);
Repeat
if z > maxPuffer then
begin
Anzahl := maxPuffer;
z := z - Anzahl;
end else
begin
Anzahl := Word(z);
z := 0;
end;
Blockread(Datei,Puffer^,Anzahl,lergebnis);
asm push ds
les di,PuffPtr
mov dx,lergebnis
mov cl,8
mov ax,CRC
lds si,CrcPtr
@Again:
mov bx,ax
shl ax,cl
or al,[es:di]
shr bx,cl
shl bx,1
xor ax,[ds:si+bx]
inc di
dec dx
ja @Again
pop ds
mov CRC,ax
end;
(*
for z := 0 to lergebnis-1
do CRC := crcFeld[(CRC shr 8)] xor ((CRC shl 8) or Puffer^[z]);
*)
Until z = 0;
FiResult := CloseBin(Datei);
While pos(BS ,Files) <> 0 do delete(Files,1,pos(BS ,Files));
Zeile := 'CRC = ' + int_str(CRC) + '(dez) ' + Hex(CRC,4) + '(hex) '+
Files + ' -> Anzahl = ' + int_str(absolut) + ' Bytes (' + int_str(von) +
'-' + int_str(bis) + ')';
FreeMem(Puffer,maxPuffer);
end;
End;
Procedure GetNetRom;
Const PufferGroesse = $FFD0;
Type PufferPtr = Array[0..Puffergroesse] of Byte;
Var i,Anz,i1 : Integer;
lergebnis,
CRC,Anzahl,
maxPuffer : Word;
Groesse,
absolut,z,
von,bis : LongInt;
Puffer : ^PufferPtr;
Datei : File;
ok : Boolean;
zeile,
Files,
Hstr : string[80];
PuffPtr,
CrcPtr : Pointer;
Begin
maxpuffeR:=puffergroesse;
Zeile:='XPACKET.EXE';
ok := false;
KillEndBlanks(Zeile);
Files := UpCaseStr(ParmStr(1,' ',Zeile));
Anz := ParmAnz;
CRC := 0;
Assign(Datei,Files);
if ResetBin(Datei,T) = 0 then
begin
Puffer := Nil;
if MaxAvail < maxPuffer then maxPuffer := MaxAvail;
GetMem(Puffer,maxPuffer);
FillChar(Puffer^,maxPuffer,#0);
Groesse := Filesize(Datei);
absolut := Groesse;
if Anz = 3 then
begin
Zeile := RestStr(Zeile);
von := str_int(CutStr(Zeile));
bis := str_int(RestStr(Zeile));
if (bis >= von) and (bis < Groesse) and (von >= 0) then
begin
ok := true;
absolut := bis - von + 1;
end;
end else
if Anz = 2 then
begin
von := str_int(RestStr(Zeile));
if (von >= 0) and (von < Groesse) then
begin
ok := true;
bis := Groesse - 1;
absolut := bis - von + 1;
end;
end;
if not ok then
begin
absolut := Groesse;
von := 0;
bis := Groesse - 1;
end else Seek(Datei,von);
z := absolut;
PuffPtr := Addr(Puffer^[0]);
CrcPtr := Addr(G^.CrcFeld[0]);
Repeat
if z > maxPuffer then
begin
Anzahl := maxPuffer;
z := z - Anzahl;
end else
begin
Anzahl := Word(z);
z := 0;
end;
Blockread(Datei,Puffer^,Anzahl,lergebnis);
asm push ds
les di,PuffPtr
mov dx,lergebnis
mov cl,8
mov ax,CRC
lds si,CrcPtr
@Again:
mov bx,ax
shl ax,cl
or al,[es:di]
shr bx,cl
shl bx,1
xor ax,[ds:si+bx]
inc di
dec dx
ja @Again
pop ds
mov CRC,ax
end;
(*
for z := 0 to lergebnis-1
do CRC := crcFeld[(CRC shr 8)] xor ((CRC shl 8) or Puffer^[z]);
*)
Until z = 0;
hstr:=Hex(CRC,4);
if hstr<>CRCNROM then
begin
{$I-}
{ rewrite(datei);
if ioresult<>0 then HALT;}
HALT;
{$I+}
end;
FiResult := CloseBin(Datei);
FreeMem(Puffer,maxPuffer);
end;
End;

161
XPDEBUG.PAS Executable file
View file

@ -0,0 +1,161 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P D E B U G . P A S ³
³ ³
³ Verschiedene Systemausk<73>nfte ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Debug_Info (* Kanal,Aufruf : Byte *);
Var A : Byte;
i,i1 : Integer;
l : LongInt;
Istr,
Chan : String[2];
Frei : String[10];
Hstr : String[80];
f : Text;
Begin
A := Aufruf;
Assign(G^.TFile,G^.TempPfad + DebDatei);
FiResult := RewriteTxt(G^.TFile);
if A = 0 then Moni_Off(0);
Frei := B1 + InfoZeile(325) + B1;
Writeln(G^.TFile);
Writeln(G^.TFile,'':5,'D E B U G - I N F O','':10,Version,B2,lastEdit);
Writeln(G^.TFile,ConstStr('Ä',79));
Writeln(G^.TFile,EFillStr(30,B1,'Prefix-Segment : ' + Hex(PrefixSeg,4)) +
'³ OvrDosHandle : ' + int_str(OvrDosHandle));
Writeln(G^.TFile,EFillStr(30,B1,'Code-Segment : ' + Hex(CSeg,4)) +
'³ OvrEmsHandle : ' + int_str(OvrEmsHandle));
Writeln(G^.TFile,EFillStr(30,B1,'Daten-Segment : ' + Hex(DSeg,4)) +
'³ OvrHeapBegin : ' + Pointer_Str(Ptr(OvrHeapOrg,0)));
Writeln(G^.TFile,EFillStr(30,B1,'Stack-Segment : ' + Hex(SSeg,4)) +
'³ OvrHeapEnde : ' + Pointer_Str(Ptr(OvrHeapEnd,0)));
Writeln(G^.TFile,EFillStr(30,B1,'Stack-Pointer : ' + Hex(SPtr,4)) +
'³ OvrHeapPtr : ' + Pointer_Str(Ptr(OvrHeapPtr,0)));
Writeln(G^.TFile,EFillStr(30,B1,'Heap-Anfang : ' + Pointer_Str(HeapOrg)) +
'³ OvrHeapSize : ' + FormByte(int_str(OvrHeapSize)) + B1 + Bytes);
Writeln(G^.TFile,EFillStr(30,B1,'Akt.HeapSpitze : ' + Pointer_Str(HeapPtr)) +
'³ OvrGetBuf : ' + FormByte(int_str(OvrGetBuf)) + B1 + Bytes);
Writeln(G^.TFile,EFillStr(30,B1,'Heap-Ende : ' + Pointer_Str(HeapEnd)) +
'³ OvrLoadCount : ' + int_str(OvrLoadCount));
Writeln(G^.TFile,EFillStr(30,B1,'Video-Pointer : ' + Pointer_Str(Bild)) +
'³ OvrLoadList : ' + int_str(OvrLoadList));
Writeln(G^.TFile,ConstStr('Ä',79));
for i := 1 to 4 do
begin
Hstr := 'Port LPT-' + int_str(i) + ' = ' + Hex(LPT_Base[i],4);
if not LPT_Error(i) then Hstr := Hstr + ' Printer exist.';
Writeln(G^.TFile,Hstr);
end;
Writeln(G^.TFile,ConstStr('Ä',79));
for i := 0 to maxLink do
begin
l := SizeOf(K[i]^);
Chan := SFillStr(2,B1,int_str(i));
Hstr := Chan + '.Kanal-Pointer: ' + Pointer_Str(K[i]) + ' => '
+ FormByte(int_str(l)) + B1 + Bytes
+ ' ³ Syncherrors = ' + int_str(K[i]^.SynchErrAnz);
Writeln(G^.TFile,Hstr);
end;
Writeln(G^.TFile,ConstStr('Ä',79));
for i := 1 to maxTNC do
begin
if TNC_used[i] then l := SizeOf(TNC[i]^) else l := 0;
Hstr := int_str(i) + '.TNC-Pointer : ' + Pointer_Str(TNC[i]) +
' => ' + SFillStr(4,B1,FormByte(int_str(l))) + B1 + Bytes + B1;
if TNC_used[i] then
begin
if TNC[i]^.RS232 <> 5 then
begin
if HwHs then Istr := '--'
else Istr := SFillStr(2,B1,int_str(Com[TNC[i]^.RS232].IRQ_Nr));
Hstr := Hstr + ' COM/PORT/IRQ/BAUD = ' +
int_str(TNC[i]^.RS232) + '/' +
Hex(Com[TNC[i]^.RS232].Base,4) + '/' +
Istr + '/' +
int_str(Com[TNC[i]^.RS232].Baudrate)
end else Hstr := Hstr + B1 + PcxStr;
end;
Writeln(G^.TFile,Hstr);
end;
Writeln(G^.TFile,ConstStr('Ä',79));
Writeln(G^.TFile,ConstStr(B1,10) + 'IRQs - 76543210');
Writeln(G^.TFile,'IRQ-Maske : ' + Bin(Port[$21],8));
Writeln(G^.TFile,ConstStr('Ä',79));
Writeln(G^.TFile,'System-Pfad : ' +
SFillStr(11,B1,FreeStr(SysPfad[1])) + B1 + Bytes + frei + SysPfad);
Writeln(G^.TFile,'Mailbox-Pfad : ' +
SFillStr(11,B1,FreeStr(G^.MailPfad[1])) + B1 + Bytes + Frei + G^.MailPfad);
Writeln(G^.TFile,'Remote-Pfad : ' +
SFillStr(11,B1,FreeStr(K[show]^.RemPath[1])) + B1 + Bytes + Frei + K[show]^.RemPath);
Writeln(G^.TFile,'Runfile-Pfad : ' +
SFillStr(11,B1,FreeStr(G^.RunPfad[1])) + B1 + Bytes + Frei + G^.RunPfad);
Writeln(G^.TFile,'Speakfile-Pfad : ' +
SFillStr(11,B1,FreeStr(G^.SpkPfad[1])) + B1 + Bytes + Frei + G^.SpkPfad);
if use_VDisk then
Writeln(G^.TFile,'RAM-Floppy : ' +
SFillStr(11,B1,FreeStr(Vdisk[1])) + B1 + Bytes + Frei + Vdisk);
Writeln(G^.TFile,ConstStr('Ä',79));
Assign(f,SysPfad + BootDatei);
if ResetTxt(f) = 0 then
begin
Readln(f);
Readln(f);
while not Eof(f) do
begin
Readln(f,Hstr);
Writeln(G^.TFile,Hstr);
end;
FiResult := CloseTxt(f);
Writeln(G^.TFile,ConstStr('Ä',79));
end;
Writeln(G^.TFile,'Freier RAM insgesamt : ' + SFillStr(8,B1,FormByte(int_str(MemAvail))) + B1 + Bytes);
Writeln(G^.TFile,'gr. freier RAM-Block : ' + SFillStr(8,B1,FormByte(int_str(MaxAvail))) + B1 + Bytes);
Writeln(G^.TFile,'RAM vor dem Start : ' + SFillStr(8,B1,FormByte(int_str(FreeRam))) + B1 + Bytes);
Writeln(G^.TFile,'Belegter Heap : ' +
SFillStr(8,B1,FormByte(int_str(Adr_absolut(HeapPtr) - Adr_absolut(HeapOrg) + OvrGetBuf))) + B1 + Bytes);
Writeln(G^.TFile,ConstStr('Ä',79));
for i := 0 to maxLink do
begin
l := K[i]^.maxNotCh;
Chan := SFillStr(2,B1,int_str(i));
Hstr := Chan + '.Scroll : ' + Pointer_Str(NotCh[i]) + ' => ' +
SFillStr(6,B1,FormByte(int_str(l))) + B1 + Bytes + ' ³ ';
l := K[i]^.VorZeilen * 81;
Hstr := Hstr + Chan + '.Vor : ' + Pointer_Str(VorWrite[i]) + ' => ' +
SFillStr(6,B1,FormByte(int_str(l))) + B1 + Bytes + B1;
Writeln(G^.TFile,Hstr);
end;
Writeln(G^.TFile,ConstStr('Ä',79));
FiResult := CloseTxt(G^.TFile);
if Aufruf = 0 then
begin
ExecDOS(G^.Ext_View_Path + B1 + G^.TempPfad + DebDatei);
Neu_Bild;
Moni_On;
end;
if Aufruf = 1 then SF_Text(Kanal,G^.TempPfad + DebDatei);
KillFile(G^.TempPfad + DebDatei);
END;

2504
XPDEFS.PAS Executable file
View file

File diff suppressed because it is too large Load diff

1200
XPDIR.PAS Executable file
View file

File diff suppressed because it is too large Load diff

216
XPDOS.PAS Executable file
View file

@ -0,0 +1,216 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P D O S . P A S ³
³ ³
³ Routinen f<>r den DOS-Austieg ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure DosAufruf (* Var Zeile : Str128; Art : Byte *);
Var Flag : Boolean;
f : File;
INr,
i,Z : Byte;
Begin
Ini_TNC_Text(1);
if Art = 1 then Teil_Bild_Loesch(1,maxZ,7);
if Art = 2 then Teil_Bild_Loesch(1,maxZ,Attrib[18]);
SetzeCursor(1,2);
Flag := (Zeile = '');
if Flag then WriteRam(1,1,Attrib[5],0,InfoZeile(254));
if Zeile > '' then Zeile := COM_C + Zeile;
Close_SaveFiles;
StoreHeap;
Call_DOS(Zeile);
LoadHeap;
if DosError = 0 then Zeile := 'OK' else Zeile := '';
Open_SaveFiles;
Z := Zeilen_ermitteln;
if (Art = 1) and not Flag then
begin
Teil_Bild_Loesch(Z,Z,7);
WriteRam(1,Z,Attrib[5],0,InfoZeile(78));
SetzeCursor(length(InfoZeile(78))+2,Z);
Warten;
end;
if Art = 2 then
begin
Assign(f,Konfig.TempVerz + DosBild);
if ResetBin(f,T) = 0 then
begin
if FileSize(f) = 0 then
begin
FiResult := CloseBin(f);
FiResult := EraseBin(f);
DosBildSave(Z);
end else FiResult := CloseBin(f);
end else DosBildSave(Z);
end;
if Z <> maxZ then Switch_VGA_Mono;
ColorItensity(HighCol);
Cursor_Aus;
if not HwHs and HardCur then for i := 1 to 4 do
with COM[i] do if Active then
begin
Port[Base + $01] := $01;
end;
Ini_TNC_Text(0);
Neu_Bild;
Init_HardDrive;
End;
Procedure ExecDOS (* Zeile : str128 *);
Var Z : Byte;
Begin
if Zeile > '' then Zeile := COM_C + Zeile;
Ini_TNC_Text(1);
Teil_Bild_Loesch(1,maxZ,7);
SetzeCursor(1,1);
Close_SaveFiles;
StoreHeap;
Call_DOS(Zeile);
LoadHeap;
Open_SaveFiles;
Z := Zeilen_ermitteln;
if Z <> maxZ then Switch_VGA_Mono;
ColorItensity(HighCol);
Cursor_aus;
Init_HardDrive;
Ini_TNC_Text(0);
End;
Procedure DosBildSave (* Zeilen : Byte *);
var i,i1,
max : Word;
f : text;
H : string[80];
Begin
H := '';
Assign(f,Konfig.TempVerz + DosBild);
FiResult := RewriteTxt(f);
i1 := 1;
max := Zeilen * 160;
for i := 1 to max do
begin
if i mod 2 = 1 then
begin
if Bild^[i] in [#32..#254] then H := H + Bild^[i];
inc(i1);
if i1 > 80 then
begin
KillEndBlanks(H);
if H <> '' then Writeln(f,H);
H := '';
i1 := 1;
end;
end;
end;
Writeln(f);
FiResult := CloseTxt(f);
End;
Procedure StoreHeap;
var Result : Word;
Zaehl : LongInt;
Begin
HeapFeld := HeapOrg;
Zaehl := Adr_absolut(HeapPtr) - Adr_absolut(HeapOrg);
SizeHeap := Zaehl;
if use_XMS and ((LongInt(get_XMS_Free) * 1024) > Zaehl) then
begin
SwpHandle := get_XMS_Ram((Zaehl div 1024) + 2);
Data_to_XMS(HeapOrg,SwpHandle,0,SizeHeap);
SwapXms := true;
end else
begin
if Vdisk_Exists and (DiskFree(ord(VDisk[1])-64) > (Zaehl + 2048))
then Assign(HeapFile,VDisk + SwapDatei)
else Assign(HeapFile,Konfig.TempVerz + SwapDatei);
FiResult := RewriteBin(HeapFile,T);
if Zaehl > $FFFF then
Repeat
if Zaehl >= $FFFF then BlockWrite(HeapFile,HeapFeld^,$FFFF,Result)
else BlockWrite(HeapFile,HeapFeld^,Word(Zaehl),Result);
Zaehl := Zaehl - Result;
HeapFeld := Ptr(Seg(HeapFeld^) + $1000,Ofs(HeapFeld^));
Until Zaehl <= 0 else BlockWrite(HeapFile,HeapFeld^,Zaehl,Result);
FiResult := CloseBin(HeapFile);
end;
End;
Procedure LoadHeap;
var Result : Word;
Begin
HeapFeld := HeapOrg;
if use_XMS and SwapXms then
begin
XMS_to_Data(HeapOrg,SwpHandle,0,SizeHeap);
SwapXMS := false;
Free_XMS_Ram(SwpHandle);
end else
begin
FiResult := ResetBin(HeapFile,T);
Repeat
BlockRead(HeapFile,HeapFeld^,$FFFF,Result);
HeapFeld := Ptr(Seg(HeapFeld^) + $1000,Ofs(HeapFeld^));
Until Result <= 0;
FiResult := CloseBin(HeapFile);
FiResult := EraseBin(HeapFile);
end;
End;
Function Zeilen_ermitteln (* : Byte *);
var r : Registers;
i : Integer;
Begin
if Hercules then Zeilen_ermitteln := 25 else
begin
r.ah := $11;
r.al := $30;
intr($10,r);
i := r.dl + 1;
if i in [25,30,34,43,50,60] then Zeilen_ermitteln := Byte(i)
else Zeilen_ermitteln := 25;
end;
End;
Procedure Switch_VGA_Mono;
Begin
if not Hercules then
begin
if _VGA then TextMode(LastModeStore or $100)
else TextMode(LastModeStore and $FF);
end;
End;
Procedure Ini_TNC_Text (* Art : Byte *);
Var i : Byte;
Begin
for i := 1 to TNC_Anzahl do
begin
K[0]^.TncNummer := i;
S_PAC(0,CM,true,'U' + int_str(Art));
end;
End;

309
XPEMS.PAS Executable file
View file

@ -0,0 +1,309 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P E M S . P A S ³
³ ³
³ Routinen f<>r die EMS-Verwaltung. ³
³ ³
³ Abschrift mit leichten Žnderungen aus der Fachzeitschrift ³
³ " DOS - International " ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Unit XPEMS;
{$F+}
Interface
Uses DOS;
{ Globale Vereinbarungen f<>r Konstanten }
Const
{
EMS_NoError = 0;
EMS_DriverError = 1;
EMS_HardwareError = 2;
EMS_InvalidHandle = 3;
EMS_InvalidFunction = 4;
EMS_NoHandlesAvail = 5;
EMS_NoPageAvail = 6;
EMS_InvalidPageNumber = 7;
EMS_InvalidPage = 8;
EMS_MappingNotSaved = 9;
EMS_MappingAlreadySaved = 10;
EMS_NoEMSAvail = 11;
}
EMS_errortext : array[0..11] of string[40] =
('Keinen Fehler erkannt',
'Fehler im EMS-Treiber',
'Fehler in der EMS-Hardware',
'Ung<6E>ltiges EMS-Handle',
'Ung<6E>ltige EMS-Funktionsnummer',
'Keine EMS-Handles verf<72>gbar',
'Keine freien EMS-Seiten verf<72>gbar',
'Falsche EMS-Seitenzahl',
'Ung<6E>ltige EMS-Seitennummer',
'EMS-Mapping kann nicht gesichert werden',
'EMS-Mapping ist bereits gesichert',
'Kein EMS-Treiber installiert');
{ Globale Typ-Definitionen }
Type EMS_Handle = Word;
EMS_Seite = Byte;
EMS_SeiteImFenster = 0..3;
EMS_AlleHandles = array[0..255] of record
Handle,
SeitenAnzahl : Word;
end;
{ Globale Variablen-Definitionen }
Var EMS_Segment : Word;
EMS_Error : Byte;
EMS_Installiert : Boolean;
EMS_Fenster : array[0..3] of Word;
Function EMS_Status : Byte;
Function EMS_GesamtSeiten : Word;
Function EMS_FreieSeiten : Word;
Function EMS_Belegen(Anzahl : Word) : EMS_Handle;
Procedure EMS_Zuordnung(Handle : EMS_Handle; Fensterseite : EMS_SeiteImFenster; Seite : EMS_Seite);
Procedure EMS_Freigeben(Handle : EMS_Handle);
Function EMS_Version : Byte;
Procedure EMS_ZuordnungSichern(Handle : EMS_Handle);
Procedure EMS_ZuordnungEntsichern(Handle : EMS_Handle);
Function EMS_HandleAnzahl : Word;
Function EMS_BelegteSeiten(Handle : EMS_Handle) : Word;
Procedure EMS_AlleHandlesFeststellen(var tab : EMS_AlleHandles);
Procedure Init_EMS;
Implementation
Type EMS_Kopf = record
dummy : array[1..9] of Byte;
name : string[8];
end;
EMS_Zeiger = ^EMS_Kopf;
var cpu : Registers;
I : Byte;
Procedure Fehler(code : Byte);
Begin
Case code of
$80 : EMS_Error := 0;
$81 : EMS_Error := 1;
$83 : EMS_Error := 2;
$84 : EMS_Error := 3;
$85 : EMS_Error := 4;
$87 : EMS_Error := 5;
$88 : EMS_Error := 6;
$8A : EMS_Error := 7;
$8C : EMS_Error := 8;
$8D : EMS_Error := 9;
end;
End;
Function get_EMS_Window : Word;
Begin
cpu.ah := $41;
Intr($67,cpu);
if cpu.ah <> 0 then
begin
Fehler(cpu.ah);
get_EMS_Window := 0;
end else
begin
EMS_Error := 0;
get_EMS_Window := cpu.bx;
end;
End;
Function get_EMS_Installiert : Boolean;
Const id : string = 'EMMXXXX0';
var kopf : EMS_Zeiger;
flag : Boolean;
Index : Byte;
Begin
cpu.ah := $35;
cpu.al := $67;
MsDos(cpu);
kopf := Ptr(cpu.es,0);
flag := true;
index := 1;
Repeat
if kopf^.name[index] <> id[index] then flag := false;
inc(index);
Until (index = 9) or (flag = false);
get_EMS_Installiert := flag;
End;
Function EMS_Status : Byte;
Begin
cpu.ah := $40;
Intr($67,cpu);
EMS_Status := cpu.ah;
if cpu.ah <> 0 then Fehler(cpu.ah) else EMS_Error := 0;
End;
Function EMS_GesamtSeiten : Word;
Begin
cpu.ah := $42;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_GesamtSeiten := cpu.dx;
end else
begin
Fehler(cpu.ah);
EMS_GesamtSeiten := 0;
end;
End;
Function EMS_FreieSeiten : Word;
Begin
cpu.ah := $42;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_FreieSeiten := cpu.bx;
end else
begin
Fehler(cpu.ah);
EMS_FreieSeiten := 0;
end;
end;
Function EMS_Belegen(anzahl : Word) : EMS_Handle;
Begin
cpu.ah := $43;
cpu.bx := anzahl;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_Belegen := cpu.dx;
end else
begin
Fehler(cpu.ah);
EMS_Belegen := 0;
end;
End;
Procedure EMS_Zuordnung(Handle : EMS_Handle; Fensterseite : EMS_SeiteImFenster; Seite : EMS_Seite);
Begin
cpu.ah := $44;
cpu.al := Fensterseite;
cpu.bx := Seite;
cpu.dx := Handle;
Intr($67,cpu);
if cpu.ah = 0 then EMS_Error := 0 else Fehler(cpu.ah);
End;
Procedure EMS_Freigeben(Handle : EMS_Handle);
Begin
cpu.ah := $45;
cpu.dx := Handle;
Intr($67,cpu);
if cpu.ah = 0 then EMS_Error := 0 else Fehler(cpu.ah);
End;
Function EMS_Version : Byte;
Begin
cpu.ah := $46;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_Version := cpu.al;
end else
begin
Fehler(cpu.ah);
EMS_Error := 0;
end;
End;
Procedure EMS_ZuordnungSichern(Handle : EMS_Handle);
Begin
cpu.ah := $47;
cpu.dx := Handle;
Intr($67,cpu);
if cpu.ah = 0 then EMS_Error := 0 else Fehler(cpu.ah);
End;
Procedure EMS_ZuordnungEntsichern(Handle : EMS_Handle);
Begin
cpu.ah := $48;
cpu.dx := Handle;
Intr($67,cpu);
if cpu.ah = 0 then EMS_Error := 0 else Fehler(cpu.ah);
End;
Function EMS_HandleAnzahl : Word;
Begin
cpu.ah := $4B;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_HandleAnzahl := cpu.bx;
end else
begin
Fehler(cpu.ah);
EMS_HandleAnzahl := 0;
end;
End;
Function EMS_BelegteSeiten(Handle : EMS_Handle) : Word;
Begin
cpu.ah := $4C;
cpu.dx := Handle;
Intr($67,cpu);
if cpu.ah = 0 then
begin
EMS_Error := 0;
EMS_BelegteSeiten := cpu.bx;
end else
begin
Fehler(0);
EMS_BelegteSeiten := 0;
end;
End;
Procedure EMS_AlleHandlesFeststellen(var tab : EMS_AlleHandles);
var I : Byte;
Begin
for I := 0 to 255 do
begin
tab[i].Handle := 0;
tab[i].SeitenAnzahl := 0;
end;
cpu.ah := $4D;
cpu.es := Seg(tab);
cpu.di := Ofs(tab);
Intr($67,cpu);
if cpu.ah = 0 then EMS_Error := 0 else Fehler(cpu.ah);
End;
Procedure Init_EMS;
Begin
EMS_Installiert := get_EMS_Installiert;
if EMS_Installiert then
begin
EMS_Segment := get_EMS_Window;
for I := 0 to 3 do EMS_Fenster[I] := EMS_Segment + I*1024;
end else EMS_Error := 11;
End;
End.

1196
XPFILE.PAS Executable file
View file

File diff suppressed because it is too large Load diff

863
XPFRX.PAS Executable file
View file

@ -0,0 +1,863 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P F R X . P A S ³
³ ³
³ Routinen fuer die Speicherung von Savefiles ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure FileRxMenu (* Kanal : Byte *);
Const ArtMax = 5;
Var i : Byte;
KC : Sondertaste;
VC : Char;
Flag : Boolean;
X,Y,
Art : Byte;
Begin
with K[Kanal]^ do
begin
Moni_Off(0);
Flag := false;
for i := 9 to 15 do G^.Fstx[i] := 2;
G^.Fstr[7] := InfoZeile(329);
G^.Fstr[9] := InfoZeile(330);
G^.Fstr[10] := InfoZeile(331);
G^.Fstr[11] := InfoZeile(332);
G^.Fstr[12] := InfoZeile(333);
case RX_Bin of
1 : Art := 1;
2 : Art := 2;
3,
4,
5 : Art := 3;
else Art := 4;
end;
Repeat
for i := 9 to 12 do
begin
G^.Fstr[i][vM+1] := B1;
G^.Fstr[i][hM+1] := B1;
G^.Fstr[i][vM] := B1;
G^.Fstr[i][hM] := B1;
end;
if Art in [1..4] then
begin
X := vM;
Y := Art + 8;
end else
begin
X := hM;
Y := Art + 4;
end;
G^.Fstr[Y][X] := A_ch;
if HardCur then SetzeCursor(X+1,Y);
case RX_Bin of
1 : G^.Fstr[9][vM+1] := X_ch;
2 : G^.Fstr[10][vM+1] := X_ch;
3,
4 : G^.Fstr[11][vM+1] := 'x';
5 : G^.Fstr[11][vM+1] := X_ch;
end;
if Save then G^.Fstr[12][vM+1] := X_ch;
G^.Fstr[13] := '';
G^.Fstr[14] := '';
G^.Fstr[15] := '';
Fenster(15);
_ReadKey(KC,VC);
Case KC of
_Esc : Flag := true;
_Ret : ;
_F1 : Art := 1;
_F2 : Art := 2;
_F3 : Art := 3;
_F4 : Art := 4;
_F5 : Art := 5;
_F6,
_F7,
_F8,
_F9,
_F10 : Alarm;
_Up : if Art > 1 then dec(Art)
else Alarm;
_Dn : if Art < ArtMax then inc(Art)
else Alarm;
_Right : if Art < ArtMax then
begin
Art := Art + 4;
if Art > ArtMax then Art := ArtMax;
end else Alarm;
_Left : if Art > 1 then
begin
if Art <= 4 then Art := 1
else Art := Art - 4;
end else Alarm;
_AltH : XP_Help(G^.OHelp[21]);
else Alarm;
End;
if KC in [_F1.._F5,_Ret] then
case Art of
1,
2,
3 : begin
case Art of
1 : G^.Fstr[9][vM] := S_ch;
2 : G^.Fstr[10][vM] := S_ch;
3 : G^.Fstr[11][vM] := S_ch;
end;
Fenster(15);
Datei_Empfangen(Kanal,Art);
if RX_Bin > 0 then Flag := true;
end;
4 : begin
G^.Fstr[12][vM] := S_ch;
SaveFile(Kanal);
if Save then Flag := true;
end;
5 : Kill_Save_File(Kanal);
end;
SetzeFlags(Kanal);
Until Flag;
ClrFenster;
Neu_Bild;
Moni_On;
end;
End;
Procedure Datei_Empfangen (* Kanal : Byte; Art : Byte *);
Var Flag,
Fehler : Boolean;
l,
Size : LongInt;
KC : Sondertaste;
SizeStr : String[10];
Hstr : String[60];
i : Byte;
Begin
if Kanal > 0 then with K[Kanal]^ do
begin
if RX_Save then
begin
Size := FilePos(RXFile);
CloseRxFile(Kanal,1);
if Size < 1 then FiResult := EraseBin(RXFile);
RemoteSave := false;
Ignore := false;
RX_Save := false;
RX_Bin := 0;
AutoBinOn := AutoBin;
BoxZaehl:=5;
end else
begin
if RX_Bin = 0 then
begin
Fehler := false;
Flag := false;
Remotesave := false;
RX_Bin := Art;
G^.Fstr[14]:=InfoZeile(204);
Fenster(15);
GetString(FRxName,Attrib[3],60,2,15,KC,1,Ins);
if KC <> _Esc then
begin
FRxName := SvFRxCheck(Kanal,FRxName,TxtName);
if not PfadOk(1,FRxName) then
begin
Hstr := FRxName;
While Hstr[length(Hstr)] <> BS do delete(Hstr,length(Hstr),1);
Flag := MkSub(Hstr) and PfadOk(1,FRxName);
end else Flag := true;
if Flag then
begin
if RX_Bin = 1 then (* Textfile *)
begin
if OpenTextFile(Kanal) then
begin
RX_Count := 0;
RX_Laenge := 0;
RX_TextZn := 0;
RX_Time := Uhrzeit;
RX_Save := true;
end else Fehler := true;
end else
if RX_Bin = 2 then (* Bin„r *)
begin
Assign(RXFile,FRxName);
if ResetBin(RxFile,T) = 0 then
begin (* File vorhanden !!! *)
SizeStr := int_str(FileSize(RXFile));
G^.Fstr[14] := FRxName + B1 + InfoZeile(156);
G^.Fstr[15] := InfoZeile(286) + B1+ FormByte(SizeStr) + B3 + InfoZeile(287);
Size := FileSize(RXFile);
if Size mod 1000 < 300 then Size := Size - 1000;
if Size < 0 then Size := 0;
SizeStr := int_str((Size div 1000) * 1000);
Fenster(15);
Alarm;
GetString(SizeStr,Attrib[3],10,length(G^.Fstr[15])+3,15,KC,3,Ins);
if KC <> _Esc then
begin
Size := str_int(SizeStr);
if Size < 0 then Size := 0;
if Size < FileSize(RXFile) then
begin
Seek(RXFile,Size);
Truncate(RXFile);
if Size > 0 then
begin
VorWrite[Kanal]^[stV] := VorWrite[Kanal]^[stV] + B1 + SizeStr;
Chr_Vor_Show(Kanal,_End,#255);
end;
end;
RX_CRC := 0;
RX_Count := 0;
RX_Laenge := 0;
RX_Save := true;
end else
begin
FiResult := CloseBin(RXFile);
RX_Bin := 0;
end;
end else
begin (* alles klar, File ist nicht da *)
if RewriteBin(RXFile,T) = 0 then
begin
RX_CRC := 0;
RX_Count := 0;
RX_Laenge := 0;
RX_Save := true;
end else Fehler := true;
end;
end else
if RX_Bin = 3 then (* Auto-Bin„r *)
begin
if Exists(FRxName) then
begin (* File vorhanden !!! *)
Assign(RXFile,FRxName);
FiResult := ResetBin(RxFile,T);
Size := FileSize(RXFile);
FiResult := CloseBin(RxFile);
l := Size;
SizeStr := int_str(l);
G^.Fstr[14] := FRxName + B1 + InfoZeile(156);
G^.Fstr[15] := InfoZeile(286) + B1+ FormByte(SizeStr) + B3 + InfoZeile(287);
if l mod 1000 < 300 then l := l - 1000;
if l < 0 then l := 0;
SizeStr := int_str((l div 1000) * 1000);
Fenster(15);
Alarm;
GetString(SizeStr,Attrib[3],10,length(G^.Fstr[15])+3,15,KC,3,Ins);
if KC <> _Esc then
begin
l := str_int(SizeStr);
if l < 0 then l := 0;
if l < Size then
begin
RX_Count := l;
if l > 0 then
begin
VorWrite[Kanal]^[stV] := VorWrite[Kanal]^[stV] + B1 + SizeStr;
Chr_Vor_Show(Kanal,_End,#255);
end;
end else RX_Count := Size;
end else RX_Bin := 0;
end else AutoBinOn := true; (* alles klar, File ist nicht da *)
end else RX_Bin := 0;
end else Fehler := true;
end else RX_Bin := 0;
if Fehler then
begin
RX_Bin := 0;
Alarm;
G^.Fstr[15] := FRxName + B2 + InfoZeile(75) + B2 + InfoZeile(78);
Fenster(15);
SetzeCursor(length(G^.Fstr[15])+2,15);
Warten;
end;
Cursor_aus;
end else RX_Bin := 0;
end;
end else Alarm;
End;
Function OpenTextFile (* Kanal : Byte) : Boolean *);
Var Result : Word;
Begin
with K[Kanal]^ do
begin
Assign(RXFile,FRxName);
Result := ResetBin(RxFile,T);
if Result = 0 then Seek(RXFile,FileSize(RXFile))
else Result := RewriteBin(RxFile,T);
OpenTextFile := Result = 0;
end;
End;
Procedure OpenBinFile (* Kanal : Byte; Zeile : Str80 *);
Var i, ier : Byte;
Free : LongInt;
XFsize:longint;
xfile : file of byte;
FlagPkt:Boolean;
Schnibbel:string[10];
Function NewName(Kanal,Art : Byte; NStr : Str12) : Str25;
var i : Byte;
Ext : String[4];
Sstr : String[8];
Hstr : String[12];
Flag : Boolean;
begin
Hstr := K[Kanal]^.Call;
Strip(Hstr);
i := 0;
if Art = 0 then
begin
Repeat
inc(i);
Sstr := int_str(i) + Hstr;
Flag := not Exists(Konfig.BinVerz + Sstr + BS + Nstr);
Until Flag or (i > 250);
if Flag then
begin
if MkSub(Konfig.BinVerz + Sstr) then NewName := Sstr + BS + Nstr;
end else
begin
Ext := Pkt + ParmStr(2,Pkt,Nstr);
Repeat
inc(i);
Until not Exists(Konfig.BinVerz + Hstr + SFillStr(2,'0',int_str(i)) + Ext);
NewName := Hstr + SFillStr(2,'0',int_str(i)) + Ext;
end;
end;
if Art = 1 then
begin
Repeat
inc(i);
Ext := Pkt + SFillStr(3,'0',int_str(i));
Until not Exists(Konfig.BinVerz + Hstr + Ext);
NewName := Hstr + Ext;
end;
end;
Begin
with K[Kanal]^ do
begin
KillEndBlanks(Zeile);
Zeile := UpCaseStr(Zeile);
{ #BIN#818#|32501#$1AC785A4#A:\TREMEX\VIRUS.TXT }
{ #BIN#205453#|55561#$1EB98723?#fpac391.Lzh }
if not (XBIN.An) then delete(Zeile,1,5) else delete(Zeile,1,6);
i := pos('#',Zeile);
if i = 0 then i := length(Zeile)
else dec(i);
if i > 0 then RX_Laenge := LongInt(str_int(copy(Zeile,1,i)))
else RX_Laenge := 0;
if RX_laenge > 0 then
begin
Free := DiskFree(ord(FRxName[1])-64);
if (Free + FFFF) > RX_Laenge then
begin
if pos(Pipe,Zeile) > 0 then
begin
delete(Zeile,1,pos(Pipe,Zeile));
i := pos(LZ,Zeile);
if i > 0 then
begin
RX_Soll_CRC := Word(str_int(copy(Zeile,1,i-1)));
delete(Zeile,1,i);
end else RX_Soll_CRC := 0;
end else RX_Soll_CRC := 0;
if (pos('$',Zeile) = 1) and (pos(LZ,Zeile) in [10,11]) then
begin
RX_Date := str_int(copy(Zeile,1,9));
delete(Zeile,1,pos(LZ,Zeile));
end else RX_Date := 0;
xfsize:=0;
if RX_Bin = 0 then
begin
While pos(DP,Zeile) > 0 do delete(Zeile,1,pos(DP,Zeile));
While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
{**Check f<>r <20>berl„nge}
flagpkt:=false;
if pos(Pkt,Zeile) = 0 then
begin
Zeile := Zeile + Pkt;
flagpkt:=true;
end;
if pos(Pkt, Zeile)>9 then
begin
Zeile[7]:='~';
ier:=0;
repeat
inc(ier);
Schnibbel:=int_str(ier);
Zeile[8]:=Schnibbel[1];
until (not Exists(Konfig.BinVerz + Zeile)) or (ier>8);
repeat
delete(Zeile,9,1);
until Zeile[9]='.';
end; {>9}
if (length(zeile)-pos(pkt, Zeile))>3 then
begin
repeat
delete(Zeile, length(zeile), 1);
until (length(zeile)-pos(pkt, Zeile))<=3;
end;
if FlagPkt then delete(Zeile, length(zeile), 1);
FlagPkt:=false;
{**Check f<>r <20>berl„nge Ende}
if SaveNameCheck(0,Zeile) then
begin
if pos(Pkt,Zeile) > 0 then
begin
if Exists(Konfig.BinVerz + Zeile) then
begin
if xbin.an then
begin
assign(xfile, Konfig.BinVerz+Zeile);
reset(XFile);
xfsize:=filesize(XFile);
if (rx_laenge>xfsize) and (xFsize>1999) then
begin
xfsize:=xfsize-1000
end else xfsize:=0;
close(XFile);
end;
if (not xbin.an) or (xfsize=0) then Zeile := NewName(Kanal,0,Zeile);
end;
end else Zeile := NewName(Kanal,1,Zeile);
end else Zeile := NewName(Kanal,1,Zeile);
FRxName := Konfig.BinVerz + Zeile;
end;
Assign(RXFile,FRxName);
if RX_Bin = 0 then
begin
RemoteSave := true;
if (not XBin.An) or (XFsize=0) then FiResult := RewriteBin(RXFile,T);
end;
if RX_Bin = 3 then
begin
FiResult := ResetBin(RXFile,T);
if FiResult = 0 then
begin
Seek(RXFile,RX_Count);
Truncate(RXFile);
end else FiResult := RewriteBin(RXFile,T);
end;
if RX_Bin = 4 then
begin
RemoteSave := true;
FiResult := RewriteBin(RXFile,T);
end;
if FiResult = 0 then
begin
if not FileSend then
begin
if (not xbin.an) or ((xbin.an) and (xfsize=0)) then
begin
S_PAC(Kanal,NU,true,Meldung[9] + M1); { #OK# }
InfoOut(Kanal,0,1,Meldung[9]);
XBin.FrameNr:=0;
end;
if (xbin.an) and (xfsize>0) then
begin
XBin.FrameNr:=0;
S_PAC(Kanal,NU,true,Meldung[9] + int_str(xFsize)+ M1);
reset(RXFile, T);
Seek(RXFile,xfsize);
Truncate(RXFile);
InfoOut(Kanal,0,1,Meldung[9]+Int_Str(XFsize));
rx_Count:=xfsize;
end;
if xbin.an then xbin.rx:=true;
end;
if not xbin.rx then
begin
RX_Save := true;
Ignore := true;
end;
xbin.rtxOK:=true;
RX_Time := Uhrzeit;
RX_Count := 0;
RX_TextZn := 0;
RX_CRC := 0;
if not XBin.An then RX_Bin := 5 else XBin.RX:=true;
end else
begin
S_Aus(Kanal,3,M1 + Meldung[10] + M1); { #ABORT# }
S_PAC(Kanal,NU,true,'');
end;
end else
begin
RX_Bin := 0;
RemoteSave := false;
Ignore := false;
S_Aus(Kanal,3,M1 + Meldung[10] + M1); { #ABORT# }
S_PAC(Kanal,NU,true,'');
SetzeFlags(Kanal);
end;
end;
if xbin.an then rx_bin:=0;
end;
End;
Procedure Write_RxFile (* Kanal : Byte; Zeile : String *);
Var i,i1 : Integer;
Free : LongInt;
DatPos:longint;
Result : Word;
Hstr : String[80];
VC : Char;
Bstr : String;
XBinRX : string;
Begin
with K[Kanal]^ do
Begin
case RX_Bin of
1 : begin (* normales Textfile *)
if RemoteSave and (MldOk in [16,17]) then
begin
CloseRxFile(Kanal,0);
RX_Save := false;
BoxZaehl:=5;
RX_Bin := 0;
RemoteSave := false;
If Not FWD then
S_Aus(Kanal,3,M1 + InfoZeile(117) + B1 +
int_Str(RX_TextZn) + B1 + InfoZeile(118)+ M1);
if MsgToMe then
begin
MsgToMe := false;
Eig_Mail_Zeile := '';
Check_Eig_Mail(1,maxLink);
if Eig_Mail_Zeile > '' then
begin
InfoOut(show,0,1,InfoZeile(153) + Eig_Mail_Zeile);
If Klingel then Triller;
end;
end;
Ignore := false;
SetzeFlags(Kanal);
Send_Prompt(Kanal,FF);
end else
if RemoteSave and (MldOk = 10) then
begin
CloseRxFile(Kanal,0);
RX_Save := false;
BoxZaehl:=5;
RX_Bin := 0;
RemoteSave := false;
Ignore := false;
if EraseBin(RXFile) = 0
then S_Aus(Kanal,3,M1 + Star + InfoZeile(41) + M1);
SetzeFlags(Kanal);
Send_Prompt(Kanal,FF);
end else
begin
RX_Count := RX_Count + length(Zeile);
Zeile := Line_Convert(Kanal,2,Zeile);
Bstr := '';
for i := 1 to length(Zeile) do
Begin
VC := Zeile[i];
case VC of
^I : Bstr := Bstr + VC;
M1 : begin
Bstr := Bstr + #13 + #10;
inc(RX_TextZn);
end;
#1..#31
: Bstr := Bstr + '^' + chr(ord(VC)+64);
^Z :;
#0 :;
#127:;
else Bstr := Bstr + VC;
end;
if (length(Bstr) > 250) or (i = length(Zeile)) then
begin
BlockWrite(RXFile,Bstr[1],length(Bstr),Result);
Bstr := '';
end;
End;
FileInfo(Kanal,0,0,RX_Count,0,0);
end;
end;
2 : begin (* normales Bin„rfile-Empfangen *)
BlockWrite(RXFile,Zeile[1],length(Zeile),Result);
RX_Count := RX_Count + length(Zeile);
FileInfo(Kanal,0,0,RX_Count,0,0);
end;
5 : begin (* Automatischer Bin„rfile-Empfang *)
if MldOk in [5,6,10] then
begin
if MldOk = 10 then
begin
FiResult := CloseBin(RxFile);
FiResult := EraseBin(RxFile);
S_PAC(Kanal,NU,false,InfoZeile(41) + M1);
Send_Prompt(Kanal,FF);
end else CloseRxFile(Kanal,1);
RX_Bin := 0;
RX_Save := false;
BoxZaehl:=5;
Remotesave := false;
Ignore := false;
AutoBinOn := AutoBin;
SetzeFlags(Kanal);
end else
begin
if xbin.an then
begin
if length(zeile)>8 then
begin
XBinRX := copy (Zeile, 1, 8);
delete (Zeile,1,8);
end else
begin
XBinRX := Zeile;
zeile:='';
end;
DatPos:=filePos(RXFile);
XBinCHECK(Kanal, XBinRX, DatPos, Zeile);
end;
i1 := length(Zeile);
if (RX_Count + i1) > RX_Laenge then i1 := Byte(RX_Laenge - RX_Count);
BlockWrite(RXFile,Zeile[1],i1,Result);
RX_CRC := Compute_CRC(RX_CRC,copy(Zeile,1,Result));
RX_Count := RX_Count + i1;
FileInfo(Kanal,0,RX_Laenge,RX_Count,0,0);
if RX_Count >= RX_Laenge then
begin
CloseRxFile(Kanal,0);
Result := Word(RX_CRC);
RX_Save := false;
BoxZaehl:=5;
RX_Bin := 0;
AutoBinOn := AutoBin;
Ignore := false;
SetzeFlags(Kanal);
Hstr := Time_Differenz(RX_Time,Uhrzeit);
Zeile := FName_aus_FVar(RxFile);
While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
{ Zeile := M1 + B1 + InfoZeile(103) + B1 + }
Zeile := B1 + InfoZeile(103) + B1 + {//db1ras}
EFillStr(14,B1,Zeile) + InfoZeile(100) +
int_str(Result) + B2 + LRK + Hex(Result,4) + B1 +
BdStr + FileBaud(Hstr,int_str(RX_Count)) + B2 +
LRK + Hstr + RRK + M1;
if (RX_Soll_CRC > 0) and (Result <> RX_Soll_CRC)
then Zeile := Zeile + B1 + InfoZeile(113) + ^G + M1;
{ Zeile := Zeile + M1; }
{//db1ras}
if SysArt in [0,17,21] then begin {XP, PROFI}
S_PAC(Kanal,NU,false,Zeile);
Send_Prompt(Kanal,FF);
end else if SysArt = 3 then {FBB}
S_PAC(Kanal,NU,true,M1);
Remotesave := false;
if RxComp then MeldeCompZ := ''
else MeldeZeile := '';
DZeile := Zeile;
WeFlag := true;
end;
end;
end;
end; (* case RX_Bin of ... *)
End; (* with ... do *)
End;
Procedure CloseRxFile (* Kanal,Art : Byte *);
Var dt : DateTime;
Begin
with K[Kanal]^ do
begin
if ((RX_Bin = 5) or (Xbin.An)) and (RX_Date > 0) then
begin
if Art = 1 then
begin
UnpackTime(RX_Date,dt);
dt.Year := dt.Year + 50;
PackTime(dt,RX_Date);
end;
SetFTime(RxFile,RX_Date);
end;
FiResult := CloseBin(RxFile);
end;
End;
Procedure SaveFile (* Kanal : Byte *);
var Result : Word;
Hstr : String[60];
KC : Sondertaste;
Flag : Boolean;
Begin
with K[Kanal]^ do
begin
if Save then
begin
Save := false;
FiResult := CloseBin(SFile);
end else
begin
Flag := false;
Fenster(15);
GetString(SvName,Attrib[3],60,2,15,KC,1,Ins);
svname:=upcasestr(SvName);
if KC <> _Esc then
begin
SvName := SvFRxCheck(Kanal,SvName,SaveName);
if not PfadOk(1,SvName) then
begin
Hstr := SvName;
While Hstr[length(Hstr)] <> BS do delete(Hstr,length(Hstr),1);
Flag := MkSub(Hstr) and PfadOk(1,SvName);
end else Flag := true;
if Flag then
begin
Assign(SFile,SvName);
Result := ResetBin(SFile,T);
If Result = 0 then Seek(SFile,FileSize(SFile))
else if Result = 2 then Result := RewriteBin(SFile,T);
if Result in [0,2] then Save := true;
end;
if not Save then
begin
Alarm;
G^.Fstr[15] := InfoZeile(295) + B2 + InfoZeile(78);
Fenster(15);
SetzeCursor(length(G^.Fstr[15])+2,15);
Warten;
Cursor_aus;
end else SvLRet := true;
end;
end;
end;
End;
Procedure Write_SFile (* Kanal : Byte; Zeile : String *);
Var i : Byte;
Result : Word;
VC : Char;
Flag : Boolean;
Hstr : String;
Begin
Flag := K[Kanal]^.EigFlag or K[Kanal]^.FileFlag or K[Kanal]^.RemFlag;
Zeile := Line_Convert(Kanal,2,Zeile);
Hstr := '';
for i := 1 to length(Zeile) do
Begin
VC := Zeile[i];
if Flag and (Kanal > 0) and K[Kanal]^.SvLRet then Hstr := Hstr + EchoCh + B1;
K[Kanal]^.SvLRet := false;
case VC of
^I : Hstr := Hstr + VC;
^J : if Kanal = 0 then Hstr := Hstr + #13 + #10;
M1 : begin
if (Kanal = 0) and ZeigeRET then Hstr := Hstr + '^' + chr(ord(^J)+64);
Hstr := Hstr + #13 + #10;
K[Kanal]^.SvLRet := true;
end;
^Z :;
#0 :;
#127:;
#1..#31
: Hstr := Hstr + '^' + chr(ord(VC)+64)
else Hstr := Hstr + VC;
end;
if (length(Hstr) > 250) or (i = length(Zeile)) then
begin
BlockWrite(K[Kanal]^.SFile,Hstr[1],length(Hstr),Result);
Hstr := '';
end;
End;
End;
Function SvFRxCheck (* Kanal : Byte; Zeile : Str60; Name : Str12) : Str60 *);
Begin
if (Zeile = '') or (Zeile[length(Zeile)] = BS) or not SaveNameCheck(1,Zeile)
then Zeile := Konfig.SavVerz + Name + SFillStr(3,'0',int_str(Kanal));
if pos(Pkt,Zeile) = 0 then Zeile := Zeile + Pkt + SFillStr(3,'0',int_str(Kanal));
if pos(DP,Zeile) = 0 then Zeile := Konfig.SavVerz + Zeile;
SvFRxCheck := Zeile;
End;

735
XPFTX.PAS Executable file
View file

@ -0,0 +1,735 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P T R X . P A S ³
³ ³
³ Routinen fuer die Aussendung von Files ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure FileTxMenu (* Kanal : Byte *);
Const ArtMax = 8;
Var i : Byte;
KC : Sondertaste;
VC : Char;
Fehler,
Flag : Boolean;
X,Y,
Art : Byte;
Begin
with K[Kanal]^ do
begin
if node then Wishbuf:=false;
Moni_Off(0);
Flag := false;
for i := 9 to 15 do G^.Fstx[i] := 2;
G^.Fstr[7] := InfoZeile(334);
G^.Fstr[9] := InfoZeile(335);
G^.Fstr[10] := InfoZeile(336);
G^.Fstr[11] := InfoZeile(337);
G^.Fstr[12] := InfoZeile(338);
G^.FStr[13] := InfoZeile(339);
if FileSendWait then Art := 5 else
begin
if FileSend then
begin
case TX_Bin of
0 : Art := 1;
1 : Art := 2;
2,
3 : Art := 3;
end;
if XBin.TX then Art:=5;
end else
if TNC_Puffer then Art := 6 else
if WishBuf then Art := 7
else Art := 1;
end;
Repeat
for i := 9 to 13 do
begin
G^.Fstr[i][vM+1] := B1;
G^.Fstr[i][hM+1] := B1;
G^.Fstr[i][vM] := B1;
G^.Fstr[i][hM] := B1;
end;
if Art in [1..5] then
begin
X := vM;
Y := Art + 8;
end else
begin
X := hM;
Y := Art + 4;
end;
{ if Art= 9 then
begin
x:=vm;
y:=art+8;
end;}
G^.Fstr[Y][X] := A_ch;
if HardCur then SetzeCursor(X+1,Y);
if FileSend then
begin
case TX_Bin of
0 : G^.Fstr[9][vM+1] := X_ch;
1 : G^.Fstr[10][vM+1] := X_ch;
2 : G^.Fstr[11][vM+1] := 'x';
3 : G^.Fstr[11][vM+1] := X_ch;
end;
end;
if FileSendWait then G^.Fstr[9][hM+1] := X_ch;
if TNC_Puffer then G^.Fstr[10][hM+1] := X_ch;
if WishBuf then G^.Fstr[11][hM+1] := X_ch;
if BufExists then G^.Fstr[12][hM+1] := X_ch;
{if XBin.AN then G^.FSTR[13]:='XBIN AN ' else G^.Fstr[13]:='XBIN Aus';}
{G^.Fstr[13] := '';}
G^.Fstr[14] := '';
G^.Fstr[15] := '';
Fenster(15);
_ReadKey(KC,VC);
Case KC of
_Esc : Flag := true;
_AltH : XP_Help(G^.OHelp[22]);
_Ret : ;
_F1 : Art := 1; {text}
_F2 : Art := 2; {bin}
_F3 : Art := 3; {autobin}
_F4 : Art := 4; {autobin sof}
_F5 : Art := 5; {xbin}
_F6 : Art := 6; {ftx anhalten}
_F7 : Art := 7; {tnc-puffer}
_F8 : Art := 8; {ZWP anlegen}
_F9 : Art := 9; {ZWP l”schen}
_F10 : Alarm;
_Up : if Art > 1 then dec(Art)
else Alarm;
_Dn : if Art < ArtMax then inc(Art)
else Alarm;
_Right : if Art < ArtMax then
begin
Art := Art + 4;
if Art > ArtMax then Art := ArtMax;
end else Alarm;
_Left : if Art > 1 then
begin
if Art <= 4 then Art := 1
else Art := Art - 4;
end else Alarm;
else Alarm;
End;
if KC in [_F1.._F9,_Ret] then
case Art of
1,
2,
3,
4,
5 : begin
if Art=5 then XBin.AN:=true;
if (not FileSend) and (not SPlSave) and (RX_bin=0) then
begin
case Art of
1 : G^.Fstr[9][vM] := S_ch;
2 : G^.Fstr[10][vM] := S_ch;
3 : G^.Fstr[11][vM] := S_ch;
4 : G^.Fstr[12][vM] := S_ch;
5 : G^.Fstr[13][vM] := S_ch;
end;
Fenster(15);
if art=5 then art:=3;
Datei_Senden(Kanal,Art);
if FileSend then
begin
Flag := true;
end else if xbin.an then art:=5;
end else Alarm;
end;
6 : if (FileSend) and (not XBin.TX) then
begin
if (not XBin.TX) then FileSendWait := not FileSendWait
else
begin
xbinWait:=not XBinWait;
{if not FileSendWait then
begin
FileSendWait:=true;
end;}
end;
end
else Alarm;
7 : begin
if not TNC_Puffer then
begin
Fehler:=false;
For i:=1 to maxlink do
if K[i]^.TNC_Puffer then Fehler:=true;
if not fehler then
TNC_Puffer := not TNC_Puffer
else Alarm;
end else TNC_Puffer := not TNC_Puffer;
end;
8 : if not node then WishBuf := not WishBuf else Alarm;
9 : If BufExists then EraseBufferFile(Kanal);
end;
SetzeFlags(Kanal);
Until Flag;
if (filesend) and (XBin.AN) then TNC_Puffer:=false;
{bei XBIN-protokoll unbedingt vorzeitiges senden an TNC verbieten,
zwecks Pr<50>fsummenerstellung und Framez„hler!!}
ClrFenster;
Neu_Bild;
Moni_On;
end;
End;
Procedure Datei_Senden (* Kanal : Byte; Art : Byte *);
Var Hstr : String[80];
abByte : Boolean;
KC : Sondertaste;
Flag : Boolean;
Begin
if Kanal > 0 then with K[Kanal]^ do
begin
xbin.rtxok:=true;
if FileSend then
begin
FileSend := false;
BoxZaehl:=5;
FiResult := CloseBin(TxFile);
S_PAC(Kanal,NU,true,'');
TNC_Puffer := false;
end else
begin
Flag := false;
Case Art of
1 : TX_Bin := 0;
2 : TX_Bin := 1;
3 : TX_Bin := 2;
4 : begin
TX_Bin := 2;
Flag := true;
end;
End;
G^.Fstr[14]:=InfoZeile(204);
Fenster(15);
GetString(FTxName,Attrib[3],60,2,15,KC,1,Ins);
G^.Fstr[14]:='';
Fenster(15);
if KC <> _Esc then
begin
if pos(B1,FTxName) > 0 then
begin
Hstr := RestStr(FTxName);
FTxName := CutStr(FTxName);
abByte := true;
end else abByte := false;
FTxName := UpCaseStr(FTxName);
if pos(DP,FTxName) = 0 then FTxName := Konfig.SavVerz + FTxName;
if SaveNameCheck(1,FTxName) then Assign(TxFile,FTxName)
else Assign(TxFile,'###***##');
if ResetBin(TxFile,T) = 0 then
begin (* File vorhanden *)
TX_Laenge := FileSize(TxFile);
TX_Count := 0;
TX_Time := Uhrzeit;
if abByte then FileSendVon(Kanal,Hstr);
abByte := false;
FileSend := true;
if TX_Bin = 2 then
begin (* Bei Auto-Bin-Send die Filel„nge <20>bertragen *)
Hstr := MakeBinStr(Kanal,FTxName);
if paclen<30 then paclen:=30;
TX_CRC := 0;
S_PAC(Kanal,NU,not Flag,Hstr);
if Flag then TX_Bin := 3;
end;
end else
begin (* File nicht vorhanden *)
Alarm;
G^.Fstr[15] := FTxName + B1 + InfoZeile(157) + B2 + InfoZeile(78);
Fenster(15);
SetzeCursor(length(G^.Fstr[15])+2,15);
Warten;
Cursor_aus;
end;
end;
end;
end else Alarm;
End;
Procedure FileSendVon (* Kanal : Byte; Zeile : Str40 *);
Var von,bis : LongInt;
Hstr : String[20];
Function Pos_ZlNr(Kanal : Byte; ZNr : LongInt) : LongInt;
Var i,
Result : Word;
ir,iz : LongInt;
Hstr : String;
Begin
with K[Kanal]^ do
begin
iz := 0;
ir := 0;
Seek(TxFile,0);
While not Eof(TxFile) and (ir < ZNr) do
begin
BlockRead(TxFile,Hstr[1],FF,Result);
Hstr[0] := Chr(Result);
for i := 1 to Result do
begin
if ir < ZNr then inc(iz);
if Hstr[i] = M1 then inc(ir);
end;
end;
Pos_ZlNr := iz;
end;
End;
Begin
with K[Kanal]^ do
begin
Hstr := CutStr(Zeile);
if Hstr > '' then
begin
if copy(Hstr,1,1) = '$' then
begin
delete(Hstr,1,1);
von := Pos_ZlNr(Kanal,str_int(Hstr)-1);
end else von := str_int(Hstr);
end else von := 0;
Hstr := RestStr(Zeile);
if Hstr > '' then
begin
if copy(Hstr,1,1) = '$' then
begin
delete(Hstr,1,1);
bis := Pos_ZlNr(Kanal,str_int(Hstr));
end else bis := str_int(Hstr);
end else bis := TX_Laenge - 1;
if (von < 0) or (von >= TX_Laenge) then von := 0;
if (bis <= 0) or (bis >= TX_Laenge) or (bis < von) then bis := TX_Laenge - 1;
TX_Laenge := bis - von + 1;
Seek(TxFile,von);
end;
End;
Procedure Send_File (* Kanal : Byte; OFlag : Boolean; *);
Var Zeile : String;
Hstr : String[9];
i,l : Byte;
ch : Char;
FileEnde : Boolean;
Result : Word;
XBTrans : Boolean;
DatPos : longint;
Begin
FileEnde := false;
Zeile := '';
with K[Kanal]^ do
Begin
XBTrans:=(XBIN.AN) and (TX_BIN=3);
FileFlag := (TX_Bin = 0) and (Echo in [2,3,6,7]);
if TX_Bin <> 2 then
Begin
if TxComp then l := maxCompPac
else l := FF;
if XBTrans then l:=paclen-8;
if xbtrans and txcomp then l:=paclen-10;
if xbtrans then DatPos:=filepos(TXFile);
BlockRead(TxFile,Zeile[1],l,Result);
if (TX_Count + Result) > TX_Laenge then Result := TX_Laenge - TX_Count;
Zeile[0] := chr(Byte(Result));
if XBTRANS then Zeile:=XBinStr(Kanal, Zeile, DatPos)+Zeile;
{if XBTrans then Zeile[0] := chr(Byte(Result+7));}
TX_Count := TX_Count + Result;
IF (TX_Count >= TX_Laenge) then FileEnde := true;
if TX_Bin = 0 then (* Textfile senden *)
Begin
While pos(^J,Zeile) > 0 do delete(Zeile,pos(^J,Zeile),1);
While pos(^Z,Zeile) > 0 do delete(Zeile,pos(^Z,Zeile),1);
for i := 1 to length(Zeile) do
case Zeile[i] of
^I : ;
M1 : ;
#1..#31 : Zeile[i] := '^';
end;
Zeile := Line_convert(Kanal,1,Zeile);
end else TX_CRC := Compute_CRC(TX_CRC,Zeile);
S_PAC(Kanal,NU,false,Zeile);
FileInfo(Kanal,1,TX_Laenge,TX_Count,0,0);
if FileEnde then
Begin
TNC_Puffer := false;
FileSend := false;
Result := Word(TX_CRC);
boxzaehl:=5;
FiResult := CloseBin(TxFile);
if not DirScroll then SetzeFlags(Kanal);
case TX_Bin of
0 : begin
if FileSendRem then Send_Prompt(Kanal,FF)
else S_PAC(Kanal,NU,true,'');
end;
1 : begin
_aus(Attrib[20],Kanal,M2 + InfoZeile(100) + M1);
S_PAC(Kanal,NU,true,'');
if FileSendRem then S_PAC(Kanal,CM,true,'D');
end;
3 : begin
Hstr := Time_Differenz(TX_Time,Uhrzeit);
Zeile := FName_aus_FVar(TxFile);
While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
Zeile := M1 + B1 + InfoZeile(102) + B1 +
EFillStr(14,B1,Zeile) + InfoZeile(100) +
int_str(Result) + B2 + LRK + Hex(Result,4) + B1 +
BdStr + FileBaud(Hstr,int_str(TX_Count)) + B2 +
LRK + Hstr + RRK + M1;
if OFlag then _aus(Attrib[20],Kanal,Zeile);
{ if FileSendRem then
begin }
{//db1ras}
if SysArt = 3 then {FBB}
S_PAC(Kanal,NU,true,M1)
else begin
if (SysArt in [0,17,21]) and not XBin.An then begin
{XP, PROFI}
S_PAC(Kanal,NU,false,Zeile);
Send_Prompt(Kanal,FF);
end else if XBin.An then begin
S_pac(kanal,NU,TRUE,'');
s_pac(kanal,nu,true,xprot+COMD+chr(TRASK));
xbin.framenr:=0;
xbin.ok:=false;
xbin.pdat:=false;
xbin.datpos:=0;
xbin.retries:=0;
end else
S_PAC(Kanal,NU,true,'');
end;
{ end else S_PAC(Kanal,NU,true,''); }
end;
end;
FileSendRem := false;
End;
End;
FileFlag := false;
End;
End;
Procedure SF_Text (* Kanal : Byte; Zeile : Str80 *);
var f : Text;
i : Byte;
Hstr : String;
Begin
with K[Kanal]^ do
begin
Assign(f,Zeile);
if ResetTxt(f) = 0 then
begin
WishBuf := true;
While not Eof(f) do
begin
Readln(f,Hstr);
Hstr := Line_convert(Kanal,1,Platzhalter(Kanal,Hstr)) + M1;
S_PAC(Kanal,NU,false,Hstr);
end;
FiResult := CloseTxt(f);
end else S_PAC(Kanal,NU,true,InfoZeile(114) + B1 + Zeile + B1 + InfoZeile(115) +M1);
end;
End;
Procedure TXT_Senden (* Kanal,Art,FNr : Byte *);
Var Hstr : String;
EndText,
First,
Flag,
FixFlag : Boolean;
TNr : String[1];
GegCall : String[6];
Kenner : Str32;
Function FindLine(TncStr,ArtStr,CallStr : Str9) : Boolean;
Var Find : Boolean;
Tstr : String[4];
Cstr,
Rstr : String[9];
Begin
Tstr := copy(TncStr,1,3) + 'A';
Repeat
Readln(G^.TFile,Hstr);
KillEndBlanks(Hstr);
Find := (pos(TncStr + ArtStr,Hstr) = 1) or (pos(TStr + ArtStr,Hstr) = 1);
if Find and (RestStr(Hstr) > '') then
begin
Find := false;
Repeat
Hstr := RestStr(Hstr);
Rstr := CutStr(Hstr);
if Rstr[length(Rstr)] = '-' then
begin
delete(Rstr,length(Rstr),1);
Cstr := copy(CallStr,1,length(Rstr));
end else Cstr := CallStr;
Find := Cstr = Rstr;
Until Find or (length(Hstr) = 0);
end;
Until Find or Eof(G^.TFile);
FindLine := Find;
End;
Begin
with K[Kanal]^ do
begin
Assign(G^.TFile,Sys1Pfad + TxtDatei);
if ResetTxt(G^.TFile) = 0 then
begin
Hstr := '';
Flag := false;
First := true;
FixFlag := false;
TNr := int_str(TncNummer);
GegCall := Call;
Strip(GegCall);
case Art of
1 : begin (* INFO *)
Flag := FindLine(TncI + TNr,TInf + int_str(TNC[TncNummer]^.Info),OwnCall);
end;
2 : begin (* AKTUELL *)
Flag := FindLine(TncI + TNr,TAkt + int_str(TNC[TncNummer]^.Aktuell),OwnCall);
end;
3 : begin (* CTEXT *)
Flag := FindLine(TncI + TNr,TCtx + int_str(TNC[TncNummer]^.CText),OwnCall);
end;
4 : begin (* QTEXT *)
Flag := FindLine(TncI + TNr,TQtx + int_str(TNC[TncNummer]^.QText),OwnCall);
end;
5 : begin (* FIX *)
Flag := FindLine(TncI + TNr,TFix + int_str(FNr) + GL +
int_str(TNC[TncNummer]^.FIX),OwnCall);
FixFlag := Flag;
end;
6 : begin (* GRT *)
Flag := FindLine(TncI + TNr,TGrt,GegCall);
GrtFlag := Flag;
end;
end;
if Flag then
begin
if FixFlag then
begin
if Vor_im_EMS then EMS_Seite_Einblenden(Kanal,Vor);
Set_st_Szeile(Kanal,1,1);
if VorWrite[Kanal]^[stV] <> '' then
begin
Vor_Feld_Scroll(Kanal);
Vor_Dn_Scroll(Kanal);
end;
end;
EndText:=False;
if (Art=3) or (art=6) then
begin
{Kenner:=AutoSysKenner[3]+copy(Version,Pos(' ',Version)+1,Length(Version));
if node then Kenner:=Kenner + NodeK + M1
else Kenner:=Kenner+ ']' + M1; }
Kenner:=AutoSysKenner[3];
if node then Kenner:=Kenner + NodeK;
Kenner:=Kenner+copy(Version,Pos(' ',Version)+1,Length(Version))+DatenKenner+int_str(Umlaut);
if ((user_komp=1) or (user_komp=3)) and (not node) then kenner:=kenner+'C'+int_str(user_komp-1);
kenner:=kenner+']'+m1;
S_PAC(Kanal,NU,false,Kenner);
end;
EigFlag := SysTextEcho;
While (not Eof(G^.TFile)) and (Not EndText) do
begin
Readln(G^.TFile,Hstr);
if (pos('#ENDE#',UpcaseStr(Hstr)) > 0) then EndText:=true;
if Not EndText then
begin
Hstr := Line_convert(Kanal,1,Platzhalter(Kanal,Hstr));
if FixFlag then
begin
if not First then
begin
Set_st_Szeile(Kanal,0,stV);
Vor_Feld_Scroll(Kanal);
end;
First := false;
VorWrite[Kanal]^[stV] := Hstr;
Chr_Vor_Show(Kanal,_End,#255);
Chr_Vor_Show(Kanal,_Andere,#255);
end else
begin
S_PAC(Kanal,NU,FALSE,Hstr + M1);
end;
end;
end; {while}
end;
FiResult := CloseTxt(G^.TFile);
EigFlag:=false;
end;
if art= 3 then RequestName(Kanal);
end;
End;
Procedure RequestName (* (Kanal) *);
var hstr:String;
begin
with k[kanal]^ do
if (not node) and ((not einstiegskanal) and (not ausstiegskanal)) then
if (not reqName) and (konfig.ReqNam) then
begin
hstr:='';
if User_Name='' then hstr:=hstr+'+' else hstr:=hstr+'-';
if User_QTH='' then hstr:=hstr+'+' else hstr:=hstr+'-';
if User_LOC='' then hstr:=hstr+'+' else hstr:=hstr+'-';
hstr:=Meldung[36]+hstr+'#';
if pos('+', hstr)>0 then s_pac(kanal, nu, true, hstr+#13);
reqName:=true;
end;
end;
Procedure BIN_TX_File_Sofort (* Kanal : Byte ; Zeile : Str80 *);
Var Bstr : String[80];
RResult,
WResult : Word;
HeapFree : LongInt;
Begin
with K[Kanal]^ do
begin
Assign(TxFile,Zeile);
if ResetBin(TxFile,T) = 0 then
begin
FileSend := true;
TX_Laenge := FileSize(TxFile);
if TxComp then
begin
TX_Count := 0;
TX_CRC := 0;
TX_Bin := 3;
TX_Time := Uhrzeit;
WishBuf := true;
S_PAC(Kanal,NU,false,MakeBinStr(Kanal,Zeile));
FertigSenden(Kanal);
end else
begin
WishBuf := true;
if not BufExists then OpenBufferFile(Kanal);
Bstr := MakeBinStr(Kanal,Zeile);
BlockWrite(BufFile,Bstr[1],length(Bstr),RResult);
HeapFree := MaxAvail;
if HeapFree > FA00 then HeapFree := FA00;
if HeapFree > TX_Laenge then HeapFree := TX_Laenge;
GetMem(BFeld,HeapFree);
FillChar(BFeld^,HeapFree,0);
Seek(BufFile,FileSize(BufFile));
Repeat
BlockRead(TxFile,BFeld^,HeapFree,RResult);
if RResult > 0 then TxLRet := BFeld^[RResult] = 13;
BlockWrite(BufFile,BFeld^,RResult,WResult);
Until RResult = 0;
FreeMem(BFeld,HeapFree);
FiResult := CloseBin(TxFile);
FileSend := false;
end;
end;
end;
End;
Procedure TXT_TX_File_Sofort (* Kanal : Byte ; Zeile : Str80 *);
Begin
with K[Kanal]^ do
begin
Assign(TxFile,Zeile);
if ResetBin(TxFile,T) = 0 then
begin
FileSend := true;
TX_Laenge := FileSize(TxFile);
TX_Count := 0;
TX_CRC := 0;
TX_Bin := 0;
TX_Time := Uhrzeit;
FertigSenden(Kanal);
end;
end;
End;
Procedure FertigSenden (* Kanal : Byte *);
Begin
with K[Kanal]^ do
begin
WishBuf := true;
Repeat
if TX_Bin = 2 then inc(TX_Bin);
Send_File(Kanal,false);
Until not FileSend;
end;
End;

639
XPHELP.PAS Executable file
View file

@ -0,0 +1,639 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P H E L P . P A S ³
³ ³
³ Routinen f<>r die Hilfe durch ALT-H aus TOP ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Hlp_Laden (* Istr : Str6 *);
Var Nstr : String[6];
Hstr : String[HlpRec];
Result : Word;
Flag,
Find : Boolean;
Begin
FillChar(Hlp^,SizeOf(Hlp^),0);
Hlp_Anz := 0;
Flag := false;
KillEndBlanks(Istr);
Assign(G^.BFile,Konfig.TempVerz + THlpDatei);
if ResetBin(G^.BFile,HlpRec) = 0 then
begin
Hlp_ZlnNr := str_int(Istr);
if Hlp_ZlnNr > 0 then
begin
dec(Hlp_ZlnNr);
Seek(G^.BFile,Hlp_ZlnNr);
Repeat
BlockRead(G^.BFile,Hstr[1],1,Result);
Hstr[0] := Chr(HlpRec);
Flag := LZ = copy(Hstr,1,1);
if not Flag then
begin
inc(Hlp_Anz);
Nstr := copy(Hstr,1,6);
KillEndBlanks(Nstr);
if Nstr > '' then
begin
Hlp^[Hlp_Anz].ID := Nstr;
Hlp^[Hlp_Anz].Attr := Attrib[31];
end else Hlp^[Hlp_Anz].Attr := Attrib[2];
Hlp^[Hlp_Anz].Sp7 := Hstr[7];
delete(Hstr,1,7);
Hlp^[Hlp_Anz].Entry := Hstr;
end;
Until Flag or (Hlp_Anz >= maxHelpZln) or Eof(G^.BFile);
end;
FiResult := CloseBin(G^.BFile);
end;
End;
Procedure XP_Help (* IDstr : Str6 *);
Const Bofs = 1;
Kl = '[ ]';
Type AnwTyp = Record
IDk : String[6];
Dmp : Integer;
Bmp : Byte;
End;
Var i,i1,i2,
xc,yc,
Klpos,
Bpos,
yM,aM,
Zmax : Byte;
show2 : byte;
Dpos : Integer;
w : Word;
Flag,
CurSh,
CurFlag,
Fertig : Boolean;
Vstr : String[6];
Hstr : String[80];
Save_Name : String[60];
Such : String[80];
KC : Sondertaste;
VC : Char;
Result : Word;
OldBild : ^BildPtr;
HlpAnw : Array [1..maxHlpAnw] of AnwTyp;
HlpAnwPtr : Byte;
Procedure StepHlpAnw (AnId : Str6; Dpar : Integer; Bpar : Byte);
Var i : Byte;
Flag : Boolean;
Begin
Flag := false;
i := 0;
While not Flag and (i < maxHlpAnw) do
begin
inc(i);
if HlpAnw[i].IDk = AnId then
begin
Flag := true;
move(HlpAnw[1],HlpAnw[i],SizeOf(HlpAnw[1]));
end;
end;
if not Flag then move(HlpAnw[1],HlpAnw[2],SizeOf(HlpAnw[1])*(maxHlpAnw-1));
HlpAnw[1].IDk := AnId;
HlpAnw[1].Dmp := Dpar;
HlpAnw[1].Bmp := Bpar;
End;
Procedure HlpPage(beg : Word);
Var i,i1 : Byte;
Begin
Teil_Bild_Loesch(2,maxZ-1,Attrib[2]);
i1 := Zmax;
if i1 > Hlp_Anz then i1 := Hlp_Anz;
for i := 1 to i1 do
WriteRam(1,i+Bofs,Hlp^[beg-1+i].Attr,1,
EFillStr(80,B1,B1+Hlp^[beg-1+i].Entry));
yM := 0;
End;
Begin
if HeapFrei(SizeOf(Hlp^) + SizeOf(OldBild^)) then
begin
{ OnlHelp:=true;
Show2:=show;
show:=0; }
NowFenster := false;
Moni_Off(0);
GetMem(Hlp,SizeOf(Hlp^));
GetMem(OldBild,SizeOf(OldBild^));
move(Bild^,OldBild^,SizeOf(OldBild^));
CurFlag := Cursor_On;
xc := WhereX;
yc := WhereY;
Cursor_Aus;
Bpos := 1;
Dpos := 1;
HlpAnwPtr := 0;
FillChar(HlpAnw,SizeOf(HlpAnw),0);
Hlp_Laden(IDstr);
Such := '';
Zmax := maxZ - (1 + Bofs);
Fertig := false;
CurSh := true;
Hstr := B1 + InfoZeile(56);
Klpos := pos(Kl,Hstr);
WriteRam(1,1,Attrib[15],1,ZFillStr(80,B1,InfoZeile(55)));
WriteRam(1,maxZ,Attrib[15],1,EFillStr(80,B1,Hstr));
HlpPage(Dpos);
yM := 1;
aM := Hlp^[Dpos].Attr;
WriteAttr(1,Bpos+Bofs,80,Attrib[4],1);
Repeat
if CurSh then InitCursor(1,Bpos+Bofs)
else InitCursor(1,1);
WriteRam(71,1,Attrib[15],1,EFillStr(10,B1,Such));
if (Klpos > 0) then
begin
if (Hlp^[Dpos].ID > '') then
begin
WriteRam(Klpos+1,maxZ,Attrib[15],1,X_ch);
WriteRam(Klpos+5,maxZ,Attrib[15],1,EFillStr(10,B1,LRK + Hlp^[Dpos].ID + RRK));
end else
begin
WriteRam(Klpos+1,maxZ,Attrib[15],1,B1);
WriteRam(Klpos+5,maxZ,Attrib[15],1,EFillStr(10,B1,B1));
end;
WriteRam(74,maxZ,Attrib[15],1, SFillStr(7,B1,LRK + int_str(Hlp_ZlnNr + Dpos) + RRK));
end;
_ReadKey(KC,VC);
if KC <> _Andere then Such := '';
case KC of
_Esc, _Del
: Fertig := true;
_Dn
: if Dpos < Hlp_Anz then
begin
inc(Dpos);
if Bpos < Zmax then inc(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,aM,1);
Scroll(Up,1,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],1,EFillStr(80,B1,B1+Hlp^[Dpos].Entry));
end;
end else Alarm;
_Up
: if Dpos > 1 then
begin
dec(Dpos);
if Bpos > 1 then dec(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,aM,1);
Scroll(Dn,1,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],1,EFillStr(80,B1,B1+Hlp^[Dpos].Entry));
end;
end else Alarm;
_Left
: if (HlpAnwPtr < maxHlpAnw) and (HlpAnw[HlpAnwPtr+1].IDk > '') then
begin
inc(HlpAnwPtr);
IDstr := HlpAnw[HlpAnwPtr].IDk;
Hlp_Laden(IDstr);
Dpos := HlpAnw[HlpAnwPtr].Dmp;
Bpos := HlpAnw[HlpAnwPtr].Bmp;
Such := '';
HlpPage(Dpos - Bpos + 1);
end else Alarm;
_PgDn
: if Dpos < Hlp_Anz then
begin
if Dpos + Zmax - Bpos >= Hlp_Anz then
begin
Dpos := Hlp_Anz;
Bpos := Zmax;
if Bpos > Hlp_Anz then Bpos := Hlp_Anz;
end else
begin
Dpos := Dpos + Zmax - 1;
if Dpos + Zmax - 1 > Hlp_Anz then Dpos := Hlp_Anz - Zmax + Bpos;
HlpPage(Dpos - Bpos + 1);
end;
end else Alarm;
_PgUp
: if Dpos > 1 then
begin
if Dpos <= Bpos then
begin
Dpos := 1;
Bpos := 1;
end else
begin
Dpos := Dpos - Zmax + 1;
if Dpos - Zmax + 1 < 1 then Dpos := Bpos;
HlpPage(Dpos - Bpos + 1);
end;
end else Alarm;
_CtrlPgUp
: if Dpos > 1 then
begin
Dpos := 1;
Bpos := 1;
HlpPage(1);
end else Alarm;
_CtrlPgDn
: if Dpos < Hlp_Anz then
begin
Dpos := Hlp_Anz;
Bpos := Zmax;
if Bpos > Hlp_Anz then Bpos := Hlp_Anz;
HlpPage(Dpos - Bpos + 1);
end else Alarm;
_CtrlHome
: begin
Dpos := Dpos - Bpos + 1;
Bpos := 1;
end;
_CtrlEnd
: if Hlp_Anz < Zmax then
begin
Dpos := Hlp_Anz;
Bpos := Hlp_Anz;
end else
begin
Dpos := Dpos + Zmax - Bpos;
Bpos := Zmax;
end;
_ShTab
: CurSh := not CurSh;
_F1.._F5, _F10, _AltH
: begin
case KC of
_F1 : Vstr := G^.OHelp[12];
_F2 : Vstr := G^.OHelp[13];
_F3 : Vstr := G^.OHelp[14];
_F4 : Vstr := G^.OHelp[15];
_F5 : Vstr := G^.OHelp[16];
_F10 : Vstr := G^.OHelp[11];
_AltH : Vstr := G^.OHelp[28];
else Vstr := '';
end;
if Vstr > '' then
begin
StepHlpAnw(IDstr,Dpos,Bpos);
Hlp_Laden(Vstr);
IDstr := Vstr;
HlpAnwPtr := 0;
yM := 1;
Bpos := 1;
Dpos := 1;
Such := '';
HlpPage(1);
end else Alarm;
end;
_AltS
: begin
WriteRam(1,Bofs+Bpos,Attrib[4],1,EFillStr(80,B1,B1 + 'Pfad =' + B1));
Save_Name := Konfig.SavVerz + 'HELP.' + TxtExt;
GetString(Save_Name,Attrib[4],60,9,Bofs+Bpos,KC,0,Ins);
if KC <> _Esc then
begin
Assign(G^.TFile,Save_Name);
Result := AppendTxt(G^.TFile);
if Result <> 0 then Result := RewriteTxt(G^.TFile);
if Result = 0 then
begin
for w := Dpos to Hlp_Anz do
begin
Hstr := Hlp^[w].Entry;
Writeln(G^.TFile,Hstr);
end;
FiResult := CloseTxt(G^.TFile);
end else
begin
WriteRam(1,Bofs+Bpos,Attrib[4],1,
EFillStr(80,B1,B1 + InfoZeile(75) + DP + B2 + Save_Name));
Alarm;
Verzoegern(ZWEI);
end;
end;
WriteRam(1,Bofs+Bpos,Attrib[4],1,EFillStr(80,B1,B1+Hlp^[Dpos].Entry));
end;
_Ret
: begin
Vstr := Hlp^[Dpos].ID;
if Vstr > '' then
begin
StepHlpAnw(IDstr,Dpos,Bpos);
Hlp_Laden(Vstr);
IDstr := Vstr;
HlpAnwPtr := 0;
yM := 1;
Bpos := 1;
Dpos := 1;
Such := '';
HlpPage(1);
end else Alarm;
end;
_Andere
: begin
Such := Such + UpCase(VC);
w := 0;
Flag := false;
While (w < Hlp_Anz) and not Flag do
begin
inc(w);
if pos(Such,Hlp^[w].Entry) = 1 then
begin
Flag := true;
Dpos := w;
if (Dpos < Bpos) or (Hlp_Anz <= Zmax) then Bpos := Dpos;
if ((Hlp_Anz - Dpos + Bpos) < Zmax) and
(Hlp_Anz > Zmax) and (Dpos > Bpos)
then Bpos := Zmax - (Hlp_Anz - Dpos);
end;
end;
if not Flag then
begin
Alarm;
Such := '';
end else HlpPage(Dpos - Bpos + 1);
end;
else Alarm;
end;
if yM > 0 then WriteAttr(1,Bofs+yM,80,aM,1);
WriteAttr(1,Bofs+Bpos,80,Attrib[4],1);
yM := Bpos;
aM := Hlp^[Dpos].Attr;
Until Fertig;
move(OldBild^,Bild^,SizeOf(OldBild^));
FreeMem(OldBild,SizeOf(OldBild^));
FreeMem(Hlp,SizeOf(Hlp^));
Cursor_Aus;
if CurFlag then
begin
GotoXY(xc,yc);
Cursor_Ein;
end;
Moni_On;
{ show:=show2;
OnlHelp:=false;
SwitchChannel (show);
SetzeFlags(show); }
end else Alarm;
OnlHelp:=false;
End;
Procedure REM_Help (* Kanal : Byte; HNr : Byte *);
Var i : Byte;
w : Word;
IDstr : String[10];
Hstr : String[80];
Begin
with K[Kanal]^ do
begin
i := Byte(HlpRemBeg-1+HNr);
if i in [1..maxOHelp] then
begin
IDstr := G^.OHelp[i];
if HeapFrei(SizeOf(Hlp^)) then
begin
GetMem(Hlp,SizeOf(Hlp^));
Hlp_Laden(IDstr);
for w := 1 to Hlp_Anz do
begin
if Hlp^[w].Sp7 = DP then
begin
Hstr:=Hlp^[w].Entry;
if (Node) and (Pos('//', HStr)>0) then delete(HStr,pos('//', Hstr), 2);
S_PAC(Kanal,NU,false,B1 + Hstr + M1);
end;
end;
FreeMem(Hlp,SizeOf(Hlp^));
end;
end;
end;
End;
Procedure Send_Hilfe (* Kanal : Byte; IDstr : Str6 *);
Var w : Word;
Hstr : String[80];
Begin
with K[Kanal]^ do
begin
if HeapFrei(SizeOf(Hlp^)) then
begin
GetMem(Hlp,SizeOf(Hlp^));
Hlp_Laden(IDstr);
for w := 1 to Hlp_Anz do if Hlp^[w].Sp7 = DP then
begin
Hstr := Line_convert(Kanal,1,Hlp^[w].Entry);
KillEndBlanks(Hstr);
S_PAC(Kanal,NU,false,B1 + Hstr + M1);
end;
FreeMem(Hlp,SizeOf(Hlp^));
end;
end;
End;
Procedure Help_Compile;
Var l,Hlpl : LongInt;
w,
Result : Word;
X7 : Byte;
Nstr : String[6];
Bstr,
Hstr : String[HlpRec];
Flag,
EFlag : Boolean;
HlpNr : ^HlpNrPtr;
BalkSt : str8;
BalkZa : Byte;
z1,z2 : char;
BalkK : Boolean;
Procedure HlpAnzeige(l : LongInt);
Begin
BalkSt:='';
if not Balkk then
begin
inc(BalkZa);
z1:='²';
z2:='°';
end
else begin
dec(BalkZa);
z2:='²';
z1:='°';
end;
if BalkZa=6 then Balkk:=true;
if BalkZa=1 then Balkk:=false;
BalkSt:=SFillStr(BalkZa,z1,BalkSt);
WriteTxt(X7,SZ2,StartColor,EFillStr(6,z2,BalkSt));
{ WriteTxt(X7,SZ2,StartColor,EFillStr(6,B1,int_str(l))); }
End;
Function NrExists(Kstr : Str6) : Word;
Var z : Word;
Flag : Boolean;
Begin
z := 0;
Flag := false;
if Kstr > '' then
Repeat
inc(z);
if CutStr(HlpNr^[z]) = Kstr then Flag := true;
Until Flag or (z >= maxHlpNr);
if Flag then NrExists := z
else NrExists := 0;
End;
Begin
BalkZa:=0;
BalkK:=false;
Hstr := HelpDatei + B1 + GL + RSK + B1 + THlpDatei + B1;
WriteTxt(30,SZ2,StartColor,Hstr);
X7 := 30 + length(Hstr);
Assign(G^.TFile,SysPfad + HelpDatei);
if ResetTxt(G^.TFile) = 0 then
begin
GetMem(HlpNr,SizeOf(HlpNr^));
FillChar(HlpNr^,SizeOf(HlpNr^),0);
Assign(G^.BFile,Konfig.TempVerz + THlpDatei);
if RewriteBin(G^.BFile,HlpRec) = 0 then
begin
l := 0;
w := 0;
While not Eof(G^.TFile) do
begin
inc(l);
if ((l mod 50)=0) then HlpAnzeige(l);
Readln(G^.TFile,Hstr);
if pos(DP,Hstr) = 1 then
begin
inc(w);
delete(Hstr,1,1);
if w <= maxHlpNr then
HlpNr^[w] := EFillStr(7,B1,CutStr(Hstr)) +
SFillStr(6,'0',int_str(l));
Hstr := ConstStr(B1,HlpRec);
BlockWrite(G^.BFile,Hstr[1],1,Result);
end else
begin
Hstr := EFillStr(HlpRec,B1,Hstr);
BlockWrite(G^.BFile,Hstr[1],1,Result);
end;
end;
Hlpl := FilePos(G^.BFile);
if Hlpl = 0 then Hlpl := 1;
FiResult := CloseBin(G^.BFile);
end;
FiResult := CloseTxt(G^.TFile);
if ResetBin(G^.BFile,HlpRec) = 0 then
begin
Flag := false;
EFlag := false;
Repeat
dec(l);
if ((l mod 50)=0) then HlpAnzeige(l);
BlockRead(G^.BFile,Hstr[1],1,Result);
Hstr[0] := Chr(HlpRec);
KillEndBlanks(Hstr);
if Hstr = LZ then EFlag := true;
KillStartBlanks(Hstr);
if (Hstr > '') and not EFlag then
begin
if Flag then
begin
Bstr := ConstStr(B1,7);
While Hstr > '' do
begin
Nstr := CutStr(Hstr);
w := NrExists(Nstr);
if w > 0 then Bstr := Bstr + RestStr(HlpNr^[w]) + B3
else Bstr := Bstr + ConstStr('0',7) + B3;
Hstr := RestStr(Hstr);
end;
Bstr := EFillStr(HlpRec,B1,Bstr);
Seek(G^.BFile,FilePos(G^.BFile)-1);
BlockWrite(G^.BFile,Bstr[1],1,Result);
end else if (OHelpStr = Hstr) then Flag := true;
end;
Until Eof(G^.BFile) or EFlag;
{ Writeln(G^.Bootfile);}
While not Eof(G^.BFile) do
begin
dec(l);
if ((l mod 50)=0) then HlpAnzeige(l);
BlockRead(G^.BFile,Hstr[1],1,Result);
Hstr[0] := Chr(HlpRec);
Nstr := copy(Hstr,1,6);
KillEndBlanks(Nstr);
w := NrExists(Nstr);
if w > 0 then
begin
Seek(G^.BFile,FilePos(G^.BFile)-1);
delete(Hstr,1,6);
Hstr := RestStr(HlpNr^[w]) + Hstr;
BlockWrite(G^.BFile,Hstr[1],1,Result);
end else
begin
if (Nstr > '') and (Nstr <> LZ) then
begin
Alarm;
WriteTxt(7,SZ2+1,StartColor,Hstr);
KillEndBlanks(Hstr);
{Writeln(G^.Bootfile,Hstr);}
end;
end;
end;
FiResult := CloseBin(G^.BFile);
end;
FreeMem(HlpNr,SizeOf(HlpNr^));
end;
writetxt(30,sz2,startcolor,' ');
End;

495
XPINI.PAS Executable file
View file

@ -0,0 +1,495 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P I N I . P A S ³
³ ³
³ Initialisierung der globalen Variablen in XPDEFS.PAS ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Var_INIT (* Kanal : Byte *);
var i,i1 : Integer;
Begin
BackupBremsen:=false;
BackupJetzt:=true;
if Kanal <> 99 then
Begin
with K[Kanal]^ do { Variablen eines jeden Kanals initialisieren }
Begin
PWMerk:='';
SPRxCount:=0;
SPRxSoll:=0;
XBIN.AN:=false;
xbin.pdat:=false;
xbin.ok:=false;
xbin.retries:=0;
xbin.frameNr:=0;
xbin.DatPos:=0;
xbin.pdat:=false;
xbin.eof:=false;
BellCount:=0;
StopCODE:=0;
STOPComp:=False;
CompC:=false;
KompressUpd:=false;
SPComp:=false;
ReqName := false;
for i:=1 to 255 do
begin
Kompression[i]:=0;
end;
OnAct:='';
Node := FALSE;
FBBStreng:=false;
NZeile := '';
NodeTimeOut:=30;
TermTimeOut:=0;
TX_CRC:=0;
RX_CRC:=0;
ACZeile := '';
FTxName := Konfig.SavVerz;
FRxName := Konfig.SavVerz;
Autokenn:=false;
SystemErkannt:='';
RxLRet := true;
TxLRet := true;
SvLRet := true;
OwnCall := '*';
Call := ' ';
connected := false;
Outside := true;
QSO_Date := '';
QSO_Begin := '';
QSO_End := '';
ConText := '';
LogMerker := '';
BeLogEintr := false;
SendZeile := '';
TxByte := 0;
Loesch := false;
Insert_ON := true;
Rx_Beep := false;
Echo := 0;
SysTextEcho := false;
Cmd := false;
ObStat := 5;
if Kanal = 0 then UnStat := ObStat + 1
else UnStat := maxZ - 3;
X2 := 1;
Response := '';
for i := 1 to 6 do L_Status[i] := 0;
FlagTxBeep := false;
TxBeepAck := false;
First_Frame := true;
RemPath := '';
RX_Bin := 0;
RX_Save := false;
Save := false;
SplSave := false;
Spl_Time := '';
Spl_Baud := 0;
Spl_UmlMerk := 0;
FileSend := false;
FileSendRem := false;
FileSendWait := false;
TX_Bin := 0;
TX_Time := '';
TX_Baud := 0;
Drucker := false;
Umlaut := 0;
UmlautMerk := 0;
NR_Stelle := 0;
ConnectMerk := '';
ACMerk := '';
Pause := 0;
Paclen := 230;
MaxFrame := 3;
TNCKanal := #0;
{FwdMails:=0;
fwdstarted:=false;}
fwd:= false;
fwdgo:=false;
Kan_Char := #0;
TNC_Code := 0;
TNC_Count := 0;
Auto := true;
Auto_CON := false;
Ziel_Call := '';
Ignore := false;
NochNichtGelesen := false;
RemoteSave := false;
AnzLines := 0;
AnzNotiz := 0;
stV := 1;
Y1V := 1;
Y1C := 1;
X1V := 1;
X1C := 3;
NodeCon := false;
NodeCmd := false;
Mail_SP := false;
MerkInfo := '';
EinstiegsKanal := false;
AusstiegsKanal := false;
GegenKanal := 0;
Kanal_benutz := false;
RemConReady := false;
FoundCall := false;
Last_CR_Pos := 0;
unknown := false;
notRC := false;
ParmWrong := false;
Hold := false;
HoldStr := '';
HoldTime := 0;
RTF := false;
Cself := 0;
AutoZeile := '';
Auto1Zeile := '';
AutoTime := '';
AutoZaehl := 0;
AutoJump := 0;
AutoZyConst := 0;
AutoZyCount := 0;
AutoToConst := 0;
AutoToCount := 0;
AutoToAnz := 0;
AutoToMax := 0;
AutoToAnzJmp := 0;
AutoWait := 0;
AutoChMerk := 0;
AutoArt := 0;
AutoCheckLn := false;
AutoJmpPtr := 1;
FillChar(AutoJmpRet,SizeOf(AutoJmpRet),0);
Test := false;
TestMerk := 0;
Priv_Modus := false;
RemAll := false;
SysopParm := false;
Priv_Errechnet := '';
SysopStr := '';
SysopArt := '';
FillChar(StatZeile,SizeOf(StatZeile),0);
Rekonnekt := false;
Now_Msg_holen := true;
MeldeCompZ := '';
MeldeZeile := '';
MldOk := 0;
EigMail := false;
MsgToMe := false;
TNC_Puffer := false;
NotPos := 0;
Einer_st := false;
for i := 1 to maxVorZeilen do stTX[i] := false;
for i := 0 to 3 do PagesNot[i] := 0;
PagesAnz := 0;
BufPos := 0;
BufExists := false;
BufToLow := false;
FillChar(Conv,SizeOf(Conv),0);
RX_DatenPieps := false;
User_Name := '';
NeueZeilen := 0;
ScrZlnMerk := 0;
BoxZlnMerk := 0;
with Mo do
begin
MonBeide := false;
MonActive := false;
MonDisAbr := false;
MonHCall := false;
MonStrict := false;
MonSignal := false;
MonIFr := true;
MonUFr := false;
MonLast := '';
for i := 1 to 2 do
begin
MonNow[i] := false;
MonStr[i] := '';
MonFirst[i] := true;
MonFrameNr[i] := 0;
for i1 := 0 to 7 do MonCtrl[i][i1] := 0;
end;
end;
QsoScroll := false;
AutoBin := true;
AutoBinOn := true;
SPlus := true;
Spl_COR_ERR := false;
Ext_Poll := false;
C_Poll := false;
DieBoxPW := '';
DBoxScaned := false;
SysArt := 0;
UserArt := 0;
for i := 0 to maxSCon do SCon[i] := false;
ChkLstOpen := false;
FillChar(BoxStr,SizeOf(BoxStr),0);
FillChar(Rubrik,SizeOf(Rubrik),0);
FillChar(RunRub,SizeOf(RunRub),0);
NewChkLst := 0;
BoxScroll := false;
ChecksSorted := false;
PassRetry := 1;
PassRight := 1;
RxComp := false;
TxComp := false;
CompZeile := '';
TncAkt := 0;
TncNix := false;
Kopieren := 0;
KopierenFm:=0;
WishBuf := false;
NoCurJump := false;
use_RomLw := false;
SynchErrAnz := 0;
GrtFlag := false;
EigFlag := false;
FileFlag := false;
RemFlag := false;
User_AutoPW:=false;
user_komp:=0;
End;
End;
if Kanal = 99 then { globale Variablen intialisieren..(keine Kanalvariablen)}
begin
G^.ZeilenwTX := False;
G^.StatusModus:=0;
gotLastHr:=false;
lminute:=61;
ESC_Call:=false;
Versi:='';
Scan_:=false;
MailInBox:=Mailsvorhanden;
_OnAct:=false;
for i := 1 to maxArrayTNC do TNC_used[i] := false;
maxLink := 0;
Tnc_Anzahl := 0;
Mon_Anz := 0;
MPort := 0;
FirstA := false;
QRT := false;
FreiKanal := 0;
show := 0;
ShowMerk := 0;
maxPath := 0;
Unproto := 1;
TopBox := true;
NeuCall := '';
RemoteCall := '';
LastInfoCount := 0;
LastInfoFlag := false;
HistoryCount := 0;
Del := false;
FillChar(G^.Leer[1],80,B1);
G^.Leer[0] := Chr(80);
notScroll := false;
ZeigeRET := false;
Aufwaerts := false;
for i := 7 to 15 do
begin
G^.Fstr[i] := '';
G^.Fstx[i] := 1;
end;
FirstConCh := 1;
ch_aus := false;
DZeile := '';
CNr := 0; { Anzahl Connects auf 0 setzen, danach Wert lesen }
WBox := '';
WCall := '';
LaufZeit := 0;
Poll := 0;
PollTnr := 1;
PollRate := 5;
TNC_ReadOut := false;
JumpRxScr := true;
JumpRxZaehl := 5;
Win_Rout := false;
Win_Time := 5;
Box_Time := 10;
BoxZaehl := 10;
NowCurBox := false;
Priv_PassWord := '';
D_Spalte := 1;
Time_stamp := false;
PacOut := false;
Resync_Z := 0;
Nodes_Change := false;
Old_active_TNC := 0;
Klingel := true;
CtrlBeep := true;
_VGA := false;
ScreenSTBY := false;
TNC_K := false;
Ausgabe := true;
NTimeOut := 30;
VDisk := '';
use_Vdisk := true;
RomDisk := '';
Rom_Exists := false;
Print := false;
for i := 1 to 4 do LPT_Base[i] := LPT_PORTs[i];
LPT_vorhanden := false;
PrtPort := 1;
PrtFailure := false;
morsen := false;
MPause := 50;
HardCur := false;
Gross := true;
minTncBuf := 200;
maxTncBuf := minTncBuf - 50;
NowFenster := false;
ScrollVor := false;
BlTon := false;
XL := 0;
XR := 0;
ParmAnz := 0;
ParmPos := 254;
G^.DArt:=1;
G^.C1_Ton := 800;
G^.C1_TonTime := 100;
G^.C2_Ton := 1200;
G^.C2_TonTime := 100;
G^.Alarm_Freq := 1200;
G^.Alarm_Time := 20;
G^.RxPiepFreq := 1300;
G^.RxPiepTime := 50;
G^.TxPiepFreq := 400;
G^.TxPiepTime := 30;
G^.RemPiepFreq := 600;
G^.RemPiepTime := 400;
G^.PopFreq := 1400;
G^.PopFreqTime := 30;
G^.CTRL_G_Freq := 880;
G^.CTRL_G_Time := 80;
G^.TonHoehe := 1300;
G^.BLockAnfFreq := 700;
G^.BLockEndFreq := 350;
G^.BlockPiep1Time := 10;
G^.BlockPiep2Time := 10;
for i := 1 to 4 do NrStat[i] := i;
Eig_Mail_Zeile := '';
TNC_Halt := false;
polling := true;
IrqMask := 0;
XCP := 1;
Color := false;
EMS_Pages_Ins := 0;
File_Frame_max := 20;
Pseudo := false;
ConvHilfsPort := 0;
ReconMorsen := false;
ConMorsen := false;
{ ReconVoice := false;
ConVoice := false;}
MonID := 1;
ShTab_Pressed := false;
Braille80 := false;
ZeitArt := 'MEZ';
ZeitDiff := 0;
UseUTC := false;
TagOver := false;
ScreenInit := 5;
GesamtNotCh := 0;
GesamtVorCh := 0;
PortStufe := 0;
volle_Breite := false;
Vor_im_EMS := false;
use_EMS := false;
use_XMS := false;
Speek := false;
VSpeed := 400;
UeberNr := '';
SwapXms := false;
SwpHandle := 0;
SizeHeap := 0;
KeyDelay := 1;
GlobalTrenn := false;
BinOut := false;
Ins := true;
HighCol := false;
Kbd := 0;
TimeOut := 0;
HD_was_Active := false;
AnyConnect := false;
SortMhNr := 3;
Cursor_on := false;
CurX := 1;
CurY := 1;
DateiInfo := 1;
SSAV := 1;
RTC := false;
WishBoxLst := true;
WishDXC := true;
KillEsc := false;
WCTRL := true;
LogArt := 1;
Upload := false;
K_Record_on_Heap := false;
QRT_Text := true;
WeekDayStr := '';
WochenTag := '';
SynchError := false;
OverRun := false;
ColMon := 0;
MonCode5 := false;
HD_Read := 0;
KStat := false;
KStatTr := ' ';
ZlnMerk := true;
NoBinMon := true;
RX_TX_Win := false;
SplCountLines := false;
BiosOut := false;
MhKill := false;
AltQFlag := false;
HoldDXc := false;
HoldDXcStr := '';
G^.PromptStr := '#CALL# de #MCAL#>';
G^.TabStr := ' ';
maxMH := 25;
KeyCheck := false;
RecCheck := false;
for i := 1 to 10 do G^.SETL[i] := 7;
SETNr := 1;
TicAnz := 0;
ModMonFr := false;
WeFlag := false;
DirScroll := false;
KeyOpt := 0;
EraseChk := 0;
LogChk := 0;
SiAltD := false;
SiAltK := false;
TabFill := false;
MoniStaAnz := 0;
Idle := false;
Idle_Pos := true;
Idle_Anz := 10;
Idle_Count := 0;
Idle_Tout := 20;
Idle_TCount := 0;
Idle_TMerk := 0;
DelayCor := 1;
LockInt := false;
BackUpProc:=false;
BackUpLauf:=false;
{$IFDEF Sound}
WavStream:='';
{$ENDIF}
end;
End;

3148
XPIO.PAS Executable file
View file

File diff suppressed because it is too large Load diff

277
XPKEY.PAS Executable file
View file

@ -0,0 +1,277 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P K E Y . P A S ³
³ ³
³ Routinen f<>r die Tastaturabfrage ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure _ReadKey (* var SK : Sondertaste; var VC : char *);
var Code,
Scan : Byte;
Shift : Boolean;
Procedure FunktionsTaste(cch: char);
begin
case cch of
#59 : SK := _F1; #84 : SK := _ShF1; #94 : SK := _CtrlF1;
#60 : SK := _F2; #85 : SK := _ShF2; #95 : SK := _CtrlF2;
#61 : SK := _F3; #86 : SK := _ShF3; #96 : SK := _CtrlF3;
#62 : SK := _F4; #87 : SK := _ShF4; #97 : SK := _CtrlF4;
#63 : SK := _F5; #88 : SK := _ShF5; #98 : SK := _CtrlF5;
#64 : SK := _F6; #89 : SK := _ShF6; #99 : SK := _CtrlF6;
#65 : SK := _F7; #90 : SK := _ShF7; #100 : SK := _CtrlF7;
#66 : SK := _F8; #91 : SK := _ShF8; #101 : SK := _CtrlF8;
#67 : SK := _F9; #92 : SK := _ShF9; #102 : SK := _CtrlF9;
#68 : SK := _F10; #93 : SK := _ShF10; #103 : SK := _CtrlF10;
#133 : SK := _F11; #135 : SK := _ShF11; #137 : SK := _CtrlF11;
#134 : SK := _F12; #136 : SK := _ShF12; #138 : SK := _CtrlF12;
#104 : SK := _AltF1; #120 : SK := _Alt1;
#105 : SK := _AltF2; #121 : SK := _Alt2;
#106 : SK := _AltF3; #122 : SK := _Alt3;
#107 : SK := _AltF4; #123 : SK := _Alt4;
#108 : SK := _AltF5; #124 : SK := _Alt5;
#109 : SK := _AltF6; #125 : SK := _Alt6;
#110 : SK := _AltF7; #126 : SK := _Alt7;
#111 : SK := _AltF8; #127 : SK := _Alt8;
#112 : SK := _AltF9; #128 : SK := _Alt9;
#113 : SK := _AltF10; #129 : SK := _Alt0;
#139 : SK := _AltF11;
#140 : SK := _AltF12;
#16 : SK := _AltQ; #30 : SK := _AltA; #44 : SK := _AltZ;
#17 : SK := _AltW; #31 : SK := _AltS; #45 : SK := _AltX;
#18 : SK := _AltE; #32 : SK := _AltD; #46 : SK := _AltC;
#19 : SK := _AltR; #33 : SK := _AltF; #47 : SK := _AltV;
#20 : SK := _AltT; #34 : SK := _AltG; #48 : SK := _AltB;
#21 : SK := _AltY; #35 : SK := _AltH; #49 : SK := _AltN;
#22 : SK := _AltU; #36 : SK := _AltJ; #50 : SK := _AltM;
#23 : SK := _AltI; #37 : SK := _AltK;
#24 : SK := _AltO; #38 : SK := _AltL;
#25 : SK := _AltP;
#71 : SK := _Home; #114 : SK := _CtrlPrtSc;
#73 : SK := _PgUp; #115 : SK := _CtrlLeft;
#79 : SK := _End; #116 : SK := _CtrlRight;
#81 : SK := _PgDn; #117 : SK := _CtrlEnd;
#82 : SK := _Ins; #118 : SK := _CtrlPgDn;
#83 : SK := _Del; #119 : SK := _CtrlHome;
#72 : SK := _Up; #132 : SK := _CtrlPgUp;
#80 : SK := _Dn;
#77 : SK := _Right;
#75 : SK := _Left;
#15 : SK := _ShTab;
#76 : SK := _Fuenf;
else SK := _Nix;
end; { case }
VC := cch;
if Shift then
begin
case SK of
_Left : SK := _ShLeft;
_Right : SK := _ShRight;
_Up : SK := _ShUp;
_Dn : SK := _ShDn;
_Ins : SK := _ShIns;
_Del : SK := _ShDel;
_Home : SK := _ShHome;
_End : SK := _ShEnd;
_PgUp : SK := _ShPgUp;
_PgDn : SK := _ShPgDn;
end;
end;
end;
Begin
if G^.Makro then MakroKey(SK,VC) else
begin
{-------------------------------------------------------------|
| Status liefert den Status der Sondertasten |
+-------------------------------------------------------------|
| Bit 0 = 1 : Rechte Shift-Taste gedr<64>ckt |
| Bit 1 = 1 : Linke Shift-Taste gedr<64>ckt |
| Bit 2 = 1 : Crtl-Taste gedr<64>ckt |
| Bit 3 = 1 : Alt-Taste gedr<64>ckt |
| Bit 4 = 1 : [Scroll Lock] gedr<64>ckt |
| Bit 5 = 1 : [Num Lock] gedr<64>ckt |
| Bit 6 = 1 : [Caps Lock] gedr<64>ckt |
| Bit 7 = 1 : [Ins] gedr<64>ckt |
+-------------------------------------------------------------}
Case Kbd of
0 : begin
Repeat
{ if OnlHelp then TNCs_pollen; }
Until Key1A <> Key1C;
code := TastPuffer[Key1A];
scan := TastPuffer[Key1A+1];
if Key1A + 2 > $3D then Key1A := $1E
else Key1A := Key1A + 2;
end;
1 : begin
asm
mov ah, $10
int $16
mov code,al
mov scan,ah
end;
end;
2 : begin
asm
mov ah, $00
int $16
mov code,al
mov scan,ah
end;
end;
3 : begin
asm
mov ah,$07
int $21
mov code,al
cmp code,0
jnz @1
mov ah,$07
int $21
mov scan,al
@1:
end;
end;
End;
if (code = $E0) and (scan > 0) then code := $00;
if (code = $F0) and (scan > 0) then code := $00;
VC := Chr(Code);
Shift := (KeyStatus and 3) in [1..3];
if VC = #0 then FunktionsTaste(Chr(scan)) else
begin
case VC of
M1 : SK := _Ret;
^I : SK := _Tab;
^H : SK := _Back;
#27 : SK := _Esc;
else SK := _Andere;
end;
if Shift and (KeyOpt in [1,3]) then
case VC of
'1' : SK := _ShEnd;
'2' : SK := _ShDn;
'3' : SK := _ShPgDn;
'4' : SK := _ShLeft;
'6' : SK := _ShRight;
'7' : SK := _ShHome;
'8' : SK := _ShUp;
'9' : SK := _ShPgUp;
end;
if KeyOpt in [2,3] then
case VC of
'+': if scan = 78 then SK := _Plus;
'-': if scan = 74 then SK := _Minus;
'*': if scan = 55 then SK := _Star;
'/': if scan = 53 then SK := _Slash;
end;
end;
if G^.MakroLearn then Makro_Erlernen(SK,VC);
end;
End;
Function _KeyPressed (* : Boolean *);
Var w : Word;
Begin
Case Kbd of
0 : _KeyPressed := Key1A <> Key1C;
1 : begin
asm
mov ah, $11
int $16
pushf
pop w
and w, $40
end;
_KeyPressed := w = 0;
end;
2 : begin
asm
mov ah, $01
int $16
pushf
pop w
and w, $40
end;
_KeyPressed := w = 0;
end;
3 : _KeyPressed := KeyPressed;
End;
if G^.Makro then _KeyPressed := true;
End;
Procedure MakroKey (* var SK : Sondertaste; var VC : char *);
var Taste : Sondertaste;
Flag : Boolean;
Procedure Init;
Begin
G^.Makro := false;
G^.MakroZeile := '';
SK := _Nix;
VC := #255;
End;
Begin
if G^.MakroZeile = '' then MakroZeile_holen;
if pos(S_ch+B1,G^.MakroZeile) = 1 then
begin
G^.MakroZeile := UpCaseStr(RestStr(G^.MakroZeile));
Taste := _CtrlF1;
Flag := false;
While not Flag and (Taste <> _Key2) do
begin
if Key[Taste].Ta = G^.MakroZeile then
begin
SK := Taste;
VC := Key[Taste].Ze;
Flag := true;
end;
inc(Taste);
end;
if not Flag then
begin
if (pos(CTRL,G^.MakroZeile) = 1) and (length(G^.MakroZeile) = 5) then
begin
VC := G^.MakroZeile[5];
if VC in ['A'..'Z'] then
begin
VC := chr(ord(VC)-64);
SK := _Andere;
Flag := true;
end;
end;
if not Flag then
begin
SK := _Nix;
VC := #255;
end;
end;
G^.MakroZeile := '';
end else
begin
SK := _Andere;
VC := G^.MakroZeile[1];
delete(G^.MakroZeile,1,1);
end;
if G^.MakroFileEnd and (G^.MakroZeile = '') then MakroInit;
End;

2108
XPLIB.PAS Executable file
View file

File diff suppressed because it is too large Load diff

3819
XPLIB1.PAS Executable file
View file

File diff suppressed because it is too large Load diff

869
XPLINK.PAS Executable file
View file

@ -0,0 +1,869 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P L I N K . P A S ³
³ ³
³ Routinen f<>r den automatischen Connectaufbau ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Lnk_Sort (* Art : Byte *);
Var x,i,j : Integer;
Change : Boolean;
Hilf : Lnk_Type;
N : Word;
Flag : Boolean;
Hstr,
Xstr : String[14];
Begin
N := Lnk_Anz;
if N > 1 then
begin
x := 1;
While x <= N do x := x * 3 + 1;
x := x div 3;
While x > 0 do
begin
i := x;
While i <= N do
begin
j := i - x;
Change := true;
While (j > 0) and Change do
begin
case Art of
1 : Flag := Lnk^[j].Ext;
2 : Flag := CutStr(Lnk^[j].Entry) > CutStr(Lnk^[j+x].Entry);
3 : Flag := RestStr(Lnk^[j].Entry) > RestStr(Lnk^[j+x].Entry);
4 : Flag := length(RestStr(Lnk^[j].Entry)) >
length(RestStr(Lnk^[j+x].Entry));
else Flag := false;
end;
if Flag then
begin
move(Lnk^[j+x],Hilf,SizeOf(Lnk_Type));
move(Lnk^[j],Lnk^[j+x],SizeOf(Lnk_Type));
move(Hilf,Lnk^[j],SizeOf(Lnk_Type));
j := j - x;
end else Change := false;
end;
i := i + 1;
end;
x := x div 3;
end;
end;
End;
Procedure Lnk_Init (* TNr : Byte; Freq : Str8 *);
Var Hstr : String[80];
VC : Char;
Flag,
Extr : Boolean;
Begin
Lnk_Anz := 0;
FillChar(Lnk^,SizeOf(Lnk^),0);
FiResult := ResetTxt(G^.LinkFile);
Flag := false;
While not Eof(G^.LinkFile) and not Flag do
begin
Readln(G^.LinkFile,Hstr);
KillEndBlanks(Hstr);
Flag := (TncI + int_str(TNr) + DP + Freq) = Hstr;
end;
if Flag then
begin
Flag := false;
Repeat
Readln(G^.LinkFile,Hstr);
if Hstr[0] > #0 then VC := Hstr[1]
else VC := #0;
if VC in [B1,'ù'] then
begin
Extr := copy(Hstr,1,1) = 'ù';
delete(Hstr,1,1);
if Hstr > '' then
begin
inc(Lnk_Anz);
if Lnk_Anz >= (maxLnk-1) then Flag := true;
Lnk^[Lnk_Anz].Entry := Hstr;
Lnk^[Lnk_Anz].Ext := Extr;
end;
end else Flag := true;
Until Eof(G^.LinkFile) or Flag;
end;
FiResult := CloseTxt(G^.LinkFile);
End;
Procedure ALT_C_Connect (* Kanal : Byte *);
Const Bofs = 1;
Var TNr,
i,i1,i2,
Bpos : Byte;
Dpos : Integer;
w : Word;
yM,
Zmax,
SSort : Byte;
KeyTime : LongInt;
OK,
Flag,
CurCON,
AFlag,
Fertig : Boolean;
Hstr : String[80];
Nstr,
Astr,
SuStr : String[9];
Qstr : String[8];
KC : Sondertaste;
VC : Char;
Procedure LnkPage(beg : Word);
Var i : Byte;
VC : Char;
Begin
Teil_Bild_Loesch(Bofs+1,maxZ-1,Attrib[2]);
for i := 1 to Zmax do
begin
if Lnk^[beg-1+i].Ext then VC := 'ù'
else VC := B1;
WriteRam(1,i+Bofs,Attrib[2],0,EFillStr(80,B1,VC + Lnk^[beg-1+i].Entry));
end;
End;
Function GetLinkStr(Nr : Integer) : Str80;
Var VC : Char;
Begin
if Lnk^[Nr].Ext then VC := 'ù'
else VC := B1;
GetLinkStr := EFillStr(80,B1,VC + Lnk^[Dpos].Entry);
End;
Function GetStr_Con(Kanal : Byte; Zeile : Str80) : Str80;
Var i : Byte;
Begin
with K[Kanal]^ do
begin
i := pos(RSK + Call + B1,Zeile + B1);
if i > 0 then
begin
delete(Zeile,1,i-1);
Zeile := RestStr(Zeile);
While (pos(RSK,CutStr(Zeile)) = 0) and (length(Zeile) > 0) do
Zeile := RestStr(Zeile);
end;
GetStr_Con := Zeile;
end;
End;
Procedure WriteKopfzeilen;
Begin
WriteRam(1,1,Attrib[15],0,
EFillStr(80,B1,B1+ TncI + int_str(TNr) + DP +
EFillStr(20,B1,Qstr) + InfoZeile(140)));
WriteRam(1,maxZ,Attrib[15],0,EFillStr(80,B1,B1+InfoZeile(2)));
End;
Begin
with K[Kanal]^ do
begin
NowFenster := false;
GetMem(Lnk,SizeOf(Lnk^));
TNr := K[Kanal]^.TncNummer;
Qstr := TNC[TNr]^.QRG_Akt;
Lnk_Init(TNr,Qstr);
GetMem(FreqList,SizeOf(FreqList^));
yM := 1;
Bpos := 1;
Dpos := 1;
SSort := 0;
SuStr := '';
Zmax := maxZ - (1 + Bofs);
AFlag := false;
Fertig := false;
CurCON := true;
WriteKopfzeilen;
LnkPage(Dpos);
WriteAttr(1,Bpos+Bofs,80,Attrib[4],0);
KeyTime := TimerTick + 1;
Repeat
if CurCON then InitCursor(1,Bpos+Bofs)
else InitCursor(1,1);
if AFlag then VC := S_ch
else VC := B1;
WriteRam(69,1,Attrib[15],0,VC + B1 + EFillStr(10,B1,SuStr));
Repeat
if TimerTick > KeyTime then
begin
Hstr := GetConPfad(CutStr(Lnk^[Dpos].Entry));
if connected then Hstr := GetStr_Con(Kanal,Hstr);
WriteRam(12,Bofs+Bpos,Attrib[4],0,EFillStr(69,B1,Hstr));
end;
Until _KeyPressed;
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetLinkStr(Dpos));
_ReadKey(KC,VC);
KeyTime := TimerTick + 1;
if KC <> _Andere then SuStr := '';
case KC of
_Esc
: Fertig := true;
_Del
: begin
Fertig := true;
Auto_CON := false;
ACZeile := '';
end;
_Dn
: if Dpos < Lnk_Anz then
begin
inc(Dpos);
if Bpos < Zmax then inc(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
Scroll(Up,0,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetLinkStr(Dpos));
end;
end else Alarm;
_Up
: if Dpos > 1 then
begin
dec(Dpos);
if Bpos > 1 then dec(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
Scroll(Dn,0,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetLinkStr(Dpos));
end;
end else Alarm;
_PgDn
: if Dpos < Lnk_Anz then
begin
if Dpos + Zmax - Bpos >= Lnk_Anz then
begin
Dpos := Lnk_Anz;
Bpos := Zmax;
if Bpos > Lnk_Anz then Bpos := Lnk_Anz;
end else
begin
Dpos := Dpos + Zmax - 1;
if Dpos + Zmax - 1 > Lnk_Anz then Dpos := Lnk_Anz - Zmax + Bpos;
LnkPage(Dpos - Bpos + 1);
end;
end else Alarm;
_PgUp
: if Dpos > 1 then
begin
if Dpos <= Bpos then
begin
Dpos := 1;
Bpos := 1;
end else
begin
Dpos := Dpos - Zmax + 1;
if Dpos - Zmax + 1 < 1 then Dpos := Bpos;
LnkPage(Dpos - Bpos + 1);
end;
end else Alarm;
_CtrlPgUp
: if Dpos > 1 then
begin
Dpos := 1;
Bpos := 1;
LnkPage(1);
end else Alarm;
_CtrlPgDn
: if Dpos < Lnk_Anz then
begin
Dpos := Lnk_Anz;
Bpos := Zmax;
if Bpos > Lnk_Anz then Bpos := Lnk_Anz;
LnkPage(Dpos - Bpos + 1);
end else Alarm;
_CtrlHome
: begin
Dpos := Dpos - Bpos + 1;
Bpos := 1;
end;
_CtrlEnd
: if Lnk_Anz < Zmax then
begin
Dpos := Lnk_Anz;
Bpos := Lnk_Anz;
end else
begin
Dpos := Dpos + Zmax - Bpos;
Bpos := Zmax;
end;
_Right, _Left
: begin
FreqCount := 0;
FillChar(FreqList^,SizeOf(FreqList^),0);
FiResult := ResetTxt(G^.LinkFile);
Repeat
Readln(G^.LinkFile,Hstr);
if (copy(Hstr,1,3) = TncI) and (copy(Hstr,5,1) = DP) then
begin
inc(FreqCount);
FreqList^[FreqCount].TNr := str_int(copy(Hstr,4,1));
delete(Hstr,1,5);
Hstr := CutStr(Hstr);
FreqList^[FreqCount].QRG := Hstr;
end;
Until Eof(G^.LinkFile);
FiResult := CloseTxt(G^.LinkFile);
if FreqCount > 1 then
begin
FreqPos := 0;
for i := 1 to FreqCount do
begin
if (TNr = FreqList^[i].TNr) and (Qstr = FreqList^[i].QRG)
then FreqPos := i;
end;
if FreqPos = 0 then FreqPos := 1;
if KC = _Right then
begin
inc(FreqPos);
if FreqPos > FreqCount then FreqPos := 1;
end else if KC = _Left then
begin
dec(FreqPos);
if FreqPos < 1 then FreqPos := FreqCount;
end;
TNr := FreqList^[FreqPos].TNr;
Qstr := FreqList^[FreqPos].QRG;
Lnk_Init(TNr,Qstr);
Lnk_Sort(SSort);
yM := 1;
Bpos := 1;
Dpos := 1;
WriteKopfzeilen;
LnkPage(Dpos);
end;
end;
_ShTab
: CurCON := not CurCON;
_Ret
: if (Lnk_Anz > 0) and
not (Test or SplSave or Auto_CON or Mo.MonActive or
FileSend {or Ignore} or {//db1ras}
((SysArt in [1..4]) And connected)) then {//db1ras}
begin
ACZeile := GetConPfad(CutStr(Lnk^[Dpos].Entry));
if connected then ACZeile := GetStr_Con(Kanal,ACZeile);
if length(ACZeile) > 0 then
begin
Auto_CON := true;
Hstr := GetConStr(ACZeile);
if not connected then Connect(Kanal,Hstr)
else S_PAC(Kanal,NU,true,Hstr + M1);
Fertig := true;
end else Alarm;
end else Alarm;
_AltA
: if (Lnk_Anz > 0) then
begin
AFlag := true;
Lnk^[Dpos].Ext := not Lnk^[Dpos].Ext;
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetLinkStr(Dpos));
end else Alarm;
_AltE
: begin
Cursor_ein;
ExecDOS(Konfig.EditVerz + B1 + Sys1Pfad + LinkDatei);
Cursor_aus;
Lnk_Init(TNr,Qstr);
Lnk_Sort(SSort);
yM := 1;
Bpos := 1;
Dpos := 1;
WriteKopfzeilen;
LnkPage(Dpos);
end;
_AltH
: XP_Help(G^.OHelp[27]);
_AltL
: if (Lnk_Anz > 0) then
begin
Hstr := GetConPfad(CutStr(Lnk^[Dpos].Entry));
Hstr := copy(Hstr,1,68);
GetString(Hstr,Attrib[4],68,12,Bofs+Bpos,KC,0,Ins);
KillEndBlanks(Hstr);
if KC = _Ret then
begin
AFlag := true;
Lnk^[Dpos].Entry := EFillStr(10,B1,CutStr(Lnk^[Dpos].Entry)) + Hstr;
LinkMod(Hstr);
Lnk^[Dpos].Entry := EFillStr(10,B1,CutStr(Lnk^[Dpos].Entry)) + Hstr;
end;
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetLinkStr(Dpos));
end else Alarm;
_AltN
: if (Lnk_Anz > 0) then
begin
Nstr := CutStr(Lnk^[Dpos].Entry);
Astr := Nstr;
GetString(Nstr,Attrib[4],9,2,Bofs+Bpos,KC,0,Ins);
While pos(B1,Nstr) > 0 do Nstr[pos(B1,Nstr)] := '-';
KillEndBlanks(Nstr);
if (KC = _Ret) and (Nstr > '') then
begin
AFlag := true;
Lnk^[Dpos].Entry := EFillStr(10,B1,Nstr) +
RestStr(Lnk^[Dpos].Entry);
if (Astr > '') then for i := 1 to Lnk_Anz do
begin
Repeat
i1 := pos(LSym+Astr,Lnk^[i].Entry);
if i1 > 0 then
begin
Repeat
delete(Lnk^[i].Entry,i1,1);
Until (i1 > length(Lnk^[i].Entry)) or
(Lnk^[i].Entry[i1] = B1);
Insert(LSym+Nstr,Lnk^[i].Entry,i1);
end;
Until i1 = 0;
end;
end;
LnkPage(Dpos - Bpos + 1);
end else Alarm;
_AltS
: if (Lnk_Anz > 0) then
begin
SaveLinks(Kanal,TNr,Qstr);
AFlag := false;
end else Alarm;
_Alt1.._Alt4
: if (Lnk_Anz > 0) then
begin
case KC of
_Alt1 : SSort := 1;
_Alt2 : SSort := 2;
_Alt3 : SSort := 3;
_Alt4 : SSort := 4;
end;
Lnk_Sort(SSort);
LnkPage(Dpos - Bpos + 1);
end else Alarm;
_Andere
: if (Lnk_Anz > 0) then
begin
SuStr := SuStr + UpCase(VC);
w := 0;
Flag := false;
While (w < Lnk_Anz) and not Flag do
begin
inc(w);
if pos(SuStr,Lnk^[w].Entry) = 1 then
begin
Flag := true;
Dpos := w;
if (Dpos < Bpos) or (Lnk_Anz <= Zmax) then Bpos := Dpos;
if ((Lnk_Anz - Dpos + Bpos) < Zmax) and
(Lnk_Anz > Zmax) and
(Dpos > Bpos) then Bpos := Zmax - (Lnk_Anz - Dpos);
end;
end;
if not Flag then
begin
Alarm;
SuStr := '';
end else LnkPage(Dpos - Bpos + 1);
end else Alarm;
else Alarm;
end;
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
WriteAttr(1,Bofs+Bpos,80,Attrib[4],0);
yM := Bpos;
Until Fertig;
FreeMem(FreqList,SizeOf(FreqList^));
FreeMem(Lnk,SizeOf(Lnk^));
Neu_Bild;
end;
End;
Function GetConPfad (* Rufz : Str9) : String *);
Const maxLoop = 30;
Var Hstr : String;
Cstr : String[9];
i,i1,
Loop : Byte;
FLoop : Boolean;
Function GetLink(Call : Str9) : String;
Var i : Byte;
Flag : Boolean;
hlpst:str12;
Begin
i := 0;
Call:=UpcaseStr(Call);
Repeat
inc(i);
hlpst:=upcasestr(CutStr(Lnk^[i].Entry));
Flag := Call = hlpst;
Until (i = Lnk_Anz) or Flag;
if Flag then GetLink := RestStr(Lnk^[i].Entry)
else GetLink := '';
End;
Begin
Hstr := GetLink(Rufz);
if Hstr > '' then
begin
Loop := 0;
FLoop := false;
While not Floop and (pos(LSym,Hstr) > 0) do
begin
i := pos(LSym,Hstr);
delete(Hstr,i,2);
Cstr := '';
Repeat
Cstr := Cstr + Hstr[i];
delete(Hstr,i,1);
Until (i > length(Hstr)) or (Hstr[i] = B1);
Insert(GetLink(Cstr),Hstr,i);
inc(Loop);
if Loop > maxLoop then FLoop := true;
end;
if FLoop then Hstr := '';
GetConPfad := Hstr;
end else GetConPfad := '';
End;
Function GetConStr (* var Zeile : String) : Str80 *);
Var Hstr : String[80];
Begin
Hstr := '';
Repeat
Hstr := Hstr + CutStr(Zeile) + B1;
While pos(RSK,Hstr) > 0 do Hstr[pos(RSK,Hstr)] := B1;
Zeile := RestStr(Zeile);
Until (pos(RSK,CutStr(Zeile)) > 0) or (Zeile = '');
KillEndBlanks(Hstr);
GetConStr := Hstr;
End;
Function LinkExists (* Name : Str9; var Gate : Byte) : Boolean *);
var Flag,
Find : Boolean;
Hstr : String[9];
Freq : String[8];
i,
CrNr : Byte;
Begin
Flag := false;
Find := false;
KillEndBlanks(Name);
Freq := '';
FiResult := ResetTxt(G^.LinkFile);
Repeat
Readln(G^.LinkFile,DZeile);
i := pos(DP,DZeile);
if i = 5 then
begin
CrNr := str_int(copy(DZeile,4,1));
delete(DZeile,1,i);
Freq := CutStr(DZeile);
i := 0;
Repeat
inc(i);
Flag := (Freq = TNC[i]^.QRG_Akt) and (i = CrNr);
Until Flag or (i >= TNC_Anzahl);
end else if Flag and (copy(DZeile,1,1) = 'ù') then
begin
delete(DZeile,1,1);
Hstr := UpcaseStr(CutStr(DZeile));
Find := (Hstr = Name) and (Freq > '');
end;
Until Eof(G^.LinkFile) or Find;
if Find then
begin
i := 0;
Repeat
inc(i);
Flag := (Freq = TNC[i]^.QRG_Akt) and (i = CrNr);
Until Flag or (i >= TNC_Anzahl);
Gate := i;
end;
LinkExists := Find;
FiResult := CloseTxt(G^.LinkFile);
End;
Procedure RemoteLnk (* Kanal,T : Byte; Zeile : Str9 *);
Var Bstr,
Hstr : String[80];
Freq : String[8];
LZ,
Flag : Boolean;
i,TNr : Byte;
Begin
Flag := false;
LZ := length(Zeile) > 0;
GetMem(Lnk,SizeOf(Lnk^));
S_PAC(Kanal,NU,false,M1 + B1 + InfoZeile(128) + M1 + ConstStr('-',75) + M1);
for TNr := 1 to TNC_Anzahl do
begin
Freq := TNC[TNr]^.QRG_Akt;
Lnk_Init(TNr,Freq);
Lnk_Sort(1);
for i := 1 to Lnk_Anz do
begin
if Lnk^[i].Ext and (not LZ or
(LZ and (pos(Zeile,CutStr(Lnk^[i].Entry)) = 1))) then
begin
Hstr := CutStr(Lnk^[i].Entry);
Bstr := GetConPfad(Hstr);
Hstr := EFillStr(10,B1,Hstr);
Hstr := B1 + Hstr + TncI + int_str(TNr) +
DP + EFillStr(10,B1,Freq) + Bstr + M1;
S_PAC(Kanal,NU,false,Hstr);
Flag := true;
end;
end;
end;
FreeMem(Lnk,SizeOf(Lnk^));
if Flag then
begin
if K[Kanal]^.TxLRet then Hstr := M1
else Hstr := M2;
Hstr := Hstr + InfoZeile(6) + M1;
S_PAC(Kanal,NU,false,Hstr);
end else S_PAC(Kanal,NU,false,M1 + InfoZeile(253) + M2);
End;
Procedure LinkMod (* var Zeile : Str80 *);
Var i,i1 : Byte;
Begin
i := 0;
if Lnk_Anz > 0 then
Repeat
inc(i);
i1 := pos(RestStr(Lnk^[i].Entry)+B1,Zeile+B1);
if (i1 > 0) and (RestStr(Lnk^[i].Entry) <> Zeile) then
begin
delete(Zeile,i1,length(RestStr(Lnk^[i].Entry)));
Insert(LSym+CutStr(Lnk^[i].Entry),Zeile,i1);
i := 0;
end;
Until i >= Lnk_Anz;
End;
Procedure SaveLinks (* Kanal,TNr : Byte; Freq : Str8 *);
Var i : Byte;
f : Text;
a,b : Integer;
Old : String[12];
Hstr : String[13];
Lstr : String[80];
VC : Char;
First,
Flag : Boolean;
Begin
Hstr := TncI + int_str(TNr) + DP + Freq;
Old := ParmStr(1,Pkt ,LinkDatei) + 'OLD';
a := 1;
b := 0;
File_Umbenennen(Sys1Pfad + LinkDatei,Sys1Pfad + Old,a,b);
if a = 136 then
begin
Assign(f,Sys1Pfad + Old);
FiResult := ResetTxt(f);
FiResult := RewriteTxt(G^.LinkFile);
First := false;
Repeat
Readln(f,Lstr);
KillEndBlanks(Lstr);
Flag := Lstr = Hstr;
if Lstr > '' then First := true;
if not Flag and First then Writeln(G^.LinkFile,Lstr);
Until Eof(f) or Flag;
if not Flag then for i := 1 to 2 do Writeln(G^.LinkFile);
Writeln(G^.LinkFile,Hstr);
for i := 1 to Lnk_Anz do
begin
if Lnk^[i].Ext then VC := 'ù'
else VC := B1;
Writeln(G^.LinkFile,VC,EFillStr(10,B1,CutStr(Lnk^[i].Entry)),
RestStr(Lnk^[i].Entry));
end;
for i := 1 to 2 do Writeln(G^.LinkFile);
if Flag then
Repeat
Readln(f,Lstr);
KillEndBlanks(Lstr);
if Lstr[0] > #0 then VC := Lstr[1]
else VC := #0;
Flag := not(VC in [#0,B1,'ù']);
Until Eof(f) or Flag;
if Flag then Writeln(G^.LinkFile,Lstr);
While not Eof(f) do
begin
Readln(f,Lstr);
KillEndBlanks(Lstr);
Writeln(G^.LinkFile,Lstr);
end;
FiResult := CloseTxt(f);
FiResult := EraseTxt(f);
FiResult := CloseTxt(G^.LinkFile);
end;
End;
Procedure LinkLearn (* Kanal : Byte; Zeile : Str80 *);
Var i,
TNr : Byte;
Hstr : String[80];
Flag : Boolean;
KC : Sondertaste;
VC : Char;
Begin
with K[Kanal]^ do
begin
KillEndBlanks(Zeile);
if Zeile > '' then
begin
GetMem(Lnk,SizeOf(Lnk^));
TNr := K[Kanal]^.TncNummer;
Lnk_Init(TNr,TNC[TNr]^.QRG_Akt);
LinkMod(Zeile);
Hstr := Zeile;
While pos(B1,Hstr) > 0 do delete(Hstr,1,pos(B1,Hstr));
delete(Hstr,1,pos(RSK,Hstr));
Repeat
Flag := false;
G^.Fstr[7] := InfoZeile(236);
G^.Fstr[9] := '"' + B1 + Zeile + B1 + '"';
G^.Fstr[11] := B1 + InfoZeile(237);
for i:=7 to 15 do
G^.Fstx[i]:=2;
Fenster(15);
GetString(Hstr,Attrib[3],9,length(G^.Fstr[11])+3,11,KC,0,Ins);
if KC = _Ret then
begin
While pos(B1,Hstr) > 0 do Hstr[pos(B1,Hstr)] := '-';
i := 0;
Repeat
inc(i);
Flag := CutStr(Lnk^[i].Entry) = Hstr;
Until Flag or (i >= Lnk_Anz);
if Flag then
begin
G^.Fstr[13] := '"' + Hstr + '" ' + InfoZeile(238);
G^.Fstr[15] := '"' + copy(RestStr(Lnk^[i].Entry),1,78) + '" ';
SetzeCursor(pos('[',G^.Fstr[13])+1,13);
Fenster(15);
Alarm;
_ReadKey(KC,VC);
VC := UpCase(VC);
if (VC in YesMenge) or (KC = _Ret) then
begin
Lnk^[i].Entry := EFillStr(10,B1,Hstr) + Zeile;
end else
begin
Flag := false;
G^.Fstr[14] := '';
Hstr := '';
KC := _Nix;
end;
Cursor_Aus;
end else
begin
inc(Lnk_Anz);
Lnk^[Lnk_Anz].Entry := EFillStr(10,B1,Hstr) + Zeile;
Flag := true;
end;
end;
Until Flag or (KC = _Esc);
if Flag then SaveLinks(Kanal,TNr,TNC[TNr]^.QRG_Akt);
FreeMem(Lnk,SizeOf(Lnk^));
ClrFenster;
Neu_Bild;
end else InfoOut(Kanal,0,1,InfoZeile(239));
end;
End;

2065
XPLOAD.PAS Executable file
View file

File diff suppressed because it is too large Load diff

280
XPLOG.PAS Executable file
View file

@ -0,0 +1,280 @@
(*
Dieses Programm ist nicht von mir, sondern stammt von DL5FBD.
Es dient zum Ausdruck der TOP-Logbuchdatei (LOG.TOP).
Allerdings ist das Programm wenig getestet und muss gegebenfalls
angepasst werden.
*)
{LOGPRINT bietet folgende Moeglichkeiten:
1. Formattierter Druck von SP.LOG auf EPSON-komp. Druckern
Der Druck wird in Blaettern zu je 67 Zeilen formattiert und
die 5 SP.LOG Kopfzeilen am Anfang jeder jedes Blatt ausgedruckt.
2. Anpositionieren einer gewuenschten Druckseite und Druck der
Restdatei inklusiv dieser Seite.
Der Aufruf ist:
LOGPRINT <Datei> fuer kompletten Ausdruck einer SP.LOG
LOGPRINT <Datei> (Druckseite) fuer Ausdruck ab Seite (Druckseite)
Sofern die Environmentvariable SPDIR gesetzt ist, wird SP.LOG in der darin de-
finierten Directory gesucht. Ist SPDIR nicht gesetzt so wird in der aktuellen
Directory gesucht.
73 de Gerd Michael}
{-------------------------------------------------------------------------}
{LOGPRINT 22.07.90 DL5FBD }
{ }
{Druckutility zum Ausdruck der SP.LOG Datei }
{Erlaubt den Ausdruck von SP.LOG in Seiten formattiert wobei die }
{Kopfzeilen am Anfang jeder Seite wiederholt werden. }
{ }
{Das Programm erlaubt die Positionierung auf eine gewuenschte Druckseite }
{mittels eines Suchlaufs. }
{ }
{22.07.90 DL5FBD }
{-------------------------------------------------------------------------}
Program LOGPRT;
USES Printer;
CONST TopOfForm = 0;
TextFenster = 50;
AnzKopfzeil = 3;
unwichtig = 10;
VAR Datei : Text;
Name : STRING[70];
Seite : Word;
Seiten : Word;
Zeilen : Byte;
I : Byte;
Test : Integer;
Zeile : String[140];
Start : String[80];
Ende : String[80];
CRLF : String[2];
SeitS : String[5];
Fett : String[10];
Normal : String[10];
Kopfzeile : Array[1..5] of STRING;
Formfeed : String[1];
FUNCTION GetEnv (EnvVar : String) : String;
TYPE
EnvPtr = Word;
VAR
Enviro : ^EnvPtr;
Offset : Word;
I : Byte;
S : String;
BEGIN
GetEnv := '';
IF Length(EnvVar) = 0 THEN Exit;
FOR I := 1 TO Length(EnvVar) DO EnvVar[I] := UpCase(EnvVar[I]);
EnvVar := EnvVar + '=';
Enviro := Ptr(PrefixSeg,$2C);
Offset := 0;
S := '';
Repeat
S:='';
{Environmentstring komplett extrahieren}
While Mem[Enviro^:Offset] > 0 DO
BEGIN
S := S+UpCase(Chr(Mem[Enviro^:Offset]));
INC (Offset);
END;
{Ist die Environmentvariable vorhanden ??}
{Dann Zuweisungsteil holen und beenden !}
IF (Pos(EnvVar,S) = 1) THEN
BEGIN
GetEnv := Copy(S,Pos('=',S)+1,Length(S));
EXIT;
END;
Inc(Offset);
{Endekennung Environmentvariablenbereich}
Until (Mem[Enviro^:Offset] = 0)
AND (Mem[Enviro^:Offset+1] = 1)
AND (Mem[Enviro^:Offset+2] = 0);
END;
Function GetDIR(Pfad:String):String;
VAR Dummi :String[70];
BEGIN
Dummi:=GetEnv(Pfad);
IF LENGTH(Dummi) >0 THEN Dummi:=Dummi+'\';
GETDIR:=Dummi;
END;
Procedure DefiniereDruckervariable;
Begin
CRLF :=chr(13)+chr(10); {Zeilenabschluss CR+LF}
Formfeed:=chr(12); {Seitenvorschub}
Start :=chr(27)+'@'; {Drucker-Reset}
{Start :=Start+chr(27)+chr(25)+'T'+'1';}{Druckbeginn Einzelblatteinzug Zeile 1}
Start :=Start+chr(27)+chr(15); {Eliteschrift 96 Zeichen/Zeile}
{Start :=Start+chr(27)+'l'+chr(1);} {Heftrand 1 Zeichen}
Ende :=chr(27)+'@'; {Drucker-Reset}
Fett :=chr(27)+'E'; {Fettschrift ein}
Normal:=chr(27)+'F'; {Fettschrift aus}
END;
Procedure Druckstring(AusZeile :String);
VAR K :Byte;
Z :CHAR;
Begin
FOR K:=1 TO LENGTH(AusZeile) DO
BEGIN
Z:=AusZeile[K];
Repeat
{$I-} Write(LST,Z); {$I+}
Until IOResult=0;
END;
END;
Procedure DruckKopf;
Begin
Begin
DruckString(Fett+Name+' ');
STR(Seite,SeitS);
DruckString('Seite: '+SeitS+CRLF);
Writeln(crlf,crlf);
Writeln(Name+' Seite: '+SeitS);
FOR I:=1 to AnzKopfZeil-1 DO
BEGIN
Druckstring(Kopfzeile[I]+CRLF);
Writeln(Kopfzeile[I]);
END;
Druckstring(Normal);
Zeilen:=AnzKopfZeil;
END;
END;
BEGIN
DefiniereDruckervariable;
IF ParamCount>=1 THEN Name:=ParamStr(1)
ELSE
BEGIN
Writeln;
Writeln('LOGPRINT - Formattierter Ausdruck der SP-Log-Datei');
Writeln(' 22.07.90 DL5FBD');
Writeln;
Writeln('Aufruf: LOGPRINT <Dateiname> [Druckseite]');
Writeln;
Halt;
END;
Assign(Datei,GETDIR('SPDIR')+Name);
{$I-} Reset(Datei); {$I+}
If IOResult<>0 THEN
BEGIN
Writeln;
Writeln(GETDIR('SPDIR'),Name,' nicht gefunden!');
Writeln;
Halt;
END;
FOR I:=1 to unwichtig DO Readln(Datei);
FOR I:=1 to AnzKopfZeil-1 DO Readln(Datei,Kopfzeile[I]);
DruckString(Start);
IF ParamCount=2 THEN
BEGIN
Zeile:=ParamStr(2);
VAL(Zeile,Seite,Test);
IF Test <>0 THEN
BEGIN
Writeln;
Writeln('Fehlerhafte Druckseitenangabe!');
Writeln;
Halt;
END;
Seite:=Seite-1
END
ELSE Seite:=0;
IF Seite>0 THEN
BEGIN
Seiten:=0;
Writeln;
Repeat
INC(Seiten);
Write('Positionierung steht auf Seite ',Seiten+1,CHR(13));
Zeilen:=AnzKopfZeil;
Repeat
Readln(Datei,Zeile);
INC(Zeilen);
Until (Eof(Datei)) OR (Zeilen=Textfenster);
Until Eof(Datei) OR (Seiten=Seite);
IF Eof(Datei) THEN
BEGIN
Writeln;
Writeln('Fehlerabbruch! Das Ende der Logdatei wurde vor der');
Writeln(' Leseposition der Druckseite erreicht!');
Writeln;
Halt;
END;
END;
Repeat { Druckschleife }
IF TopOfForm>0 THEN For I:=1 TO TopOfForm DO DruckString(CRLF);
INC(Seite);
Zeilen:=0;
DruckKopf; {Kopfzeile bei Zusatzparametern}
Repeat { Seitenschleife }
Readln(Datei,Zeile);
Druckstring (Zeile);
Druckstring (CRLF);
Writeln(Zeile);
INC(Zeilen);
Until (Zeilen=TextFenster) OR Eof(Datei);
IF Zeilen=TextFenster THEN
Begin
Druckstring(Formfeed); { Seitenvorschub }
End;
Until Eof(Datei);
Druckstring(Formfeed); { Seitenvorschub }
DruckString(Ende);
FiResult := CloseBin(Datei);
END.

849
XPMAIL.PAS Executable file
View file

@ -0,0 +1,849 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P M A I L . P A S ³
³ ³
³ Mailpolling-Routinen (Pseudo-Forward) ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function GetS_Con(Kanal : Byte; Zeile : Str80) : Str80;
Var i : Byte;
Begin
with K[Kanal]^ do
begin
i := pos(RSK + Call + B1,Zeile + B1);
if i > 0 then
begin
delete(Zeile,1,i-1);
Zeile := RestStr(Zeile);
While (pos(RSK,CutStr(Zeile)) = 0) and (length(Zeile) > 0) do
Zeile := RestStr(Zeile);
end;
GetS_Con := Zeile;
end;
End;
Procedure Link_Holen (* Var TNr : Byte; Var Port : Byte; Var CString : Str80 *);
Var ConStr, Hstr : String[80];
QRG, Call : Str10;
VC : Char;
Flag,
Extr : Boolean;
Begin
FiResult := ResetTxt(G^.LinkFile);
if FiResult=0 then
begin
Flag := false;
While not Eof(G^.LinkFile) and not Flag do
begin
Readln(G^.LinkFile,Hstr);
if (Pos(TncI,Hstr)=1) and (Pos(DP, Hstr)=5) then
begin
Port:=str_int(Copy(Hstr,4,1));
QRG:=copy(Hstr,6,length(Hstr));
end;
delete(hstr,1,1);
KillEndBlanks(Hstr);
Call:=copy(HStr,1,pos(B1,hstr)-1);
Flag:= upcasestr(Cstring)=upcaseStr(Call);
(* Flag := (TncI + int_str(TNr) + DP + Freq) = Hstr; *)
end;
end;
CString:='';
FiResult := CloseTxt(G^.LinkFile);
if flag then
begin
LinksVorbereiten(Port,QRG);
CString:=GetConPfad(Call);
LinksKillen;
end;
{ KillStartBlanks(Cstring);}
End;
Function NextPollCmd : string;
var HStr:string;
begin
HStr:='';
if Pos(';', MailPolling)>0 then
begin
Hstr:=copy (Mailpolling,1,Pos(';',MailPolling)-1);
Delete(MailPolling,1,Pos(';',MailPolling));
end else
begin
Hstr:=MailPolling;
MailPolling:='';
end;
NextPollCmd:=HStr;
{Lesebefehl VORHER mit *+* markiert!}
end;
procedure MailSchliessen(*Kanal:Byte*);
var dum:boolean;
begin
with K[Kanal]^ do
begin
CloseRxFile(Kanal,0);
RX_Save := false;
BoxZaehl:=5;
RX_Bin := 0;
RemoteSave := false;
end;
end;
procedure CancelMailPoll (*Kanal:Byte*);
begin
PollStr:='';
with K[kanal]^ do
begin
fwdgo:=false;
fwd:=false;
fwd_:=false;
MailPolling:='';
MailPrompt:='';
MailRXCall:='';
MailSynonym:='';
MailSchliessen(Kanal);
end;
end;
Procedure MailOeffnen(Kanal:Byte);
var path, dummy : string;
begin
With K[Kanal]^ do
begin
Path := Konfig.MailVerz + MailRXCall + MsgExt;
MsgToMe:=true;
EigMail:=true;
FRxName := Path;
if OpenTextFile(Kanal) then
begin
RX_Count := 0;
RX_TextZn := 0;
RX_Laenge := 0;
RX_Bin := 1;
RX_Time := Uhrzeit;
RX_Save := true;
if node then Mail_sp:=true;
RemoteSave := true;
Dummy := M1 + InfoZeile(96) + B1+ EFillStr(10,B1,Call) +
Datum + B2 + copy(Uhrzeit,1,5) + B1 + ZeitArt + M1;
Dummy := Dummy + ConstStr('-',length(Dummy)) + M1;
Write_RxFile(Kanal,Dummy);
end;
end;
end;
procedure StartMailPolling (*(Kanal, RXCall)*);
var path,
dummy : String;
Link,hstr : Str80;
i,Port : byte;
found,
flag:boolean;
CStr,
Pstr: str10;
User2 : User_Typ2;
USeidx: User_idx;
UsFile: file of user_typ2;
USIdx : file of User_IDX;
obf:integer;
begin
found:=false;
MailPolling:='';
Link:=rxcall;
PStr:=RxCall;
if MailSynonym<>'' then Link:=MailSynonym
else
if not MailAusUDB then begin
{$I-}
assign(UsIDX, Sys1Pfad+UserIDX);
reset(USIDX);
obf:=ioresult;
if obf=0 then
begin
Repeat
read(UsIDX, USeIDX);
CStr := USeidx.Call;
Strip(CStr);
found := cstr=PStr;
until (Found) or (EOF(UsIDX));
close(UsIDX);
end;
if found then
begin
assign(UsFile, Sys1Pfad+UserDatei);
reset(UsFile);
seek(UsFile, UseIDX.Pos);
read(usfile, User2);
close(usfile);
obf:=ioresult;
if user2.synonym<>'' then Link:=user2.Synonym;
end;
{$I+}
end;
MailSynonym:='';
MailAusUDB:=false;
Link_Holen(Port,Link);
flag:=false;
i:=0;
repeat
inc(i);
if K[i]^.TNCNummer=Port then flag:=not K[i]^.connected;
until flag;
Kanal:=i;
if Flag then
begin
with K[Kanal]^ do
begin
ACZeile:=link;
{if connected then ACZeile := GetS_Con(Kanal,ACZeile);}
if length(ACZeile) > 0 then
begin
fwd:=true;
fwd_:=true;
Auto_CON := true;
Hstr := GetConStr(ACZeile);
if not connected then Connect(Kanal,Hstr)
else S_PAC(Kanal,NU,true,Hstr + M1);
end;
end;
end; {if flag}
end;
procedure LinksVorbereiten(*Port:byte;QRG:Str10*);
begin
GetMem(Lnk,SizeOf(Lnk^));
Lnk_Init(Port,QRG);
end;
Procedure LinksKillen;
begin
FreeMem(Lnk,SizeOf(Lnk^));
end;
Procedure MailPollGo (*Kanal : byte*);
var HStr:string;
SStr:string;
MPTyp:byte;
Flag : Boolean;
begin
if MailPolling='' then
begin
if MailBoxCall<>'' then MailKillen (MailBoxCall, MailRXCall, 0);
MailBoxCall:='';
MailRXCall:='';
NFwd:=false;
end
else NFwd:=true;
if MailPWWait then Sysop_Einloggen(Kanal,'');
if not MailPWWait then
begin
with K[kanal]^ do
begin
MailPrompt:='';
hstr:=UpcaseStr(NextPollCmd);
KillEndBlanks(Hstr);
MPTyp:=0;
flag:=true;
repeat
inc(MpTyp);
flag:=Hstr=MailPollC[MPTyp];
until (flag) or (MPTyp=MaxMailPollCmd);
if (not flag) then MPtyp:=0;
SStr:='';
case MPTyp of
1:MailPrompt:=UpcaseStr(MailPrompt_);
2: begin
SStr:=#13;
_aus(Attrib[19],Kanal,m1);
end;
3:SStr:=MailRXCall;
4: begin
Sysop_Einloggen(Kanal,'');
MailPWWait:=true;
end;
5: begin
MailPrompt:=UpcaseStr(MailPWPrompt_);
MailPWWait:=true;
end;
end;
if MPTyp=0 then
begin
if pos('*+*',HStr)=1 then
begin
MailOeffnen(Kanal);
delete(HStr,1,3);
end;
if pos('+*+',HStr)=1 then
begin
{ MailSchliessen(Kanal);}
delete(HStr,1,3);
end;
SStr:=Hstr;
end;
if SSTr<>'' then
begin
infoout(Kanal,0,0,SSTr);
sstr:=sstr+m1;
S_Pac(Kanal,NU,true,SStr);
enD;
end;
end;
end;
{****************************************}
Function OpenMailDatei (var MFile:MailDat) : word;
begin
{$I-}
assign(MFile, sys1pfad+MailsDatei);
reset(MFile);
OpenMailDatei:=IoResult;
{$I+}
end;
Function CloseMailDatei (var MFile:MailDat) : word;
begin
{$I-}
Close(MFile);
CloseMailDatei:=IoResult;
{$I+}
end;
procedure GetMails;
var mfile:Maildat;
i:integer;
begin
i:=OpenMailDatei(mfile);
if i=0 then MailAnz:=FileSize(MFile);
i:=CloseMailDatei(Mfile);
end;
Procedure MailsSortieren;
Var x,i,j : longInt;
N : longint;
Change : Boolean;
MFile : MailDat;
MTyp, MTyp1, MTyp2, MTyp3 : Mail_Typ;
Begin
{if inUDB then WriteRam(1,3,Attrib[5],1,EFillStr(80,B1,B1+'Sortiere Datenbank ...'));}
GetMails;
i:=OpenMailDatei(MFile);
N := MailAnz;
if N > 1 then
begin
x := 1;
While x <= N do x := x * 3 + 1;
x := x div 3;
While x > 0 do
begin
i := x;
While i <= N do
begin
j := i - x;
Change := true;
While (j > 0) and Change do
begin
Seek(MFile, j-1); read(MFile, MTyp1);
Seek(MFile, j+x-1); read(MFile, MTyp2);
if MTyp1.Boxcall > MTyp.BoxCall then
begin
MTyp3 := MTyp2;
MTyp2 := MTyp1;
MTyp1 := MTyp3;
Seek(MFile, j-1); write(MFile, MTyp1);
Seek(MFile, j+x-1); write(MFile, Mtyp2);
j := j - x;
end else Change := false;
end;
i := i + 1;
end;
x := x div 3;
end;
end;
{$I-}
i:=closeMailDatei(MFile);
{$I+}
End;
Function MailsVorhanden (* : Boolean *);
var Anz:longint;
check:word;
MFile : MailDat;
flag:boolean;
begin
flag:=false;
if OpenMailDatei(MFile)=0 then
begin
anz:=FileSize(Mfile);
if Anz>0 then flag:=true;
check:=CloseMailDatei(MFile);
end;
MailsVorhanden:=flag;
end;
Procedure MailVersucheRauf;
var MFile : MailDat;
MTyp : Mail_Typ;
i : longint;
begin
i:=0;
if OpenMailDatei(MFile)=0 then
begin
if FileSize(MFile)>0 then
begin
seek(MFile, DPos-1);
read(MFile, MTyp);
if MTyp.Versuche<255 then inc(MTyp.Versuche);
seek(MFile, DPos-1);
write(MFile, MTyp);
end;
i:=CloseMailDatei(MFile);
end;
end;
Procedure MailKillen (*Box, RX:Str10; DPos : longint*);
VAR Killed : Boolean;
i:word;
MFile : MailDat;
MTyp : Mail_Typ;
Max,
Lesen,
schreiben : Longint;
begin
lesen:=0;
schreiben:=0;
Killed:=false;
if DPOS=0 then
begin
if OpenMailDatei(MFile)=0 then
begin
Max:=FileSize(Mfile);
while (not EOF(MFile)) and (lesen<Max) do
begin
seek(MFile,lesen);
read(MFile, MTyp);
inc (Lesen);
if (MTyp.BoxCall=Box) and (Mtyp.ZielCall=RX) and (not Killed) then
begin
Killed:=true;
end
else
begin
seek (MFile,Schreiben);
write(MFile, Mtyp);
inc(Schreiben);
end;
end; {while not eof}
seek (MFile,Schreiben);
Truncate(MFile);
i:=CloseMailDatei(MFile);
end; {if openmail}
end;
if DPOS>0 then
begin
if OpenMailDatei(MFile)=0 then
begin
Max:=FileSize(Mfile);
while (not EOF(MFile)) and (lesen<Max) do
begin
seek(MFile,lesen);
read(MFile, MTyp);
inc (Lesen);
if (LESEN=Dpos) and (not Killed) then
begin
Killed:=true;
end
else
begin
seek (MFile,Schreiben);
write(MFile, Mtyp);
inc(Schreiben);
end;
end; {while not eof}
seek (MFile,Schreiben);
Truncate(MFile);
i:=CloseMailDatei(MFile);
end; {if openmail}
end;
MailInBox:=Mailsvorhanden;
end;
Procedure MailSpeichern (* Mail : Mail_typ *);
var i: longint;
MFile: Maildat;
MDat,
MDatH : Mail_typ;
Flag : boolean; {gespeichert?}
begin
flag:=false;
{$i-}
i:=-1;
if OpenMailDatei(Mfile)=0 then
begin
While (not EOF(MFile)) and (not Flag) do
begin
inc(i);
Read(MFile, MDat);
if (MDat.BoxCall=Mail.BoxCall) and (MDat.ZielCall=Mail.ZielCall) then
begin
MDat.Datum:=Mail.Datum;
MDat.Uhrzeit:=Mail.Uhrzeit;
MDat.Port:=Mail.Port;
Seek(MFile,i);
Write(MFile,MDat);
Flag:=true;
end;
end;
end else REwrite(MFile); {if ioresult}
if not Flag then write(MFile, Mail);
i:=closeMailDatei(Mfile);
{$i+}
end;
Procedure MDatensatzHolen (Nr: longint; VAR Md:Mail_typ);
var MFile : MailDat;
i:word;
begin
i:=OpenMailDatei(MFile);
if i=0 then
begin
seek(Mfile, Nr-1);
read(Mfile, MD);
end;
i:=closeMailDatei(Mfile);
end;
Function MarkMailStr(Nr : longint; Sp : Byte) : Str80;
var UDummy : String[14];
MUS : String[80];
MDat : Mail_typ;
Begin
if Nr>MailAnz then MarkMailStr :=''
else
begin
MDatensatzHolen(nr, MDat);
if nr>-1 then
With Mdat do
begin
MUS := EfillStr(12,B1,BoxCall);
MUS:=MUS+Efillstr(12,B1,ZielCall);
MUS:=MUS+Efillstr(14,B1,Datum);
MUS:=MUS+EfillStr(11,B1,Uhrzeit);
MUS:=MUS+EfillStr(7,B1,Int_Str(Versuche));
MUS:=MUS+EfillStr(2,B1,int_str(Port));
MarkMailStr:=MUS;
end;
end;
End;
Function BoxCall (DP : longint) : str9;
var md:mail_typ;
begin
MDatenSatzHolen(DP,Md);
BoxCall:=Md.BoxCall;
MailRXCall:=MD.ZielCall;
MailBoxCall:=MD.BoxCall;
end;
Procedure MailsZeigen (* Kanal : Byte *);
Const Bofs = 1;
Var X : longint;
yM,
Bpos,
Zmax : Byte;
fz:file;
NeuDpos,
SavDpos,
Dpos : longint;
w,w1,
AnzM,
Result : longint;
Flag,
Fertig : Boolean;
KC : Sondertaste;
VC,
VA : Char;
f : Text;
Hstr,
Sstr,
Pfad,
XPfad : String[80];
MHelp : Mail_typ;
Procedure DirPage(beg : Longint);
Var i : Byte;
Begin
for i := 1 to Zmax do WriteRam(1,i+Bofs,Attrib[2],1,EFillStr(80,B1,MarkMailStr(beg-1+i,1)));
WriteRam(1,maxZ,Attrib[5],1,EFillStr(80,B1,B1+InfoZeile(49)));
End;
Procedure WartenSchirm;
Var i : Byte;
Begin
WriteRam(1,1,Attrib[5],1,EFillStr(80,B1,InfoZeile(47)));
for i := 1 to Zmax do WriteRam(1,i+1,Attrib[2],1,EFillStr(80,B1,' '));
WriteRam(1,3,Attrib[5],1,EFillStr(80,B1,B1+InfoZeile(230)));
WriteRam(1,maxZ-1,Attrib[5],1,EFillStr(80,B1,InfoZeile(48)) );
WriteRam(1,maxZ,Attrib[5],1,EFillStr(80,B1,B1+InfoZeile(49)));
End;
Procedure GetCursorLine;
Begin
WriteRam(1,Bpos+Bofs,Attrib[4],1,EFillStr(80,B1,MarkMailStr(Dpos,1)));
End;
Procedure RestAuflisten;
var i: byte;
i2:longint;
Begin
i2:=DPos;
for i:=BPos to zmax do
begin
WriteRam(1,i+Bofs,Attrib[2],1,EFillStr(80,B1,MarkMailStr(i2,1)));
inc(I2);
end;
End;
Procedure InitStart(Art : Byte; Bstr : Str12);
Var w : longint;
Flag : Boolean;
Vpos : Byte;
call1,
call2: string[8];
Begin
WartenSchirm;
Vpos := Bpos;
yM := 1;
Bpos := 1;
Dpos := 1;
AnzM := 0;
GetMails;
if Art = 1 then
begin
DirPage(Dpos);
end;
End;
Procedure CursorDn;
Begin
if Dpos < MailAnz then
begin
inc(Dpos);
if Bpos < Zmax then inc(Bpos) else
begin
WriteAttr(1,yM+Bofs,80,Attrib[2],1);
Scroll(Up,1,1+Bofs,Zmax+Bofs);
WriteRam(1,Bpos+Bofs,Attrib[4],1,MarkMailStr(Dpos,1));
end;
end else Alarm;
End;
Begin
{ INUdb:=true;}
Moni_Off(0);
DirScroll := true;
NowFenster := false;
Zmax := maxZ - 3;
Fertig := false;
X := 1;
InitStart(1,'');
WriteAttr(1,Bpos+Bofs,80,Attrib[4],1);
Repeat
InitCursor(X,Bpos+Bofs);
hstr:=int_Str(DPos);
if MailAnz=0 then hstr:='0';
WriteRam(1,maxZ-1,Attrib[5],1,EFillStr(80,B1,InfoZeile(48)+' '+hstr+'/'+int_str(MailAnz)));
WriteRam(1,1,Attrib[5],1,EFillStr(80,B1,InfoZeile(47)));
GetCursorLine;
_ReadKey(KC,VC);
case KC of
_Esc
: begin
Fertig := true;
end;
_Dn
: CursorDn;
_Up
: if Dpos > 1 then
begin
dec(Dpos);
if Bpos > 1 then dec(Bpos) else
begin
WriteAttr(1,yM+Bofs,80,Attrib[2],1);
Scroll(Dn,1,1+Bofs,Zmax+Bofs);
WriteRam(1,Bpos+Bofs,Attrib[4],1,MarkMailStr(Dpos,1));
end;
end else Alarm;
_PgDn
: if Dpos < MailAnz then
begin
if Dpos + Zmax - Bpos >= MailAnz then
begin
Dpos := MailAnz;
Bpos := Zmax;
if Bpos > MailAnz then Bpos := MailAnz;
end else
begin
Dpos := Dpos + Zmax - 1;
if Dpos + Zmax - 1 > MailAnz then Dpos := MailAnz - Zmax + Bpos;
DirPage(Dpos - Bpos + 1);
end;
end else Alarm;
_PgUp
: if Dpos > 1 then
begin
if Dpos <= Bpos then
begin
Dpos := 1;
Bpos := 1;
end else
begin
Dpos := Dpos - Zmax + 1;
if Dpos - Zmax + 1 < 1 then Dpos := Bpos;
DirPage(Dpos - Bpos + 1);
end;
end else Alarm;
_Home
: if Dpos > 1 then
begin
Dpos := 1;
Bpos := 1;
DirPage(1);
end else Alarm;
_End
: if Dpos < MailAnz then
begin
Dpos := MailAnz;
Bpos := Zmax;
if Bpos > MailAnz then Bpos := MailAnz;
DirPage(Dpos - Bpos + 1);
end else Alarm;
_Ret
: begin
if (not fwd_) and (MailAnz>0) then
begin
MailVersucheRauf (DPos);
StartMailPolling(Kanal,BoxCall(Dpos));
Fertig:=true;
end else alarm;
end;
_altd, _del
: begin
if MailAnz>0 then
begin
SavDpos:=Dpos;
if (SiAltD) then
begin
WriteRam(1,Bpos+Bofs,Attrib[5],1,EFillStr(80,B1,B2+InfoZeile(224)));
_ReadKey(KC,VC);
end;
if (KC = _Ret) or (UpCase(VC) in YesMenge) or (not SiAltD) then
begin
userkilled:=dpos;
MailKillen('','',DPOS);
{ InitStart(1,'');}
GetMails;
if MailAnz>savDpos then
begin
DPos:=SavDpos;
if ((MailAnz-dpos)<ZMax) and (MailAnz>=ZMax) then
begin
BPos:=ZMax-(MailAnz-dPos);
DirPage(Dpos-Bpos+1);
end else RestAuflisten;
end
else
begin
DPOs:=MailAnz;
BPos:=ZMax;
if MailAnz<ZMax then BPos:=MailAnz;
if MailAnz<1 then
begin
Bpos:=1;
Dpos:=1;
end;
DirPage(Dpos-Bpos+1);
end;
{ yM := 1;
AnzM := 0;
BPos:=1;
DirPage(Dpos);}
end;
end;
end;
_AltH
: XP_Help(G^.OHelp[93 ]);
{ _ALTS
: begin
BoxSuchen(DPOs,'');
BPos:=1;
DirPage(Dpos);
end;}
else Alarm;
end;
WriteAttr(1,yM+Bofs,80,Attrib[2],1);
WriteAttr(1,Bpos+Bofs,80,Attrib[4],1);
yM := Bpos;
Until Fertig;
DirScroll := false;
Moni_On;
InUDB:=false;
End;

149
XPMAKRO.PAS Executable file
View file

@ -0,0 +1,149 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P M A K R O . P A S ³
³ ³
³ Routinen f<>r die Abarbeitung der Makrofunktionen. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure MakroZeile_holen;
Var w : Word;
Begin
if ResetTxt(G^.MakroFile) = 0 then
begin
for w := 1 to G^.MakroZaehl do Readln(G^.MakroFile);
if not Eof(G^.MakroFile) then
begin
Readln(G^.MakroFile,G^.MakroZeile);
KillEndBlanks(G^.MakroZeile);
inc(G^.MakroZaehl);
G^.MakroFileEnd := Eof(G^.MakroFile);
end else MakroInit;
FiResult := CloseTxt(G^.MakroFile);
end else MakroInit;
End;
Procedure Makro_aktivieren (* Zeile : Str60 *);
Begin
if pos(BS,Zeile) = 0 then Zeile := Konfig.MakVerz + Zeile;
if pos(Pkt,Zeile) = 0 then Zeile := Zeile + KeyExt;
Assign(G^.MakroFile,Zeile);
if ResetTxt(G^.MakroFile) = 0 then
begin
FiResult := CloseTxt(G^.MakroFile);
G^.Makro := true;
G^.MakroZeile := '';
end else
begin
MakroInit;
InfoOut(show,1,1,InfoZeile(27) + B1 + Zeile);
end;
End;
Procedure MakroInit;
Begin
G^.MakroZeile := '';
G^.Makro := false;
G^.MakroFileEnd := false;
G^.MakroZaehl := 0;
End;
Procedure Makro_Erlernen (* SK : Sondertaste; VC : Char *);
Begin
if not(KeyCheck and (SK = _Alt3)) then
begin
if SK = _Andere then
begin
if not G^.MakroReturn then Writeln(G^.MakroFile);
G^.MakroReturn := true;
if VC in [^A..^Z] then
begin
Writeln(G^.MakroFile,S_ch + B1 + CTRL + chr(ord(VC)+64));
G^.MakroZeile := '';
end else G^.MakroZeile := G^.MakroZeile + VC;
end else
begin
if not G^.MakroReturn then Writeln(G^.MakroFile);
G^.MakroReturn := true;
if G^.MakroZeile > '' then
begin
if not G^.MakroReturn then Writeln(G^.MakroFile);
Writeln(G^.MakroFile,G^.MakroZeile);
G^.MakroZeile := '';
G^.MakroReturn := true;
end;
Writeln(G^.MakroFile,'* ',Key[SK].Ta);
end;
end;
End;
Procedure Makro_Open_LearnFile;
var Hstr : String[80];
KC : Sondertaste;
VC : Char;
Flag : Boolean;
i : Byte;
Begin
if not G^.MakroLearn then
begin
Flag := false;
Hstr := Konfig.MakVerz + MakDatei + KeyExt;
G^.Fstr[7] := InfoZeile(187);
G^.Fstr[10] := B1 + InfoZeile(168);
Fenster(15);
GetString(Hstr,Attrib[3],60,2,14,KC,2,Ins);
if KC <> _Esc then
begin
Assign(G^.MakroFile,Hstr);
if ResetTxt(G^.MakroFile) = 0 then
begin
FiResult := CloseTxt(G^.MakroFile);
for i := 9 to 15 do G^.Fstr[i] := '';
G^.Fstr[11] := B1 + Hstr + DP + InfoZeile(156);
G^.Fstr[13] := B1 + InfoZeile(188);
Fenster(15);
SetzeCursor(length(G^.Fstr[13]) + 1,13);
Alarm;
_ReadKey(KC,VC);
Cursor_aus;
VC := UpCase(VC);
if (VC in YesMenge) or (KC = _Ret) then
begin
if RewriteTxt(G^.MakroFile) = 0 then Flag := true
else Triller;
end else if KC <> _Esc then
begin
if AppendTxt(G^.MakroFile) = 0 then Flag := true
else Triller;
end;
end else
begin
if RewriteTxt(G^.MakroFile) = 0 then Flag := true
else Triller;
end;
if Flag then
begin
G^.MakroZeile := '';
G^.MakroLearn := true;
G^.MakroReturn := true;
end;
end;
end else
begin
G^.MakroLearn := false;
if G^.MakroZeile > '' then Writeln(G^.MakroFile,G^.MakroZeile);
FiResult := CloseTxt(G^.MakroFile);
G^.MakroZeile := '';
end;
ClrFenster;
SetzeFlags(show);
Neu_Bild;
End;

663
XPMH.PAS Executable file
View file

@ -0,0 +1,663 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P M H . P A S ³
³ ³
³ Routinen f<>r die MH-Liste ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure MH_Sort (* Art : Byte *);
Var x,i,j : Integer;
Change : Boolean;
Hilf : MH_Typ;
N : Word;
flag : Boolean;
Hstr,
Xstr : String[14];
Begin
N := maxMH;
if N > 1 then
begin
x := 1;
While x <= N do x := x * 3 + 1;
x := x div 3;
While x > 0 do
begin
i := x;
While i <= N do
begin
j := i - x;
Change := true;
While (j > 0) and Change do
begin
case Art of
1 : begin
Hstr := copy(MHeard^[j+x].Zeit,7,2) + copy(MHeard^[j+x].Zeit,3,4) +
copy(MHeard^[j+x].Zeit,1,2) + copy(MHeard^[j+x].Zeit,9,6);
Xstr := copy(MHeard^[j].Zeit,7,2) + copy(MHeard^[j].Zeit,3,4) +
copy(MHeard^[j].Zeit,1,2) + copy(MHeard^[j].Zeit,9,6);
flag := Hstr > Xstr;
end;
2 : flag := (MHeard^[j+x].Rej > MHeard^[j].Rej);
3 : flag := (MHeard^[j+x].UIs > MHeard^[j].UIs);
4 : flag := (MHeard^[j+x].Call > MHeard^[j].Call);
5 : flag := (MHeard^[j+x].Link > MHeard^[j].Link);
6 : flag := (MHeard^[j+x].QRG > MHeard^[j].QRG);
else flag := false;
end;
if flag then
begin
move(MHeard^[j+x],Hilf,SizeOf(MH_Typ));
move(MHeard^[j],MHeard^[j+x],SizeOf(MH_Typ));
move(Hilf,MHeard^[j],SizeOf(MH_Typ));
j := j - x;
end else Change := false;
end;
i := i + 1;
end;
x := x div 3;
end;
end;
End;
Function GetMhStr(Art : Byte; MPos : Word) : Str80;
Var Hstr : String[80];
Begin
with MHeard^[MPos] do
begin
Hstr := '';
if Art = 0 then
begin
if Call > '' then Hstr := B1 + copy(Zeit,1,5) + '-' + copy(Zeit,10,5) + B1 +
SFillStr(3,B1,int_str(Rej)) + B1 +
SFillStr(3,B1,int_str(UIs)) + B2 +
EFillStr(10,B1,Call) + B1 +
Link;
Hstr := EFillStr(80,B1,Hstr);
end;
if Art = 1 then
begin
if Call > '' then Hstr := B1 + copy(Zeit,1,5) + '-'
+ copy(Zeit,10,5) + B1 +
EFillStr(10,B1,Call) + B1 +
Link;
end;
if Art = 2 then
begin
if Call > '' then Hstr := B1 + int_str(TNr) + SFillStr(9,B1,QRG) +
B1 + copy(Zeit,1,5) + '-' +
copy(Zeit,10,5) + B1 +
EFillStr(10,B1,Call) + B1 +
Link;
end;
if Art = 3 then
begin
if Call > '' then Hstr := EFillStr(11,B1,Call);
end;
GetMhStr := Hstr;
end;
End;
Procedure MH_QRG_Init(Freq : Str8);
Var FreqMerk : String[8];
i : Byte;
Begin
FillChar(MHeard^,maxMH * SizeOf(MH_Typ),0);
move(MH^,MHeard^,maxMH * SizeOf(MH_Typ));
MH_Sort(6);
FillChar(FreqList^,SizeOf(FreqList^),0);
FreqMerk := '';
FreqPos := 0;
FreqCount := 0;
for i := 1 to maxMH do
begin
if (FreqMerk <> MHeard^[i].QRG) and
(MHeard^[i].QRG > '') and
(FreqCount < maxQRG) then
begin
inc(FreqCount);
FreqList^[FreqCount].QRG := MHeard^[i].QRG;
FreqMerk := MHeard^[i].QRG;
if Freq = MHeard^[i].QRG then FreqPos := FreqCount;
end;
end;
End;
Procedure MH_Init(Art,TNr : Byte; Freq : Str8);
Var i : Byte;
Flag : Boolean;
Begin
FillChar(MHeard^,maxMH * SizeOf(MH_Typ),0);
move(MH^,MHeard^,maxMH * SizeOf(MH_Typ));
MH_Anz := 0;
for i := 1 to maxMH do
begin
Flag := false;
if (MHeard^[i].Call > '') then
begin
case Art of
0 : if (TNr = MHeard^[i].TNr) then
if ((Freq > '') and (Freq = MHeard^[i].QRG)) or
(MHeard^[i].QRG = '') then Flag := true;
1 : Flag := true;
2 : if (TNr = MHeard^[i].TNr) then flag := true;
end;
if Flag then inc(MH_Anz)
else FillChar(MHeard^[i],SizeOf(MHeard^[i]),0);
end;
end;
End;
Procedure MH_Show;
Const Bofs = 3;
Var TNr,i,i1,i2,
Bpos : Byte;
Dpos : Integer;
w : Word;
yM,
Zmax : Byte;
Flag,
CurMH,
Fertig : Boolean;
Hstr : String[60];
Save_Name : String[60];
KC : Sondertaste;
VC : Char;
Such : String[9];
SArt : Byte;
MH_Save : Text;
Result : Word;
Procedure InitVar;
Begin
yM := 1;
Bpos := 1;
Dpos := 1;
MH_Sort(SArt);
End;
Procedure MhPage(beg : Word);
Var i,i1 : Byte;
Begin
Teil_Bild_Loesch(4,maxZ-1,Attrib[2]);
i1 := Zmax;
if i1 > MH_Anz then i1 := MH_Anz;
for i := 1 to i1 do
WriteRam(1,i+Bofs,Attrib[2],0,EFillStr(80,B1,GetMhStr(0,beg-1+i)));
WriteRam(30,1,Attrib[15],0,B1+ InfoZeile(328));
End;
Begin
NowFenster := false;
Moni_Off(0);
GetMem(MHeard,maxMH * SizeOf(MH_Typ));
GetMem(FreqList,SizeOf(FreqList^));
if (show = 0) then TNr := Unproto
else TNr := K[show]^.TncNummer;
if tnr=0 then tnr:=K[1]^.TNCNummer;
MH_QRG_Init(TNC[TNr]^.QRG_Akt);
MH_Init(0,TNr,TNC[TNr]^.QRG_Akt);
SArt := 1;
MH_Sort(SArt);
InitVar;
Such := '';
Zmax := maxZ - (1 + Bofs);
Fertig := false;
CurMH := true;
WriteRam(1,1,Attrib[15],0,ConstStr(B1,80));
WriteRam(1,2,Attrib[2],0,EFillStr(80,B1,B1 + InfoZeile(227)));
WriteRam(1,3,Attrib[2],0,ConstStr('Ä',80));
WriteRam(1,maxZ,Attrib[15],0,EFillStr(80,B1,InfoZeile(228)));
MhPage(Dpos);
WriteAttr(1,Bpos+Bofs,80,Attrib[4],0);
Repeat
if CurMH then InitCursor(1,Bpos+Bofs)
else InitCursor(1,1);
WriteRam(60,1,Attrib[15],0,'Nr:' + SFillStr(3,B1,int_str(Dpos)));
WriteRam(2,1,Attrib[15],0,TncI + int_str(MHeard^[Dpos].TNr) + DP +
EFillStr(10,B1,MHeard^[Dpos].QRG));
WriteRam(71,1,Attrib[15],0,EFillStr(10,B1,Such));
_ReadKey(KC,VC);
if KC <> _Andere then Such := '';
case KC of
_Esc, _Del
: Fertig := true;
_Dn
: if Dpos < MH_Anz then
begin
inc(Dpos);
if Bpos < Zmax then inc(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
Scroll(Up,0,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetMhStr(0,Dpos));
end;
end else Alarm;
_Up
: if Dpos > 1 then
begin
dec(Dpos);
if Bpos > 1 then dec(Bpos) else
begin
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
Scroll(Dn,0,1+Bofs,Zmax+Bofs);
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetMhStr(0,Dpos));
end;
end else Alarm;
_PgDn
: if Dpos < MH_Anz then
begin
if Dpos + Zmax - Bpos >= MH_Anz then
begin
Dpos := MH_Anz;
Bpos := Zmax;
if Bpos > MH_Anz then Bpos := MH_Anz;
end else
begin
Dpos := Dpos + Zmax - 1;
if Dpos + Zmax - 1 > MH_Anz then Dpos := MH_Anz - Zmax + Bpos;
MhPage(Dpos - Bpos + 1);
end;
end else Alarm;
_PgUp
: if Dpos > 1 then
begin
if Dpos <= Bpos then
begin
Dpos := 1;
Bpos := 1;
end else
begin
Dpos := Dpos - Zmax + 1;
if Dpos - Zmax + 1 < 1 then Dpos := Bpos;
MhPage(Dpos - Bpos + 1);
end;
end else Alarm;
_CtrlPgUp
: if Dpos > 1 then
begin
Dpos := 1;
Bpos := 1;
MhPage(1);
end else Alarm;
_CtrlPgDn
: if Dpos < MH_Anz then
begin
Dpos := MH_Anz;
Bpos := Zmax;
if Bpos > MH_Anz then Bpos := MH_Anz;
MhPage(Dpos - Bpos + 1);
end else Alarm;
_CtrlHome
: begin
Dpos := Dpos - Bpos + 1;
Bpos := 1;
end;
_CtrlEnd
: if MH_Anz < Zmax then
begin
Dpos := MH_Anz;
Bpos := MH_Anz;
end else
begin
Dpos := Dpos + Zmax - Bpos;
Bpos := Zmax;
end;
_Right
: if FreqPos > 0 then
begin
i := 0;
i1 := FreqPos;
Repeat
If FreqPos < FreqCount then inc(FreqPos)
else FreqPos := 1;
MH_Init(0,TNr,FreqList^[FreqPos].QRG);
inc(i);
Until (MH_Anz > 0) or (i > FreqCount);
if (i1 = FreqPos) or (MH_Anz = 0) then Alarm;
InitVar;
MhPage(Dpos);
end else Alarm;
_Left
: if FreqPos > 0 then
begin
i := 0;
i1 := FreqPos;
Repeat
If FreqPos > 1 then dec(FreqPos)
else FreqPos := FreqCount;
MH_Init(0,TNr,FreqList^[FreqPos].QRG);
inc(i);
Until (MH_Anz > 0) or (i > FreqCount);
if (i1 = FreqPos) or (MH_Anz = 0) then Alarm;
InitVar;
MhPage(Dpos);
end else Alarm;
_CtrlRight
: if MultiTNC then
begin
If TNr < Tnc_Anzahl then inc(TNr)
else TNr := 1;
MH_Init(2,TNr,'');
InitVar;
MhPage(Dpos);
end else Alarm;
_CtrlLeft
: if MultiTNC then
begin
If TNr > 1 then dec(TNr)
else TNr := Tnc_Anzahl;
MH_Init(2,TNr,'');
InitVar;
MhPage(Dpos);
end else Alarm;
_ShDel
: begin
for i := 1 to MH_Anz do
begin
i1 := 0;
Repeat
inc(i1);
if (MH^[i1].Call = MHeard^[i].Call) and
(MH^[i1].TNr = MHeard^[i].TNr) and
(MH^[i1].QRG = MHeard^[i].QRG) then
begin
move(MH^[i1+1],MH^[i1],(maxMH-i1) * SizeOf(MH_Typ));
FillChar(MH^[maxMH],SizeOf(MH_Typ),0);
dec(MH_Anz);
end;
Until (i1 >= maxMH);
end;
Fertig := true;
end;
_ShTab
: CurMH := not CurMH;
_AltA
: begin
MH_Init(1,TNr,'');
InitVar;
MhPage(Dpos);
end;
_AltH
: XP_Help(G^.OHelp[1]);
_AltS
: begin
WriteRam(1,Bofs+Bpos,Attrib[4],0,EFillStr(80,B1,B1 + InfoZeile(142)));
Save_Name := Konfig.SavVerz + 'MH.' + SFillStr(3,'0',int_str(TNr));
GetString(Save_Name,Attrib[4],60,9,Bofs+Bpos,KC,0,Ins);
if KC <> _Esc then
begin
Assign(MH_Save,Save_Name);
Result := AppendTxt(MH_Save);
if Result <> 0 then
begin
Result := RewriteTxt(MH_Save);
if Result = 0 then
begin
Writeln(MH_Save,B1,InfoZeile(227));
Writeln(MH_Save,ConstStr('-',70));
end;
end;
if Result = 0 then
begin
for w := Dpos to MH_Anz do
begin
Hstr := GetMhStr(0,w);
Writeln(MH_Save,Hstr);
end;
FiResult := CloseTxt(MH_Save);
end else
begin
WriteRam(1,Bofs+Bpos,Attrib[4],1,
EFillStr(80,B1,B1 + InfoZeile(75) + ': ' + Save_Name));
Alarm;
Verzoegern(ZWEI);
end;
end;
WriteRam(1,Bofs+Bpos,Attrib[4],0,GetMhStr(0,Dpos));
end;
_Alt0, _Alt1.._Alt5
: begin
case KC of
_Alt0 : SArt := 6;
_Alt1 : SArt := 1;
_Alt2 : SArt := 2;
_Alt3 : SArt := 3;
_Alt4 : SArt := 4;
_Alt5 : SArt := 5;
end;
MH_Sort(SArt);
MhPage(Dpos - Bpos + 1);
end;
_Ret
: begin
Chr_Darstell(show,_Dn,#255);
Hstr := MHeard^[Dpos].Call;
KillEndBlanks(Hstr);
Hstr := CvCh + 'C ' + Hstr + B1 + MHeard^[Dpos].Link;
KillEndBlanks(Hstr);
VorWrite[show]^[K[show]^.stC] := Hstr;
Chr_Darstell(show,_Up,#255);
SK_out := _Esc;
ch_aus := true;
fertig := true;
end;
_Andere
: begin
Such := Such + UpCase(VC);
w := 0;
Flag := false;
While (w < MH_Anz) and not Flag do
begin
inc(w);
if pos(Such,MHeard^[w].Call) = 1 then
begin
Flag := true;
Dpos := w;
if (Dpos < Bpos) or (MH_Anz <= Zmax) then Bpos := Dpos;
if ((MH_Anz - Dpos + Bpos) < Zmax) and
(MH_Anz > Zmax) and (Dpos > Bpos)
then Bpos := Zmax - (MH_Anz - Dpos);
end;
end;
if not Flag then
begin
Alarm;
Such := '';
end else MhPage(Dpos - Bpos + 1);
end;
else Alarm;
end;
WriteAttr(1,Bofs+yM,80,Attrib[2],0);
WriteAttr(1,Bofs+Bpos,80,Attrib[4],0);
yM := Bpos;
Until Fertig;
FreeMem(FreqList,SizeOf(FreqList^));
FreeMem(MHeard,maxMH * SizeOf(MH_Typ));
Neu_Bild;
Moni_On;
End;
Procedure RemoteMH (* Kanal,T : Byte; Zeile : Str9 *);
Var i,i1,
i2,i3,
TNr : Byte;
ch : Char;
tnst : String[4];
Hstr : String[80];
TExist,
flag,
all,
find,
long : Boolean;
Freq : String[8];
Begin
GetMem(MHeard,maxMH * SizeOf(MH_Typ));
GetMem(FreqList,SizeOf(FreqList^));
TNr := K[Kanal]^.TncNummer;
all := false;
long := false;
find := false;
TExist := true;
if str_int(Zeile[1])>0 then zeile:=' '+Zeile;
all:=true;
for i:=1 to 8 do
begin
TNSt:= ' '+int_Str(i) + ' ';
if pos(tnSt, Zeile)>0 then
begin
TNr:=i;
all:=false;
delete(Zeile, Pos(tnst,zeile),2);
end;
end;
if Zeile[1]=' ' then delete(zeile,1,1);
While pos('/',Zeile) > 0 do
begin
i := pos('/',Zeile);
if i > 0 then
begin
case Zeile[i+1] of
'L': long := true;
{'A': all := true;}
{ '1'..Chr(maxTNC+48)
: TNr := Byte(ord(Zeile[i+1])-48);}
end;
delete(Zeile,i,2);
end;
end;
if TNr in [1..TNC_Anzahl] then
begin
Freq := TNC[TNr]^.QRG_Akt;
MH_QRG_Init(Freq);
Zeile := CutStr(Zeile);
KillEndBlanks(Zeile);
if Zeile > '' then
begin
all := false;
find := true;
end;
S_PAC(Kanal,NU,false,M1);
if not (find or all) then
begin
MH_Init(0,TNr,Freq);
MH_Sort(1);
if long then Hstr := InfoZeile(183)
else Hstr := InfoZeile(92);
Hstr := M1 + B1 + EFillStr(28,B1,Hstr) +
ConstStr(B1,10) +
TncI + int_str(TNr) + DP + Freq;
S_PAC(Kanal,NU,false,Hstr);
S_PAC(Kanal,NU,false,+ M1 + ConstStr('-',70) + M1);
if MH_Anz > 0 then for i := 1 to MH_Anz do
begin
if long then Hstr := GetMhStr(1,i) + M1 else
begin
Hstr := GetMhStr(3,i);
if (i mod 7 = 1) then Hstr := B1 + Hstr;
if (i mod 7 = 0) or (i = MH_Anz) then
begin
KillEndBlanks(Hstr);
Hstr := Hstr + M1;
end;
end;
S_PAC(Kanal,NU,false,Hstr);
end else S_PAC(Kanal,NU,false,B1+ InfoZeile(182) + M1);
S_PAC(Kanal,NU,false,M1);
end else
begin
MH_Init(1,TNr,'');
MH_Sort(6);
S_PAC(Kanal,NU,false,EFillStr(12,B1,B1+InfoZeile(93)) +
InfoZeile(183) + ConstStr(B1,10) + M1);
S_PAC(Kanal,NU,false,ConstStr('-',77) + M1);
i1 := 0;
for i := 1 to MH_Anz do
begin
if (pos(Zeile,MHeard^[i].Call) = 1) or all then
begin
S_PAC(Kanal,NU,false,GetMhStr(2,i) + M1);
inc(i1);
end;
end;
if i1 = 0 then S_PAC(Kanal,NU,false,B1+InfoZeile(182) + M1);
end;
end else S_PAC(Kanal,NU,false,Star + InfoZeile(124) + M1);
FreeMem(FreqList,SizeOf(FreqList^));
FreeMem(MHeard,maxMH * SizeOf(MH_Typ));
End;

362
XPMON.PAS Executable file
View file

@ -0,0 +1,362 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P M O N . P A S ³
³ ³
³ Routinen f<>r das Monitoren auf einem QSO-Kanal ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Stat_MonitorCalls (* Kanal : Byte *);
Var Ch : Char;
Begin
with K[Kanal]^ do
begin
with Mo do
begin
if MonActive then
begin
if MonBeide then Ch := #29 else Ch := #26;
StatusOut(Kanal,2,2,Attrib[25],EFillStr(19,B1,CutStr(MonStr[1]) +
Ch + RestStr(RestStr(MonStr[1]))),1);
end else StatusOut(Kanal,14,1,Attrib[9],ConstStr(B1,19),1);
end;
StatusOut(Kanal,4,1,Attrib[9],EFillStr(9,B1,OwnCall),1);
Status2;
end;
End;
Procedure Calls_Monitoren (* Kanal : Byte; Zeile : Str80 *);
Const ArtMax = 11;
Var i,i1,
X,Y,
Art,
aktiv : Byte;
Flag,
ZFlag,
DisAbr,
Beide,
HCall,
EHCall,
Strict,
Signal,
IFr,UFr : Boolean;
Hstr : String[19];
KC : Sondertaste;
VC : Char;
Procedure InitKanal(Kanal : Byte);
Begin
with K[Kanal]^.Mo do
begin
DisAbr := MonDisAbr;
Beide := MonBeide;
Strict := MonStrict;
HCall := MonHCall;
EHCall := MonEHCall;
Signal := MonSignal;
IFr := MonIFr;
UFr := MonUFr;
end;
End;
Procedure Ins_Auswert(Istr : Str20);
Var Flag : Boolean;
Begin
Flag := pos(B1,Zeile) = 0;
DisAbr := not Flag;
Beide := true;
HCall := true;
EHCall := true;
Strict := not Flag;
Signal := true;
IFr := true;
UFr := false;
End;
Begin
with K[Kanal]^ do
begin
InitKanal(Kanal);
KillEndBlanks(Zeile);
ZFlag := Zeile > '';
if not Mo.MonActive then
begin
if (Zeile > '') then Ins_Auswert(Zeile);
end else
begin
Zeile := CutStr(Mo.MonStr[1]) + B1 + CutStr(Mo.MonStr[2]);
KillEndBlanks(Zeile);
end;
for i := 9 to 15 do G^.Fstx[i] := 2;
G^.Fstr[7] := InfoZeile(304);
G^.Fstr[9] := InfoZeile(305);
G^.Fstr[10] := InfoZeile(306);
G^.Fstr[11] := InfoZeile(307);
G^.Fstr[12] := InfoZeile(308) + B1 + Zeile;
G^.Fstr[13] := InfoZeile(309);
G^.Fstr[14] := InfoZeile(310);
G^.Fstr[15] := InfoZeile(311);
Flag := false;
if ZFlag and not Mo.MonActive then Art := 8 else
if not ZFlag and Mo.MonActive then Art := 10 else
if not ZFlag then Art := 11
else Art := 1;
Repeat
for i := 9 to 15 do
begin
G^.Fstr[i][vM+1] := B1;
G^.Fstr[i][hM+1] := B1;
G^.Fstr[i][vM] := B1;
G^.Fstr[i][hM] := B1;
end;
if Art in [1..7] then
begin
X := vM;
Y := Art + 8;
end else
begin
X := hM;
Y := Art + 1;
end;
G^.Fstr[Y][X] := A_ch;
if HardCur then SetzeCursor(X+1,Y);
if DisAbr then G^.Fstr[9][vM+1] := X_ch;
if Beide then G^.Fstr[10][vM+1] := X_ch;
if HCall then G^.Fstr[11][vM+1] := X_ch;
if EHCall then G^.Fstr[12][vM+1] := X_ch;
if Strict then G^.Fstr[13][vM+1] := X_ch;
if IFr then G^.Fstr[14][vM+1] := X_ch;
if Signal then G^.Fstr[15][vM+1] := X_ch;
if Zeile > '' then G^.Fstr[12][hM+1] := X_ch;
aktiv := 0;
if Zeile > '' then
begin
for i := 1 to maxLink do with K[i]^.Mo do
begin
if MonActive and (i <> Kanal) and
((Zeile = (CutStr(MonStr[1]) + B1 + CutStr(MonStr[2]))) or
(Zeile = (CutStr(MonStr[2]) + B1 + CutStr(MonStr[1])))) then
aktiv := i;
end;
end;
if aktiv > 0 then
begin
delete(G^.Fstr[13],hM,2);
insert(SFillStr(2,B1,int_str(aktiv)),G^.Fstr[13],hM);
end;
Fenster(15);
_ReadKey(KC,VC);
Case KC of
_Esc : Flag := true;
_Ret :;
_F1 : Art := 1;
_F2 : Art := 2;
_F3 : Art := 3;
_F4 : Art := 4;
_F5 : Art := 5;
_F6 : Art := 6;
_F7 : Art := 7;
_Back: Art := 8;
_End : Art := 9;
_Del : Art := 10;
_Ins : Art := 11;
_AltH : XP_Help(G^.OHelp[10]);
_Up : if Art > 1 then dec(Art)
else Alarm;
_Dn : if Art < ArtMax then inc(Art)
else Alarm;
_Right : if Art < ArtMax then
begin
Art := Art + 7;
if Art > ArtMax then Art := ArtMax;
end else Alarm;
_Left : if Art > 1 then
begin
if Art <= 7 then Art := 1
else Art := Art - 7;
end else Alarm;
_Andere : case VC of
B1:;
else Alarm;
end;
else Alarm;
End;
if (KC in [_F1.._F7,_Ret,_End,_Back,_Del,_Ins]) or
((KC = _Andere) and (VC = B1)) then
case Art of
1 : DisAbr := not DisAbr;
2 : Beide := not Beide;
3 : HCall := not HCall;
4 : begin
EHCall := not EHCall;
if EHCall then HCall := true;
end;
5 : Strict := not Strict;
6 : begin
IFr := not IFr;
UFr := not IFr;
if UFr then
begin
DisAbr := false;
Strict := false;
end;
end;
7 : Signal := not Signal;
8 : begin
if Zeile > '' then with Mo do
begin
Init_Call_Monitoren(Kanal,Zeile);
MonDisAbr := DisAbr;
MonBeide := Beide;
MonHCall := HCall;
MonEHCall := EHCall;
MonStrict := Strict;
MonSignal := Signal;
MonIFr := IFr;
MonUFr := UFr;
Flag := true;
end else Alarm;
end;
9 : begin
if Mo.MonActive then for i := 1 to 2 do with Mo do
begin
MonFrameNr[i] := 0;
MonFirst[i] := true;
MonLast := '';
for i1 := 0 to 7 do MonCtrl[i][i1] := 0;
end else Alarm;
end;
10: begin
Cancel_Call_Monitoren(Kanal);
Flag := true;
end;
11: begin
Hstr := Zeile;
GetString(Hstr,Attrib[3],19,length(InfoZeile(308))+3,12,KC,0,Ins);
if KC <> _Esc then
begin
Zeile := UpcaseStr(Hstr);
KillEndBlanks(Zeile);
G^.Fstr[12] := InfoZeile(308) + B1 + Zeile;
if not ZFlag and not Mo.MonActive then Ins_Auswert(Zeile);
end;
end;
end;
Until Flag;
Stat_MonitorCalls(Kanal);
end;
ClrFenster;
Neu_Bild;
End;
Procedure Init_Call_monitoren (* Kanal : Byte; Zeile : Str80 *);
Var i,i1 : Byte;
Begin
with K[Kanal]^ do
begin
with Mo do
begin
KillEndBlanks(Zeile);
MonStr[1] := CutStr(Zeile) + zu + RestStr(Zeile);
KillEndBlanks(MonStr[1]);
MonStr[2] := RestStr(Zeile) + zu + CutStr(Zeile);
KillEndBlanks(MonStr[2]);
for i := 1 to 2 do
begin
MonFrameNr[i] := 0;
MonFirst[i] := true;
for i1 := 0 to 7 do MonCtrl[i][i1] := 0;
end;
MonLast := '';
MonActive := true;
end;
Mon_Anz := 0;
for i := 1 to maxLink do if K[i]^.Mo.MonActive then inc(Mon_Anz);
S_PAC(Kanal,CM,true,'I ' + PhantasieCall);
Kanal_benutz := true;
Stat_MonitorCalls(Kanal);
end;
End;
Procedure Cancel_Call_monitoren (* Kanal : Byte *);
Var i,i1 : Byte;
Begin
with K[Kanal]^ do
begin
with Mo do
begin
MonActive := false;
MonDisAbr := false;
MonBeide := false;
MonHCall := false;
MonEHCall := false;
MonStrict := false;
MonSignal := false;
for i := 1 to 2 do
begin
MonNow[i] := false;
MonStr[i] := '';
MonFrameNr[i] := 0;
MonFirst[i] := false;
for i1 := 0 to 7 do MonCtrl[i][i1] := 0;
end;
MonLast := '';
end;
if Mon_Anz > 0 then dec(Mon_Anz);
S_PAC(Kanal,CM,true,'I '+ OwnCall);
Kanal_benutz := false;
TxComp := false;
RxComp := false;
SetzeFlags(Kanal);
StatusOut(Kanal,2,2,Attrib[14],EFillStr(19,B1,' '),1);
Stat_MonitorCalls(Kanal);
end;
End;
Procedure FreeMonitorKanal (* Var KA : Byte; Zeile : Str80 *);
Var Flag : Boolean;
i : Byte;
Begin
Flag := false;
i := 1;
While (i <= maxLink) and not Flag do with K[i]^.Mo do
begin
if MonActive and (MonStr[1] = Zeile) then Flag := true
else inc(i);
end;
if Flag then KA := i else KA := KanalFrei(0);
End;

985
XPMRK.PAS Executable file
View file

@ -0,0 +1,985 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P M R K . P A S ³
³ ³
³ Routinen zum Lesen und Schreiben des Merkerfiles MERKER.TOP ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Merker_Conn_Schreiben;
var i,i1 : Byte;
obf: Byte;
CDat: File Of MemoCTyp;
ConDat : ^MemoCTyp;
Begin
ConDat:=NIL;
GetMem(ConDat, SizeOf(MemoCTyp));
Assign(CDat,Sys1Pfad + ConDatei);
{$I-}
Rewrite(CDat);
obf:=ioresult;
{$I+}
if obf=0 then
begin
i:=1;
while (i<=MaxLink) do
begin
if not K[i]^.connected then K[i]^.Call:='';
ConDat^.Call:=K[i]^.Call;
ConDat^.QSO_Date:=K[i]^.qso_date;
ConDat^.Qso_begin:=k[i]^.QSO_Begin;
condat^.ConText:=k[i]^.context;
condat^.eingangskanal:=K[i]^.Einstiegskanal;
condat^.ausgangskanal:=K[i]^.Ausstiegskanal;
condat^.Gegenkanal:=K[i]^.Gegenkanal;
ConDat^.HoldLauf:=K[i]^.HoldLauf;
ConDat^.Hold:=K[i]^.Hold;
ConDat^.HoldTime:=K[i]^.HoldTime;
ConDat^.Holdstr:=K[i]^.Holdstr;
condat^.userart:=k[i]^.UserArt;
condat^.Sysart:=k[i]^.SysArt;
condat^.SystemErkannt :=K[i]^.SystemErkannt;
conDat^.OnAct:=K[i]^.OnAct;
ConDat^.RemAll :=K[i]^.RemAll;
ConDat^.SelfSysop:=K[i]^.SelfSysop;
condat^.cv1:=1; condat^.cv2:=81;
write(cdat, condat^);
inc(i);
end;
{$I-}
Close(CDat);
obf:=ioresult;
{$I+}
end;
FreeMem(ConDat, SizeOf(MemoCTyp));
End;
Procedure Merker_Conn_Lesen;
Var obf,i : Byte;
cdat:file of MemoCTyp;
ConDat : ^MemoCTyp;
Begin
ConDat:=NIL;
GetMem(ConDat, SizeOf(MemoCTyp));
Assign(CDat,Sys1Pfad + ConDatei);
{$I-}
Reset(Cdat);
obf:=ioresult;
if OBF = 0 then
begin
i:=0;
while (i<MaxLink) and (not EOF(CDat)) do
begin
inc(i);
read(CDat, ConDat^);
if ConDat^.Call > '' then
begin
K[i]^.Einstiegskanal:=condat^.eingangskanal;
K[i]^.Ausstiegskanal:=condat^.ausgangskanal;
K[i]^.Gegenkanal:=condat^.Gegenkanal;
K[i]^.Call := condat^.call;
K[i]^.QSO_Date := ConDat^.Qso_Date;
k[i]^.QSO_Begin := condat^.qso_begin;
K[i]^.ConText := ConDat^.ConText;
K[i]^.HoldLauf:= ConDat^.HoldLauf;
K[i]^.Hold:= ConDat^.Hold;
K[i]^.HoldTime:= ConDat^.HoldTime;
K[i]^.Holdstr:= ConDat^.Holdstr;
K[i]^.SysArt := condat^.sysart;
K[i]^.UserArt := condat^.userart;
K[i]^.SystemErkannt:=condat^.SystemErkannt;
K[i]^.First_Frame:=false;
K[i]^.RemAll:=ConDat^.RemAll ;
K[i]^.SelfSysop:=ConDat^.SelfSysop;
K[i]^.OnAct := condat^.OnAct;
if K[i]^.Onact <> '' then _OnAct:=true;
if K[i]^.SysArt in [0..maxSCon] then K[i]^.SCon[K[i]^.SysArt] := true
else K[i]^.SysArt := 0;
if (K[i]^.SysArt = 11) and HoldDXc then
begin
DZeile := HoldDXcStr;
Link_erhalter(i,DZeile);
SetzeFlags(i);
end;
if K[i]^.Sysart in [1,2,3,4,5,11,12,14] then K[i]^.SCon[0]:=false else K[i]^.scon[0]:=true;
{if not(K[i]^.UserArt in [1..maxUser]) then K[i]^.UserArt := 1;}
K[i]^.connected := true;
K[i]^.TermTimeOut:=Konfig.TTimeout * 60;
K[i]^.NodeTimeOut:=NTimeout * 60;
end;
end;
close(Cdat);
obf:=ioresult;
end;
{$I+}
FreeMem(ConDat, SizeOf(MemoCTyp));
End;
{
Procedure Merker_File_Schreiben;
Var i,i1 : Integer;
Kanal : Byte;
Hstr : String[80];
Begin
Assign(G^.TFile,Sys1Pfad + MerkDatei + Ext);
if RewriteTxt(G^.TFile) = 0 then
Begin
Writeln(G^.TFile,LZ);
for i := 1 to maxTNC do if TNC_used[i] then with TNC[i]^ do
begin
if BText = '' then BText := 'CQ';
Writeln(G^.TFile,Rrtn,i,':BT=',BText);
if BPfad = '' then BPfad := 'ALL';
Writeln(G^.TFile,Rrtn,i,':BP=',BPfad);
if Bake then Write(G^.TFile,Rrtn,i,Rpar,GL,'1,')
else Write(G^.TFile,Rrtn,i,Rpar,GL,'0,');
Write(G^.TFile,BTimer,Km);
Write(G^.TFile,CText,Km);
Write(G^.TFile,Info,Km);
Write(G^.TFile,Aktuell,Km);
Write(G^.TFile,QText,Km);
Write(G^.TFile,Fix,Km);
Writeln(G^.TFile,QRG_Akt);
end else
begin
Writeln(G^.TFile,Rrtn,i,':BT=','CQ');
Writeln(G^.TFile,Rrtn,i,':BP=','ALL');
Writeln(G^.TFile,Rrtn,i,Rpar,GL,'0,20,1,1,1,1,1');
end;
Writeln(G^.TFile,LZ);
for Kanal := 0 to maxLink do
Begin
Writeln(G^.TFile,LZ);
with K[Kanal]^ do
begin
if Kanal > 0 then
begin
if OwnCall = '*' then OwnCall := TNC[TncNummer]^.HostCall;
Writeln(G^.TFile,Rrch,Kanal,':CALL=',OwnCall);
if AutoZyConst > 0 then
Writeln(G^.TFile,Rrch,Kanal,':AUTO=',AutoZyConst);
end;
Writeln(G^.TFile,Rrch,Kanal,
Rpar + GL,MaxFrame,Km,PacLen,Km,ObStat,Km,UnStat,Km,UmlautMerk);
if RX_Save then
begin
CloseRxFile(Kanal,1);
Writeln(G^.TFile,Rrch,Kanal,':RXS=',FRxName);
RX_Save := false;
RX_Bin := 0;
end;
if Save then
begin
FiResult := CloseBin(SFile);
Writeln(G^.TFile,Rrch,Kanal,':SAV=',FName_aus_FVar(SFile));
Save := false;
end;
if SPlus and SplSave then
begin
Writeln(G^.TFile,Rrch,Kanal,':7PL=',FName_aus_FVar(SplFile),' ',
Spl_gLaenge,' ',Spl_gCount,' ',Spl_tLaenge,' ',Spl_tCount);
FiResult := CloseBin(SplFile);
SplSave := false;
end;
Write(G^.TFile,Rrch,Kanal,':FLAG=');
if Umlaut > 0 then Write(G^.TFile,'U',Umlaut);
if Echo > 0 then Write(G^.TFile,'E',Echo);
if not Gross then Write(G^.TFile,'Y');
if Kanal > 0 then
begin
if Auto then Write(G^.TFile,'F');
if TopBox then Write(G^.TFile,'M');
if Rx_Beep then Write(G^.TFile,'ì');
if morsen then Write(G^.TFile,'C');
if TxBeepAck then Write(G^.TFile,'Q');
(* if Speek then Write(G^.TFile,'P'); *)
if AutoBin then Write(G^.TFile,'$');
if SPlus then Write(G^.TFile,'+');
if TxComp then Write(G^.TFile,'ø');
if RxComp then Write(G^.TFile,'÷');
if NoCurJump then Write(G^.TFile,'ö');
if Node then Write(G^.TFile,'N');
AutoBinOn := AutoBin;
end else
begin
if Klingel then Write(G^.TFile,'K');
if CtrlBeep then Write(G^.TFile,'G');
if Time_stamp then Write(G^.TFile,'T');
if PacOut then Write(G^.TFile,'L');
if ZeigeRET then Write(G^.TFile,'R');
if ConMorsen then Write(G^.TFile,'O');
if ReconMorsen then Write(G^.TFile,'D');
(* if ConVoice then Write(G^.TFile,'A');
if ReconVoice then Write(G^.TFile,'J'); *)
if GlobalTrenn then Write(G^.TFile,'H');
if BinOut then Write(G^.TFile,'i');
if Ins then Write(G^.TFile,'Z');
if NoBinMon then Write(G^.TFile,'!');
if RX_TX_Win then Write(G^.TFile,'&');
end;
Writeln(G^.TFile);
end;
end;
Writeln(G^.TFile,LZ);
Writeln(G^.TFile,LZ);
Hstr := '';
for i := 1 to 10 do Hstr := Hstr + int_str(G^.SETL[i]) + Km;
Hstr := Hstr + int_str(SETNr);
Writeln(G^.TFile,Rrgl,Rsetl,GL,Hstr);
if Idle_Pos then i := 1
else i := 0;
Hstr := int_str(i) + Km + int_str(Idle_Anz) + Km + int_str(Idle_Tout);
Writeln(G^.TFile,Rrgl,Ridle,GL,Hstr);
Writeln(G^.TFile,Rrgl,Rmfreq,GL,G^.TonHoehe);
if _VGA then i := 1
else i := 0;
Writeln(G^.TFile,Rrgl,Rega,GL,int_str(i));
Writeln(G^.TFile,Rrgl,Rplen,GL,MPause);
Writeln(G^.TFile,Rrgl,Rsynch,GL,Resync_Z);
Writeln(G^.TFile,Rrgl,Rcnr,GL,CNr);
(* Writeln(G^.TFile,Rrgl,Rvsp,GL,VSpeed); *)
Writeln(G^.TFile,Rrgl,Rinfo,GL,G^.InfoStr);
FiResult := CloseTxt(G^.TFile);
end;
End;
}
Procedure Merker_File_Schreiben;
Var i,i1 : Integer;
OBF,
Kanal : Byte;
Hstr : String[80];
Memo : ^MemoTyp;
MDat : file of MemoTyp;
Begin
{ GetMem(Memo,SizeOf(Memotyp));}
Memo:=NIL;
New(Memo);
FillChar(Memo^, SizeOf(Memotyp), 0);
Assign(MDat,Sys1Pfad + MerkDatei + Ext);
{$I-}
Rewrite(MDat);
OBF:=IOResult;
{$I+}
memo^.v1:=MerkV1; memo^.v2:=MerkV2; {//db1ras}
if OBF = 0 then
Begin
for i := 1 to MaxTNC do with Memo^.TNC[i] do
begin
if TNC_Used[i] then
begin
if TNC[i]^.BText = '' then TNC[i]^.BText := 'CQ';
if TNC[i]^.BPfad = '' then TNC[i]^.BPfad := 'ALL';
Bake := TNC[i]^.Bake;
BPfad := TNC[i]^.BPfad;
BText := TNC[i]^.BTEXT;
BTimer := TNC[i]^.btimer;
BCall := TNC[i]^.bcall;
CText := TNC[i]^.ctext;
Info := TNC[i]^.info;
Aktuell := TNC[i]^.aktuell;
QText := TNC[i]^.qtext;
Fix := TNC[i]^.fix;
QRG_Akt := TNC[i]^.qrg_akt;
if ctext<1 then ctext:=1;
if info<1 then info:=1;
if aktuell<1 then aktuell:=1;
if qtext<1 then qtext:=1;
if fix<1 then fix:=1;
end;
end;
for Kanal := 0 to maxLink do
Begin
with K[Kanal]^ do
begin
if Kanal > 0 then
begin
if OwnCall = '*' then OwnCall := TNC[TncNummer]^.HostCall;
IF Kanal> Maxlink then Owncall:='';
Memo^.Kanal[Kanal].OwnCall := Owncall;
Memo^.Kanal[Kanal].AutoZyConst := AutoZyConst;
end;
Memo^.Kanal[Kanal].MaxFrame := MaxFrame;
Memo^.Kanal[Kanal].PacLen := PacLen;
Memo^.Kanal[Kanal].ObStat := ObStat;
Memo^.Kanal[Kanal].UnStat := UnStat;
Memo^.Kanal[Kanal].UmlautMerk:= UmlautMerk;
{ if (connected) or Mo.MonActive then } {//db1ras}
Memo^.Kanal[kanal].ignore := ignore;
Memo^.Kanal[Kanal].FRxName:='';
if RX_Save then
begin
if not BackUpLauf then
begin
CloseRxFile(Kanal,1);
RX_Save := false;
RX_Bin := 0;
end;
Memo^.Kanal[Kanal].FRxName:=FRXName;
end;
Memo^.Kanal[Kanal].SaveFName:='';
if Save then
begin
if not BackUpLauf then
begin
FiResult := CloseBin(SFile);
Save := false;
end;
Memo^.Kanal[Kanal].SaveFName:=FName_aus_FVar(SFile);
end;
Memo^.Kanal[Kanal].SPLFName :='';
if SPlus and SplSave then
begin
Memo^.Kanal[Kanal].SPLFName := FName_aus_FVar(SplFile);
Memo^.Kanal[Kanal].Spl_gLaenge := Spl_glaenge;
Memo^.Kanal[Kanal].Spl_gCount := spl_gcount;
Memo^.Kanal[Kanal].Spl_tLaenge := spl_tlaenge;
Memo^.Kanal[Kanal].Spl_tCount := spl_Tcount;
if not BackUpLauf then
begin
FiResult := CloseBin(SplFile);
SplSave := false;
end;
end;
Memo^.Kanal[Kanal].Umlaut := Umlaut;
Memo^.Kanal[Kanal].Echo := Echo;
if SysTextEcho then Memo^.Kanal[kanal].Echo:=Memo^.Kanal[kanal].Echo+100;
Memo^.Global.Gross := Gross;
Memo^.Kanal[Kanal].Auto:=Auto;
Memo^.Global.TopBox := TopBox;
Memo^.Kanal[Kanal].Rx_Beep := RX_Beep;
Memo^.Global.morsen := morsen;
Memo^.Kanal[Kanal].TxBeepAck := TXBeepAck;
(* if Speek then Write(G^.TFile,'P'); *)
Memo^.Kanal[Kanal].AutoBin := AutoBin;
Memo^.Kanal[Kanal].SPlus := Splus;
Memo^.Kanal[Kanal].TxComp := TXComp;
Memo^.Kanal[Kanal].RxComp := RXComp;
Memo^.Kanal[Kanal].CompC := CompC;
Memo^.kanal[kanal].StopComp:=StopComp;
memo^.kanal[kanal].StopCode := StopCode;
memo^.kanal[kanal].SpComp := SpComp;
Memo^.Kanal[kanal].KompressUpd := KompressUpd;
Memo^.Kanal[Kanal].CompCUpdZahl := CompCUpdZahl;
for i := 1 to 255 do
Memo^.Kanal[Kanal].Kompression[i] := Kompression[i];
Memo^.Kanal[Kanal].NoCurJump := NoCurJump;
Memo^.Kanal[Kanal].Node := Node;
AutoBinOn := AutoBin;
{//db1ras}
Memo^.Kanal[Kanal].CSelf := CSelf ;
Memo^.Kanal[Kanal].AutoZeile := AutoZeile ;
Memo^.Kanal[Kanal].Auto1Zeile := Auto1Zeile ;
Memo^.Kanal[Kanal].AutoTime := AutoTime ;
Memo^.Kanal[Kanal].AutoZaehl := AutoZaehl ;
Memo^.Kanal[Kanal].AutoJump := AutoJump ;
Memo^.Kanal[Kanal].AutoZyConst := AutoZyConst ;
Memo^.Kanal[Kanal].AutoZyCount := AutoZyCount ;
Memo^.Kanal[Kanal].AutoWait := AutoWait ;
Memo^.Kanal[Kanal].AutoToConst := AutoToConst ;
Memo^.Kanal[Kanal].AutoToCount := AutoToCount ;
Memo^.Kanal[Kanal].AutoToAnz := AutoToAnz ;
Memo^.Kanal[Kanal].AutoToMax := AutoToMax ;
Memo^.Kanal[Kanal].AutoToAnzJmp := AutoToAnzJmp ;
Memo^.Kanal[Kanal].AutoChMerk := AutoChMerk ;
Memo^.Kanal[Kanal].AutoArt := AutoArt ;
Memo^.Kanal[Kanal].AutoCheckLn := AutoCheckLn ;
Memo^.Kanal[Kanal].AutoJmpPtr := AutoJmpPtr ;
For i:=1 To maxAutoJmpPtr Do
Memo^.Kanal[Kanal].AutoJmpRet[i]:= AutoJmpRet[i];
Memo^.Global.Klingel := Klingel;
Memo^.Global.CtrlBeep := CtrlBeep;
Memo^.Global.Time_stamp := Time_Stamp;
Memo^.Global.PacOut := PacOut;
Memo^.Global.ZeigeRET := ZeigeRet;
Memo^.Global.ConMorsen := ConMorsen;
Memo^.Global.ReconMorsen := ReconMorsen;
(* if ConVoice then Write(G^.TFile,'A');
if ReconVoice then Write(G^.TFile,'J'); *)
Memo^.Global.GlobalTrenn := GlobalTrenn;
Memo^.Global.BinOut := BinOut;
Memo^.Global.Ins := Ins;
Memo^.Global.NoBinMon := NoBinMon;
Memo^.Global.RX_TX_Win := RX_TX_Win;
end;
end;
Hstr := '';
for i := 1 to 10 do Memo^.Global.Setl[i]:=G^.SETL[i];
Memo^.Global.SetNr:=SETNr;
Memo^.global.Speak:=speek;
if vspeed<1 then vspeed:=40;
Memo^.global.SpeakSpeed:=Vspeed;
Memo^.Global.Idle_Pos := Idle_Pos;
Memo^.Global.Idle_Anz := Idle_anz;
Memo^.Global.Idle_Tout := Idle_Tout;
Memo^.Global.TonHoehe:=G^.TonHoehe;
Memo^.Global._VGA := _vga;
Memo^.Global.MPause:=MPause;
Memo^.Global.Resync_Z:=Resync_Z;
Memo^.Global.CNr:=CNr;
Memo^.Global.VIP:=VIPG;
Memo^.Global.SoZeichen:=SoZeichen;
Memo^.Global.StatusModus:=G^.StatusModus;
Memo^.Global.ZeilenwTX := G^.ZeilenwTX;
(* Writeln(G^.TFile,Rrgl,Rvsp,GL,VSpeed); *)
Memo^.Global.InfoStr:=G^.InfoStr;
write(mdat, Memo^);
{$I-}
Close(MDat);
obf:=ioresult;
{$I+}
end;
Dispose(Memo);
{FreeMem(Memo,SizeOf(Memotyp));}
End;
Procedure Merker_File_Lesen; {//db1ras}
{$IFDEF ReadOldMemo} {//db1ras}
Procedure Altes_Merker_File_Lesen;
Var Result : Word;
Hstr : String[10];
i,i1,
i2,C : Integer;
Memo : ^OldMemoTyp;
MDat : File of OldMemoTyp;
OBF : Byte;
{for i := 1 to maxTNC do if TNC_used[i] then with TNC[i]^ do}
Begin
Assign(Mdat,Sys1Pfad + MerkDatei + Ext);
{$I-}
Reset(MDat);
obf:=ioresult;
{$I+}
if obf = 0 then begin
Memo:=NIL;
New(Memo);
{ WriteTxt(XCP,SZ1,StartColor,MerkDatei + Ext);}
{*** 3}
gotoxy(1,20);
writeln(' Ú ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ ¿');
writeln(' À ßßßßßßßßßßßßßßßßßßßßßßßßßß Ù');
XCP := XCP + SZL;
read(MDat, Memo^);
for i := 1 to MaxTNC do if TNC_used[i] then
begin
with TNC[i]^ do
begin
Btext := Memo^.TNC[i].btext;
BPfad := Memo^.TNC[i].bpfad;
Bake := Memo^.TNC[i].Bake;
BTimer := Memo^.TNC[i].Btimer;
if BTimer = 0 then BTimer := 20;
BCall:=Memo^.TNC[i].BCall;
CText := Memo^.TNC[i].ctext;
Info := Memo^.TNC[i].info;
Aktuell := Memo^.TNC[i].aktuell;
QText := Memo^.TNC[i].qtext;
Fix := Memo^.TNC[i].fix;
QRG_Akt := Memo^.TNC[i].qrg_akt;
if QRG_Akt = '' then QRG_Akt := PseudoQRG;
end;
end;
c:=-1;
while (C < MaxLink) do
begin
inc(c);
K[c]^.OwnCall := '*';
K[c]^.Umlaut := Memo^.Kanal[c].Umlaut;
if c=0 then k[c]^.RxComp:= Memo^.Kanal[c].RXComp;
if Memo^.Kanal[c].OwnCall<>'' then
with K[C]^ do
begin
if C > 0 then
begin
OwnCall:=Memo^.Kanal[c].owncall;
AutoZyConst := Memo^.Kanal[c].AutoZyConst;
if AutoZyConst > 0 then CSelf := 2;
end;
MaxFrame := Memo^.Kanal[c].MaxFrame;
if not (MaxFrame in [1..7]) then MaxFrame := 1;
PacLen := Memo^.Kanal[c].PacLen;
if not (PacLen in [1..FF]) then PacLen := FF;
ObStat := Memo^.Kanal[c].OBStat;
UnStat := Memo^.Kanal[c].UnStat;
UmlautMerk := Memo^.Kanal[c].UmlautMerk;
if not (UmlautMerk in UmlMenge) then UmlautMerk := 0;
FRxName := Memo^.Kanal[c].FRxName;
if FRXName <>'' then
begin
if OpenTextFile(C) then
begin
RX_Count := 0;
RX_Laenge := 0;
RX_Bin := 0;
RX_Save := true;
FTxName := G^.Drive;
end;
end
else
begin
FRxName := Konfig.SavVerz + TxtName + SFillStr(3,'0',int_str(C));
FTxName := Konfig.SavVerz;
end;
SvName := Memo^.Kanal[c].SaveFName;
if SvName<>'' then
begin
Assign(SFile,SvName);
Result := ResetBin(SFile,T);
if Result = 0 then Seek(SFile,FileSize(SFile))
else Result := RewriteBin(SFile,T);
if Result = 0 then Save := true;
end else
begin
SvName := Konfig.SavVerz + SaveName + SFillStr(3,'0',int_str(C));
end;
if Memo^.Kanal[c].SplFName > '' then
begin
Assign(SplFile,Memo^.Kanal[c].SPlFName);
if ResetBin(SplFile,T) = 0 then
begin
Seek(SplFile,FileSize(SplFile));
SPlus := true;
SplSave := true;
Spl_gLaenge := Memo^.Kanal[c].SPl_glaenge;
Spl_gCount := Memo^.Kanal[c].spl_gcount;
Spl_tLaenge := Memo^.Kanal[c].spl_tlaenge;
Spl_tCount := Memo^.Kanal[c].Spl_TCount;
end;
end;
echo := Memo^.Kanal[c].Echo;
if echo>99 then
begin
Echo:=Echo-100;
SysTextEcho:=true;
end;
if C > 0 then
begin
Auto := Memo^.Kanal[c].Auto;
RX_Beep := Memo^.Kanal[c].RX_Beep;
TxBeepAck := Memo^.Kanal[C].TxBeepAck;
{ Speek := (pos('P',DZeile) > 0);}
AutoBin := Memo^.Kanal[c].AutoBin;
SPlus := Memo^.Kanal[c].SPlus;
if K[c]^.connected then {unsinnig, da immer true //db1ras}
begin
TxComp := Memo^.Kanal[c].TXComp;
RxComp := Memo^.Kanal[c].RXComp;
StopComp := Memo^.Kanal[c].StopComp;
StopCode := Memo^.Kanal[c].StopCode;
SPComp := Memo^.Kanal[c].SPComp;
CompC:=Memo^.Kanal[c].CompC;
KompressUpd:=Memo^.Kanal[c].KompressUpd;
CompCUpdZahl:=Memo^.Kanal[c].CompCUpdZahl;
for i := 1 to 255 do
Kompression[i]:=Memo^.Kanal[c].Kompression[i];
end;
NoCurJump := Memo^.Kanal[C].NoCurJump;
Node := Memo^.Kanal[c].Node;
{if (connected) or (Mo.MonActive) then }ignore := memo^.Kanal[c].ignore;
end;
end;
end;
for i := 1 to 10 do G^.SETL[i] := Memo^.Global.Setl[i];
SETNr := Memo^.Global.setnr;
if not (SETNr in [1..10]) then SETNr := 1;
Klingel := Memo^.Global.Klingel;
CtrlBeep := Memo^.Global.CtrlBeep;
Time_Stamp := Memo^.Global.Time_Stamp;
PacOut := Memo^.Global.PacOut;
ZeigeRET := Memo^.Global.ZeigeRet;
ConMorsen := Memo^.Global.ConMorsen;
ReconMorsen := Memo^.Global.ReconMorsen;
{ ConVoice := (pos('A',DZeile) > 0);
ReconVoice := (pos('J',DZeile) > 0);}
GlobalTrenn := Memo^.Global.GlobalTrenn;
BinOut := Memo^.Global.BinOut;
Ins := Memo^.Global.ins;
NoBinMon := Memo^.Global.NoBinMon;
RX_TX_Win := Memo^.Global.RX_TX_win;
morsen := Memo^.Global.morsen;
TopBox := Memo^.Global.TopBox;
Gross := Memo^.Global.Gross;
Idle_Pos := Memo^.Global.idle_pos;
Idle_Anz := Memo^.Global.idle_anz;
Idle_Tout := Memo^.Global.Idle_Tout;
G^.TonHoehe := Memo^.Global.TonHoehe;
VIPG := Memo^.Global.VIP;
SoZeichen := Memo^.Global.SoZeichen;
_VGA := Memo^.Global._vga;
MPause := Memo^.Global.MPause;
Resync_Z := Memo^.Global.Resync_Z;
CNr := Memo^.Global.Cnr;
VSpeed:=memo^.global.speakspeed;
speek:=memo^.global.speak;
{ MerkRead(Rrgl + Rvsp);
if DZeile > '' then VSpeed := Word(str_int(DZeile));}
G^.InfoStr := Memo^.Global.InfoStr;
G^.StatusModus := Memo^.Global.StatusModus;
G^.ZeilenwTX := Memo^.Global.ZeilenwTX;
{$I-}
Close(MDat);
obf:=Ioresult;
{$I+}
Dispose(Memo);
end else (* If IOResult ... *)
begin
for i := 0 to maxLink do with K[i]^ do
begin
FRxName := G^.Drive + Txt + int_str(i) + Ext;
FTxName := G^.Drive;
end;
end;
End;
{$ENDIF}
Procedure Neues_Merker_File_Lesen;
Var Result : Word;
Hstr : String[10];
i,i1,
i2,C : Integer;
Memo : ^MemoTyp;
MDat : File of MemoTyp;
OBF : Byte;
{for i := 1 to maxTNC do if TNC_used[i] then with TNC[i]^ do}
Begin
Assign(Mdat,Sys1Pfad + MerkDatei + Ext);
{$I-}
Reset(MDat);
obf:=ioresult;
{$I+}
if obf = 0 then
begin
Memo:=NIL;
New(Memo);
{ WriteTxt(XCP,SZ1,StartColor,MerkDatei + Ext);}
{*** 3}
gotoxy(1,20);
writeln(' Ú ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ ¿');
writeln(' À ßßßßßßßßßßßßßßßßßßßßßßßßßß Ù');
XCP := XCP + SZL;
read(MDat, Memo^);
for i := 1 to MaxTNC do if TNC_used[i] then
begin
with TNC[i]^ do
begin
Btext := Memo^.TNC[i].btext;
BPfad := Memo^.TNC[i].bpfad;
Bake := Memo^.TNC[i].Bake;
BTimer := Memo^.TNC[i].Btimer;
if BTimer = 0 then BTimer := 20;
BCall:=Memo^.TNC[i].BCall;
CText := Memo^.TNC[i].ctext;
Info := Memo^.TNC[i].info;
Aktuell := Memo^.TNC[i].aktuell;
QText := Memo^.TNC[i].qtext;
Fix := Memo^.TNC[i].fix;
QRG_Akt := Memo^.TNC[i].qrg_akt;
if QRG_Akt = '' then QRG_Akt := PseudoQRG;
end;
end;
c:=-1;
while (C < MaxLink) do
begin
inc(c);
K[c]^.OwnCall := '*';
K[c]^.Umlaut := Memo^.Kanal[c].Umlaut;
if c=0 then k[c]^.RxComp:= Memo^.Kanal[c].RXComp;
if Memo^.Kanal[c].OwnCall<>'' then
with K[C]^ do
begin
if C > 0 then
begin
OwnCall:=Memo^.Kanal[c].owncall;
AutoZyConst := Memo^.Kanal[c].AutoZyConst;
if AutoZyConst > 0 then CSelf := 2;
end;
MaxFrame := Memo^.Kanal[c].MaxFrame;
if not (MaxFrame in [1..7]) then MaxFrame := 1;
PacLen := Memo^.Kanal[c].PacLen;
if not (PacLen in [1..FF]) then PacLen := FF;
ObStat := Memo^.Kanal[c].OBStat;
UnStat := Memo^.Kanal[c].UnStat;
UmlautMerk := Memo^.Kanal[c].UmlautMerk;
if not (UmlautMerk in UmlMenge) then UmlautMerk := 0;
FRxName := Memo^.Kanal[c].FRxName;
if FRXName <>'' then
begin
if OpenTextFile(C) then
begin
RX_Count := 0;
RX_Laenge := 0;
RX_Bin := 0;
RX_Save := true;
FTxName := G^.Drive;
end;
end
else
begin
FRxName := Konfig.SavVerz + TxtName + SFillStr(3,'0',int_str(C));
FTxName := Konfig.SavVerz;
end;
SvName := Memo^.Kanal[c].SaveFName;
if SvName<>'' then
begin
Assign(SFile,SvName);
Result := ResetBin(SFile,T);
if Result = 0 then Seek(SFile,FileSize(SFile))
else Result := RewriteBin(SFile,T);
if Result = 0 then Save := true;
end else
begin
SvName := Konfig.SavVerz + SaveName + SFillStr(3,'0',int_str(C));
end;
if Memo^.Kanal[c].SplFName > '' then
begin
Assign(SplFile,Memo^.Kanal[c].SPlFName);
if ResetBin(SplFile,T) = 0 then
begin
Seek(SplFile,FileSize(SplFile));
SPlus := true;
SplSave := true;
Spl_gLaenge := Memo^.Kanal[c].SPl_glaenge;
Spl_gCount := Memo^.Kanal[c].spl_gcount;
Spl_tLaenge := Memo^.Kanal[c].spl_tlaenge;
Spl_tCount := Memo^.Kanal[c].Spl_TCount;
end;
end;
echo := Memo^.Kanal[c].Echo;
if echo>99 then
begin
Echo:=Echo-100;
SysTextEcho:=true;
end;
if C > 0 then
begin
Auto := Memo^.Kanal[c].Auto;
RX_Beep := Memo^.Kanal[c].RX_Beep;
TxBeepAck := Memo^.Kanal[C].TxBeepAck;
{ Speek := (pos('P',DZeile) > 0);}
AutoBin := Memo^.Kanal[c].AutoBin;
SPlus := Memo^.Kanal[c].SPlus;
if K[c]^.connected then {unsinnig, da immer true //db1ras}
begin
TxComp := Memo^.Kanal[c].TXComp;
RxComp := Memo^.Kanal[c].RXComp;
StopComp := Memo^.Kanal[c].StopComp;
StopCode := Memo^.Kanal[c].StopCode;
SPComp := Memo^.Kanal[c].SPComp;
CompC:=Memo^.Kanal[c].CompC;
KompressUpd:=Memo^.Kanal[c].KompressUpd;
CompCUpdZahl:=Memo^.Kanal[c].CompCUpdZahl;
for i := 1 to 255 do
Kompression[i]:=Memo^.Kanal[c].Kompression[i];
end;
NoCurJump := Memo^.Kanal[C].NoCurJump;
Node := Memo^.Kanal[c].Node;
{if (connected) or (Mo.MonActive) then }
ignore := memo^.Kanal[c].ignore;
end;
{//db1ras}
CSelf := Memo^.Kanal[c].CSelf ;
AutoZeile := Memo^.Kanal[c].AutoZeile ;
Auto1Zeile := Memo^.Kanal[c].Auto1Zeile ;
AutoTime := Memo^.Kanal[c].AutoTime ;
AutoZaehl := Memo^.Kanal[c].AutoZaehl ;
AutoJump := Memo^.Kanal[c].AutoJump ;
AutoZyConst := Memo^.Kanal[c].AutoZyConst ;
AutoZyCount := Memo^.Kanal[c].AutoZyCount ;
AutoWait := Memo^.Kanal[c].AutoWait ;
AutoToConst := Memo^.Kanal[c].AutoToConst ;
AutoToCount := Memo^.Kanal[c].AutoToCount ;
AutoToAnz := Memo^.Kanal[c].AutoToAnz ;
AutoToMax := Memo^.Kanal[c].AutoToMax ;
AutoToAnzJmp := Memo^.Kanal[c].AutoToAnzJmp ;
AutoChMerk := Memo^.Kanal[c].AutoChMerk ;
AutoArt := Memo^.Kanal[c].AutoArt ;
AutoCheckLn := Memo^.Kanal[c].AutoCheckLn ;
AutoJmpPtr := Memo^.Kanal[c].AutoJmpPtr ;
For i:=1 To maxAutoJmpPtr Do
AutoJmpRet[i]:= Memo^.Kanal[c].AutoJmpRet[i];
end;
end;
for i := 1 to 10 do G^.SETL[i] := Memo^.Global.Setl[i];
SETNr := Memo^.Global.setnr;
if not (SETNr in [1..10]) then SETNr := 1;
Klingel := Memo^.Global.Klingel;
CtrlBeep := Memo^.Global.CtrlBeep;
Time_Stamp := Memo^.Global.Time_Stamp;
PacOut := Memo^.Global.PacOut;
ZeigeRET := Memo^.Global.ZeigeRet;
ConMorsen := Memo^.Global.ConMorsen;
ReconMorsen := Memo^.Global.ReconMorsen;
{ ConVoice := (pos('A',DZeile) > 0);
ReconVoice := (pos('J',DZeile) > 0);}
GlobalTrenn := Memo^.Global.GlobalTrenn;
BinOut := Memo^.Global.BinOut;
Ins := Memo^.Global.ins;
NoBinMon := Memo^.Global.NoBinMon;
RX_TX_Win := Memo^.Global.RX_TX_win;
morsen := Memo^.Global.morsen;
TopBox := Memo^.Global.TopBox;
Gross := Memo^.Global.Gross;
Idle_Pos := Memo^.Global.idle_pos;
Idle_Anz := Memo^.Global.idle_anz;
Idle_Tout := Memo^.Global.Idle_Tout;
G^.TonHoehe := Memo^.Global.TonHoehe;
VIPG := Memo^.Global.VIP;
SoZeichen := Memo^.Global.SoZeichen;
_VGA := Memo^.Global._vga;
MPause := Memo^.Global.MPause;
Resync_Z := Memo^.Global.Resync_Z;
CNr := Memo^.Global.Cnr;
VSpeed:=memo^.global.speakspeed;
speek:=memo^.global.speak;
{ MerkRead(Rrgl + Rvsp);
if DZeile > '' then VSpeed := Word(str_int(DZeile));}
G^.InfoStr := Memo^.Global.InfoStr;
G^.StatusModus := Memo^.Global.StatusModus;
G^.ZeilenwTX := Memo^.Global.ZeilenwTX;
{$I-}
Close(MDat);
obf:=Ioresult;
{$I+}
Dispose(Memo);
end else (* If IOResult ... *)
begin
for i := 0 to maxLink do with K[i]^ do
begin
FRxName := G^.Drive + Txt + int_str(i) + Ext;
FTxName := G^.Drive;
end;
end;
End;
{$IFDEF ReadOldMemo} {//db1ras}
Var MVer : File of Char;
v1,v2 : Char;
sv1,sv2 : String[2];
Memo : String;
obf : Byte;
{$ENDIF}
Begin (* Merker_File_Lesen *)
{$IFDEF ReadOldMemo} {//db1ras}
Assign(MVer,Sys1Pfad + MerkDatei + Ext);
{$I-}
Reset(MVer);
obf:=ioresult;
{$I+}
If obf = 0 Then Begin
Read(MVer, v1,v2);
{$I-}
Close(MVer);
obf:=Ioresult;
{$I+}
If (v1<>Chr(MerkV1)) Or (v2<>Chr(MerkV2)) Then Begin
If (v1=Chr(OldMerkV1)) And (v2=Chr(OldMerkV2)) Then
Altes_Merker_File_Lesen;
Str(Ord(v1),sv1);
Str(Ord(v2),sv2);
Memo:=Sys1Pfad+MerkDatei+Ext+' '+Sys1Pfad+MerkDatei+'.'+sv1+sv2;
FileKopieren(Memo);
{ Rename(MVer,Sys1Pfad+MerkDatei+'.'+sv1+sv2); }
End Else
{$ENDIF}
Neues_Merker_File_Lesen;
{$IFDEF ReadOldMemo} {//db1ras}
End Else
Neues_Merker_File_Lesen;
{$ENDIF}
End;

482
XPNETROM.PAS Executable file
View file

@ -0,0 +1,482 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P N E T R O M . P A S ³
³ ³
³ Netrom-Datenbank-Verwaltung und Online-Ansicht ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function NodesAnzahl;
var BFNa:string[12];
N:integer;
Bcdt:file of Broadcast;
ioo:word;
begin
{$I-}
if NAfu then bfna:=BCastHAM else bfna:=BCastCB;
assign(bcdt, sys1pfad+BFNa);
reset(bcdt);
if ioresult=0 then N:=FileSize(bcdt) else N:=0;
ioo:=ioresult;
close(bcdt);
ioo:=ioresult;
{$I+}
Nodesanzahl:=N;
end;
Function BCastBackupRename (AltNam : String) :boolean;
var ior : word;
bkflg:boolean;
BKD_ : file;
begin
{$I-}
bkflg:=false;
assign (BKD_, sys1pfad+BcastBAK);
erase(BKD_);
ior:=ioresult;
close(BKD_);
ior:=ioresult;
assign (BKD_, AltNam);
rename (BKd_, sys1pfad+BCastBAK);
ior:=ioresult;
if ior<1 then bkflg:=true;
BCastBackupRename := bkflg;
close(bKD_);
ior:=ioresult;
{$I+}
end;
Procedure BCastKillen;
var ior : word;
bkflg:boolean;
BKD_ : file;
begin
{$I-}
bkflg:=false;
assign (BKD_, sys1pfad+BcastCB);
erase(BKD_);
ior:=ioresult;
close(BKD_);
ior:=ioresult;
assign (BKD_, sys1pfad+BcastHAM);
erase(BKD_);
ior:=ioresult;
close(BKD_);
ior:=ioresult;
{$I+}
end;
Procedure NodesLifetime;
var bfn : string[12];
i, kill : integer;
durch : byte;
bdbk,
bd : file of broadcast;
bdd : broadcast;
AktDT : longint;
min1, min2:longint;
gekillt : boolean;
ioo : word;
begin
aktDT:=LastLTCheck;
{aktdt:=589865783+14400;}
{(Dtst-bcast.DatTime) div 60)*2));}
ioo:=NodesAnzahl(false);
{$I-}
for durch:=1 to 2 do
begin
gekillt:=false;
if durch=1 then bfn:=BCastHAM else bfn:=BCastCB;
if BCastBackupRename (Sys1Pfad+bfn) then
begin
assign(bd, sys1pfad+bfn);
rewrite(bd);
ioo:=ioresult;
assign(BDBK, Sys1Pfad+BCastBAK); reset(BDBK);
if ioresult=0 then
begin
kill:=0; i:=0;
while not eof(bdbk) do
begin
read(bdbk, bdd);
ioo:=ioresult;
{(Dtst-bcast.DatTime) div 60)*2));}
min1:=0;
min1:=(aktdt-bdd.dattime) *2;
if min1>=Konfig.Lifetime then gekillt:=true;;
if (not gekillt) then write(bd, bdd);
gekillt:=false;
ioo:=ioresult;
end;
end;
close(bd);
ioo:=ioresult;
close(BDBK);
ioo:=ioresult;
end; {if BackupRename}
end; {for}
ioo:=ioresult;
ioo:=NodesAnzahl(false);
{$I+}
end;
Procedure NodesSortieren;
Var du, x,i,j : longInt;
N : longint;
Change : Boolean;
bfn:string[12];
bcda : file of Broadcast;
bcda1, bcda2, bcda3 : Broadcast;
obf:boolean;
ioo:word;
Begin
{if inUDB then WriteRam(1,3,Attrib[5],1,EFillStr(80,B1,B1+InfoZeile(402)));}
{$I-}
for DU:=1 to 2 do
begin
if Du=1 then
begin
bfn:=BCastHAM;
N:=NodesAnzahl(true);
end
else
begin
bfn:=BCastCB;
N:=NodesAnzahl(false);
end;
assign(bcda, sys1pfad+bfn);reset(bcda);
ioo:=ioresult;
if N>0 then
begin
if N > 1 then
begin
x := 1;
While x <= N do x := x * 3 + 1;
x := x div 3;
While x > 0 do
begin
i := x;
While i <= N do
begin
j := i - x;
Change := true;
While (j > 0) and Change do
begin
Seek(bcda, j-1); read(bcda, bcda1);
Seek(bcda, j+x-1); read(bcda, bcda2);
if bcda2.DatTime > bcda1.DatTime then
begin
bcda3 := bcda2;
bcda2 := bcda1;
bcda1 := bcda3;
Seek(bcda, j-1); write(bcda, bcda1);
Seek(bcda, j+x-1); write(bcda, bcda2);
j := j - x;
end else Change := false;
end;
i := i + 1;
end;
x := x div 3;
end;
end;
end; {if N}
obf:=ioresult<1;
close(bcda);
obf:=ioresult<0;
{$I+}
end;{for du}
End;
Procedure NodeListen (* (Naf : Boolean) *) ;
var BCast : Broadcast;
BCDat : file of broadcast;
HamZ,
CBZ,
bfn : string[12];
dummy : String[80];
DatPos : Longint;
BPos,
i,
y : Byte;
ZMax : byte;
dtst : longint;
MaxNodes: integer;
ioo : word;
Raus,
Change : boolean;
KC : Sondertaste;
VC : Char;
Procedure NodeLesen;
begin
{ dtst:=packdt;}
{$I-}
Seek(BCDat, DatPos); read(BCdat,BCast);
ioo:=ioresult;
if ioo<>0 then FillChar(BCast,SizeOf(Bcast), 0);
{$I+}
dummy:=b1+efillstr(22,B1,BCast.NodeCall+':'+BCast.NodeAlias);
dummy:=dummy+efillstr(22,B1,BCast.SourceCall+':'+Bcast.SourceAlias);
dummy:=dummy+SfillStr(5,B1,int_Str(Bcast.quality))+b2+b1;
dummy:=dummy+b2+int_Str(Bcast.Port); {+B2+int_str((Konfig.Lifetime div 60));
dummy:=dummy+sfillstr(6,b1,int_Str(((Dtst-bcast.DatTime) div 60)*2)); }
if ioo<>0 then dummy:='';
end;
Procedure NodeDateiSchalten;
begin
{$I-}
if NAf then bfn:=BCastHAM
else bfn:=BCastCB;
MaxNodes:=NodesAnzahl(Naf);
assign(BCDat, sys1pfad+bfn);reset(BCDat);
ioo:=ioresult;
{$I+}
end;
begin
InNodeListe:=true;
NodesSortieren;
HamZ:=ParmStr(1,b1,InfoZeile(431));
CBZ :=ParmStr(2,b1,InfoZeile(431));
Raus:=False;
Moni_Off(0);
DirScroll := true;
NowFenster := false;
NodeDateiSchalten;
if MaxNodes=0 then
begin
Naf:=Not Naf;
{$I-}
Close(Bcdat);
datpos:=ioresult;
{$I+}
NodeDateiSchalten;
end;
{ NodeDateiSchalten;}
ZMax:=MaxZ-4;
DatPos:=0;
WriteRam(1,1,Attrib[5],1,EFillStr(64,B1,B1+InfoZeile(432)));
WriteRam(1,2,Attrib[5],1,EFillStr(64,B1,B1+InfoZeile(429)));
WriteRam(1,MaxZ,Attrib[5],1,EFillStr(80,B1,B1+'Bl„ttern mit PgUp/PgDn - AFU/CB umschalten mit Cursor rechts/links'));
Change:=true;
repeat
if Change then
begin
if Naf then WriteRam(65,1,Attrib[5],1,SFillStr(16,B1,HamZ+b1))
else WriteRam(65,1,Attrib[5],1,sFillStr(16,B1,CBZ+b1));
WriteRam(65,2,Attrib[5],1,sFillStr(16,B1,'('+int_str(maxNodes)+')'+B1));
i:=3;
BPos:=DatPos;
For DatPos:=Bpos to Bpos+ZMax do
begin
NodeLesen;
WriteRam(1,i,Attrib[2],1,EFillStr(80,b1,Dummy));
inc(i);
end;
Change:=false;
datpos:=Bpos;
end;
_ReadKey(KC,VC);
Case KC of
_ESC : raus:=true;
_AltH: XP_Help(G^.OHelp[94]);
_Home: begin
DatPos:=0;
Change:=true;
end;
_PGDn: begin
if (DatPos+zmax+1)<MaxNodes then
begin
inc(DatPos,zmax+1);
Change:=true;
end;
end;
_PGUp: begin
if ((DatPos+zmax+1)>zmax) and ((DatPos-(zmax+1))>=0) then
begin
Dec(DatPos,zmax+1);
Change:=true;
end;
end;
_Right, _Left:
begin
Naf := Not Naf;
DatPos:=0;
Change:=true;
{$I-}
Close(BCDat);
ioo:=ioresult;
{$I+}
NodeDateiSchalten;
end;
end;
until Raus;
{$I-}
Close(BCDat);
ioo:=ioresult;
{$I+}
DirScroll := false;
Moni_On;
inNodeListe:=false;
end;
Procedure REMNodesListen (*Kanal:Byte;CZeile:String*);
Var i,i1,i2,
ix : Integer;
dB,Tn,C,
Anz : Byte;
Bstr,
Dummy : String;
P : String[4];
Komm : String[80];
Path : String[80];
Rufz : String[6];
RufzStr : String[9];
Hstr : String[9];
srec : SearchRec;
flagq,
Flag : Boolean;
Parm : Array[1..3] of String[60];
Udb : User_typ2;
L_I : Longint;
ENTFG,
RICHTG : REAL;
STATUS : Boolean;
OESLAE,NOEBRE:real;
BCDat : file of Broadcast;
BCDatNam : string[12];
BCast : Broadcast;
begin
With K[Kanal]^ do
begin
if Konfig.MaxNodes>0 then
begin
i2:=str_int(RestStr(upcaseStr(CZeile)));
if i2=0 then i2:=50;
NodesSortieren;
if TNC[TncNummer]^.AfuPort then BCDatNam:=BCastHAM else BCDatnam:=BCastCB;
i:=NodesAnzahl(TNC[TncNummer]^.AfuPort);
assign (BCDat, sys1pfad+BCDatNam);
{$I-}
i1:=0;
reset(BCDat);
if (i<=0) or (ioresult<>0) then S_Pac(kanal, nu, false, InfoZeile(430)+M1)
else
begin
S_Pac(kanal, nu, false, m1+InfoZeile(434)+M2);
while (not eof(BCDat)) and (i1<i2) do
begin
read(BCdat,BCast);
{l„nge: max 19 je node}
dummy:=efillstr(19,B1,BCast.NodeCall+':'+BCast.NodeAlias);
inc(i1);
if (i1 mod 4)=0 then S_Pac(kanal,Nu, false, dummy+m1)
else S_Pac(kanal,Nu, false, dummy);
end;
end;
if not ((i1 mod 4)=0) then s_pac(kanal, nu, false, m1);
close(BCDat);
i:=ioresult;
{$I+}
end else S_Pac(kanal, nu, false, InfoZeile(430)+M1)
end;{with kanal}
end;
Procedure REMRoutesListen (*Kanal:Byte; CZeile:String*);
Var i,i1,i2,
ix : Integer;
dB,Tn,C,
Anz : Byte;
Bstr,
Dummy : String;
P : String[4];
Komm : String[80];
Path : String[80];
Rufz : String[6];
RufzStr : String[9];
Hstr : String[9];
srec : SearchRec;
flagq,
Flag : Boolean;
Parm : Array[1..3] of String[60];
Udb : User_typ2;
L_I : Longint;
ENTFG,
RICHTG : REAL;
STATUS : Boolean;
OESLAE,NOEBRE:real;
BCDat : file of Broadcast;
BCDatNam : string[12];
BCast : Broadcast;
begin
with K[Kanal]^ do
begin
if Konfig.MaxNodes>0 then
begin
hstr:=RestStr(upcaseStr(CZeile));
if hstr<>'' then
begin
if TNC[TncNummer]^.AfuPort then BCDatNam:=BCastHAM else BCDatnam:=BCastCB;
assign (BCDat, sys1pfad+BCDatNam);
{$I-}
i1:=0;
reset(BCDat);
if (ioresult<>0) then S_Pac(kanal, nu, false, InfoZeile(430)+M1)
else
begin
flag:=false;
while (not eof(BCDat)) do
begin
read(BCdat,BCast);
if (pos(hstr,bcast.NodeCall)=1) or (pos(hstr, bcast.nodealias)=1) then
begin
if not flag then S_Pac(kanal, nu, false, m1+InfoZeile(435)+m2+InfoZeile(429)+M2);
flag:=true;
dummy:=efillstr(22,B1,BCast.NodeCall+':'+BCast.NodeAlias);
dummy:=dummy+efillstr(22,B1,BCast.SourceCall+':'+Bcast.SourceAlias);
dummy:=dummy+SfillStr(5,B1,int_Str(Bcast.quality))+b2+b1;
dummy:=dummy+b2+int_Str(Bcast.Port){+B2+int_str(Bcast.DatTime)};
inc(i1);
if (i1 mod 4)=0 then S_Pac(kanal,Nu, true, dummy+m1)
else S_Pac(kanal,Nu, false, dummy+m1);
end;
end; {while not eof}
if not flag then S_Pac(kanal, nu, false, m1+InfoZeile(436)+M1);
end;
close(BCDat);
i:=ioresult;
{$I+}
end else parmwrong:=true; {if hstr<>'' ...}
end else S_Pac(kanal, nu, false, InfoZeile(430)+M1)
end; {with kanal}
end;

137
XPOVR.PAS Executable file
View file

@ -0,0 +1,137 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR;
{$F+,O+}
{-$DEFINE Sound}
Interface
Uses CRT,
DOS,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funtionen der XPINI.PAS *)
Procedure Var_Init(Kanal : Byte);
(* Proceduren und Funtionen der XPLIB1.PAS *)
Function CheckXP161 (kanal:Byte) :Boolean;
Function PackDT : longint;
PROCEDURE Editor;
Procedure Link_erhalter(Kanal : Byte; var Zeile : Str80);
Procedure RC_update(Kanal : Byte; var Zeile : str80);
Procedure File_Umbenennen(alt,neu : Str80; var Ueber,Art : Integer);
Function SetzeSysArt (Kanal : Byte) : Boolean; {//db1ras}
{$IFNDEF no_Bake} {//db1ras}
Procedure BakenMenu;
{$ENDIF}
Procedure Tschuess(Kanal : Byte);
Procedure TschuessFenster;
Procedure TestCheck(Kanal : Byte; Zeile : Str80);
Procedure UserInStatus (Kanal : Byte);
Procedure Connect(Kanal : Byte; Zeile : Str80);
Procedure S_Aus(Kanal,Art : Byte; Zeile : String);
Procedure RC_Alle(Kanal,Art : Byte);
Procedure TNC_Parm(Kanal,Art : Byte);
Procedure GetVideoMode;
Procedure Umlautstatus_Aendern(Kanal : Byte);
Procedure Echo_Menue(Kanal : Byte);
Function LPT_Error(Nr : Byte) : Boolean;
Procedure Write_Lpt(Kanal : Byte; Zeile : Str20);
Procedure Write_Drucker(Kanal : Byte; Zeile : String);
Procedure LptEscSeq(Kanal : Byte; Zeile : Str80);
Procedure Lpt_On_Off(Kanal : Byte);
Procedure Vorschreib_Uebergabe;
Procedure Vorschreib_Such(Kanal : Byte);
Procedure Belog_Eintrag(Kanal : Byte);
Procedure BoxListe (Kanal : Byte);
Procedure L_ON(Kanal : Byte; Zeile : Str128; Connect_out,ReKon : Boolean);
Procedure L_Off(Kanal : Byte);
Procedure LogBuchEintrag(Kanal,Art : Byte);
Procedure Line_ON(Kanal : Byte);
Procedure FreiKanalSuch(Kanal : Byte; Zeile : Str80);
Procedure Remote_Connect_Aufbauen(Kanal : Byte; Zeile : Str80);
Procedure RemConInit(Kanal : Byte);
Procedure Unproto_darstellen;
Procedure Terminal_Kanal(Kanal : Byte; Anz : ShortInt);
Procedure Trennzeilen(Kanal : Byte; KC : SonderTaste);
Procedure Fenster_Berechnen;
Procedure Change_WIN;
Procedure ClearVorBuffer(Kanal : Byte);
Procedure ClearScrBuffer(Kanal : Byte);
Function GetWeekDay (Dstr : Str8) : Str2;
Procedure Text_Einstellung(Kanal : Byte);
Procedure Compress_Ein_Aus(Kanal : Byte);
Procedure CompressMenu(Kanal : Byte);
Procedure Morse_Menue(Kanal : Byte);
Procedure Voice_Menue(Kanal : Byte);
Procedure QRG_Einstellen(Kanal : Byte; Zeile : Str8);
Procedure Verschiedene_Einstellungen(Kanal : Byte);
Procedure Alt_Disc(Kanal : Byte);
Procedure Auswert_Kopieren(Kanal : Byte; Zeile : Str80);
Procedure Idle_Einstellen(Kanal : Byte; Zeile : Str20);
Procedure Remote_Emulieren(Kanal : Byte; Zeile : Str80);
Procedure GetString(var S : Str80;
Attr,
L,X,Y : Byte;
var TC : Sondertaste;
Art : Byte;
var Ins : Boolean);
(* Proceduren und Funtionen der XPMH.PAS *)
Procedure MH_Sort(Art : Byte);
Procedure MH_Show;
Procedure RemoteMH(Kanal,T : Byte; Zeile : Str9);
Function CBCallCheck (CBCall : Str9) : Boolean;
{$IFDEF Sound} {//db1ras}
(* Function der XPMIDI *)
Function PlayMidi (MidiFilename : String) : Boolean;
{$ENDIF}
Implementation
Uses XPACT,
XPACT1,
XPOVR1,
XPOVR2,
XPOVR3,
XPOVR4,
xpovr5
{$IFDEF Sound} {//db1ras}
,midifm,
midifile,
ibk
{$ENDIF}
;
{$I XPINI}
{$I XPLIB1}
{$I XPMH}
{$IFDEF Sound} {//db1ras}
{$I MID2}
{$ENDIF}
End.

120
XPOVR1.PAS Executable file
View file

@ -0,0 +1,120 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 1 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR1;
{$F+,O+}
Interface
Uses CRT,
DOS,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funtionen der XPFILE.PAS *)
Function Compute_CRC(CRC : Integer; Zeile : String) : Integer;
Procedure FileInfo(Kanal,Art : Byte; Groesse,Count,tGroesse,tCount : LongInt);
Function Zeit_to_Sek(Zeile : Str8) : LongInt;
Function Time_Differenz(Start,Stop : Str8) : Str8;
Function FileBaud(ZeitStr,AnzStr : Str9) : Str9;
Procedure Kill_Save_File(Kanal : Byte);
Procedure Close_SaveFiles;
Procedure Open_SaveFiles;
Procedure Neu_Name(Kanal,Art : Byte; Call : str9; Name : str28);
Function GetName(Kanal : Byte; Call : Str9; var FlagByte : Byte; Con:Boolean) : Str40;
Function Platzhalter(Kanal : Byte; Zeile : String) : String;
Function MakeBinStr(Kanal : Byte; Zeile : Str80) : Str80;
Function FName_aus_FVar(var f : File) : Str80;
Function SaveNameCheck(Art : Byte; Zeile : Str80) : Boolean;
Function MakePathName(Kanal : Byte; Var DFlag : Boolean; Zeile : Str80) : Str80;
Function FNameOK(Zeile : Str80) : Boolean;
Function PfadOk(Art : Byte; Zeile : Str80) : Boolean;
Function MkSub(Pfad : Str80) : Boolean;
Procedure KillFile(Zeile : Str80);
Procedure Ini_RemPath;
Procedure File_Bearbeiten(Kanal : Byte; Zeile : Str80);
(* Proceduren und Funtionen der XPFRX.PAS *)
Procedure FileRxMenu(Kanal : Byte);
Procedure Datei_Empfangen(Kanal : Byte; Art : Byte);
Function OpenTextFile(Kanal : Byte) : Boolean;
Procedure OpenBinFile(Kanal : Byte; Zeile : Str80);
Procedure Write_RxFile(Kanal : Byte; Zeile : String);
Procedure CloseRxFile(Kanal,Art : Byte);
Procedure SaveFile(Kanal : Byte);
Procedure Write_SFile(Kanal : Byte; Zeile : String);
Function SvFRxCheck(Kanal : Byte; Zeile : Str60; Name : Str12) : Str60;
(* Proceduren und Funtionen der XPFTX.PAS *)
Procedure FileTxMenu(Kanal : Byte);
Procedure Datei_Senden(Kanal : Byte; Art : Byte);
Procedure FileSendVon(Kanal : Byte; Zeile : Str40);
Procedure Send_File(Kanal : Byte; OFlag : Boolean);
Procedure SF_Text(Kanal : Byte; Zeile : Str80);
Procedure TXT_Senden(Kanal,Art,FNr : Byte);
Procedure RequestName(Kanal:Byte);
Procedure BIN_TX_File_Sofort(Kanal : Byte; Zeile : Str80);
Procedure TXT_TX_File_Sofort(Kanal : Byte; Zeile : Str80);
Procedure FertigSenden(Kanal : Byte);
(* Proceduren und Funtionen der XP7PL.PAS *)
Procedure Open_Close_7Plus(Kanal : Byte; Zeile : Str80);
Procedure Close_7Plus(Kanal : Byte);
Procedure Write_SplFile(Kanal : Byte; Zeile : String);
(* Proceduren und Funtionen der XPBUF.PAS *)
Procedure OpenBufferFile(Kanal : Byte);
Procedure WriteBuffer(Kanal : Byte; Zeile : String);
Procedure SendBuffer(Kanal : Byte);
Procedure EraseBufferFile(Kanal : Byte);
Procedure SendTestBuffer(Kanal : Byte);
(* Proceduren und Funtionen der XPDIR.PAS *)
Procedure GetDirFiles(Zeile : Str80; ax, Art : Byte);
Procedure DirZeig(Var Zeile : Str80; var Ch : char; QRet : Boolean);
Procedure RemoteDir(Kanal : Byte; Zeile : Str80);
Procedure DelAll(Pfad : Str80; Yp : Byte);
Function Get7PlFNr(Zeile : Str80) : Str20;
(* Proceduren und Funktionen der XPCOPY.PAS *)
Procedure FileKopieren(Var Zeile : String);
Procedure Delete_Datei(Var Zeile : Str80);
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR2,
XPOVR3,
XPOVR4,
xpovr5,
xpovr6;
{$I XPFILE}
{$I XPFRX}
{$I XPFTX}
{$I XP7PL}
{$I XPBUF}
{$I XPDIR}
{$I XPCOPY}
End.

99
XPOVR2.PAS Executable file
View file

@ -0,0 +1,99 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 2 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR2;
{$F+,O+}
Interface
Uses CRT,
DOS,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funtionen der XPLOAD.PAS *)
Procedure Emblem_Zeigen;
Procedure Ini_Start_Tnc;
Procedure Switch_Hostmode(V24Nr,TNC_Nr : Byte);
Procedure TNC_High_Channel_Init;
Procedure DRSI_Hostmode(TNC_Nr,Art : Byte);
Procedure Configlesen;
Procedure Infos_Lesen;
Procedure Strings_Lesen;
Procedure AttributFile_Lesen;
Procedure ESC_Lesen;
Procedure QRG_Lesen;
Procedure REM_Lesen;
Procedure PWD_Lesen;
Procedure HELP_Lesen;
Procedure TncIni(Art : Byte);
Procedure Abschluss_XP;
Procedure Sicherung_Speichern;
Procedure Abbruch_XP(Nr : Byte; Zeile : str80);
Procedure ScrFile_erzeugen;
{Procedure LineRead(Fstr : Str10);}
Function HeapFrei(Bedarf : LongInt) : Boolean;
Procedure Config_Verz_Lesen;
Procedure Config_Allg_Lesen;
Procedure Config_TNC_Lesen;
Procedure Config_PRN_Lesen;
Procedure Config_RAM_Lesen;
Procedure Config_BLIND_Lesen;
Procedure Config_SOUND_Lesen;
Procedure Puffer_schreiben;
Procedure Puffer_lesen;
Procedure VorCurEnd;
Procedure Interface_Exist;
Procedure GenCrcTab;
Procedure GenPrivPWD;
Procedure UebergabeAuswert;
(* Proceduren und Funtionen der XPDOS.PAS *)
Procedure DosAufruf(Var Zeile : Str128; Art : Byte);
Procedure ExecDOS(Zeile : Str128);
Procedure DosBildSave(Zeilen : Byte);
Procedure StoreHeap;
Procedure LoadHeap;
Function Zeilen_ermitteln : Byte;
Procedure Switch_VGA_Mono;
Procedure Ini_TNC_Text(Art : Byte);
(* Proceduren und Funtionen der XPHELP.PAS *)
Procedure Hlp_Laden(Istr : Str6);
Procedure XP_Help(IDstr : Str6);
Procedure REM_Help(Kanal : Byte; HNr : Byte);
Procedure Send_Hilfe(Kanal : Byte; IDstr : Str6);
Procedure Help_Compile;
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR3,
XPOVR4,
xpovr5,
xpovr6;
{$I XPLOAD}
{$I XPDOS}
{$I XPHELP}
End.

127
XPOVR3.PAS Executable file
View file

@ -0,0 +1,127 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 3 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR3;
{$F+,O+}
Interface
Uses CRT,
DOS,
OVERLAY,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funtionen der XPLINK.PAS *)
Procedure Lnk_Sort(Art : Byte);
Procedure Lnk_Init(TNr : Byte; Freq : Str8);
Procedure ALT_C_Connect(Kanal : Byte);
Function GetConPfad(Rufz : Str9) : String;
Function GetConStr(var Zeile : String) : Str80;
Function LinkExists(Name : Str9; var Gate : Byte) : Boolean;
Procedure LinkMod(var Zeile : Str80);
Procedure RemoteLnk(Kanal,T : Byte; Zeile : Str9);
Procedure SaveLinks(Kanal,TNr : Byte; Freq : Str8);
Procedure LinkLearn(Kanal : Byte; Zeile : Str80);
(* Proceduren und Funtionen der XPCRC.PAS *)
Procedure CRC_Datei(var Zeile : Str80);
Procedure GetNetRom;
(* Proceduren und Funtionen der XPCOL.PAS *)
Procedure Color_Einstellung;
(* Proceduren und Funtionen der XPMON.PAS *)
Procedure Stat_MonitorCalls(Kanal : Byte);
Procedure Calls_Monitoren(Kanal : Byte; Zeile : Str80);
Procedure Init_Call_monitoren(Kanal : Byte; Zeile : Str80);
Procedure Cancel_Call_monitoren(Kanal : Byte);
Procedure FreeMonitorKanal(Var KA : Byte ; Zeile : Str80);
(* Proceduren und Funtionen der XPMRK.PAS *)
Procedure Merker_Conn_Schreiben;
Procedure Merker_Conn_Lesen;
Procedure Merker_File_Schreiben;
Procedure Merker_File_Lesen;
(* Proceduren und Funtionen der XPMAKRO.PAS *)
Procedure Makrozeile_holen;
Procedure Makro_Aktivieren(Zeile : Str60);
Procedure MakroInit;
Procedure Makro_Erlernen(SK : Sondertaste; VC : Char);
Procedure Makro_Open_LearnFile;
(* Proceduren und Funtionen der XPAUTO.PAS *)
Procedure Auto_Aktivieren(Kanal : Byte; Zeile : Str60);
Procedure Auto_Init(Kanal : Byte);
Procedure Autozeile_Holen(Kanal : Byte);
Function AutoJmpZnNr(Kanal : Byte; Zeile : Str40) : Word;
(* Proceduren und Funtionen der XPPASS.PAS *)
Procedure Sysop_Einloggen(Kanal : Byte; Zeile : Str80);
Procedure Password_Auswert(Kanal : Byte; Zeile : String);
Procedure DieBox_PW_Scan(Kanal : Byte; Zeile : String);
Procedure Scan_PW_Array(Kanal : Byte);
Procedure BayBox_US_Scan(Kanal : Byte; Zeile : String);
Function GetPwParm (Nr : Byte; Zeile : Str80) : Str20;
Function Found_Pw_Call(Zeile : Str80; Cstr : Str9; AlStr:str9; AStr : Str6) : Boolean;
Function PseudoPriv(Laenge : Byte; Pstr : Str20; Dstr : Str80) : Str80;
Function Check_Parm(Zeile : String) : String;
Procedure RMNC_Auswert(Kanal : Byte; Zeile : Str80);
Procedure TheNet_SYS_Auswert(Kanal : Byte ; Zeile : String);
Procedure EZBOX_Auswert(Kanal : Byte; Zeile : Str80);
(* Proceduren und Funtionen der XPCONV.PAS *)
Procedure Conv_Tx_All (Kanal : Byte);
Procedure ConversTX (Kanal : Byte; All,Head : Boolean; Zeile : String);
Procedure ConversUser (Kanal : Byte);
Procedure ConversRemote (Kanal : Byte; Zeile : String);
Function ConversIni (Kanal : Byte; INI : Boolean) : Boolean;
Procedure ConversAuswert (Kanal,Nr : Byte);
Function ConversCall(Kanal : Byte) : Str20;
Procedure ConversQuit(Kanal : Byte);
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR4,
XPOVR5,
xpovr6;
{$I XPLINK}
{$I XPCRC}
{$I XPCOL}
{$I XPMON}
{$I XPMRK}
{$I XPMAKRO}
{$I XPAUTO}
{$I XPPASS}
{$I XPCONV}
End.

71
XPOVR4.PAS Executable file
View file

@ -0,0 +1,71 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 4 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR4;
{$F+,O+}
{-$DEFINE Sound}
Interface
Uses CRT,
DOS,
OVERLAY,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funtionen der XPREM.PAS *)
Procedure Remote(Kanal : Byte; Art : Integer; CZeile : Str80);
Procedure Send_Prompt(Kanal : Byte; Art : Integer);
Procedure Ch_Dir(Kanal : Byte; Var Zeile : Str80);
Function REM_Auswert(Kanal, Art : Byte; Komm : Str80) : Byte;
Procedure TNC_Auswert(Kanal : Byte; Var TncKom, Doc : Str20);
Procedure Mk_Dir(Kanal : Byte; var Zeile : Str80);
Procedure Rm_Dir(Kanal : Byte; var Zeile : Str80);
Function Call_Exist(Kanal,Art : Byte; Zeile : Str9) : Boolean;
Procedure SendToChannel(Kanal,Art,von,bis : Byte; Zeile : Str80);
Procedure Quit(Kanal : Byte);
Function QSO_Time(Kanal : Byte) : Str20;
Function Rom_Ready : Boolean;
Procedure REM_HelpLong(Kanal : Byte; IDstr : Str6);
Procedure ComputeRTF(Kanal : Byte; Zeile : Str80);
(* Proceduren und Funtionen der XPSCROL.PAS *)
Procedure Notiz_Zeigen(Kanal : Byte);
Procedure FileScroll(Kanal : Byte);
Procedure CheckSort(Kanal,Spalte,AnzSp : Byte; Dpos : LongInt; SC : Char);
Procedure OpenDBox(Kanal : Byte);
Procedure CloseDBox(Kanal : Byte);
Procedure Sprechen (Zeile : Str80) ;
Procedure SprachMenu;
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
xpovr5,
xpovr6;
{$I XPREM}
{$I XPSCROL}
{$I xpspeak}
End.

118
XPOVR5.PAS Executable file
View file

@ -0,0 +1,118 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 5 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR5;
{$F+,O+}
Interface
Uses CRT,
DOS,
OVERLAY,
XPEMS,
XPXMS,
XPDEFS;
(* Proceduren und Funktionen der XPUSER.PAS *)
Procedure UserZeigen (Kanal : Byte; VAR Call2:Str9);
Procedure GetUser(var udi:longint);
Procedure PutUser(Neu: User_typ2; Var Resultat : Byte; Typ : Byte; VAR _DPos:longint; Shard:Boolean);
Function UserSuchroutine (CallS : Str10; var USu:longint; Sali, shart:boolean) : Boolean;
Function UserSuchen (VAR USuch:Longint; SCall:string; SAlias:boolean) : Boolean;
Procedure DatensatzHolen(DatP:Longint; Var UDs: User_typ2);
Procedure NeuNameSave(User2: User_typ2; Var Result : Byte);
Procedure UserAnwesend;
(* XPUSEDIT.Pas *)
Procedure UserEditieren(User_:User_Typ2; Kanal :Byte; Neu:boolean; ZMax:Byte; VAR NeuPos : LongInt);
Function UserShow (Kanal:Byte;Suche:Str9) : Boolean;
(* XPMAIL.PAS *)
Procedure StartMailPolling(Kanal : byte; RXCall:str9);
Procedure Link_Holen (Var Port : Byte; Var CString : Str80);
Procedure MailVersucheRauf (DPos:LongInt);
Function MailsVorhanden : Boolean;
Procedure MailKillen (Box, RX:Str10; DPos : longint);
Procedure MailSpeichern (Mail : Mail_Typ);
Procedure MailsZeigen (Kanal : Byte);
Procedure MailPollGo (Kanal:Byte; NFwd:boolean);
Procedure MailSchliessen (Kanal:byte);
procedure CancelMailPoll (Kanal:Byte);
procedure LinksVorbereiten(Port:byte;QRG:Str10);
procedure LinksKillen;
{XPXBIN}
Function XBinStr (Kanal : Byte; Zeile : String; TXPos:longint) : String;
Procedure XBinCheck (kanal : Byte; XBinZ:string; DtPos:longint; XZeile:string);
procedure XBinWrite (kanal:Byte; Zeile:string);
Procedure XBinSend (Kanal : Byte; OFlag : Boolean);
Procedure OpenXBinProt (Kanal:byte);
Procedure CloseXBinProt (Kanal:byte);
{XPQTH}
PROCEDURE QTH_Pruefen (QTH : STRING;
VAR
OESLAE,
NOEBRE : REAL;
VAR
STATUS : BOOLEAN);
PROCEDURE QTH_ENTFG_RICHTG (QTH1 : STRING;
QTH2 : STRING;
VAR
ENTFG,
RICHTG : REAL;
VAR
STATUS : BOOLEAN);
FUNCTION WINKEL_IN_ALT(OESLAE,NOEBRE :REAL):STRING;
FUNCTION WINKEL_IN_NEU(OESLAE,NOEBRE :REAL):STRING;
FUNCTION WINKEL_IN_GMS (OESLAE,NOEBRE:REAL):STRING;
Procedure Compute_QTH (Var Zeile : Str80 );
{$IFNDEF no_Netrom} {//db1ras}
{Funktionen und Prozeduren in XPNETROM.PAS}
Procedure NodesSortieren;
Procedure NodesLifetime;
Function NodesAnzahl(Nafu:Boolean) : integer;
Procedure NodeListen(Naf : Boolean);
Procedure BCastKillen;
Procedure REMNodesListen (Kanal:Byte;CZeile:String);
Procedure REMRoutesListen (Kanal:Byte; CZeile:String);
{$ENDIF}
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
xpovr4,
xpovr6;
{$I XPUSER}
{$I XPUSEDIT}
{$I XPMAIL}
{$I XPQTH}
{$I XPXBIN}
{$IFNDEF no_Netrom} {//db1ras}
{$I XPNETROM}
{$ENDIF}
End.

65
XPOVR6.PAS Executable file
View file

@ -0,0 +1,65 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ UNIT: X P O V R 6 . P A S ³
³ ³
³ Programmcode, der aus dem Overlayteil nachgeladen wird ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
UNIT XPOVR6;
{$F+,O+}
{-$DEFINE Sound}
{-$DEFINE code}
Interface
Uses CRT,
DOS,
OVERLAY,
XPEMS,
XPXMS,
XPDEFS;
Function STOPCompress (Kanal : Byte; Zeile : String; Code : Byte) : String;
Function STOPDeCompress (Kanal : Byte; Zeile2 : String; Code : Byte) : String;
Function PackIt (Zeile : String) : String;
Function UnPackIt (Zeile : String) : String;
Function CodeIt (Kanal : Byte; Zeile : String; Code : Byte) : String;
Function DeCodeIt (Kanal : Byte; Zeile : String; Code : Byte) : String;
Function CodeStr (Kanal : Byte; Zeile : String) : String;
Function DeCode (Kanal : Byte; Zeile : String) : String;
Function GetCode (Call : Str9) : Word;
Function PMak (Nr : Byte) : String;
Function DetectStopCode (LastBt, Cd1, Cd2 : Byte) : Boolean;
{XPWAV}
Procedure FindBlaster;
procedure PlayWave (FileName : String);
procedure StopWave;
procedure ExitWavePlayer;
Implementation
Uses XPACT,
XPACT1,
XPOVR,
XPOVR1,
XPOVR2,
XPOVR3,
xpovr4,
xpovr5;
{$I XPSTOP}
{$I XPWAV}
End.

113
XPPACK.PAS Executable file
View file

@ -0,0 +1,113 @@
{$A+,B-,D+,E+,F-,I-,L+,N+,O-,R-,S-,V-}
{$M 16384,0,655360}
program LZH_Test;
uses
dos,crt,LZH;
CONST
{ MaxInstall = 20;
PackDats : array [1..maxInstall] of String[12] =
('160_170.TXT', 'LOGO.XP', 'MSGS.XP', 'CMD.XP',
'REMOTES.XP',
'ONLHELP.XP', 'XPSETHLP.XP', 'UPDATE.EXE',
'LINKS.XP', 'LOG.XP' , 'USER.XP',
'PASSWORD.XP', 'TEXT.XP' , 'TNC.XP',
'CALLS.XP', 'COLOR.XP' , 'COOKIE.XP',
'QRG.XP', 'XPACKSET.EXE', 'XPACKET.EXE');
}
MaxInstall = 65;
PackDats : array [1..maxInstall] of String[12] =
('V181.txt', 'MSGS.xp', 'XPACKSET.exe', 'UPDATE.exe',
'XPACKET.exe', 'ONLHELP.xp', 'XPSETHLP.xp', 'LOGO.xp', 'XP.ico',
'CMD.xp',
'A.SPK','B.SPK','C.SPK','D.SPK','E.SPK','F.SPK','G.SPK','H.SPK','I.SPK','J.SPK',
'K.SPK','L.SPK','M.SPK','N.SPK','O.SPK',
'P.SPK','Q.SPK','R.SPK','S.SPK','T.SPK','U.SPK','V.SPK','W.SPK','X.SPK','Y.SPK',
'Z.SPK','0.SPK','1.SPK','2.SPK','3.SPK','4.SPK',
'5.SPK','6.SPK','7.SPK','8.SPK','9.SPK','10.SPK',
'11.SPK','12.SPK','13.SPK','14.SPK','15.SPK','_.SPK','!.SPK',
'REMOTES.xp',
'LINKS.xp', 'LOG.xp' ,
'PASSWORD.xp', 'TEXT.xp' , 'TNC.xp',
'CALLS.xp', 'COLOR.xp' , 'COOKIE.xp',
'QRG.xp',
'USER.xp');
procedure OpenInput (fn: String);
begin
assign(infile,fn); reset(infile,1);
if IoResult>0 then Error('! Can''t open input file');
inbuf:= @ibuf;
ReadToBuffer:= ReadNextBlock;
ReadToBuffer;
end;
begin {main}
comp:=false; decomp:=false;
{ if ParamCount<>1 then begin
writeln('Usage: lz e(compression)|d(uncompression) infile');
HALT(1)
end;}
PackDat:=ParamStr(3);
SourceDat:=ParamStr(2);
s:= ParamStr(1);
case s[1] of
'e','E':begin
{sourceDat:=DirInfo.Name;}
OpenOutput('XPPACK.XPP'); {PackDat}
for i:=1 to MaxInstall do
begin
SourceDat:=PackDats[i];
{SourceDat:='ONLHELP.XP';}
Write(EFillStr(12,' ',Sourcedat)+':');
PackDat:=SourceDat;
delete(PackDat,pos('.',packdat),length(PackDat)-pos('.',packdat)+1);
PackDat:=packdat+'.'+Exten;
writeln(PackDAt);
OpenInput(SourceDat);
comp:=true;
Encode(filesize(infile),SourceDat);
close(infile); if IoResult>0 then Error('! Error closing input file');
if outptr>0 then WriteNextBlock;
end;
close(outfile); if IoResult>0 then Error('! Error closing output file');
end;
'd','D': begin
FindFirst(ParamStr(2), Archive, DirInfo);
while DosError = 0 do
begin
ZielDat:='';
sourceDat:=DirInfo.Name;
{ if Sourcedat[length(sourceDat)]='#' then
begin}
OpenInput(SourceDat);
{OpenOutput(PackDat);}
decomp:=true;
Decode;
close(infile); if IoResult>0 then Error('! Error closing input file');
if outptr>0 then WriteNextBlock;
close(outfile); if IoResult>0 then Error('! Error closing output file');
{ end; }
FindNext(DirInfo);
end;
end;
else
Error('! Use [D] for Decompression or [E] for Compression')
end;
{ close(infile); if IoResult>0 then Error('! Error closing input file');
if outptr>0 then WriteNextBlock;
close(outfile); if IoResult>0 then Error('! Error closing output file');}
end.

551
XPPASS.PAS Executable file
View file

@ -0,0 +1,551 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P P A S S . P A S ³
³ ³
³ Enth„lt notwendige Routinen zum Einloggen als SYSOP in den ³
³ verschiedenen Systemen. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure Sysop_Einloggen (* Kanal : Byte; Zeile : Str80 *);
Var i,i1 : Byte;
Flag : Boolean;
Hstr : String[80];
Astr : String[5];
KC : Sondertaste;
VC : char;
SysArt_B : Byte; {//db1ras}
Begin
with K[Kanal]^ do
begin
if SysopParm then
begin
SysopParm := false;
InfoOut(Kanal,0,1,InfoZeile(3));
end else
begin
Flag := false;
Zeile := RestStr(UpCaseStr(Zeile));
KillEndBlanks(Zeile);
Astr := Zeile;
{DigiCom Parm 19}
For SysArt_B:=1 To maxSCon Do {//db1ras}
If ((Astr=SNam[SysArt_B]) Or ((Astr='') And (SysArt=SysArt_B)))
And (SysArt_B in [1,2,3,5..11,13,14,15,17,18]) Then Begin
Astr := SNam[SysArt_B];
Flag := true;
if SysArt_B<>18 then begin
if SysArt_B=8 then
begin
for i:=7 to 15 do G^.FStr[i]:='';
for i:=7 to 15 do G^.FStx[i]:=22;
G^.Fstr[7] := InfoZeile(412);
G^.Fstr[10] := InfoZeile(413);
G^.Fstr[12] := InfoZeile(414);
Fenster(15);
_ReadKey(KC,VC);
clrFenster;
end;
if (Upcase(VC)='M') and (SysArt_B=8) then
SysopStr := ParmStr(18,B1,InfoZeile(217))
else
begin
Case SysArt_B of
1..18:SysopStr := ParmStr(SysArt_B,B1,InfoZeile(217));
19 :SysopStr := ParmStr(17,B1,InfoZeile(217));
20 :SysopStr := ParmStr(SysArt_B-1,B1,InfoZeile(217));
end;
end;
if (xpnodec) or (SysArt_B=19) then delete(SysOpStr,1,2);
end else SysOpStr := 'PRIV';
end else if SCon[0] then
begin
for i := 1 to maxUser do
if (not Flag and (Astr = UNam[i]))
Or ((Astr = '') And (System = UNam[i])) Then Begin {//db1ras}
Astr := UNam[i]; {//db1ras}
Flag := true;
UserArt := i;
SysopStr := ParmStr(UserArt,B1,InfoZeile(218));
end;
end;
if not Flag then InfoOut(Kanal,1,1,InfoZeile(171));
if Flag then
begin
Flag := false;
KillEndBlanks(Astr);
SysopArt := LRK + Astr + RRK;
Assign(G^.TFile,Sys1Pfad + PwDatei);
FiResult := ResetTxt(G^.TFile);
While not Eof(G^.TFile) and not Flag do
begin
Readln(G^.TFile,Hstr);
if Found_Pw_Call(Hstr,Call,Alias,SysopArt) then
begin
Flag := true;
PassRetry := Byte(str_int(GetPwParm(1,Hstr)));
end;
end;
FiResult := CloseTxt(G^.TFile);
if not Flag then
InfoOut(Kanal,1,1,InfoZeile(17) + B1 + SysopArt + B1 + Call);
end;
if Flag then
begin
Randomize;
PassRight := 1;
inc(PassRetry);
if PassRetry > 1 then
begin
PassRight := Random(PassRetry+1);
if PassRight = 0 then PassRight := 1;
end;
case SysArt_B of
1 : begin (* DBOX *)
if not DBoxScaned then Scan_PW_Array(Kanal);
SysopStr := SysopStr + B1 + DieBoxPW;
end;
else SysopParm := true;
end;
if not User_autopw then
begin
InfoOut(Kanal,0,1,SysopStr);
S_PAC(Kanal,NU,true,SysopStr + M1);
end else User_autopw:=false;
end;
end;
end;
End;
Procedure Password_Auswert (* Kanal : Byte; Zeile : String *);
Begin
with K[Kanal]^ do if SysArt in [0,2,3,5..11,13,14,15,17,18] then
begin
case SysArt of
0 : case UserArt of
1 : TheNet_SYS_Auswert(Kanal,Zeile); (* TOP *)
2 : RMNC_Auswert(Kanal,Zeile); (* SP *)
3 : TheNet_SYS_Auswert(Kanal,Zeile); (* XP *)
end;
5 : EZBOX_Auswert(Kanal,Zeile); (* EBOX *)
7 : RMNC_Auswert(Kanal,Zeile); (* RMNC *)
2, (* BBOX *)
3, (* FBOX - FBB *)
6, (* BDXL *)
8, (* TNN *)
9, (* NETR *)
10, (* BN *)
11, (* DXC *)
13, (* FALC *)
15, (* BPQ *)
14 : TheNet_SYS_Auswert(Kanal,Zeile); (* TNC3 *)
17, (* XP *)
18, (* XN *)
19, (* XPN *)
20 : TheNet_SYS_Auswert(Kanal,Zeile); (* DIGIC*)
end;
end;
SetzeFlags(Kanal);
End;
Procedure DieBox_PW_Scan (* Kanal : Byte; Zeile : String; *);
var Flag : Boolean;
Begin
with K[Kanal]^ do
begin
Flag := false;
if length(Zeile) > 14 then
Repeat
if (Zeile[3] = Pkt ) then
if (Zeile[6] = Pkt ) then
if (Zeile[9] = B1) then
if (Zeile[12] = DP) then Flag := true;
if not Flag then delete(Zeile,1,1);
Until Flag or (length(Zeile) < 14);
if Flag then DieBoxPW := copy(Zeile,1,2) +
copy(Zeile,10,2) +
copy(Zeile,13,2);
end;
End;
Procedure Scan_PW_Array (* Kanal : Byte *);
var Pw : ^PWArrayPtr;
Hstr : String[80];
flag : Boolean;
i : Byte;
Std,
Min,
Tag : Byte;
Begin
GetMem(Pw,SizeOf(Pw^));
FillChar(Pw^,SizeOf(Pw^),0);
with K[Kanal]^ do
begin
DBoxScaned := false;
Assign(G^.TFile,Sys1Pfad + PwDatei);
FiResult := ResetTxt(G^.TFile);
Repeat
Readln(G^.TFile,Hstr);
flag := Found_Pw_Call(Hstr,Call,Alias,LRK + SNam[1] + RRK);
Until flag or Eof(G^.TFile);
if flag then
begin
for i := 0 to 59 do Readln(G^.TFile,Pw^[i]);
Tag := str_int(copy(DieBoxPW,1,2));
Std := str_int(copy(DieBoxPW,3,2));
Min := str_int(copy(DieBoxPW,5,2));
i := Min + Tag;
if i > 59 then i := i - 60;
DieBoxPW := copy(Pw^[i],Std+1,4);
DBoxScaned := true;
end;
FiResult := CloseTxt(G^.TFile);
end;
FreeMem(Pw,SizeOf(Pw^));
End;
Procedure BayBox_US_Scan (* Kanal : Byte; Zeile : String *);
Begin
with K[Kanal]^ do
begin
PassRetry := 1;
PassRight := 1;
SysopArt := BBUS;
TheNet_SYS_Auswert(Kanal,Zeile);
end;
End;
Function PseudoPriv (* Laenge : Byte; Pstr : Str20; Dstr : Str80) : Str80 *);
Var i : Byte;
w : Word;
Feld : Array [1..6] of Byte;
Hstr : String[80];
Flag : Boolean;
Begin
Randomize;
w := 0;
Hstr := CutStr(Dstr);
delete(Hstr,1,1);
delete(Hstr,length(Hstr),1);
Flag := Hstr = SNam[2];
Dstr := ParmStr(2,B1,Dstr);
delete(Dstr,1,1);
delete(Dstr,length(Dstr),1);
for i := 1 to 6 do Feld[i] := 0;
for i := 1 to 3 do
begin
Hstr := ParmStr(2+i,Km,Dstr);
if (length(Hstr) = 4) and (Hstr[4] >= Hstr[1]) then
begin
Feld[2*i-1] := ord(Hstr[1]);
Feld[2*i] := ord(Hstr[4]);
w := w + Feld[2*i-1] + Feld[2*i];
end;
end;
Hstr := '';
if w = 0 then
begin
Feld[1] := 48;
Feld[2] := 122;
end;
Repeat
i := Random(254);
if Flag and (i in [35,44,59]) then i := 0;
if (i > 0) and
(i in [Feld[1]..Feld[2],Feld[3]..Feld[4],Feld[5]..Feld[6]]) then
Hstr := Hstr + Chr(i);
Until length(Hstr) >= Laenge;
if Pstr > '' then
begin
i := Random(Byte(Laenge-length(Pstr)));
if i = 0 then i := 1;
delete(Hstr,i,length(Pstr));
insert(Pstr,Hstr,i);
end;
PseudoPriv := Hstr;
End;
Function GetPwParm (* Nr : Byte; Zeile : Str80) : Str20 *);
Var i,i1 : Byte;
Begin
Zeile := ParmStr(2,B1,Zeile);
i := pos(LRK,Zeile);
i1 := pos(RRK,Zeile);
if (i = 1) and (i1 > 2) then
begin
delete(Zeile,1,1);
delete(Zeile,length(Zeile),1);
GetPwParm := ParmStr(Nr,Km,Zeile);
end else GetPwParm := '';
End;
Function Found_Pw_Call (* Zeile : Str80; Cstr : Str9; Alstr:Str9; AStr : Str6) : Boolean *);
Var i : Byte;
Flag : Boolean;
Begin
KillEndBlanks(AStr);
Flag := pos(AStr,Zeile) = 1;
if Flag then
Repeat
Zeile := RestStr(Zeile);
Flag := Cstr = CutStr(Zeile);
if (not flag) and (length(alstr)>0) then Flag:=AlStr=CutStr(Zeile);
Until Flag or (length(Zeile) = 0);
Found_Pw_Call := Flag;
End;
Function Check_Parm (* Zeile : String) : String *);
Var i,i1 : Byte;
Bstr : String;
Begin
i := pos('> ',Zeile);
if i > 0 then delete(Zeile,1,i-1);
Bstr := '';
i := 0;
i1 := length(Zeile);
While i < i1 do
begin
inc(i);
if Zeile[i] in ['0'..'9',B1] then Bstr := Bstr + Zeile[i]
else Bstr := Bstr + B1;
end;
KillStartBlanks(Bstr);
KillEndBlanks(Bstr);
Check_Parm := Bstr;
End;
Procedure RMNC_Auswert (* Kanal : Byte; Zeile : Str80 *);
var i,iz : Integer;
PrivStr : String[80];
Bstr : String[20];
Found : Boolean;
Begin
with K[Kanal]^ do
begin
While pos(B1,Zeile) > 0 do Zeile := RestStr(Zeile);
While pos(M1,Zeile) > 0 do Zeile[pos(M1,Zeile)] := B1;
While pos(^J,Zeile) > 0 do Zeile[pos(^J,Zeile)] := B1;
While pos(RSK,Zeile) > 0 do Zeile[pos(RSK,Zeile)] := B1;
KillStartBlanks(Zeile);
KillEndBlanks(Zeile);
if str_int(Zeile) > 0 then
begin
if PassRetry <> PassRight then
begin
Repeat
iz := Random(255);
Until iz in [21..255];
InfoOut(Kanal,0,1,ParmStr(2,B1,InfoZeile(241)) + B2 + Zeile + PfStr + int_str(iz));
S_PAC(Kanal,NU,true,int_str(iz) + M1);
end else
begin
PrivStr := Zeile;
Bstr := '';
for i := 1 to length(PrivStr) do if PrivStr[i] in ['0'..'9'] then
Bstr := Bstr + PrivStr[i];
While length(Bstr) < 5 do Bstr := '0' + Bstr;
Assign(G^.TFile,Sys1Pfad + PwDatei);
FiResult := ResetTxt(G^.TFile);
Found := false;
Repeat
Readln(G^.TFile,PrivStr);
if Found_Pw_Call(PrivStr,Call,Alias,SysopArt) then Found := true;
Until Found or Eof(G^.TFile);
if Found then
begin
iz := 0;
Readln(G^.TFile,PrivStr);
for i := 1 to length(Bstr) do
iz := iz + (str_int(Bstr[i]) * str_int(PrivStr[i]));
InfoOut(Kanal,0,1,ParmStr(1,B1,InfoZeile(241)) + B2 + Zeile + PfStr + int_str(iz));
S_PAC(Kanal,NU,true,int_str(iz) + M1);
end else
begin
SysopParm := false;
InfoOut(Kanal,1,1,InfoZeile(171));
end;
FiResult := CloseTxt(G^.TFile);
end;
if PassRetry > 1 then S_PAC(Kanal,NU,true,SysopStr + M1);
dec(PassRetry);
if PassRetry < 1 then SysopParm := false;
end;
end;
End;
Procedure TheNet_SYS_Auswert (* (Kanal : Byte; Zeile : String) *);
var i,i1,r,
AnzParam : Byte;
PsConst,
PwConst : Byte;
Dstr,
Rstr,
Pstr,
Hstr : String;
Found : Boolean;
Begin
with K[Kanal]^ do
begin
{** FBB-Erg„nzung: Call bis einschlieálich '> ' absensen **}
if (SysArt=3) then
begin
if Pos('> ', Zeile)>0 then Delete(Zeile,1,Pos('> ',Zeile)+2);
i:=Pos('[',Zeile);
if i>0 then
begin
i1:=Pos(']',Zeile);
if (i1>i+10) and (i1<i+14) and (i1>i) then delete(zeile, i, i1-i+1);
end;
end;
if (SysArt=8) or ((SysArt=0) and (UserArt=1)) then
begin
if Pos('} ', Zeile)>0 then Delete(Zeile,1,Pos('} ',Zeile)+2);
end;
if Zeile[length(Zeile)]=#13 then PwMerk:='';
Zeile:=PwMerk+Zeile;
Zeile := Check_Parm(Zeile);
Pstr := ParmStr(1,B1,Zeile);
AnzParam := ParmAnz;
Pstr := '';
Assign(G^.TFile,Sys1Pfad + PwDatei);
FiResult := ResetTxt(G^.TFile);
Repeat
Readln(G^.TFile,Hstr);
Found := Found_Pw_Call(Hstr,Call,Alias,SysopArt);
Until Found or Eof(G^.TFile);
if Found then
begin
Dstr := Hstr;
if SysArt = 11 then PwConst := 4
else PwConst := 5;
if AnzParam = PwConst then
begin
PWMerk:='';
PsConst := Byte(str_int(GetPwParm(2,Dstr)));
if PassRetry <> PassRight then
begin
Pstr := PseudoPriv(PsConst,'',Dstr);
InfoOut(Kanal,0,1,ParmStr(2,B1,InfoZeile(241)) + B2 +
Zeile + PfStr + copy(Pstr,1,PwConst));
S_PAC(Kanal,NU,true,Pstr + M1);
end else
begin
Pstr := '';
Readln(G^.TFile,Hstr);
for i := 1 to PwConst do
begin
i1 := Byte(str_int(ParmStr(i,B1,Zeile)));
Pstr := Pstr + copy(Hstr,i1,1);
end;
Rstr := Pstr;
if PsConst > PwConst then Pstr := PseudoPriv(PsConst,Pstr,Dstr);
InfoOut(Kanal,0,1,
ParmStr(1,B1,InfoZeile(241)) + B2 + Zeile + PfStr + Rstr);
S_PAC(Kanal,NU,true,Pstr + M1);
MailPWWait:=false;
MailPrompt:='';
end;
if PassRetry > 1 then S_PAC(Kanal,NU,true,SysopStr + M1);
dec(PassRetry);
if PassRetry < 1 then SysopParm := false;
end else {AnzParm = PwConst}
begin
if Zeile[length(zeile)]<>#13 then PWMerk:=Zeile else PWMerk:='';
end;
end else
begin
SysopParm := false;
if First_Frame then InfoOut(Kanal,1,1,InfoZeile(171));
end;
FiResult := CloseTxt(G^.TFile);
end;
End;
Procedure EZBOX_Auswert (* Kanal : Byte; Zeile : Str80 *);
var b,i,i1 : Byte;
Pstr : String[4];
Rstr : String[20];
Hstr : String[80];
Found : Boolean;
Begin
with K[Kanal]^ do
begin
if (copy(Zeile,1,1) = LRK) and (copy(Zeile,length(Zeile),1) = RSK) then
begin
delete(Zeile,1,1);
delete(Zeile,length(Zeile),1);
KillEndBlanks(Zeile);
delete(Zeile,length(Zeile),1);
While pos('.',Zeile) > 0 do Zeile[pos('.',Zeile)] := B1;
Rstr := Zeile;
Assign(G^.TFile,Sys1Pfad + PwDatei);
FiResult := ResetTxt(G^.TFile);
Repeat
Readln(G^.TFile,Hstr);
Found := Found_Pw_Call(Hstr,Call,Alias,SysopArt);
Until Found or Eof(G^.TFile);
if Found then
begin
Pstr := '';
Readln(G^.TFile,Hstr);
b := Ord(Hstr[Byte(str_int(CutStr(Zeile)))]);
Zeile := RestStr(Zeile);
for i := 1 to 4 do
begin
i1 := Byte(b + Byte(str_int(CutStr(Zeile))));
i1 := i1 mod 80;
if i1 = 0 then i1 := 80;
Pstr := Pstr + Hstr[i1];
Zeile := RestStr(Zeile);
end;
InfoOut(Kanal,0,1,ParmStr(1,B1,InfoZeile(241)) + B2 + Rstr + PfStr + Pstr);
S_PAC(Kanal,NU,true,Pstr + M1);
end else InfoOut(Kanal,1,1,InfoZeile(171));
SysopParm := false;
FiResult := CloseTxt(G^.TFile);
end;
end;
End;

974
XPQTH.PAS Executable file
View file

@ -0,0 +1,974 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P Q T H . P A S ³
³ ³
³ QTH-Kennerberechnung nach Routinen von DL5FBD (QTHBER V2.2) ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
(***********************************************************)
(* Funktionsprozeduren und Funktionen zur QTH-Kennerbe- *)
(* rechnung in Turbo-Pascal *)
(* UNIT QTHBER V2.2 von G. M. Ritter DL5FBD Juni 1993 *)
(***********************************************************)
(***********************************************************)
(* Procedure Entfernung_Richtung *)
(* Die Prozedur dient zur Berechnung von Entfernung und *)
(* Richtung bei gegebenen geografischen Koordinaten im *)
(* Gradmass. *)
(* Ergebnis sind Entfernung in Kilometern und Richtung in *)
(* Grad von QTH1 nach QTH2. *)
(* O1,N1 Oestliche Laenge,Noerdliche Breite von QTH1 *)
(* O2,N2 Oestliche Laenge,Noerdliche Breite von QTH2 *)
(***********************************************************)
PROCEDURE Entfernung_Richtung (O1,N1,O2,N2 :REAL;
VAR Entfernung,Richtung :REAL);
CONST PI=3.1415926; (*Kreiskonstante PI *)
VAR EW,RV :REAL; (*EW Entfernungswinkel *)
(*RV vorlaeufige Richtg*)
(* Funktion GSIN *)
(* Berechnung des Sinus zu einem gegebenen Gradwinkel *)
FUNCTION GSIN(WINKEL :REAL):REAL;
BEGIN
GSIN:=SIN(Winkel*PI/180);
END;
(* Funktion GCOS *)
(* Berechnung des Cosinus zu einem gegebenen Gradwinkel *)
FUNCTION GCOS(WINKEL :REAL):REAL;
BEGIN
GCOS:=COS(Winkel*PI/180);
END;
(* Funktion ARCGCOS *)
(* Berechnung des Gradwinkels zum gegebenen Cosinuswert *)
FUNCTION ARCGCOS(COSINUS :REAL) :REAL;
VAR ARCBOG :REAL; (*Hilfsvariable vor Gradumrechnung*)
BEGIN
IF COSINUS>= 1 THEN ARCGCOS:= 0 (*Sonderfall 0 Grad*)
ELSE IF COSINUS<=-1 THEN ARCGCOS:=180 (*Sonderfall 180 Grad*)
ELSE BEGIN
ARCBOG:=PI/2-ARCTAN(COSINUS/(SQRT(1-SQR(COSINUS))));
(*Umrechnung vom Bogenmaá in Grad*)
ARCGCOS:=ARCBOG*180/PI;
END;
END;
(* Beginn der eigentlichen Entfernungs-Richtungsberechnung *)
BEGIN
(* Entfernungsberechnung *)
EW:=arcgcos(gsin(n1)*gsin(n2)+gcos(n1)*gcos(n2)*gcos(o2-o1));
Entfernung:=40009/360*EW;
(* Richtungsberechnung *)
RV:=arcgcos((gsin(n2)-gsin(n1)*gcos(ew))/(gcos(n1)*gsin(ew)));
If gsin(o2-o1)>=0 then Richtung:=RV;
IF gsin(o2-o1)< 0 then Richtung:=360-RV;
END;
(*********** Ende PROCEDURE Entfernung_Richtung ************)
(***********************************************************)
(* FUNCTION NEU_Pruefen *)
(* Diese FUNCTION dient zur Pruefung ob der uebergebene *)
(* QTH-Kenner ein korrektes Format hat. *)
(* Funktionsergebnis TRUE=OK FALSE=ungueltiger Kenner *)
(* QTHKENN zu pruefender neuer QTH-Kenner als String *)
(* VERGLEICH[I] Mengenfeld zur Gueltigkeitspruefung *)
(* I Index fuer ARRAY-Operationen *)
(***********************************************************)
FUNCTION NEU_Pruefen (QTHKENN :STRING):BOOLEAN;
TYPE MENGE = SET OF CHAR;
CONST VERGLEICH :array [1..6] of MENGE (* Definitionsmenge des.. *)
= (['A'..'R','a'..'r'], (* 1. Zeichen *)
['A'..'R','a'..'r'], (* 2. Zeichen *)
['0'..'9'], (* 3. Zeichen *)
['0'..'9'], (* 4. Zeichen *)
['A'..'X','a'..'x'], (* 5. Zeichen *)
['A'..'X','a'..'x']); (* 6. Zeichen *)
VAR I :byte;
BEGIN
IF LENGTH(QTHKENN)=6 THEN
BEGIN
NEU_Pruefen:=TRUE;
For I:=1 to 6 do
BEGIN
IF NOT(QTHKENN[I] IN VERGLEICH[I]) then NEU_Pruefen:=FALSE;
END;
END
ELSE NEU_Pruefen:=false;
END;
(***********************************************************)
(* FUNCTION ALT_Pruefen *)
(* Diese FUNCTION dient zur Pruefung ob der uebergebene *)
(* QTH-Kenner ein korrektes Format hat. *)
(* Funktionsergebnis TRUE=OK FALSE=ungueltiger Kenner *)
(* QTHKENN zu pruefender neuer QTH-Kenner als String *)
(* VERGLEICH[I] Mengenfeld zur Gueltigkeitspruefung *)
(* I Index fuer ARRAY-Operationen *)
(* MINFO Mittelfeldziffer f<>r Bereichspruefung der *)
(* Mittelfelder 10-70 wegen unstetiger Kodierung *)
(***********************************************************)
FUNCTION ALT_Pruefen (QTHKENN :STRING):BOOLEAN;
TYPE MENGE = SET OF CHAR;
CONST VERGLEICH :array [1..7] of MENGE (* Definitionsmenge des..*)
= (['A'..'Z','a'..'z'], (* 1. Zeichen *)
['A'..'Z','a'..'z'], (* 2. Zeichen *)
['0'..'8'], (* 3. Zeichen *)
['0'..'9'], (* 4. Zeichen *)
['A'..'H','a'..'h','J','j'], (* 5. Zeichen *)
['/'], (* 6. Zeichen *)
['1'..'4']); (* 7. Zeichen *)
VAR I :byte;
MFINFO :string[2];
BEGIN
IF (LENGTH(QTHKENN)=5) OR (LENGTH(QTHKENN)=7) THEN
BEGIN
ALT_Pruefen:=TRUE;
(*Jedes Kodezeichen des QTH-Kenners auf Gueltigkeit ueberpruefen*)
For I:=1 to LENGTH(QTHKENN) do
BEGIN
IF NOT(QTHKENN[I] IN VERGLEICH[I]) THEN ALT_Pruefen:=FALSE;
END;
(* sowie unerlaubte Mittelfeldkodierungen ausschliessen *)
MFINFO:=Copy(QTHKENN,3,2);
IF (MFINFO='00') OR (MFINFO>'80') THEN ALT_Pruefen:=false;
END
ELSE ALT_Pruefen:=false;
END;
(***********************************************************)
(* PROCEDURE NEU_IN_WINKEL *)
(* Diese Procedure dient zum Umwandeln eines neuen QTH- *)
(* kenners in geografische Laenge und Breite *)
(* I Indexvariable fuer Feldzuweisung *)
(* OESLAE Oestliche Laenge als Gleitkommawinkel *)
(* NOEBRE Noerdliche Breite als Gleitkommawinkel *)
(* QTHKENN QTH-Kenner als STRING *)
(* WIINFO[6] Feld der QTH-Kennerindexziffern *)
(* ASCKOR[6] Hilfsfeld zur ASCII-Indexziffernumrechnung *)
(* Maske [6] Hilfsfeld zur Grossschrifteinstellung *)
(***********************************************************)
PROCEDURE NEU_IN_WINKEL (QTHKENN :STRING; VAR OESLAE,NOEBRE :REAL);
CONST ASCKOR :array [1..6] of byte = (065,065,048,048,065,065);
MASKE :array [1..6] of byte = (223,223,255,255,223,223);
VAR I :byte;
WIINFO :array [1..6] of byte;
BEGIN
(* Ermittlung der Indexziffern aus dem QTH-Kenner *)
For I:=1 to 6 do
BEGIN
WIINFO[I]:=(ORD(qthkenn[I]) AND MASKE[I])-ASCKOR[I];
END;
(* Berechnung der geografischen Koordinate aus den Indexziffern *)
OESLAE:=-180+WIINFO[1]*20+WIINFO[3]*2+WIINFO[5]/12+1/24;
NOEBRE:= -90+WIINFO[2]*10+WIINFO[4]*1+WIINFO[6]/24+1/48;
END;
(************* Ende PROCEDURE NEU_IN_WINKEL ****************)
(***********************************************************)
(* PROCEDURE ALT_IN_WINKEL *)
(* Diese Procedure dient zum Umwandeln eines alten QTH- *)
(* kenners in geografische Laenge und Breite *)
(* I Indexvariable fuer Feldzuweisung *)
(* OESLAE Oestliche Laenge als Gleitkommawinkel *)
(* NOEBRE Noerdliche Breite als Gleitkommawinkel *)
(* QTHKENN QTH-Kenner als STRING *)
(* WIINFO[5] Feld der QTH-Kennerindexziffern *)
(* ASCKOR[5] Hilfsfeld zur ASCII-Indexziffernumrechnung *)
(* Maske [5] Hilfsfeld zur Grossschrifteinstellung *)
(* KLOST [10] Hilfsfeld zur Kleinfeldlaengenzuweisung *)
(* KLNORD [10] Hilfsfeld zur Kleinfeldbreitenzuweisung *)
(* A INDEX fuer Quadrantenursprungszuweisung 1-4 *)
(* ALTURN [4] Feld fuer die 4 noerdlichen Ursprungsbreiten *)
(* ALTURO [4] Feld fuer die 4 oestlichen Ursprungslaengen *)
(***********************************************************)
PROCEDURE ALT_IN_WINKEL (QTHKENN :STRING; VAR OESLAE,NOEBRE :REAL);
CONST ASCKOR :array [1..5] of byte = (065,065,048,048,064);
MASKE :array [1..5] of byte = (223,223,255,255,223);
KLNORD :array [1..10] of ShortInt = (-1,-1,-3,-5,-5,-5,-3,-1,0,-3);
KLOST :array [1..10] of ShortInt = ( 3, 5, 5, 5, 3, 1, 1, 1,0, 3);
ALTURO :array [1..4] of ShortInt = (-52, 0,-52, 0);
ALTURN :array [1..4] of ShortInt = ( 40, 40, 14, 14);
VAR I :byte;
A :byte;
H :Integer; (* Dummivariable fuer VAL-Procedure*)
WIINFO :array [1..5] of byte;
BEGIN
(* Ermittlung des Feldursprungs aus der Quadrantenkennziffer *)
IF LENGTH(QTHKENN)=7 THEN VAL(QTHKENN[7],A,H)
ELSE A:=2;
(* Ermittlung der Indexziffern aus dem QTH-Kenner *)
For I:=1 to 5 do
BEGIN
WIINFO[I]:=(ORD(qthkenn[I]) AND MASKE[I])-ASCKOR[I];
END;
(* Berechnung der geografischen Koordinate aus den Indexziffern *)
OESLAE:=ALTURO[A]+WIINFO[1]*2 +(WIINFO[4]-1)*0.2 +KLOST [WIINFO[5]]/30;
NOEBRE:=ALTURN[A]+(WIINFO[2]+1)*1+WIINFO[3]*(-0.125)+KLNORD[WIINFO[5]]/48;
(* Korrektur des systematischen Fehlers bei den oestlichsten Mittelfeldern *)
IF WIINFO[4] = 0 THEN
BEGIN
OESLAE:=OESLAE+2;
NOEBRE:=NOEBRE+0.125;
END;
END;
(************* Ende PROCEDURE ALT_IN_WINKEL ****************)
(***********************************************************)
(* PROCEDURE GRAD_UMW *)
(* Diese Procedure wandelt eine als String uebergebene *)
(* geografische Koordinate im Format +GGG:MM:SS/-GG:MM:SS *)
(* mit Unterlaengen +GG:MM und -GG in die entsprechenden *)
(* Gleitkommawinkel um. (Oestl. Laenge/Noerd. Breite) *)
(* Uebergeben wird der Koordinatenstr. und zurueck werden *)
(* die Gleitkommawinkel und eine Statusvariable uebergeben *)
(* Ist diese False so ist ein Formatfehler entdeckt worden *)
(* und die uebergebenen Winkelparameter undefiniert. *)
(* QTHKENN Koordinatenstring *)
(* OESLAE Oestliche Laenge als REAL-Zahl *)
(* NOEBRE Noerdliche Breite als REAL-Zahl *)
(* STATUS TRUE Umwandlung erfolgreich vorgenommen *)
(* FALSE Formatfehler entdeckt oder Bereichs- *)
(* fehler der Koordinatenwinkel *)
(* MENGE Definition des Stringmengentyps *)
(* REFERENZ Gueltige Elementemenge von QTHKENN *)
(* RASTER Feld der gueltigen Formatraster von QTHKENN *)
(* I Index fuer Feldzugriffe *)
(* P Position des Trennzeichens '/' in QTHKENN *)
(* und Kontrollvariable fuer VAL-Funktion *)
(* OES,NOE String der oestlichen Laenge,noerdl. Breite *)
(* zur Umwandlung in den Gleitkommawinkel *)
(* VERGLEICH Strukturabbild von QTHKENN zur Format- *)
(* pruefung des Koordinatenstrings *)
(* LAENGE Laenge von QTHKENN fuer Abfrageschleifen *)
(***********************************************************)
PROCEDURE GRAD_UMW (QTHKENN :STRING;
VAR OESLAE,NOEBRE :REAL;
VAR STATUS :BOOLEAN);
(***********************************************************)
(* FUNCTION GMS_UMW *)
(* Die Funktion dient zur Umwandlung des Laengen und *)
(* Breitengradstring in den entsprechenden Gleitkommawinkel*)
(* GMS Stringteil mit Winkelinformation +GG:MM:SS *)
(* UMWAND Gleitkommawinkel *)
(* REST Teilstring fuer Entnahme der GG,MM,SS-Info *)
(* POSI Position des Trennzeichens ':' in REST *)
(* VORZEI Vorzeichenfaktor des Winkels +1 oder -1 *)
(* I Potenz des Minuten und Sekundenfaktors zur *)
(* BASIS 60 fuer Gleitkommawinkelberechnung *)
(* D Fehlerposition fuer VAL-Procedure *)
(* Teil Enthaelt Ziffernfaktor fuer Grad,Min.,Sekunden *)
(* Summe Teil- und Endsumme des Gleitkommawinkels *)
(***********************************************************)
FUNCTION GMS_UMW (GMS :String):REAL;
VAR REST : STRING;
POSI : BYTE;
VORZEI : ShortInt;
I : BYTE;
D : INTEGER;
Teil : REAL;
SUMME : REAL;
BEGIN
I:=0;
SUMME:=0;
REST:=GMS;
IF GMS[1]='-' THEN VORZEI:=-1 (*Vorzeichen ent- *)
ELSE VORZEI:=1; (*nehmen *)
REPEAT
(* Winkelinformation in Grad,Min. oder Sekunden entnehmen*)
VAL(REST,TEIL,D);
IF D<>0 THEN VAL((COPY(REST,1,D-1)),TEIL,D);
(* Winkelinformation gemaess Wertigkeitsfaktor aufsummieren *)
(* Wertigkeitsfaktor Grad=1 ,Min.=1/60hoch1 ,Sek.=1/60hoch2 *)
IF I=0 THEN SUMME:=TEIL
ELSE SUMME:=SUMME+VORZEI*TEIL/(EXP(LN(60)*I));
I:=I+1;
(* Pruefen ob noch eine Information in REST ist *)
(* wenn ja dann REST um bearbeiteten TEIL kuerzen *)
POSI:=POS(':',REST);
REST:=Copy(REST,POSI+1,(LENGTH(REST)-POSI));
UNTIL POSI=0; (* Wenn keine Info in REST mehr dann Ende *)
GMS_UMW := SUMME
END;
(**********************************************************)
(* Hier beginnt GRAD_UMW() *)
(**********************************************************)
TYPE MENGE = SET OF CHAR;
CONST REFERENZ :MENGE = ['0'..'9','+','-','/',':','.']; (* Definitionsmenge *)
RASTER :array[1..10] of string
= ('VZ:Z:Z/VZ:Z:Z' , 'VZ:Z:Z/VZ:Z' , 'VZ:Z:Z/VZ' ,
'VZ:Z/VZ:Z:Z' , 'VZ:Z/VZ:Z' , 'VZ:Z/VZ' ,
'VZ/VZ:Z:Z' , 'VZ/VZ:Z' , 'VZ/VZ' ,
'VZ.Z/VZ.Z');
VAR I :Byte;
P :Integer;
OES,NOE,
VERGLEICH :STRING;
LAENGE :BYTE;
BEGIN
(* 1. Stringformat und Zeichengueltigkeit ueberpruefen *)
(* 2. Wenn gueltig in Gleitkommawinkel umwandeln und *)
(* danach Gueltigkeitspruefung der Winkel vornehmen *)
(* 3. Wenn auch das in Ordnung Winkel und STATUS=TRUE *)
LAENGE:=LENGTH(QTHKENN);
IF LAENGE<=20 THEN
BEGIN
(* Ueberpruefung von Format und Inhalt der Stringinformation *)
VERGLEICH:='';
For I:=1 to LAENGE do
BEGIN
IF NOT(QTHKENN[I] IN REFERENZ) THEN VERGLEICH:=VERGLEICH+'?'
ELSE
BEGIN
IF QTHKENN[I] IN ['+','-'] THEN VERGLEICH:=VERGLEICH+'V';
IF QTHKENN[I] ='/' THEN VERGLEICH:=VERGLEICH+'/';
IF QTHKENN[I] =':' THEN VERGLEICH:=VERGLEICH+':';
IF QTHKENN[I] ='.' THEN VERGLEICH:=VERGLEICH+'.';
IF QTHKENN[I] IN ['0'..'9'] THEN
BEGIN
P:=LENGTH(VERGLEICH);
IF VERGLEICH[P]<>'Z' THEN VERGLEICH:=VERGLEICH+'Z';
END;
END;
END;
(* Vorzeichenkennungen fuer Schreibfaule nachtragen *)
IF VERGLEICH[1]='Z' THEN Insert('V',VERGLEICH,1);
P:=Pos('/',VERGLEICH)+1;
IF VERGLEICH[P]='Z' THEN Insert('V',VERGLEICH,P);
(* Abfrage ob Vergleichsraster einem der gueltigen *)
(* Raster entspricht *)
STATUS:=False;
FOR I:=1 to 10 do
STATUS:=STATUS OR (VERGLEICH = RASTER[I]);
END
ELSE STATUS := FALSE;
(* 3. Zeichenkette in Koordinaten umwandeln wenn in Ordnung *)
IF STATUS THEN
BEGIN
P:=POS('/',QTHKENN);
OES:=Copy(QTHKENN,1,P-1);
NOE:=Copy(QTHKENN,P+1,(LAENGE-P));
IF POS('.',OES) > 0 THEN VAL(OES,OESLAE,P)
ELSE OESLAE := GMS_UMW(OES);
IF POS('.',NOE) > 0 THEN VAL(NOE,NOEBRE,P)
ELSE NOEBRE := GMS_UMW(NOE);
IF ABS(NOEBRE) > 90 THEN STATUS := False;
IF ABS(OESLAE) > 180 THEN STATUS := False;
END;
END;
(**********************************************************)
(* Procedure QTH_ENTFG_RICHTG *)
(* Diese Procedure berechnet bei Uebergabe von zwei QTH- *)
(* Kennern Entfernung und Richtung zwischen den QTHs. *)
(* Gueltige QTH-Kenner bzw. Koordinaten sind: *)
(* 1. Der neue QTH-Kenner z.B. JO40HC *)
(* 2. Der alte QTH-Kenner mit Regionskennziffer 1-4 *)
(* z.B. EK74H/3 *)
(* 3. Eine geografische Koordinate (Laenge/Breite) *)
(* im Format +GGG:MM:SS/-GG:MM:SS GG=Grad,MM=Minuten *)
(* und SS=Sekunden *)
(* Minuten und Sekunden koennen weggelassen werden *)
(* Die Procedure ordnet automatisch die eingegebenen QTH- *)
(* kenner richtig zu und veranlasst bei korrektem Format *)
(* die Berechnung von Entfernung und Richtung *)
(* QTH1,QTH2 QTH-Kenner QTH1=Bezug fuer Richtung *)
(* ENTFG Entfernung zwischen den QTHs *)
(* RICHTG Richtung von QTH1 nach QTH2 *)
(* STATUS BOOLEAN FALSE=QTH-Kennerformatfehler bei *)
(* Auswertung entdeckt *)
(* QTH[2] Stringfelder fuer QTH1,QTH2 *)
(* WINKEL[K] Realfelder fuer OESLAE,NOEBRE1 und ..2 *)
(* I Feldindex fuer QTH[I] *)
(* K Feldindex fuer WINKEL[K] *)
(* LAENGE Laenge des aktuellen QTH-Kennerstrings *)
(**********************************************************)
PROCEDURE QTH_ENTFG_RICHTG (QTH1 : STRING;
QTH2 : STRING;
VAR
ENTFG,
RICHTG : REAL;
VAR
STATUS : BOOLEAN);
VAR QTH : array[1..2] of STRING;
Winkel : array[1..4] OF REAL;
I : byte;
K : ShortInt;
LAENGE : Byte;
BEGIN
QTH[1]:=QTH1;
QTH[2]:=QTH2;
K:=-1;
STATUS:=TRUE;
FOR i:=1 TO 2 DO
IF STATUS=TRUE THEN
BEGIN
LAENGE:=Length(QTH[I]);
K:=K+2;
(* QTH-Kenner ist geografische Koordinate? *)
IF QTH[I][1] IN ['+','-','0'..'9'] THEN
BEGIN
GRAD_UMW (QTH[I],WINKEL[K],WINKEL[K+1],STATUS);
END
(* Alter QTH-Kenner mit Feldkennung? *)
ELSE IF LAENGE IN [5,7] THEN
BEGIN
IF ALT_PRUEFEN(QTH[I])=TRUE THEN
BEGIN
ALT_IN_WINKEL(QTH[I],WINKEL[K],WINKEL[K+1]);
END
ELSE STATUS:=False;
END
(* Neuer QTH-Kenner *)
ELSE IF LAENGE=6 THEN
BEGIN
IF NEU_PRUEFEN(QTH[I])=TRUE THEN
BEGIN
NEU_IN_WINKEL(QTH[I],WINKEL[K],WINKEL[K+1]);
END
ELSE STATUS:=False;
END
(* Format nicht zuzuordnen *)
ELSE STATUS:=False;
END;
(* Berechnung wenn kein Formatfehler *)
IF STATUS=TRUE THEN
BEGIN
ENTFERNUNG_RICHTUNG(WINKEL[1],WINKEL[2],WINKEL[3],WINKEL[4],
ENTFG,RICHTG);
END;
END;
(************ Ende PROCEDURE QTH_ENTFG_RICHTG *************)
(**********************************************************)
(* Procedure QTH_Pruefen *)
(* Diese Procedure berechnet bei Uebergabe eines QTH- *)
(* Kennern die geografische Koordinate des QTH-Kenners *)
(* als Gleitkommawinkel *)
(* Gueltige QTH-Kenner bzw. Koordinaten sind: *)
(* 1. Der neue QTH-Kenner z.B. JO40HC *)
(* 2. Der alte QTH-Kenner mit Regionskennziffer 1-4 *)
(* z.B. EK74H/3 *)
(* 3. Eine geografische Koordinate (Laenge/Breite) *)
(* im Format +GGG:MM:SS/-GG:MM:SS GG=Grad,MM=Minuten *)
(* und SS=Sekunden *)
(* Minuten und Sekunden koennen weggelassen werden *)
(* Die Procedure ordnet automatisch die eingegebenen QTH- *)
(* kenner richtig und ueberprueft veranlasst deren Prue- *)
(* fung und Umrechnung *)
(* QTH QTH-Kenner *)
(* STATUS BOOLEAN FALSE=QTH-Kennerformatfehler bei *)
(* Auswertung entdeckt *)
(* LAENGE Laenge des aktuellen QTH-Kennerstrings *)
(* OESLAE Oestliche Laenge als Gleitkommazahl *)
(* NOEBRE Noerdliche Breite als Gleitkommazahl *)
(**********************************************************)
PROCEDURE QTH_Pruefen(QTH : STRING;
VAR
OESLAE,
NOEBRE : REAL;
VAR
STATUS : BOOLEAN);
VAR I : byte;
K : ShortInt;
LAENGE : Byte;
BEGIN
STATUS:=TRUE;
Laenge:=Length(QTH);
(* QTH-Kenner ist geografische Koordinate? *)
IF QTH[1] IN ['+','-','0'..'9'] THEN GRAD_UMW (QTH,OESLAE,NOEBRE,STATUS)
(* Alter QTH-Kenner mit Feldkennung? *)
ELSE IF LAENGE IN [5,7] THEN
BEGIN
IF ALT_PRUEFEN(QTH)=TRUE THEN ALT_IN_WINKEL(QTH,OESLAE,NOEBRE)
ELSE STATUS:=False;
END
(* Neuer QTH-Kenner *)
ELSE IF LAENGE=6 THEN
BEGIN
IF NEU_PRUEFEN(QTH)=TRUE THEN NEU_IN_WINKEL(QTH,OESLAE,NOEBRE)
ELSE STATUS:=False;
END
(* Format nicht einzuordnen *)
ELSE STATUS:=False;
END;
(*************** Ende PROCEDURE QTH_Pruefen ***************)
(**********************************************************)
(* FUNCTION WINKEL_IN_NEU *)
(* Diese FUNCTION ermittelt zu einer eingegebenen geo- *)
(* grafischen Koordinate den zugehoerigen neuen QTH-Kenner*)
(* und gibt diesen als String zurueck *)
(* OESLAE oestliche Laenge *)
(* NOEBRE noerdliche Breite *)
(* URS[I,K] Ursprungsoffset fuer Gross/Mittelfelder *)
(* BWF[I,K] Bewertungsfaktoren fuer Gross/Mittelfelder*)
(* ASCKOR[I,K] ASCIIOFFSET zur QTH-Kennerstringberechnung*)
(* BWFK[I] Bewertungsfaktoren fuer Kleinfelder *)
(* ZUORD[I,K] Zuordnungsindex zwischen 2D-Feld und Zei- *)
(* chenposition im QTH-Kenner *)
(* I,K Indezes fuer Feldoperationen *)
(* I=1 Oestliche Laenge *)
(* I=2 Noerdliche Breite *)
(* K=1 Grossfeldbearbeitung *)
(* K=2 Mittelfeldbearbeitung *)
(* K=3 Kleinfeldbearbeitung *)
(**********************************************************)
FUNCTION WINKEL_IN_NEU(OESLAE,NOEBRE :REAL):STRING;
CONST BWF :array[1..2,1..2] of BYTE = ((20,2) ,(10,1));
ASCKOR :array[1..2,1..3] of BYTE = ((65,48,65),(65,48,65));
BWFK :array[1..2] of BYTE = (12,24);
ZUORD :array[1..2,1..3] of BYTE = ((1,3,5),(2,4,6));
VAR WIINFO : BYTE;
REST :array[1..2] of REAL;
X : BYTE;
I : BYTE;
K : BYTE;
QTH : STRING;
BEGIN
REST[1] :=OESLAE+180;
REST[2] :=NOEBRE+90;
QTH:='';
FOR I:=1 to 2 DO
FOR K:=1 to 3 DO
BEGIN
IF K<>3 THEN
BEGIN
REST[I]:=REST[I]/BWF[I,K];
WIINFO:=TRUNC(REST[I]);
REST[I]:=(REST[I]-WIINFO)*BWF[I,K];
END
ELSE WIINFO:=TRUNC(REST[I]*BWFK[I]);
Insert((CHR(WIINFO+ASCKOR[I,K])),QTH,ZUORD[I,K]);
END;
WINKEL_IN_NEU:=QTH;
END;
(**********************************************************)
(* FUNCTION WINKEL_IN_ALT *)
(* Diese FUNCTION ermittelt zu einer eingegebenen geo- *)
(* grafischen Koordinate den zugehoerigen alten QTH-Kenner*)
(* und gibt diesen als String zurueck *)
(* OESLAE Oestliche Laenge *)
(* NOEBRE Noerdliche Breite *)
(* ASCKOR[I,K] ASCIIOFFSET zur QTH-Kennerstringberechnung*)
(* KLNORD[I] Bewertungsfaktor fuer Kleinfeldbreite *)
(* KLOST[I] Bewertungsfaktor fuer Kleinfeldlaenge *)
(* ZUORD[I,K] Zuordnungsindex zwischen 2D-Feld und Zei- *)
(* chenposition im QTH-Kenner *)
(* F1-F3[I,K] Bewertungsfaktoren in normierter Funktion *)
(* V1-V2[I,K] Vorzeichenfaktoren in normierter Funktion *)
(* O1-O2[I,K] Rechensummanden in normierter Funktion *)
(* Normierte Funktion ist die Berechnungs- *)
(* gleichung fuer die gemeinsamme Berechnung *)
(* der QTH-Kenner-Indexanteile in einer 2D- *)
(* Feldanordnung fuer Gross- und Mittelfeld *)
(* des alten QTH-Kenner analog der Berechnung*)
(* beim neuen QTH-Kenner *)
(* I,K Indezes fuer Feldoperationen *)
(* I=1 Oestliche Laenge *)
(* I=2 Noerdliche Breite *)
(* K=1 Grossfeldbearbeitung *)
(* K=2 Mittelfeldbearbeitung *)
(* K=3 Kleinfeldbearbeitung *)
(**********************************************************)
FUNCTION WINKEL_IN_ALT(OESLAE,NOEBRE :REAL):STRING;
CONST ALTURO :array[1..4] of ShortInt = (-52, 0,-52, 0);
ALTURN :array[1..4] of ShortInt = ( 40, 40, 14, 14);
KLNORD :array[1..10] of ShortInt = (1,1,3,5,5,5,3,1,7,3);
KLOST :array[1..10] of ShortInt = (3,5,5,5,3,1,1,1,7,3);
ASCKOR :array[1..2,1..2] of BYTE = ((65,48),(65,48));
F1 :array[1..2,1..2] of REAL = ((0.5,5),(1, 8));
F2 :array[1..2,1..2] of BYTE = ((2,30 ),(1,48));
F3 :array[1..2,1..2] of BYTE = ((1, 5 ),(1, 8));
V1 :array[1..2,1..2] of ShortInt = ((1, 1 ),(-1,1));
V2 :array[1..2,1..2] of ShortInt = ((-1,-1),(1,-1));
O1 :array[1..2,1..2] of ShortInt = (( 0,-1),(1, 0));
O2 :array[1..2,1..2] of ShortInt = (( 0, 1),(0, 0));
ZUORD :array[1..2,1..2] of byte = (( 1, 4),(2, 3));
VAR WIINFO :array[1..2,1..2] of BYTE;
REST :array[1..2,1..3] of REAL;
ALTFELD : BYTE;
I : BYTE;
K : BYTE;
QTH : STRING;
HILF : CHAR;
STATUS : BOOLEAN;
BEGIN
(* Gueltigkeitsbereich ueberpruefen *)
STATUS:=TRUE;
IF (OESLAE <-52) OR (OESLAE >=52) THEN STATUS:=FALSE;
IF (NOEBRE < 14) OR (NOEBRE > 66) THEN STATUS:=FALSE;
IF STATUS=TRUE THEN
BEGIN
(* Alt-QTH-Kennerfeld zuweisen *)
IF (OESLAE>=-52) AND (OESLAE< 0) AND (NOEBRE> 40) THEN ALTFELD:=1;
IF (OESLAE>= 0) AND (OESLAE<52) AND (NOEBRE> 40) THEN ALTFELD:=2;
IF (OESLAE>=-52) AND (OESLAE< 0) AND (NOEBRE<=40) THEN ALTFELD:=3;
IF (OESLAE>= 0) AND (OESLAE<52) AND (NOEBRE<=40) THEN ALTFELD:=4;
(* QTH-Kenner-STRING zusammenrechnen und setzen *)
QTH:=' / ';
(* Gross- und Mittelfeldanteile berechnen *)
REST[1,1]:=OESLAE-ALTURO[ALTFELD];
REST[2,1]:=NOEBRE-ALTURN[ALTFELD];
FOR I:=1 TO 2 DO
FOR K:=1 TO 2 DO
BEGIN
REST[I,K]:=REST[I,K]*F1[I,K];
WIINFO[I,K]:=TRUNC(REST[I,K])+O2[I,K];
REST[I,K+1]:=(V1[I,K]*REST[I,K]+V2[I,K]*(WIINFO[I,K]+O1[I,K]))
*F2[I,K]/F3[I,K];
END;
(* Korrektur bei oestlichstem Mittelfeld ausfuehren *)
IF WIINFO[1,2]=10 THEN BEGIN
WIINFO[1,2]:=0;
WIINFO[2,2]:=WIINFO[2,2]+1;
END;
(* Kleinfeld zuweisen *)
FOR I:=1 to 10 DO
IF (ABS(REST[2,3]-KLNORD[I])<=1)
AND
(ABS(REST[1,3]-KLOST[I])<=1) THEN
BEGIN
QTH[5]:=CHR(I+64);
END;
(* QTH-Kennerstring [1..4,7] zusammenbauen *)
QTH[7]:=CHR(ALTFELD+48);
FOR I:=1 TO 2 DO
FOR K:=1 TO 2 DO
BEGIN
QTH[ZUORD[I,K]]:=CHR(ASCKOR[I,K]+WIINFO[I,K]);
END;
WINKEL_IN_ALT:=QTH;
END
ELSE WINKEL_IN_ALT:='-------';
END;
(**********************************************************)
(* FUNCTION WINKEL_IN_GMS *)
(* Diese FUNCTION berechnet aus den Gleitkommawinkelkoor- *)
(* dinaten einen STRING im Format GRAD:MINUTEN:SEKUNDEN *)
(* und gibt als Ergebnis den Formatstring GG:MM:SS zurueck*)
(* OESLAE Oestliche Laenge *)
(* NOEBRE Noerdliche Breite *)
(* RUND[I] Rundungsparameter Sekunde wird aufgerundet *)
(* K,I Indexzaehler fuer Arrayoperationen *)
(* REST[K] Feld der Restwerte der Winkel *)
(* HILF[K,I] Feld der Koordinatenparameter *)
(* I=1 Grad I=2 Minuten I=3 Sekunden *)
(* K=1 Oestliche Laenge K=2 Noerdliche Breite *)
(* TEIL Hilfsstring zur Stringermittlung *)
(* QTH Ermittelter String *)
(* VZ[K] Vorzeichen des Winkels als Summationsfaktor *)
(* und fuer Abfragen (+1 oder -1) *)
(**********************************************************)
Function WINKEL_IN_GMS(OESLAE,NOEBRE:REAL):STRING;
CONST RUND :array[1..3] of REAL = (0,0,0.5);
VAR K : BYTE;
I : BYTE;
REST :array[1..2] of REAL;
HILF :array[1..2,1..3] of INTEGER;
TEIL : STRING[3];
QTH : STRING;
VZ :array[1..2] of ShortInt;
BEGIN
QTH:='';
REST[1]:=OESLAE;
REST[2]:=NOEBRE;
(* Grad,Minuten und Sekunden ermitteln *)
FOR K:=1 TO 2 DO
BEGIN
IF REST[K]<0 THEN VZ[K]:=-1
ELSE VZ[K]:=1;
FOR I:=1 TO 3 DO
BEGIN
HILF[K,I]:=TRUNC(REST[K]+RUND[I]*VZ[K]);
REST[K]:=FRAC(REST[K])*60;
END;
END;
(* Koordinate bei Sekundenrundungsfehler "GG:MM:60" korrigieren *)
FOR K:=1 TO 2 DO
BEGIN
FOR I:=3 DOWNTO 2 DO
BEGIN
IF HILF[K,I]=(VZ[K]*60) THEN
BEGIN
HILF[K,I]:=0;
HILF[K,I-1]:=HILF[K,I-1]+VZ[K];
END;
END;
END;
(* Koordinatenstring zusammensetzen *)
FOR K:=1 TO 2 DO
BEGIN
FOR I:=1 TO 3 DO
BEGIN
IF (VZ[K]<0) AND (I=1) THEN QTH:=QTH+'-';
STR(ABS(HILF[K,I]),TEIL);
QTH:=QTH+TEIL;
IF I<3 THEN QTH:=QTH+':';
END;
IF K=1 THEN QTH:=QTH+'/';
END;
WINKEL_IN_GMS:=QTH;
END;
Procedure Compute_QTH (* Var Zeile : Str80 *);
Const DXC = 'DXC.DAT';
Var f : Text;
Flag : Boolean;
i,l,
AnzP : Byte;
Diff : ShortInt;
Entf,
Azim : Real;
Dstr : String[3];
Sstr : String[6];
Tstr : String[8];
Fstr : String[13];
QTH : String[20];
Nstr : String[40];
Lstr,
Rstr,
Hstr : String;
Begin
Hstr := ParmStr(3,B1,Zeile);
if Hstr[length(Hstr)] = DP then
begin
Flag := false;
Assign(f,SysPfad + DXC);
if ResetTxt(f) = 0 then
begin
Readln(f,Hstr);
QTH := ParmStr(4,B1,Hstr);
Fstr := ParmStr(5,B1,Zeile);
l := 0;
While not Eof(f) do
begin
Readln(f,Hstr);
Lstr := ParmStr(1,DP,Hstr);
Sstr := ParmStr(1,Km,Lstr);
ParmAnz := AnzP;
i := 0;
Repeat
inc(i);
Sstr := ParmStr(i,Km,Lstr);
if (pos(Sstr,Fstr) = 1) and (ord(Sstr[0]) > l) then
begin
Flag := true;
l := ord(Sstr[0]);
Rstr := Hstr;
end;
Until i >= AnzP;
end;
FiResult := CloseTxt(f);
if Flag then
begin
Lstr := ParmStr(1,DP,Rstr);
Zeile := EFillStr(27,B1,ParmStr(2,DP,Rstr));
Zeile := Zeile + 'Zone' + DP + SFillStr(3,B1,ParmStr(3,DP,Rstr)) + B2 + 'Dist' + DP;
Lstr := ParmStr(4,DP,Rstr);
Dstr := ParmStr(3,';',Lstr);
i := pos(Pkt,Dstr);
if i > 0 then Dstr := copy(Dstr,1,i-1);
Diff := ShortInt(str_int(Dstr));
Tstr := Uhrzeit;
Tstr := UtcZeit;
i := str_int(copy(Tstr,1,2));
i := i + 24 + Diff;
While i > 23 do i := i - 24;
Tstr := SFillStr(2,'0',int_str(i)) + DP + copy(Tstr,4,2);
QTH_ENTFG_RICHTG(QTH,ParmStr(2,';',Lstr) + '/' +
ParmStr(1,';',Lstr),Entf,Azim,Flag);
if Flag then
begin
Zeile := Zeile + SFillStr(6,B1,int_str(Round(Entf))) + B1 + 'km' + B3 + 'Beam' + DP +
SFillStr(4,B1,int_str(Round(Azim))) + 'ø' +
B3 + '(' + Tstr + ')';
end;
end else Zeile := '';
end else WishDXC := false;
end else Zeile := '';
End;

1771
XPREM.PAS Executable file
View file

File diff suppressed because it is too large Load diff

2042
XPSCROL.PAS Executable file
View file

File diff suppressed because it is too large Load diff

213
XPSETTAS.PAS Executable file
View file

@ -0,0 +1,213 @@
UNIT XPSetTas;
{ Unit zur Tastenauswertung }
INTERFACE
USES dos, CRT;
VAR Aktion,
AktionSeitLetztem : BOOLEAN;
klicks2 : INTEGER;
CONST
F1 = #180;
PgUp = #193;
F2 = #181;
PgDn = #194;
F3 = #182;
Pos1 = #195;
F4 = #183;
Ende = #196;
F5 = #184;
Einf = #197;
F6 = #185;
Entf = #198;
F7 = #186;
CsUp = #199;
F8 = #187;
CsDn = #200;
F9 = #189;
CsRt = #201;
f10 = #190;
CsLt = #202;
F11 = #191;
Esc = #27;
F12 = #192;
CR = #13;
BS = #8;
CtrlY = #206;
TAB = #9;
SHIFT_TAB = #208;
CTRL_PgUp = #209;
CTRL_PgDn = #210;
CTRL_CsRt = #211;
CTRL_CsLt = #212;
CTRL_POS1 = #213;
CTRL_Ende = #214;
CTRL_ENTF = #12; {********* ACHTUNG! IST CTRL-L!!! ****}
SHIFT_F5 = #216;
SHIFT_F6 = #217;
SHIFT_F7 = #218;
SHIFT_F8 = #219;
SHIFT_F9 = #220;
SHIFT_F10 = #221;
CTRL_F5 = #222;
CTRL_F6 = #223;
CTRL_F7 = #176;
CTRL_F8 = #177;
CTRL_F9 = #178;
CTRL_F10 = #179;
ALT_F5 = #28;
alt_F6 = #29;
ALT_F7 = #203;
alt_F8 = #204;
ALT_F9 = #207;
alt_F10 = #205;
CTRL_T = #20;
CTRL_K = #11;
CTRL_V = #22;
ALT_K = #255;
ALT_V = #254;
CTRL_S = #19;
CTRL_Z = #26;
CTRL_r = #18;
CTRL_I = #09;
ctrl_w = #23;
FUNCTION taste : CHAR;
FUNCTION TastFlag (Flag : BOOLEAN;
FlagReg : INTEGER) : BOOLEAN;
IMPLEMENTATION
VAR saawar : BOOLEAN;
regi : REGISTERS;
fa : BYTE;
FUNCTION TastFlag (Flag : BOOLEAN; { der letzte Status des Flags }
FlagReg : INTEGER { der aktuelle Status des Flag (0 = aus) }
) : BOOLEAN;
VAR FRegs : REGISTERS;
BEGIN
FRegs.ah := $2; { Funktionsnummer f<>r Tastatursatus lesen }
INTR ($16, FRegs );
FlagReg := FRegs.al AND FlagReg;
IF (Flag AND (FlagReg = 0) ) OR { testen ob sich der Status }
(NOT (Flag) AND (FlagReg <> 0) ) THEN { des Flags ge„ndert hat }
BEGIN { JA }
IF FlagReg = 0 THEN { ist Flag jetzt aus? }
BEGIN { JA }
TastFlag := FALSE; { Ergebnis der Funktion : Flag aus }
END
ELSE
BEGIN { Flag ist jetzt an }
TastFlag := TRUE; { Ergebnis der Funktion : Flag an }
END;
END
ELSE
TastFlag := Flag { Status des Flags hat sich nicht ver„ndert }
END;
FUNCTION taste : CHAR;
VAR t : CHAR;
PROCEDURE Auswertung (t2 : CHAR);
BEGIN
CASE t2 OF
#15 : t := SHIFT_TAB;
#59 : t := F1;
#73 : t := PgUp;
#60 : t := F2;
#81 : t := PgDn;
#61 : t := F3;
#71 : t := Pos1;
#62 : t := F4;
#79 : t := Ende;
#63 : t := F5;
#82 : t := Einf;
#64 : t := F6;
#83 : t := Entf;
#65 : t := F7;
#72 : t := CsUp;
#66 : t := F8;
#80 : t := CsDn;
#67 : t := F9;
#77 : t := CsRt;
#68 : t := f10;
#75 : t := CsLt;
#132 : t := CTRL_PgUp;
#118 : t := CTRL_PgDn;
#116 : t := CTRL_CsRt;
#115 : t := CTRL_CsLt;
#119 : t := CTRL_POS1;
#117 : t := CTRL_Ende;
#88 : t := SHIFT_F5;
#89 : t := SHIFT_F6;
#90 : t := SHIFT_F7;
#91 : t := SHIFT_F8;
#92 : t := SHIFT_F9;
#93 : t := SHIFT_F10;
#98 : t := CTRL_F5;
#99 : t := CTRL_F6;
#100 : t := CTRL_F7;
#101 : t := CTRL_F8;
#102 : t := CTRL_F9;
#103 : t := CTRL_F10;
#108 : t := ALT_F5;
#109 : t := alt_F6;
#110 : t := ALT_F7;
#111 : t := alt_F8;
#112 : t := ALT_F9;
#113 : t := alt_F10;
#37 : t := ALT_K;
#47 : t := ALT_V;
END;
END;
BEGIN
saawar := FALSE;
t := READKEY;
IF t = #0 THEN
Auswertung (READKEY);
IF t = #12 THEN
t := CTRL_ENTF;
IF t = #13 THEN
t := CR;
IF t = #20 THEN
t := CTRL_T;
IF t = #19 THEN
t := CTRL_S;
IF t = #11 THEN
t := CTRL_K;
IF t = #22 THEN
t := CTRL_V;
IF t = #27 THEN
t := Esc;
IF t = #25 THEN
t := CtrlY;
IF t = #26 THEN
t := CTRL_Z;
IF t = #9 THEN
t := TAB;
IF t = #8 THEN
t := BS;
taste:=t;
END;
END.

336
XPSPEAK.PAS Executable file
View file

@ -0,0 +1,336 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P S P E A K . P A S ³
³ ³
³ Routinen f<>r die Sprachausgabe der Rufzeichen. Derzeit werden noch die ³
³ Sprachfiles vom SUPERKISS 3.0 verwendet. ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Procedure out_laut(Speed,Laenge : Word; Buffer : Pointer); Assembler;
Const out_port = $0061;
asm push bp { rette argumentenpointer }
mov bp,sp { point auf den stack }
{ rette sonstige register }
push bx
push cx
push dx
push es
push si
push di
push ds { sicherheitshalber retten }
in al, $21
push ax
mov al, $FD
out $21, al
cld { aufw„rts laden }
mov di,[bp+12] { lade die l„nge des buffers }
or di,di { noch testen }
jnz @out_pre { es gibt aber nichts }
jmp @out_end
@out_pre:
mov si,[bp+8] { hole den offset des buffers }
mov ax,[bp+10] { segment des buffers }
mov dx,out_port { addresse des modulports }
mov ds,ax { segmentpointer direkt aufsetzen }
in al,dx { lies momentanen portwert }
shr al,1 { portwert vorbereiten }
shr al,1 { f<>r sp„tere carrayschiebung }
mov bp,[bp+14] { hole ausgabespeed }
mov es,ax { und dahinein retten }
@out_periode:
lodsb { 12 lade "ax=*(ds:si++)" }
mov bx,ax { rette den akku }
mov cx,7
@07: mov ax,es { 2 hole alten portwert }
shr bl,1 { 2 datenbit ins carry schieben }
rcl al,1 { 2 bereite ausgangsdatum vor }
shl al,1 { 2 setze evtl. bit 1, l”sche bit 0 }
out dx,al { 8 nun speaker ansprechen }
push cx
mov cx,bp { 2 hole verz”gerungszeit }
@W1: loop @W1
pop cx
loop @07
mov ax,es { 2 hole alten portwert }
shr bl,1 { 2 datenbit ins carry schieben }
rcl al,1 { 2 bereite ausgangsdatum vor }
shl al,1 { 2 setze evtl. bit 1, l”sche bit 0 }
out dx,al { 8 nun speaker ansprechen }
dec di { 2 nun ein wort weniger }
jz @out_end0 { 4 es war nicht das letzte }
mov cx,bp { 2 hole verz”gerungszeit }
@W2: loop @W2
jmp @out_periode { 15 springe nach oben }
@out_end0:jmp @out_end { geht leider nur so... }
@out_end: mov ax,es { hole altenportwert }
shl al,1 { l”sche beide untern bits }
shl al,1
out dx,al { alten portwert wieder setzten }
pop ax
out $21, al
pop ds { der wurde verwendent . . . }
pop di { register restaurieren }
pop si
pop es
pop dx
pop cx
pop bx
pop bp { den auch noch }
End;
Procedure Sprechen (* Zeile : Str80 *);
Const maxLaenge = $FF00;
Type BufferTyp = Array[1..maxLaenge] of Byte;
Var Buffer : ^BufferTyp;
Result : Word;
maxBuf : LongInt;
Datei : File;
i,i1 : Byte;
P : Word;
Begin
{$IFDEF Sound}
if Konfig.WavSprach then
begin
Result:=pos('-',Zeile);
if Result>0 then
begin
Result:=(str_int(copy(Zeile,Result+1,length(Zeile)-Result)));
if Result>9 then
begin
Strip(Zeile);
Zeile:=Zeile+'-';
end;
Case Result of
10: Zeile:=Zeile+#10;
11: Zeile:=Zeile+#11;
12: Zeile:=Zeile+#12;
13: Zeile:=Zeile+#13;
14: Zeile:=Zeile+#14;
15: Zeile:=Zeile+#15;
end;
end;
WavStream:=WavStream+Zeile
end;
if not konfig.wavsprach then
begin
{$ENDIF}
Buffer := Nil;
if MaxAvail > maxLaenge then maxBuf := maxLaenge
else maxBuf := MaxAvail - 1024;
GetMem(Buffer,maxBuf);
FillChar(Buffer^,maxBuf,#0);
for i := 1 to length(Zeile) do
case Zeile[i] of
'-' : Zeile[i] := '_';
',' : Zeile[i] := '!';
end;
P := 1;
While length(Zeile) > 0 do
begin
i1 := 1;
if str_int(copy(Zeile,1,2)) in [10..15] then i1 := 2;
Assign(Datei,konfig.Spkverz + copy(Zeile,1,i1) + SpkExt);
If ResetBin(Datei,T) = 0 Then
Begin
if (FileSize(Datei) + P) > MaxLaenge then
begin
LockIntFlag(0);
out_laut(VSpeed,P,@Buffer^[1]);
LockIntFlag(1);
P := 1;
end;
BlockRead(Datei,Buffer^[P],maxBuf,Result);
P := P + Result;
FiResult := CloseBin(Datei);
end;
delete(Zeile,1,i1);
end;
if P > 1 then
begin
LockIntFlag(0);
out_laut(VSpeed,P,@Buffer^[1]);
LockIntFlag(1);
end;
FreeMem(Buffer,MaxLaenge);
{$IFDEF Sound}
end; {soundkarte}
{$ENDIF}
End;
Procedure SprachMenu;
Const ArtMax = 3;
Var i : byte;
KC : Sondertaste;
VC : Char;
Flag : Boolean;
X,Y,
Art : Byte;
Hstr : String[4];
infs : string[80];
Begin
Moni_Off(0);;
Flag := false;
for i := 9 to 15 do
begin
g^.fstr[i]:='';
G^.Fstx[i] := 10;
end;
G^.Fstr[7] := InfoZeile(445);
G^.Fstr[9] := InfoZeile(446);
infs:=InfoZeile(447);
G^.Fstr[11] := InfoZeile(448);
Art := 1;
Repeat
for i := 9 to 11 do
begin
G^.Fstr[i][vM+1] := B1;
G^.Fstr[i][hM+1] := B1;
G^.Fstr[i][vM] := B1;
G^.Fstr[i][hM] := B1;
end;
if speek then G^.fstr[9][vm+1]:=X_ch;
if Art in [1..3] then
begin
X := vM;
Y := Art + 8;
end else
begin
X := hM;
Y := Art + 4;
end;
G^.Fstr[Y][X] := A_ch;
if HardCur then SetzeCursor(X+1,Y);
{delete(G^.Fstr[9],vM+1,1);
insert(int_str(TNr),G^.Fstr[9],vM+1);
if TNC[TNr]^.Bake then G^.Fstr[13][vM+1] := X_ch;}
{ G^.Fstr[14] := '';}
G^.Fstr[15] := '';
G^.Fstr[10] :=infs+' '+int_str(VSpeed);
Fenster(15);
_ReadKey(KC,VC);
Case KC of
_Esc : Flag := true;
{_AltH : XP_Help(G^.OHelp[3]);}
_Ret : ;
_F1 : Art := 1;
_F2 : Art := 2;
_F3 : Art := 3;
_F4,
_F5,
_F6,
_F7,
_F8,
_F9,
_F10 : Alarm;
_Up : if Art > 1 then dec(Art)
else Alarm;
_Dn : if Art < ArtMax then inc(Art)
else Alarm;
_Andere : case VC of
B1:;
else Alarm;
end;
else Alarm;
End;
if (KC in [_F1.._F3,_Ret]) or ((KC = _Andere) and (VC = B1)) then
case Art of
1 : begin {an/aus}
speek:=not speek;
end;
2 : begin {geschwindigkeit}
G^.Fstr[10][vM] := S_ch;
Fenster(15);
Hstr := int_str(vspeed);
GetString(Hstr,Attrib[3],4,2,15,KC,0,Ins);
if KC <> _Esc then
begin
VSpeed := Word(str_int(Hstr));
end;
end;
3 : begin {test}
{$IFDEF Sound}
If not Konfig.WavSprach then
{$ENDIF}
sprechen('TEST');
{$IFDEF Sound}
If Konfig.WavSprach then
begin
WavStream:='TEST';
repeat
sprachwav;
until wavStream='';
end;
{$ENDIF}
end;
end;
SetzeFlags(0);
Until Flag;
ClrFenster;
Neu_Bild;
Moni_On;
End;

351
XPSTOP.PAS Executable file
View file

@ -0,0 +1,351 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P S T O P . P A S ³
³ ³
³ Routinen f<>r die Auwertung der STOP-Kompression und Codierung. ³
³ ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function STOPCompress (Kanal : Byte; Zeile : String; Code : Byte) : String;
Var Hstr : String;
t : Word;
s : Word;
i : Byte;
a : Integer;
b,c : Byte;
ch : Char;
long : Boolean;
Begin
if Zeile > '' then
begin
Zeile := PackIt(Zeile);
FillChar(Hstr,SizeOf(Hstr),0);
a := 7;
b := 1;
long := false;
i := 0;
While (i < length(Zeile)) and not long do
begin
inc(i);
t := HTable[ord(Zeile[i])].Tab;
s := $8000;
C := 0;
While (C < HTable[ord(Zeile[i])].Len) and not long do
begin
inc(C);
if t and s = s then Hstr[b] := Chr(ord(Hstr[b]) + 1 shl a);
s := s shr 1;
dec(a);
if a < 0 then
begin
a := 7;
inc(b);
if b > 254 then long := true;
end;
end;
Hstr[0] := chr(b);
end;
Hstr := CodeIt(Kanal, Hstr, Code);
if (length(Hstr) > length(Zeile)) or long then
begin
Hstr := CodeIt(Kanal, Zeile, Code);
Hstr := Chr(length(Hstr)) + Hstr;
ch := #255;
end else ch := Chr(length(Hstr));
STOPCompress := ch + Hstr;
end else STOPCompress := '';
End;
Function STOPDeCompress (Kanal : Byte; Zeile2 : String; Code : Byte) : String;
Var Zeile,
Hstr : String;
b,i,l : Byte;
a : Integer;
t,t2 : Word;
Bit : LongInt;
ch : Char;
Begin
Zeile := Zeile2;
ch := Zeile[1];
delete(Zeile,1,1);
if ch = #255 then delete(Zeile,1,1);
Zeile := DeCodeIt(Kanal, Zeile, Code);
if (ch < #255) and (Zeile[0] > #0) then
begin
Hstr := '';
l := 0;
Bit := 0;
for i := 1 to length(Zeile) do
begin
Bit := (Bit shl 8) or ord(Zeile[i]);
l := Byte(l + 8);
a := 0;
Repeat
b := HTable[a].Len;
if l >= b then
begin
t := HTable[a].Tab;
t2 := Word(Bit shr (l-b)) shl (16-b);
if t = t2 then
begin
Hstr := Hstr + chr(a);
l := l - b;
a := -1;
end;
end;
inc(a);
Until (a > 257) or (l < 3);
end;
end else Hstr := Zeile;
Hstr := UnPackIt(Hstr);
if Kanal = 0 then
begin
t := K[0]^.StopCode;
K[0]^.StopCode := G^.DetCode;
if STOPCompress(0, Hstr, Code) <> Zeile2 then
begin
Hstr := Zeile2;
end;
K[0]^.StopCode := t;
end;
STOPDeCompress := Hstr;
End;
Function PMak (Nr : Byte) : String;
Begin
if Nr = 53 then PMak := ' ÉÍÍÍÍÍÍËÍÍÍÍÍÍËÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ List Í»' + M1
else if Nr = 54 then PMak := ' ºMsg.-#ºPFRAKSºKBº An @ BBS º Von ºDat./Zeitº Titel º' + M1
else if Nr = 55 then PMak := ' ÌÍÍÍÍÍÍÎÍÍÍÍÍÍÎÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' + M1
else if Nr = 56 then PMak := ' ÈÍÍÍÍÍÍÊÍÍÍÍÍÍÊÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ' + M1
else if Nr = 57 then PMak := ' ÉÍÍÍÍÍÍËÍÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍ Read Í»' + M1
else if Nr = 58 then PMak := ' ºMsg.-#ºPFRAKSº Byteº An @ BBS º Von ºDat./ZeitºGeschrbn.º Lifet. º' + M1
else if Nr = 59 then PMak := ' ÌÍÍÍÍÍÍÎÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍ͹' + M1
else if Nr = 60 then PMak := ' ÈÍÍÍÍÍÍÊÍÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍͼ' + M1
else if Nr = 61 then PMak := ' ÉÍÍÍÍÍÍËÍÍÍÍÍÍËÍÍÍÍÍËÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍËÍÍÍÍÍÍÍÍÍËÍÍÍËÍÍÍÍÍÍÍÍ Send Í»' + M1
else if Nr = 62 then PMak := ' ºMsg.-#ºPFRAKSº Byteº An @ BBS º Von ºDat./ZeitºLt.º Bulletin-ID º' + M1
else if Nr = 63 then PMak := ' ÌÍÍÍÍÍÍÎÍÍÍÍÍÍÎÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÎÍÍÍÍÍÍÍÍÍÎÍÍÍÎÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' + M1
else if Nr = 64 then PMak := ' ÌÍÍÍÍÍÍÊÍÍÍÍÍÍÊÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÊÍÍÍÍÍÍÍÍÍÊÍÍÍÊÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹' + M1
else if Nr = 65 then PMak := ' ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ' + M1
else PMak := '';
End;
Function PackIt (Zeile : String) : String;
Var i, j,
az : Integer;
PM,
Hstr : String;
Begin
Hstr := '';
i := 1;
while i <= length(Zeile) - 3 do
begin
az := 0;
for j := 53 to maxPMak do
begin
PM := PMak(j);
if Copy(Zeile,i,length(PM)) = PM then
begin
az := 1;
Hstr := Hstr + chr(255) + chr(255) + chr(j-1);
i := i + length(PM);
j := maxPMak;
end;
end;
if az = 0 then
begin
if Zeile[i] = Zeile[i+1] then
begin
if (Zeile[i] = Zeile[i+2]) and (Zeile[i] = Zeile[i+3]) then
begin
az := 4;
while (i + az <= length(Zeile)) and (Zeile[i] = Zeile[i+az]) do
az := az + 1;
Hstr := Hstr + chr(255) + chr(az) + Zeile[i];
i := i + az - 1;
end;
end;
if az = 0 then
begin
Hstr := Hstr + Zeile[i];
if Zeile[i] = chr(255) then Hstr := Hstr + chr(0);
end;
i := i + 1;
end;
end;
while i <= length(Zeile) do
begin
Hstr := Hstr + Zeile[i];
if Zeile[i] = chr(255) then Hstr := Hstr + chr(0);
i := i + 1;
end;
PackIt := Hstr;
End;
Function UnPackIt (Zeile : String) : String;
Var i,
az : Integer;
Hstr : String;
Begin
Hstr := '';
i := 1;
while i <= length(Zeile) do
begin
if Zeile[i] = chr(255) then
begin
i := i + 1;
if Zeile[i] = chr(0) then Hstr := Hstr + chr(255)
else if Zeile[i] = chr(255) then
begin
i := i + 1;
Hstr := Hstr + PMak(ord(Zeile[i])+1);
end else
begin
az := ord(Zeile[i]);
i := i + 1;
while az > 0 do
begin
Hstr := Hstr + Zeile[i];
az := az - 1;
end;
end;
end else Hstr := Hstr + Zeile[i];
i := i + 1;
end;
UnPackIt := Hstr;
End;
Function DetectStopCode {(LastBt, Cd1, Cd2 : Byte) : Boolean};
begin
DetectStopCode := LastBt = (cd1 xor cd2 xor 55);
end;
Function CodeIt (Kanal : Byte; Zeile : String; Code : Byte) : String;
Var c1,c2 : Byte;
i : Integer;
flag : Boolean;
Hstr : String;
Begin
if (K[Kanal]^.StopCode > 0) and (Zeile > '') then
begin
c1 := Byte(K[Kanal]^.StopCode shr 8);
c2 := Byte(K[Kanal]^.StopCode and 255);
Hstr := Chr(c1) + Chr(c2);
Hstr := Hstr + Chr(c1 xor c2 xor 55);
flag := true; {======================
w„r sch”n, wenns richtig w„re, ist es
aber nicht :-) Das ist die angebliche
Berechnung des Check-Bytes}
for i := length(Zeile) downto 1 do
begin
if flag then begin Hstr := Chr(Ord(Zeile[i]) xor c1) + Hstr; flag := false; end
else begin Hstr := Chr(Ord(Zeile[i]) xor c2) + Hstr; flag := true; end;
end;
CodeIt := Hstr;
end else CodeIt := Zeile;
End;
Function DeCodeIt (Kanal : Byte; Zeile : String; Code : Byte) : String;
Var c1,c2 : Byte;
i : Integer;
flag : Boolean;
Hstr : String;
InOrdung:boolean;
Begin
i := length(Zeile);
if i > 3 then
begin
c1 := Byte(Zeile[i-2]);
c2 := Byte(Zeile[i-1]);
InOrdung:=false;
if ((((Word(c1) shl 8) + Word(c2)) = K[Kanal]^.StopCode) ) and
(DetectStopCode (Byte(Zeile[i]), c1,c2) ) {and
!weg lassen! (not k[kanal]^.mo.MonActive) } then InOrdung:=true;
{nachfolgender Teil f<>r den Spion-Autodetect!}
{$IFDEF code}
if (DetectStopCode (Byte(Zeile[i]), c1,c2) ) and
(k[kanal]^.mo.MonActive) then InOrdung:=true;
{$ENDIF}
if InOrdung then
begin
G^.DetCode := ((Word(c1) shl 8) + Word(c2));
Hstr := '';
flag := (length(Zeile) mod 2) = 0;
for i := 1 to length(Zeile) - 3 do
begin
if flag then begin Hstr := Hstr + Chr(Ord(Zeile[i]) xor c1); flag := false; end
else begin Hstr := Hstr + Chr(Ord(Zeile[i]) xor c2); flag := true; end;
end;
Zeile := Hstr;
end else G^.DetCode := 0;
end else G^.DetCode := 0;
DeCodeIt := Zeile;
End;
Function CodeStr (Kanal : Byte; Zeile : String) : String;
Var i : Integer;
Begin
for i := 1 to length(Zeile) do
begin
Zeile[i] := Chr(CodeTab[Ord(Zeile[i])]);
end;
CodeStr := Zeile;
End;
Function DeCode (Kanal : Byte; Zeile : String) : String;
Var i : Integer;
Begin
for i := 1 to length(Zeile) do
begin
Zeile[i] := Chr(DeCodeTab[Ord(Zeile[i])]);
end;
DeCode := Zeile;
End;
Function GetCode (Call : Str9) : Word;
Begin
{ReadUser(Call);
GetCode := U^.Komp;}
GetCode:=200; {Hier sollte eigentlich der Code <20>bergeben werden,
der dem User zugeordnet ist. Bei Tests mit anderen
Codes umstellen!!!}
End;
Function F2C(Call : Str9) : Str9; Begin F2C := Call; End;

255
XPSTR.PAS Executable file
View file

@ -0,0 +1,255 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P S T R . P A S ³
³ ³
³ Library - Unit mit oft ben”tigten Routinen f<>r die Stringverarbeitung ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function str_int (* Zeile : Str10 : LongInt *);
Var i : Integer;
Zahl : LongInt;
Begin
Val(Zeile,Zahl,i);
if (i > 0) then Zahl := 0;
Str_Int := Zahl;
End;
Function int_str (* i : LongInt) : Str10 *);
Var Hstr : String[10];
Begin
str(i,Hstr);
int_str := Hstr;
End;
Function ConstStr (* VC : Char ; L : Byte) : Str80; *);
Const ML = 80;
Var Bstr : String[80];
Begin
if L > ML then L := ML;
Bstr := '';
FillChar(Bstr[1],L,VC);
Bstr[0] := Chr(L);
ConstStr := Bstr;
End;
Function RetStr (* Zeile : String) : String *) ;
Var i : Byte;
Begin
i := pos(M1,Zeile);
if i = 0 then i := Length(Zeile)
else Dec(i);
Zeile[0] := Chr(i);
RetStr := Zeile;
End;
Function CutStr (* Zeile : String) : String *) ;
Var i : Byte;
Begin
i := pos(B1,Zeile);
if i = 0 then i := Length(Zeile)
else Dec(i);
Zeile[0] := Chr(i);
CutStr := Zeile;
End;
Function RestStr (* (Zeile : String) : String *);
Var i,i1 : Byte;
Begin
i := pos(B1,Zeile);
if i > 0 then
begin
i1 := length(Zeile) - i;
Zeile[0] := Chr(i1);
move(Zeile[i+1],Zeile[1],i1);
While (Zeile[0] > #0) and (Zeile[1] = ' ') do delete(Zeile,1,1);
end else Zeile := '';
RestStr := Zeile;
End;
Function UpCaseStr (* (Zeile : String) : String *) ;
Var i : Byte;
Begin
for i := 1 to Ord(Zeile[0]) do
if Zeile[i] in ['a'..'z'] then dec(Zeile[i],$20);
UpCaseStr := Zeile;
End;
Procedure KillEndBlanks (* var Zeile : String *);
Begin
While (Zeile[0] > #0) and (Zeile[Ord(Zeile[0])] = B1) do dec(Zeile[0]);
End;
Procedure KillStartBlanks (* Var Zeile : String *);
Begin
While (Zeile[0] > #0) and (Zeile[1] = B1) do
begin
dec(Zeile[0]);
move(Zeile[2],Zeile[1],Ord(Zeile[0]));
end;
End;
Function ParmStr (* (Nr : Byte; VC : char; Zeile : String) : String *);
Var i,i1,
i2,i3 : Byte;
Hstr : String;
Begin
if Zeile > '' then
begin
i2 := 0;
i3 := 254;
While (ord(Zeile[0]) > 0) and (Zeile[1] = VC) do
begin
delete(Zeile,1,1);
inc(i2);
end;
Hstr := '';
i1 := 1;
for i := 1 to Ord(Zeile[0]) do
begin
if Nr = i1 then if Zeile[i] <> VC then
begin
Hstr := Hstr + Zeile[i];
i3 := i;
end;
if (Zeile[i] = VC) and (Zeile[i-1] <> VC) then inc(i1);
end;
While (Hstr[0] > #0) and (Hstr[Ord(Hstr[0])] = B1) do Hstr[0] := Chr(Ord(Hstr[0])-1);
While (Hstr[0] > #0) and (Hstr[1] = B1) do delete(Hstr,1,1);
ParmAnz := i1;
ParmPos := Byte(i3 + i2 - length(Hstr) + 1);
ParmStr := Hstr;
end else
begin
ParmAnz := 0;
ParmPos := 0;
ParmStr := '';
end;
End;
Function SFillStr (* Anz : Byte; VC : Char; Zeile : String) : String *);
Var i,i1 : Byte;
Begin
i := length(Zeile);
if i < Anz then
begin
i1 := Anz - i;
move(Zeile[1],Zeile[i1+1],i);
FillChar(Zeile[1],i1,VC);
Zeile[0] := Chr(Anz);
end;
SFillStr := Zeile;
End;
Function EFillStr (* Anz : Byte; VC : Char; Zeile : String) : String *);
Var i : Byte;
Begin
i := length(Zeile);
if i < Anz then
begin
FillChar(Zeile[i+1],Anz-i,VC);
Zeile[0] := Chr(Anz);
end;
EFillStr := Zeile;
End;
Function CEFillStr (* Anz : Byte; VC : Char; Zeile : String) : String *);
Var i : Byte;
Begin
i := length(Zeile);
if i < Anz then
begin
FillChar(Zeile[i+1],Anz-i,VC);
Zeile[0] := Chr(Anz);
end;
cEFillStr:=copy(Zeile,1,Anz);
End;
Function ZFillStr (* Anz : Byte; VC : Char; Zeile : String) : String *);
Begin
While length(Zeile) < Anz do Zeile := VC + Zeile + VC;
if length(Zeile) > Anz then Zeile := copy(Zeile,1,Anz);
ZFillStr := Zeile;
End;
Function Hex (* Dezimal : LongInt; Stellenzahl : Byte) : Str8 *);
Const HexChars : Array [0..15] of Char = ('0','1','2','3','4','5','6','7',
'8','9','A','B','C','D','E','F');
Var Stelle : Byte;
Begin
if (Stellenzahl > 8) then Stellenzahl := 8;
Hex := ' ';
Hex[0] := Chr(Stellenzahl);
for Stelle := Stellenzahl downto 1 do
begin
Hex[Stelle] := HexChars[Dezimal and $0F];
Dezimal := Dezimal shr 4;
end;
End;
Function Adr_absolut(Zeiger : Pointer) : LongInt;
Begin
if Zeiger = NIL then Adr_absolut := 0
else Adr_absolut := (LongInt(Seg(Zeiger^)) shl 4) + Ofs(Zeiger^);
End;
Function Pointer_Str (* Zeiger : Pointer) : Str9 *);
Begin
if Zeiger = NIL then Pointer_Str := 'NIL '
else Pointer_Str := Hex(Seg(Zeiger^),4) + DP + Hex(Ofs(Zeiger^),4);
End;
Function FormByte (* Zeile : str11) : str11 *);
var Bstr : String[11];
i,i1 : Byte;
Begin
Bstr := '';
i1 := length(Zeile);
for i := 1 to i1 do
begin
Bstr := Zeile[i1+1-i] + Bstr;
if (i > 1) and (i < i1) and (i mod 3 = 0) then Bstr := Pkt + Bstr;
end;
FormByte := Bstr;
End;
Function Bin (* Dezimal : LongInt ; Stellenzahl : Byte) : Str32 *);
Var Stelle : Byte;
Begin
if Stellenzahl > 32 then Stellenzahl := 32;
Bin[0] := Chr(Stellenzahl);
for Stelle := Stellenzahl downto 1 do
begin
if (Dezimal and $01) > 0 then Bin[Stelle] := '1'
else Bin[Stelle] := '0';
Dezimal := Dezimal shr 1;
end;
End;
Procedure Strip (* var Call: str9 *);
Var p : Byte;
Begin
p := pos('-',Call);
if p > 0 then Call := Copy(Call,1,p-1);
End;

1050
XPTAST.PAS Executable file
View file

File diff suppressed because it is too large Load diff

932
XPUSEDIT.PAS Executable file
View file

@ -0,0 +1,932 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P U S E R . P A S ³
³ ³
³ Userdatenbank-Verwaltung ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
{Folge:
Call
Name
System
QTH
Locator
Adresse
Telefon
Umlaut
PacLen
Maxframe
Scan (anwesenheit)
SSIDs
VIP
FBBStreng
Vorbereitung
MailLesen
MailKillen
Nachbereitung
ByeBye
Prompt
}
Procedure UserEditieren(*User_:User_Typ2; Kanal :Byte; Neu:boolean; ZMax:Byte*);
Const ArtMax = 12;
Var AnAusDiff, e,i : Byte;
KC : Sondertaste;
VC : Char;
atr : array[1..3] of byte;
Anfang,
geaendert,
grossSave, {grosschreibungs-flag speichern}
RemAll_,
Flag,
Flag1,
Seitenwechsel : Boolean;
ulw,
Flagbyte,
obf,
X,Y,
Seite,
Art : Byte;
HStr,
Eing,
Teil1,
Teil2,
Teil3,
Teil4,
Teil5,
teil6,
teil7 : str80;
ZeileOU,
ZeileRL,
ULautZ,
eingh : string;
Zahl : longint; {//db1ras}
HStrAn, HStrAus : string[20];
SaveDat : User_typ2; {schluávergleich: wirklich ge„ndert??}
Udat : file of User_Typ2;
Begin
Seite:=1;
Anfang:=true;
if (User_.MaxFrames<1) or (user_.maxframes>7) then User_.maxFrames:=Konfig.MaxFrameStd;
if (user_.paclen<5) or (user_.paclen>255) then user_.paclen:=Konfig.PacLenStd;
User_.VErsion1:=1; User_.Version2:=80;
Flag := false;
Flag1 := false;
grosssave:=gross;
gross:=false;
HstrAn :=InfoZeile(76);
HstrAus:=InfoZeile(77);
Teil1:=infozeile(366); {Allgemein}
Teil2:=InfoZeile(378);
Teil3:=Infozeile(367); {Poll}
Teil4:=Infozeile(368); {Poll}
Teil5:=Infozeile(369); {Poll}
Teil6:=InfoZeile(371); {Kompression beim Login}
teil7:=InfoZeile(373); {Passwort beim Login}
ULautZ :=infozeile(372);
ZeileOU:=InfoZeile(389);
ZeileRL:=InfoZeile(404);
if Length(HstrAn)>Length(HstrAus) then AnAusDiff:=Length(HstrAn);
if Length(HstrAus)>Length(HstrAn) then AnAusDiff:=Length(HstrAus);
if Length(HstrAus)=Length(HstrAn) then AnAusDiff:=Length(HstrAus);
Art := 1;
Seitenwechsel:=true;
SaveDat:=User_;
Repeat
if Seitenwechsel then
begin
Seitenwechsel:=false;
if anfang then
begin
for i := 1 to Zmax do WriteRam(1,i,Attrib[2],1,cefillstr(80,B1,B1));
WriteRam(1,1,Attrib[5],1,cefillstr(80,B1,B1+InfoZeile(365)));
WriteRam(1,maxz,Attrib[5],1,cefillstr(80,B1,B1+ ZeileOU));
end else for i := 3 to Zmax-1 do WriteRam(1,i,Attrib[2],1,cefillstr(80,B1,B1));
WriteRam(67,2,Attrib[5],1,cefillstr(14,B1,B1+ParmStr(2,bs,Teil5)+b1+int_Str(Seite)+'/3'));
Case Seite of
1: begin
Art:=1;
WriteRam(1,2,Attrib[5],1,cefillstr(66,B1,B1+ParmStr(3,bs,Teil5)));
WriteRam(1,4,Attrib[2],1,cefillstr(9,B1,B1+ParmStr(1,b1,Teil1))+': '+User_.Call);
WriteRam(1,5,Attrib[2],1,cefillstr(9,B1,B1+ParmStr(2,b1,Teil1))+': '+User_.alias);
WriteRam(34,4,Attrib[2],1,cefillstr(9,B1,ParmStr(3,b1,teil1))+': '+User_.Name);
WriteRam(1,6,Attrib[2],1,cefillstr(9,B1,B1+ParmStr(4,b1,teil1))+': '+User_.System);
WriteRam(34,5,Attrib[2],1,cefillstr(9,B1,parmstr(5,b1,teil1))+': '+User_.QTH);
WriteRam(34,6,Attrib[2],1,cefillstr(9,B1,parmstr(7,b1,teil1))+': '+UpcaseStr(User_.Locator));
WriteRam(1,8,Attrib[2],1,cefillstr(9,B1,B1+parmstr(6,b1,teil1))+': '+User_.Adress);
WriteRam(1,9,Attrib[2],1,cefillstr(9,B1,B1+parmstr(8,b1,teil1))+': '+User_.Telefon);
WriteRam(1,11,Attrib[2],1,cefillstr(9,B1,B1+ParmStr(9,b1,teil1))+': '+int_str(User_.PacLen));
WriteRam(34,11,Attrib[2],1,cefillstr(9,B1,ParmStr(10,b1,teil1))+': '+int_str(User_.MaxFrames));
WriteRam(1,13,Attrib[2],1,cefillstr(9,b1,b1+ParmStr(1, b1, ULautZ))+':');
WriteRam(12,13,Attrib[2],1,'[ ] '+cefillstr(16,b1,ParmStr(2, b1, ULautZ)));
WriteRam(34,13,Attrib[2],1,'[ ] '+cefillstr(16,b1,ParmStr(3, b1, ULautZ)));
WriteRam(56,13,Attrib[2],1,'[ ] '+cefillstr(16,b1,ParmStr(4, b1, ULautZ)));
case User_.umlaut of
1: writeRam(13,13,attrib[2],1,'X');
2: writeRam(35,13,attrib[2],1,'X');
3: writeRam(57,13,attrib[2],1,'X');
end;
{+int_str(User_.umlaut));}
if User_.Anwesenheit then WriteRam(1,15,Attrib[2],1,' [X]'+cefillstr(10,B1,B1+ParmStr(12,b1,teil1)))
else WriteRam(1,15,Attrib[2],1,' [ ]'+cefillstr(10,B1,B1+ParmStr(12,b1,teil1)));
if User_.VIP then WriteRam(15,15,Attrib[2],1,'[X] '+cefillstr(9,B1,parmstr(11,b1,teil1)))
else WriteRam(15,15,Attrib[2],1,'[ ] '+cefillstr(9,B1,parmstr(11,b1,teil1)));
{SHOW} if User_.show then WriteRam(30,15,Attrib[2],1,'[X] '+cefillstr(9,B1,B1+ParmStr(13,b1,teil1)))
else WriteRam(30,15,Attrib[2],1,'[ ] '+cefillstr(9,B1,ParmStr(13,b1,teil1)));
{RemSch} if User_.RemSchreib then WriteRam(45,15,Attrib[2],1,'[X] '+cefillstr(34,B1,B1+ParmStr(1,bs,teil3)))
else WriteRam(45,15,Attrib[2],1,'[ ] '+cefillstr(34,b1,ParmStr(1,bs,teil3)));
WriteRam(1,17,Attrib[2],1,cefillstr(9,B1,B1+parmstr(1,b1,teil2) )+': ');
i:=1;
x:=12;y:=17;
while i<17 do
begin
if user_.ssids[i-1] then WriteRam(x,y,Attrib[2],1,'[X] '+cefillstr(5,B1,parmstr(i+1,b1,teil2)))
else WriteRam(x,y,Attrib[2],1,'[ ] '+cefillstr(5,B1,parmstr(i+1,b1,teil2)));
{for e:=0 to 15 do
if}
inc(i);
inc(x,8);
if i=9 then
begin
inc(y);
x:=12;
end;
end;
{User_.SSids}
WriteRam(2,20,Attrib[2],1,ParmStr(1,bs,teil6));
WriteRam(62,21,Attrib[2],1,cefillstr(10,B1,B1+ParmStr(5,bs,teil6))+': '+int_str(user_.StopCode));
Case User_.Kompression of
0:
begin
WriteRam(1,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(2,bs,teil6)));
WriteRam(20,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));
{WriteRam(40,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));}
end;
1:
begin
WriteRam(1,21,Attrib[2],1,' [X]'+cefillstr(19,B1,B1+ParmStr(2,bs,teil6)));
WriteRam(20,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));
{ WriteRam(40,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));}
end;
3:
begin
WriteRam(1,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(2,bs,teil6)));
WriteRam(20,21,Attrib[2],1,' [X]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));
{ WriteRam(40,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));}
end;
{3:
begin
WriteRam(1,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(2,bs,teil6)));
WriteRam(20,21,Attrib[2],1,' [ ]'+cefillstr(19,B1,B1+ParmStr(3,bs,teil6)));
WriteRam(40,21,Attrib[2],1,' [X]'+cefillstr(19,B1,B1+ParmStr(4,bs,teil6)));
end;}
end;
if User_.AutoBOXPassw then WriteRam(1,23,Attrib[2],1,' [X]'+cefillstr(60,B1,B1+ParmStr(1,BS,teil7)))
else WriteRam(1,23,Attrib[2],1,' [ ]'+cefillstr(60,B1,B1+ParmStr(1,bs,teil7)));
end;
2:begin
WriteRam(1,2,Attrib[5],1,cefillstr(67,B1,B1+ParmStr(4,bs,Teil5)));
Art:=20;
x:=2;y:=4;
i:=1;
While g^.Remotes[i].Befehl<>'' do
begin
writeRam(x,y,Attrib[2],1,cefillstr(14,B1,'[ ] '+g^.Remotes[i].Befehl));
if User_.RemAusnahmen[i] then writeRam(x+1,y,attrib[2],1,'X');
inc(X,15);
if i in [5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90] then
begin
x:=2;
inc(y);
end;
inc(i);
end;
end;
3:begin
Art:=21;
WriteRam(1,2,Attrib[5],1,cefillstr(67,B1,B1+ParmStr(5,bs,Teil5)));
if User_.FBBStreng_ then WriteRam(1,4,Attrib[2],1,' [X] '+cefillstr(30,B1,parmStr(2,bs,teil3)))
else WriteRam(1,4,Attrib[2],1,' [ ] '+cefillstr(30,B1,ParmStr(2,bs,Teil3)));
WriteRam(45,4,Attrib[2],1,cefillstr(15,B1,ParmStr(5,bs,teil4))+': '+User_.Synonym);
{2. spalte x=24}
WriteRam(1,6,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(3,bs,teil3))+': '+User_.Vorbereitung);
WriteRam(1,8,Attrib[2],1,cefillstr(15,B1,B1+parmStr(1,bs,teil4)) +': '+User_.MailLesen);
WriteRam(45,8,Attrib[2],1,cefillstr(15,B1,ParmStr(2,bs,teil4)) +': '+User_.MailKillen);
WriteRam(1,10,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(4,bs,teil3)) +': '+User_.Nachbereitung);
WriteRam(1,12,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(3,bs,teil4)) +': '+User_.ByeBye);
WriteRam(1,14,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(4,bs,teil4)) +': '+User_.Prompt);
WriteRam(1,15,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(6,bs,teil4)) +': '+User_.PWPrompt);
WriteRam(1,16,Attrib[2],1,cefillstr(15,B1,B1+ParmStr(1,bs,teil5)) +': '+User_.SStopPrompt);
end;
end; {case}
end; {if seitenwechsel}
{
Case KC of
_Esc : Flag := true;
_Ret : ;
_F1 : Art := 1;
_F2 : Art := 2;
_F3 : Art := 3;
_F4 : Art := 4;
_F5 : Art := 5;
_F6 : Art := 6;
_F7 : Art := 7;
_F8 : Art := 8;
_F9 : Art := 9;
_F10 : Art := 10;
_CTRLF1: ART:=11;
End;
if (KC in [_F1.._F10,_Ret,_CTRLF1]) or ((KC = _Andere) and (VC = B1)) then}
if not Anfang then
begin
if kc=_Tab then kc:=_RET;
if kc=_ShTab then kc:=_Up;
if Seite=1 then
begin
if (kc=_dn) or (kc=_Ret) then inc (art);
if art>19 then art:=1;
if (kc=_up) then dec (art);
if art<1 then art:=19;
end; {if Seite1}
if Seite=3 then
begin
if (kc=_dn) or (kc=_Ret) then inc (art);
if art>30 then art:=21;
if (kc=_up) then dec (art);
if art<21 then art:=30;
end; {if Seite3}
end;
anfang:=false;
case Art of
1 : begin {call}
eingh:=User_.Call;
GetString(eingh,Attrib[2],9,12,4,KC,1,Ins);
User_.Call:=UpcaseStr(eingh);
WriteRam(12,4,Attrib[2],1,cefillstr(9,b1,User_.Call));
end;
2 : begin {alias-call}
eingh:=User_.alias;
GetString(eingh,Attrib[2],9,12,5,KC,1,Ins);
User_.alias:=UpcaseStr(eingh);
WriteRam(12,5,Attrib[2],1,cefillstr(9,b1,User_.alias));
end;
3 : {System}
begin
eingh:=User_.System;
GetString(eingh,Attrib[2],10,12,6,KC,1,Ins);
User_.System:=upcaseStr(eingh); {//db1ras}
WriteRam(12,6,Attrib[2],1,cefillstr(10,b1,User_.System));
end;
4 : begin {name}
eingh:=User_.Name;
GetString(eingh,Attrib[2],30,45,4,KC,1,Ins);
User_.Name:=eingh;
WriteRam(45,4,Attrib[2],1,cefillstr(30,B1,User_.Name));
end;
5 : begin {qth}
eingh:=User_.QTH;
GetString(eingh,Attrib[2],30,45,5,KC,1,Ins);
User_.QTH:=eingh;
WriteRam(45,5,Attrib[2],1,cefillstr(30,b1,User_.QTH));
end;
6 : begin {locator}
eingh:=User_.Locator;
GetString(eingh,Attrib[2],7,45,6,KC,1,Ins);
User_.Locator:=upcaseStr(eingh);
WriteRam(45,6,Attrib[2],1,cefillstr(10,b1,User_.Locator));
end;
7 : begin {adresse}
eingh:=User_.Adress;
GetString(eingh,Attrib[2],60,12,8,KC,1,Ins);
User_.Adress:=eingh;
WriteRam(12,8,Attrib[2],1,cefillstr(60,b1,User_.Adress));
end;
8 : begin {telefon}
eingh:=User_.Telefon;
GetString(eingh,Attrib[2],20,12,9,KC,1,Ins);
User_.Telefon:=eingh;
WriteRam(12,9,Attrib[2],1,cefillstr(20,b1,User_.Telefon));
end;
9 : begin {Paclen}
eing:=int_str(User_.PacLen);
GetString(eing,Attrib[2],3,12,11,KC,1,ins);
Flagbyte := str_int(eing);
if flagbyte in [5..255] then eing:=eing else flagbyte:=Konfig.PacLenStd;
User_.PacLen:=flagbyte;
WriteRam(12,11,Attrib[2],1,cefillstr(3,b1,int_str(User_.PacLen)));
end;
10: begin {Maxframes}
eing:=int_str(User_.MaxFrames);
GetString(eing,Attrib[2],1,45,11,KC,1,ins);
Flagbyte := str_int(eing);
if flagbyte in [1..7] then eing:=eing else flagbyte:=Konfig.MaxFrameStd;
User_.Maxframes:=flagbyte;
WriteRam(45,11,Attrib[2],1,int_str(User_.MaxFrames));
end;
11 : begin {Umpaut}
WriteRam(1,maxz,Attrib[5],1,cefillstr(80,B1,B1+ZeileRL ));
ulw:=1;
atr[1]:=5;
atr[2]:=2;
atr[3]:=2;
repeat
case User_.umlaut of
0: begin
writeRam(13,13,attrib[atr[1]],1,' ');
writeRam(35,13,attrib[atr[2]],1,' ');
writeRam(57,13,attrib[atr[3]],1,' ');
end;
1: begin
writeRam(13,13,attrib[atr[1]],1,'X');
writeRam(35,13,attrib[atr[2]],1,' ');
writeRam(57,13,attrib[atr[3]],1,' ');
end;
2: begin
writeRam(13,13,attrib[atr[1]],1,' ');
writeRam(35,13,attrib[atr[2]],1,'X');
writeRam(57,13,attrib[atr[3]],1,' ');
end;
3: begin
writeRam(13,13,attrib[atr[1]],1,' ');
writeRam(35,13,attrib[atr[2]],1,' ');
writeRam(57,13,attrib[atr[3]],1,'X');
end;
end;
_ReadKey(KC,VC);
if kc=_right then inc (ulw);
if kc=_left then dec (ulw);
if ulw=0 then ulw:=3;
if ulw=4 then ulw:=1;
if vc=#32 then
begin
if (user_.umlaut=0) or (user_.umlaut<>ulw) then user_.umlaut:=ulw
else user_.umlaut:=0;
end;
case ulw of
1: begin
atr[1]:=5;
atr[2]:=2;
atr[3]:=2;
end;
2: begin
atr[1]:=2;
atr[2]:=5;
atr[3]:=2;
end;
3: begin
atr[1]:=2;
atr[2]:=2;
atr[3]:=5;
end;
end;
if user_.umlaut=4 then user_.umlaut:=0;
until kc in udbexit;
writeRam(13,13,attrib[2],1,' ');
writeRam(35,13,attrib[2],1,' ');
writeRam(57,13,attrib[2],1,' ');
case User_.umlaut of
1: writeRam(13,13,attrib[2],1,'X');
2: writeRam(35,13,attrib[2],1,'X');
3: writeRam(57,13,attrib[2],1,'X');
end;
{eing:=int_str(User_.Umlaut);
GetString(eing,Attrib[2],1,12,9,KC,1,Ins);
Flagbyte := Byte(str_int('$'+ eing[1]));
if not (FlagByte in UmlMenge) then Eing:='0';
if str_int(eing) in [0..5] then
User_.Umlaut:=str_int(eing);
WriteRam(1,9,Attrib[2],1,cefillstr(80,B1,B1+InfoZeile(372) +' '+int_str(User_.umlaut)));}
WriteRam(1,maxz,Attrib[5],1,cefillstr(80,B1,B1+ZeileOU ));
end;
12: begin {Anwesenheit /Scan}
if User_.Anwesenheit then writeRam(3,15,Attrib[5],1,'X')
else WriteRam(3,15,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.Anwesenheit:=not User_.Anwesenheit;
if User_.Anwesenheit then writeRam(3,15,Attrib[5],1,'X')
else WriteRam(3,15,Attrib[5],1,' ');
until kc in UdbExit;
if User_.Anwesenheit then writeRam(3,15,Attrib[2],1,'X')
else WriteRam(3,15,Attrib[2],1,' ');
end;
13: begin {VIP}
if User_.VIP then writeRam(16,15,Attrib[5],1,'X')
else WriteRam(16,15,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.VIP:=not User_.VIP;
if User_.VIP then writeRam(16,15,Attrib[5],1,'X')
else WriteRam(16,15,Attrib[5],1,' ');
until kc in UdbExit;
if User_.VIP then writeRam(16,15,Attrib[2],1,'X')
else WriteRam(16,15,Attrib[2],1,' ');
end;
14: begin {show}
if User_.show then writeRam(31,15,Attrib[5],1,'X')
else WriteRam(31,15,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.show:=not User_.show;
if User_.show then writeRam(31,15,Attrib[5],1,'X')
else WriteRam(31,15,Attrib[5],1,' ');
until kc in UdbExit;
if User_.show then writeRam(31,15,Attrib[2],1,'X')
else WriteRam(31,15,Attrib[2],1,' ');
end;
15: begin {RemSchreib}
if User_.RemSchreib then writeRam(46,15,Attrib[5],1,'X')
else WriteRam(46,15,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.RemSchreib:=not User_.RemSchreib;
if User_.RemSchreib then writeRam(46,15,Attrib[5],1,'X')
else WriteRam(46,15,Attrib[5],1,' ');
until kc in UdbExit;
if User_.RemSchreib then writeRam(46,15,Attrib[2],1,'X')
else WriteRam(46,15,Attrib[2],1,' ');
end;
16: {SSIDs}
begin
ulw:=0;
WriteRam(1,maxz,Attrib[5],1,cefillstr(80,B1,B1+ZeileRL ));
repeat
x:=13; y:=17;
for obf:=0 to 15 do
begin
if obf=ulw then atr[1]:=5 else atr[1]:=2;
if user_.ssids[obf] then writeRam(x,y,Attrib[atr[1]],1,'X')
else writeRam(x,y,Attrib[atr[1]],1,' ');
inc (x,8);
if obf=7 then
begin
x:=13;
inc(y);
end;
end;
_ReadKey(KC,VC);
if vc=#32 then user_.SSids[ulw]:=not user_.ssids[ulw];
if kc=_right then inc(ulw);
if kc=_left then dec(ulw);
if ulw=255 then ulw:=15;
if ulw=16 then ulw:=0;
until kc in UdbExit;
atr[1]:=2;
x:=13; y:=17;
for obf:=0 to 15 do
begin
if user_.ssids[obf] then writeRam(x,y,Attrib[atr[1]],1,'X')
else writeRam(x,y,Attrib[atr[1]],1,' ');
inc (x,8);
if obf=7 then
begin
x:=13;
inc(y);
end;
end;
WriteRam(1,maxz,Attrib[5],1,cefillstr(80,B1,B1+ZeileOU ));
end;
17: begin
{Kompression}
ulw:=1;
if user_.Kompression=1 then WriteRam(3,21,Attrib[5],1,'X')
else WriteRam(3,21,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then
begin
if (ulw=1) then
if (User_.Kompression=1) then User_.Kompression:=0
else User_.Kompression:=1;
{if (ulw=2) then
if (User_.Kompression=2) then User_.Kompression:=0
else User_.Kompression:=2;}
if (ulw=3) then
if (User_.Kompression=3) then User_.Kompression:=0
else User_.Kompression:=3;
end;
if kc=_right then inc(ulw,2);
if kc=_left then dec(ulw,2);
if (ulw<1) or (ulw>200) then ulw:=3;
if (ulw<190) and (ulw>3) then ulw:=1;
case ulw of
1:
begin
if user_.Kompression=1 then WriteRam(3,21,Attrib[5],1,'X')
else WriteRam(3,21,Attrib[5],1,' ');
if user_.Kompression=3 then WriteRam(22,21,Attrib[2],1,'X')
else WriteRam(22,21,Attrib[2],1,' ');
{if user_.Kompression=3 then WriteRam(42,21,Attrib[2],1,'X')
else WriteRam(42,21,Attrib[2],1,' ');}
end;
{2:
begin
if user_.Kompression=1 then WriteRam(3,21,Attrib[2],1,'X')
else WriteRam(3,21,Attrib[2],1,' ');
if user_.Kompression=2 then WriteRam(22,21,Attrib[5],1,'X')
else WriteRam(22,21,Attrib[5],1,' ');
if user_.Kompression=3 then WriteRam(42,21,Attrib[2],1,'X')
else WriteRam(42,21,Attrib[2],1,' ');
end;}
3:
begin
if user_.Kompression=1 then WriteRam(3,21,Attrib[2],1,'X')
else WriteRam(3,21,Attrib[2],1,' ');
if user_.Kompression=3 then WriteRam(22,21,Attrib[5],1,'X')
else WriteRam(22,21,Attrib[5],1,' ');
{if user_.Kompression=3 then WriteRam(42,21,Attrib[5],1,'X')
else WriteRam(42,21,Attrib[5],1,' ');}
end;
end;
until kc in UdbExit;
if user_.Kompression=1 then WriteRam(3,21,Attrib[2],1,'X')
else WriteRam(3,21,Attrib[2],1,' ');
if user_.Kompression=3 then WriteRam(22,21,Attrib[2],1,'X')
else WriteRam(22,21,Attrib[2],1,' ');
{if user_.Kompression=3 then WriteRam(42,21,Attrib[2],1,'X')
else WriteRam(42,21,Attrib[2],1,' ');}
end;
18: begin
eingh:=int_str(User_.stopcode);
GetString(eingh,Attrib[2],5,74,21,KC,1,Ins);
User_.stopcode:=str_int(UpcaseStr(eingh));
WriteRam(62,21,Attrib[2],1,cefillstr(17,B1,B1+ParmStr(5,bs,teil6)+': '+int_str(user_.StopCode)));
end;
19: begin
{autopw}
if User_.AutoBoxPassw then writeRam(3,23,Attrib[5],1,'X')
else WriteRam(3,23,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.AutoBoxPassw:=not User_.autoboxpassw;
if User_.autoboxpassw then writeRam(3,23,Attrib[5],1,'X')
else WriteRam(3,23,Attrib[5],1,' ');
until kc in UdbExit;
if User_.autoboxpassw then writeRam(3,23,Attrib[2],1,'X')
else WriteRam(3,23,Attrib[2],1,' ');
end;
{Seite 2:}
20: begin
ulw:=0;
e:=1;i:=2;
repeat
y:=2;
x:=2;y:=4;
i:=1;
While g^.Remotes[i].Befehl<>'' do
begin
if i=e then ATR[1]:=5 else ATR[1]:=2;
if User_.RemAusnahmen[i] then writeRam(x+1,y,Attrib[atr[1]],1,'X')
else writeRam(x+1,y,Attrib[atr[1]],1,' ');
inc(X,15);
if i in [5,10,15,20,25,30,35,40,45,50,55,60,65,70,75,80,85,90] then
begin
inc(y);
x:=2;
end;
inc(i);
ulw:=i-1;
end;
i:=e;
_ReadKey(KC,VC);
if VC=#32 then user_.RemAusnahmen[e]:=not user_.remAusnahmen[e];
case Kc of
_dn:begin
if e+5>ulw then Alarm else inc(e,5);
end;
_up:begin
if (e-5<1) or (e+5>200) then Alarm else dec(e,5);
end;
_right:begin
if e+1>ulw then e:=1 else inc(e);
end;
_left:begin
if e-1<1 then e:=ulw else dec(e);
end;
end;
until kc in [_PgUp, _Pgdn, _ESC];
i:=1;
x:=2;y:=4;
While g^.Remotes[i].Befehl<>'' do
begin
if User_.RemAusnahmen[i] then writeRam(x+1,y,attrib[2],1,'X')
else writeRam(x+1,y,attrib[2],1,' ');
inc(X,15);
if i in [5,10,15,20,25,30,35,40,45,50,55,60,65,70,75] then
begin
x:=2;
inc(Y);
end;
inc(i);
end;
end;
{Seite 3:}
21: begin {FBBStreng}
if User_.FBBStreng_ then writeRam(3,4,Attrib[5],1,'X')
else WriteRam(3,4,Attrib[5],1,' ');
repeat
_ReadKey(KC,VC);
if vc=#32 then User_.FBBStreng_:=not User_.FBBStreng_;
if User_.FBBStreng_ then writeRam(3,4,Attrib[5],1,'X')
else WriteRam(3,4,Attrib[5],1,' ');
until kc in UdbExit;
if User_.FBBStreng_ then writeRam(3,4,Attrib[2],1,'X')
else WriteRam(3,4,Attrib[2],1,' ');
end;
22: {Synonym}
begin
eingh:=User_.Synonym;
GetString(eingh,Attrib[2],10,62,4,KC,1,Ins);
User_.Synonym:=eingh;
WriteRam(62,4,Attrib[2],1,cefillstr(10,b1,User_.Synonym));
end;
23: {Vorbereitung}
begin
eingh:=User_.Vorbereitung;
GetString(eingh,Attrib[2],60,18,6,KC,1,Ins);
User_.Vorbereitung:=eingh;
WriteRam(18,6,Attrib[2],1,cefillstr(60,B1,User_.vorbereitung));
end;
24: {MailLesen}
begin
eingh:=User_.MailLesen;
GetString(eingh,Attrib[2],10,18,8,KC,1,Ins);
User_.MailLesen:=eingh;
WriteRam(18,8,Attrib[2],1,cefillstr(10,B1,User_.MailLesen));
end;
25: {MailL”schen}
begin
eingh:=User_.MailKillen;
GetString(eingh,Attrib[2],10,62,8,KC,1,Ins);
User_.MailKillen:=eingh;
WriteRam(62,8,Attrib[2],1,cefillstr(10,B1,User_.MailKillen));
end;
26: {Nachbereitung}
begin
eingh:=User_.Nachbereitung;
GetString(eingh,Attrib[2],60,18,10,KC,1,Ins);
User_.Nachbereitung:=eingh;
WriteRam(18,10,Attrib[2],1,cefillstr(60,B1,User_.Nachbereitung));
end;
27: {ByeBye}
begin
eingh:=User_.ByeBye;
GetString(eingh,Attrib[2],10,18,12,KC,1,Ins);
User_.ByeBye:=eingh;
WriteRam(18,12,Attrib[2],1,cefillstr(10,B1,User_.ByeBye));
end;
28: {Prompt}
begin
eingh:=User_.Prompt;
GetString(eingh,Attrib[2],60,18,14,KC,1,Ins);
User_.Prompt:=eingh;
WriteRam(18,14,Attrib[2],1,cefillstr(60,B1,User_.Prompt));
end;
29: {PWPrompt}
begin
eingh:=User_.PWPrompt;
GetString(eingh,Attrib[2],60,18,15,KC,1,Ins);
User_.PWprompt:=eingh;
WriteRam(18,15,Attrib[2],1,cefillstr(60,B1,User_.PWPrompt));
end;
30: {SStopPrompt}
begin
eingh:=User_.SStopPrompt;
GetString(eingh,Attrib[2],60,18,16,KC,1,Ins);
User_.SStopPrompt:=eingh;
WriteRam(18,16,Attrib[2],1,cefillstr(60,B1,User_.SStopPrompt));
end;
end;
if kc=_Esc then Flag := true;
if kc=_PgDn then
begin
inc(Seite);
Seitenwechsel:=true;
end;
if kc=_PgUp then
begin
dec(Seite);
Seitenwechsel:=true;
end;
if Seite>3 then Seite:=1;
if Seite<1 then Seite:=3;
Until Flag;
geaendert:=false;
if User_.Call<>SaveDat.Call then Geaendert:=true;
if User_.Alias<>SaveDat.alias then Geaendert:=true;
if User_.name<>SaveDat.Name then Geaendert:=true;
if User_.QTH <>SaveDat.QTH then Geaendert:=true;
if User_.Locator <>SaveDat.Locator then Geaendert:=true;
if User_.Adress <>SaveDat.Adress then Geaendert:=true;
if User_.Telefon <>SaveDat.Telefon then Geaendert:=true;
if User_.PacLen <>SaveDat.PacLen then Geaendert:=true;
if User_.Umlaut <>SaveDat.Umlaut then Geaendert:=true;
if User_.FBBStreng_ <>SaveDat.FBBStreng_ then Geaendert:=true;
if User_.VIP <>SaveDat.VIP then Geaendert:=true;
if User_.MaxFrames <>SaveDat.MaxFrames then Geaendert:=true;
if User_.Anwesenheit <> SaveDat.Anwesenheit then geaendert:=true;
if User_.Show<>SaveDat.Show then Geaendert:=true;
if User_.RemSchreib<>SaveDat.RemSchreib then Geaendert:=true;
if User_.System <>SaveDat.System then Geaendert:=true;
if User_.MailLesen<>SaveDat.MailLesen then Geaendert:=true;
if User_.Mailkillen<>SaveDat.Mailkillen then Geaendert:=true;
if User_.ByeBye<>SaveDat.ByeBye then Geaendert:=true;
if User_.Prompt<>SaveDat.Prompt then Geaendert:=true;
if User_.pwPrompt<>SaveDat.pwPrompt then Geaendert:=true;
if User_.SStopPrompt<>SaveDat.SStopPrompt then Geaendert:=true;
if User_.StopCode<>SaveDat.StopCode then Geaendert:=true;
for i:=0 to 15 do
if User_.SSids[i]<>SaveDat.ssids[i] then Geaendert:=true;
for i:=1 to maxrem do
begin
if (g^.Remotes[i].Befehl<>'') and (user_.RemAusnahmen[i]<>SaveDat.RemAusnahmen[i])
then Geaendert:=true;
end;
if User_.Vorbereitung<>SaveDat.Vorbereitung then Geaendert:=true;
if User_.Nachbereitung<>SaveDat.Nachbereitung then Geaendert:=true;
if User_.Synonym<>SaveDat.Synonym then Geaendert:=true;
if User_.Kompression<>SaveDat.Kompression then Geaendert:=true;
if User_.AutoBoxPassw<>SaveDat.AutoBoxPassw then geaendert:=true;
if geaendert then
begin
WriteRam(1,16,Attrib[5],1,cefillstr(80,B1,B1+InfoZeile(196)));
_ReadKey(KC,VC);
VC := UpCase(VC);
end else begin
KC := _Dn;
VC :='N';
end; {saveDat}
if (KC =_Ret) or (VC in YesMenge) then
begin
{sortUser;}
WriteRam(1,16,Attrib[5],1,cefillstr(80,B1,B1+InfoZeile(232)));
PutUser(User_,art,0,neupos, true);
{Aenderungen auf die connecteten Kanaele weiterleiten //db1ras}
For i:=1 to maxlink Do
If k[i]^.Connected Then
If k[i]^.Call=User_.Call Then Begin
If k[i]^.System<>User_.System Then Begin
k[i]^.User_Name := GetName(i,User_.Call,k[i]^.Umlaut,true);
SetzeSysArt(i);
End Else
k[i]^.User_Name := GetName(i,User_.Call,k[i]^.Umlaut,true);
End Else Begin
hstr:=k[i]^.Call;
Strip(hstr);
If (hstr = User_.Call) And
(UserSuchRoutine(k[i]^.Call,Zahl,false,true) = false) Then
Begin
If k[i]^.System<>User_.System Then Begin
k[i]^.User_Name := GetName(i,User_.Call,k[i]^.Umlaut,true);
SetzeSysArt(i);
End Else
k[i]^.User_Name := GetName(i,User_.Call,k[i]^.Umlaut,true);
End;
End;
{ Den Code hier verstehe ich nicht. Sollte aber von meinem Code }
{ (oberhalb) mit abgedeckt werden (hoffe ich zumindest) //db1ras }
{ if user_.stopCode<>SaveDat.StopCode then
begin
geaendert:=false;
for i:=1 to maxlink do
begin
if k[i]^.Call=User_.Call then
begin
Geaendert:=true;
k[i]^.StopCode:=User_.StopCode;
end;
if not Geaendert then
begin
hstr:=K[i]^.Call;
strip(hstr);
strip(User_.Call);
for i:=1 to maxlink do
begin
if hstr=User_.Call then
begin
Geaendert:=true;
k[i]^.StopCode:=User_.StopCode;
end;
end;
end;
end;
end;
}
end else if (Neu) and (UserAnz>0) then dec(UserAnz);
gross:=grosssave;
End;

1591
XPUSER.PAS Executable file
View file

File diff suppressed because it is too large Load diff

892
XPV24.PAS Executable file
View file

@ -0,0 +1,892 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P V 2 4 . P A S ³
³ ³
³ - Routinen zur Bedienung bis zu 4 Schnittstellen + ³
³ Hardware-Umschaltung bei Multiplexkarten. ³
³ ³
³ - Interface zum TFPCR-, TFPCX-Treiber von DL1MEN bzw. DG0FT ³
³ Es wird nach dem passenden Software-Interrupt im Bereich ³
³ $40 bis $FF gesucht! ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function IntFlag : Boolean;
Var FlagInt : Word;
Begin
asm
pushf
pop ax
mov FlagInt, ax
end;
IntFlag := (FlagInt and $200) = $200;
End;
Procedure RTS_Setzen (Nr : Byte);
Begin
Port[COM[Nr].Base+$04] := (Port[COM[Nr].Base+$04] or $02);
End;
Procedure RTS_Loeschen (Nr : Byte);
Begin
Port[COM[Nr].Base+$04] := (Port[COM[Nr].Base+$04] and (FF-$02));
End;
Procedure IRQsLock;
Begin
if IrqMask > 0 then Port[$21] := Port[$21] or IrqMask;
SynchError := false;
OverRun := false;
End;
Procedure IRQsFree;
Begin
if IrqMask > 0 then Port[$21] := Port[$21] and (FF - IrqMask);
End;
Procedure get_Chr_TFPC; assembler;
VAR b : Byte;
NoData : Byte;
ASM
XOR AX, AX
CMP TFPC_installed, 0
JNZ @jumptfpc
@jumpdrsi:
JMP @modifydrsi
JMP @polldrsi
@modifydrsi:
LEA BX, @modone-1
MOV DL, Kiss_Int
MOV CS:[BX], DL
LEA BX, @jumpdrsi
MOV DX, 9090h
MOV CS:[BX], DX
@polldrsi:
XOR AX, AX
MOV AH, 0h
INT $00
@modone:
CMP AH, 1
JNZ @abort
MOV b, AL
MOV NoData, 0
JMP @Ende
@jumptfpc:
jmp @modifytfpc
jmp @polltfpc
@modifytfpc:
LEA BX, @nummer-1
MOV DL, Kiss_Int
MOV CS:[BX], DL
LEA BX, @nummer2-1
MOV CS:[BX], DL
LEA BX, @jumptfpc
MOV DX, 9090h
MOV CS:[BX], DX
@polltfpc:
XOR AX, AX
MOV AH, 01h
INT $00
@nummer:
CMP AX, 01
JNZ @Abort
MOV AH, 02
INT $00
@nummer2:
MOV B, AL
MOV NoData, 0
JMP @Ende
@abort:
MOV NoData, 1
@Ende:
CMP NoData, 0
JNZ @Final
XOR BL, BL
MOV BL, b
LEA DI, V24Buffer
ADD DI, BufferPos
MOV [DS:DI], BL
INC BufferPos
CMP BufferPos, maxComBuf
JNZ @Final
LEA DI, V24Buffer
MOV AL, [DS:DI]
CMP AL, 0
JZ @Final
@ClearV24Buffer:
MOV AH, 0
MOV [DS:DI], AH
INC DI
MOV AL, [DS:DI]
CMP AL, 0
JNZ @ClearV24Buffer
@Final:
END;
(*Procedure get_Chr_TFPC;
Var r : Registers;
b : Byte;
Begin
if TFPC_installed then
begin
r.AH := $01;
Intr(Kiss_Int,r);
if r.AX = 1 then
begin
r.AH := $02;
Intr(Kiss_Int,r);
b := r.AL;
V24Buffer[BufferPos] := b;
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
end;
if DRSI_installed then
begin
r.AH := $00;
Intr(Kiss_Int,r);
if r.AH = 1 then
begin
b := r.AL;
V24Buffer[BufferPos] := b;
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
end;
End; *)
{
Procedure get_Chr_Hs (* V24Nr : Byte *);
Begin
Repeat
CB := Port[COM[V24Nr].Base + $05];
TRead := CB and $01 = $01;
if TRead then
begin
V24Buffer[BufferPos] := Port[COM[V24Nr].Base];
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
if CB and $02 = $02 then OverRun := true;
Until not TRead;
End;
}
Procedure get_Chr_Hs (* V24Nr : Byte *); Assembler;
Asm
@1:
xor ax, ax
mov al, V24Nr
dec al
shl al, $01
mov bx, Offset Default_Base
add bx, ax
mov dx, [ds:bx]
add dx, $05
in al, dx
test al, $02
jz @2
mov OverRun, $01
@2:
test al, $01
jz @4
sub dx, $05
in al, dx
mov si, BufferPos
mov bx, Offset V24Buffer
mov [ds:bx+si], al
inc BufferPos
cmp BufferPos, maxComBuf
jb @3
mov BufferPos, $00
@3:
jmp @1
@4:
End;
(*
{$F+} Procedure Com_Int1; {$F-} Interrupt;
Const V24Nr = 1;
Begin
Repeat
CB := Port[COM[V24Nr].Base + $05];
TRead := CB and $01 = $01;
if TRead then
begin
V24Buffer[BufferPos] := Port[COM[V24Nr].Base];
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
if CB and $02 = $02 then OverRun := true;
Until not TRead;
if COM[V24Nr].IRQ_Nr > 7 then Port[$A0] := $20;
Port[$20] := $20;
End;
{$F+} Procedure Com_Int2; {$F-} Interrupt;
Const V24Nr = 2;
Begin
Repeat
CB := Port[COM[V24Nr].Base + $05];
TRead := CB and $01 = $01;
if TRead then
begin
V24Buffer[BufferPos] := Port[COM[V24Nr].Base];
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
if CB and $02 = $02 then OverRun := true;
Until not TRead;
if COM[V24Nr].IRQ_Nr > 7 then Port[$A0] := $20;
Port[$20] := $20;
End;
{$F+} Procedure Com_Int3; {$F-} Interrupt;
Const V24Nr = 3;
Begin
Repeat
CB := Port[COM[V24Nr].Base + $05];
TRead := CB and $01 = $01;
if TRead then
begin
V24Buffer[BufferPos] := Port[COM[V24Nr].Base];
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
if CB and $02 = $02 then OverRun := true;
Until not TRead;
if COM[V24Nr].IRQ_Nr > 7 then Port[$A0] := $20;
Port[$20] := $20;
End;
{$F+} Procedure Com_Int4; {$F-} Interrupt;
Const V24Nr = 4;
Begin
Repeat
CB := Port[COM[V24Nr].Base + $05];
TRead := CB and $01 = $01;
if TRead then
begin
V24Buffer[BufferPos] := Port[COM[V24Nr].Base];
inc(BufferPos);
if BufferPos >= maxComBuf then ClearV24Buffer;
end;
if CB and $02 = $02 then OverRun := true;
Until not TRead;
if COM[V24Nr].IRQ_Nr > 7 then Port[$A0] := $20;
Port[$20] := $20;
End;
*)
{$F+} Procedure Com_Int1; {$F-} Interrupt; Assembler;
Asm
@1:
mov dx, ComAdr1
add dx, $05
in al, dx
test al, $02
jz @2
mov OverRun, $01
@2:
test al, $01
jz @4
sub dx, $05
in al, dx
mov si, BufferPos
mov bx, Offset V24Buffer
mov [ds:bx+si], al
inc BufferPos
cmp BufferPos, maxComBuf
jb @3
mov BufferPos, $00
@3:
jmp @1
@4:
mov al, $20
mov ah, EoiPic1
test ah, $01
jz @5
out $A0, al
@5:
out $20, al
End;
{$F+} Procedure Com_Int2; {$F-} Interrupt; Assembler;
Asm
@1:
mov dx, ComAdr2
add dx, $05
in al, dx
test al, $02
jz @2
mov OverRun, $01
@2:
test al, $01
jz @4
sub dx, $05
in al, dx
mov si, BufferPos
mov bx, Offset V24Buffer
mov [ds:bx+si], al
inc BufferPos
cmp BufferPos, maxComBuf
jb @3
mov BufferPos, $00
@3:
jmp @1
@4:
mov al, $20
mov ah, EoiPic2
test ah, $01
jz @5
out $A0, al
@5:
out $20, al
End;
{$F+} Procedure Com_Int3; {$F-} Interrupt; Assembler;
Asm
@1:
mov dx, ComAdr3
add dx, $05
in al, dx
test al, $02
jz @2
mov OverRun, $01
@2:
test al, $01
jz @4
sub dx, $05
in al, dx
mov si, BufferPos
mov bx, Offset V24Buffer
mov [ds:bx+si], al
inc BufferPos
cmp BufferPos, maxComBuf
jb @3
mov BufferPos, $00
@3:
jmp @1
@4:
mov al, $20
mov ah, EoiPic3
test ah, $01
jz @5
out $A0, al
@5:
out $20, al
End;
{$F+} Procedure Com_Int4; {$F-} Interrupt; Assembler;
Asm
@1:
mov dx, ComAdr4
add dx, $05
in al, dx
test al, $02
jz @2
mov OverRun, $01
@2:
test al, $01
jz @4
sub dx, $05
in al, dx
mov si, BufferPos
mov bx, Offset V24Buffer
mov [ds:bx+si], al
inc BufferPos
cmp BufferPos, maxComBuf
jb @3
mov BufferPos, $00
@3:
jmp @1
@4:
mov al, $20
mov ah, EoiPic4
test ah, $01
jz @5
out $A0, al
@5:
out $20, al
End;
{----------------------------------------------------------------------------
| Eine der V24-Schnittstellen initialisieren
+----------------------------------------------------------------------------}
Procedure V24_Init;
Var T,Nr,INr,dB : Byte;
V24Install : Boolean;
Begin
for T := 1 to TNC_Anzahl do
begin
Nr := TNC[T]^.RS232;
if (Nr < 5) and not COM[Nr].Active then with COM[Nr] do
begin
V24Install := (Port[Base + $05] and $60) = $60;
if V24Install then
begin
While (Port[Base + $05] and $01) = $01 do dB := Port[Base];
{FIFO-Controlregister eines NSC 16550A initialisieren sofern installiert}
{Beim 8250/16450 geht diese Initialisierung ins Leere und bewirkt nichts}
Port[Base + $02] := FifoCfg;
FifoOn := Port[Base + $02] and $C0 = $C0;
OrgLCR := Port[Base + $03]; { altes LCR sichern }
OrgMCR := Port[Base + $04]; { altes MCR sichern }
OrgIER := Port[Base + $01]; { altes IER sichern }
Port[Base + $03] := Port[Base + $03] or $80; { LCR : DLAB=1 }
OrgLODIV := Port[Base + $00]; { alte Baudrate sichern }
OrgHIDIV := Port[Base + $01];
Port[Base+3] := OrgLCR;
Inline($FA);
if not HwHs then
begin
if IRQ_Nr > 7 then INr := IRQ_Nr + 104
else INr := IRQ_Nr + 8;
GetIntVec(INr,Old_Vector);
Case Nr of
1 : SetIntVec(INr,@Com_Int1);
2 : SetIntVec(INr,@Com_Int2);
3 : SetIntVec(INr,@Com_Int3);
4 : SetIntVec(INr,@Com_Int4);
end;
if IRQ_Nr > 7 then
begin
Port[$A1] := Port[$A1] and (FF - (1 shl (IRQ_Nr-8)));
Port[$21] := Port[$21] and (FF - $04);
Port[$20] := $C1;
end else
begin
Port[$21] := Port[$21] and (FF - (1 shl IRQ_Nr));
Port[$20] := $C2; { V24 IRQ-Prioritaet setzen }
end;
end;
Inline($FB);
dB := Byte(Round(115200 / BaudRate));
Port[Base + $03] := Port[Base + $03] or $80; { LCR : DLAB=1 }
Port[Base + $00] := Lo(dB); { $06 = 19200 bd, $0C = 9600 }
Port[Base + $01] := Hi(dB); { HI Baud }
Port[Base + $03] := $03; { LCR NoParity 8Data 1Stop:DLAB=0 }
if not HwHs then
begin
Port[Base + $04] := $0B; { MCR IRQ-, RTS-, DTR-Ltg freiset.}
Port[Base + $01] := $01; { Interrupt bei Empfangsdaten }
Verzoegern(200);
end else Port[Base + $04] := $03; { MCR RTS und DTR= H }
Active := true;
end else Abbruch_XP(13,int_str(Nr));
end;
ClearV24Buffer;
end;
End;
{-----------------------------------------------------------------------------
| V24_Close setzt alle Vektoren wieder zur<75>ck
| Neu: Interrupts werden gesperrt (nach DL4NO) 11/1989
+----------------------------------------------------------------------------}
Procedure V24_Close;
Var INr, i : Byte;
Begin
for i := 1 to 4 do with COM[i] do
if Active then
begin
Port[Base + $01] := $00; { serielles Port-IER sperren }
Port[Base + $04] := $00; { IRQ-Leitung in Tristate }
Inline($FA);
if not HwHs then
begin
if IRQ_Nr > 7 then INr := IRQ_Nr + 104
else INr := IRQ_Nr + 8;
SetIntVec(INr,Old_Vector);
end;
Port[Base + $03] := Port[Base + $03] or $80;
Port[Base + $00] := OrgLODIV; { alte Baudrate restaurieren }
Port[Base + $01] := OrgHIDIV;
Port[Base + $03] := OrgLCR; { LCR restaurieren }
Port[Base + $01] := OrgIER; { IER restaurieren }
Inline($FB);
Port[Base + $04] := OrgMCR; { MCR restaurieren }
Active := false;
end;
End;
Procedure WriteAux (* V24Nr : Byte; Zeile : String *);
Var i : Byte;
r : Registers;
Begin
if (V24Nr = 5) then
begin
for i := 1 to ord(Zeile[0]) do
begin
if TFPC_installed then r.AH := 3;
if DRSI_installed then r.AH := 1;
r.AL := Ord(Zeile[i]);
Intr(Kiss_Int,r);
end;
end else with COM[V24Nr] do
begin
for i := 1 to ord(Zeile[0]) do
begin
Repeat Until (Port[Base + $05] and 32) = 32;
Port[Base] := Ord(Zeile[i]);
end;
end;
End;
{------------------------------------------------------------------------------
| Den gew<65>nschten TNC einschalten
+-----------------------------------------------------------------------------}
Procedure Switch_TNC (* TNr : Byte *);
Var sw : Byte;
MCR : Byte;
Begin
if (TNC[TNr]^.RS232 < 5) and (Old_Active_TNC <> TNr) then
begin
Old_Active_TNC := TNr;
sw := TNC[TNr]^.MPX;
if sw in [1..4] then with COM[TNC[TNr]^.RS232] do
begin
MCR := Port[Base + $04];
if HwHs then MCR := MCR and $FE
else MCR := MCR and $FC;
case sw of { RTS DTR }
1 : Port[Base + $04] := MCR or $00; { L L } { L = ca.-12V }
2 : Port[Base + $04] := MCR or $01; { L H } { H = ca.+12V }
3 : Port[Base + $04] := MCR or $02; { H L }
4 : Port[Base + $04] := MCR or $03; { H H }
end;
Verzoegern(2); { ... f<>r alle F„lle ... }
end;
end;
End;
Function ReSync (* V24Nr : Byte) : Boolean *);
Var w,i,iz : Word;
KC : SonderTaste;
VC, ch : Char;
Flag : Boolean;
Hstr : String[10];
Begin
Inc(Resync_Z);
if Klingel then Beep(1500,20);
i := 0;
VC := #0;
Flag := false;
Repeat
inc(i);
StatusOut(show,1,3,Attrib[14],'COM-' + int_str(V24Nr) + ' Resynch: ' + int_str(i),1);
ClearV24Buffer;
WriteAux(V24Nr,#1);
Wait_Read(V24Nr);
move(V24Buffer[2],Hstr[1],10);
Hstr[0] := #10;
Flag := pos('INVALID',Hstr) = 1;
if not Flag then
begin
move(V24Buffer[1],Hstr[1],10);
Hstr[0] := #10;
Flag := pos('INVALID',Hstr) = 1;
end;
{ StatusOut(show,1,3,Attrib[14],hstr,1);}
While _KeyPressed do _ReadKey(KC,VC);
Until (i = 260) or (VC = ^C) or Flag;
(* if not Flag then
begin
ClearV24Buffer;
WriteAux(V24Nr,ESC+M1);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,^Q^X);
Wait_Read(V24Nr);
if V24Buffer[0] = 6 then
begin
WriteAux(V24Nr,^R^X);
Wait_Read(V24Nr);
end;
ClearV24Buffer;
WriteAux(V24Nr,ESC + 'E1'+ M1);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,^X);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,ESC);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,^Q^X);
{^Q^M^X statt JHOST0 geht auch anstatt ESC+M1, QX}
Wait_Read(V24Nr);
if V24Buffer[0] = 6 then
begin
WriteAux(V24Nr,^R^X);
Wait_Read(V24Nr);
end;
ClearV24Buffer;
WriteAux(V24Nr,ESC + 'E1'+ M1);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,^X);
Wait_Read(V24Nr);
ClearV24Buffer;
WriteAux(V24Nr,ESC);
Wait_Read(V24Nr);
ch := Chr(V24Buffer[0]);
i := 10;
While (ch <> '*') and (i > 0) do
begin
Wait_Read(V24Nr);
w := BufferPos;
While (w > 0) and (ch <> '*') do
begin
dec(w);
ch := Chr(V24Buffer[w]);
end;
if ch <> '*' then ClearV24Buffer;
dec(i);
end;
Flag:=true; VC:=#23;
if ch <> '*' then Flag:=False;
if not Flag then
begin
ClearV24Buffer;
WriteAux(V24Nr,'JHOST1' + M1);
Wait_Read(V24Nr);
Verzoegern(300);
end;
ClearV24Buffer;
end;
*)
if Flag and (VC <> ^C) then
begin
Wait_Read(V24Nr);
ClearV24Buffer;
ReSync := true;
end else ReSync := false;
SetzeFlags(show);
if K[show]^.connected then UserInStatus(show)
else UserInStatus (show);
End;
Procedure Wait_Read (* V24Nr : Byte *);
Var l : LongInt;
Begin
TimeOut := 0;
l := TimerTick;
if (V24Nr = 5) then
begin
Repeat
get_Chr_TFPC;
if l <> TimerTick then
begin
inc(TimeOut);
l := TimerTick;
end;
Until TimeOut >= Wait_TimeOut;
end else if HwHs then
begin
RTS_Setzen(V24Nr);
Repeat
if l <> TimerTick then
begin
inc(TimeOut);
l := TimerTick;
end;
get_Chr_Hs(V24Nr);
Until TimeOut >= Wait_TimeOut;
RTS_Loeschen(V24Nr);
end else Verzoegern(120);
End;
Procedure ClearV24Buffer;
var ch : Char;
Begin
FillChar(V24Buffer,SizeOf(V24Buffer),0);
BufferPos := 0;
End;
Procedure get_Response (* Kanal *);
Var V24Nr,
a,b : Byte;
l : LongInt;
Ok : Boolean;
Begin
with K[Kanal]^ do
begin
V24Nr := V24(Kanal);
Ok := false;
TimeOut := 0;
l := TimerTick;
if HwHs then RTS_Setzen(V24Nr);
Repeat
if HwHs then get_Chr_Hs(V24Nr);
if V24Nr = 5 then get_Chr_TFPC;
if (BufferPos = 2) and (V24Buffer[1] = 0) then Ok := true;
if (BufferPos > 2) then
begin
if (V24Buffer[1] < 6) and (V24Buffer[BufferPos-1] = 0) then Ok := true;
if (V24Buffer[1] > 5) and (V24Buffer[2] + 4 = BufferPos) then Ok := true;
end;
if l <> TimerTick then
begin
inc(TimeOut);
l := TimerTick;
end;
Until Ok or OverRun or (TimeOut > TNC_TimeOut);
if HwHs then RTS_Loeschen(V24Nr);
IRQsFree;
if OverRun then Wait_Read(V24Nr);
if TimeOut > TNC_TimeOut then
begin
if not ReSync(V24Nr) then DRSI_Hostmode(TncNummer,1);
end else BufToResp(Kanal);
ClearV24Buffer;
end;
End;
Procedure BufToResp (* Kanal : Byte *);
Var V24Nr : Byte;
ic : Word;
Hstr : String[80];
Begin
with K[Kanal]^ do
begin
V24Nr := V24(Kanal);
if not (SynchError or OverRun) then
begin
Kan_Char := Chr(V24Buffer[0]);
TNC_Code := V24Buffer[1];
if (Pseudo or (Kan_Char = TNCKanal)) and ((TNC_Code >= 0) and (TNC_Code < 8)) then
begin
if (TNC_Code = 6) or (TNC_Code = 7) then
begin
TNC_Count := V24Buffer[2] + 1;
if TNC_Count > FF then ic := FF
else ic := TNC_Count;
move(V24Buffer[3],Response[1],ic);
Response[0] := Chr(ic);
if TNC_Count > FF then Response256 := Chr(V24Buffer[TNC_Count + 2]);
end else if TNC_Code > 0 then
begin
move(V24Buffer[2],Response[1],BufferPos - 3);
Response[0] := Chr(BufferPos - 3);
end;
end else SynchError := true;
end;
ClearV24Buffer;
if SynchError or OverRun then
begin
Beep(1300,10);
Hstr := Star + TNC[TncNummer]^.Ident + B1 + SynchErrStr + int_str(V24Nr);
if OverRun then Hstr := Hstr + B1 + OverRunStr;
if not K[0]^.RxLRet then Hstr := ^J + Hstr;
M_aus(Attrib[28],Hstr + ^J, Kanal);
inc(SynchErrAnz);
end;
Pseudo := false;
end;
End;

506
XPWAV.PAS Executable file
View file

@ -0,0 +1,506 @@
{***************************************************************************
** Unit to play WAV-format files from Turbo Pascal for DOS. **
** by Steven H Don **
** **
** For questions, feel free to e-mail me. **
** **
** shd@earthling.net **
** http://shd.cjb.net **
** **
***************************************************************************}
{Writes a value to the DSP-chip on the SB}
procedure WriteDSP (value : byte);
begin
{$IFDEF Sound}
while Port [base + $C] And $80 <> 0 do;
Port [base + $C] := value;
{$ENDIF}
end;
{Establishes the DSP<->Speaker connection, necessary for older cards.}
function SpeakerOn : byte;
begin
WriteDSP ($D1);
end;
{Discontinues the DSP<->Speaker connection, necessary for older cards.}
function SpeakerOff : byte;
begin
WriteDSP ($D3);
end;
{Stops playing the wave-file.}
procedure DMAStop;
begin
{$IFDEF Sound}
{Set general variable to indicate no sound}
Playing := false;
{Function : D0 Stop 8 bit DMA transfer}
WriteDSP ($D0);
{Function : D5 Stop 16 bit DMA transfer}
WriteDSP ($D5);
{$I-}
if WavFileOpen then
begin
Close (SoundFile); {Close the soundfile}
if IOResult <> 0 then; {Clear Error flag}
end;
WavFileOpen := False;
{$I+}
{Free the sound buffer}
if SoundBuffer <> nil then begin
freemem (SoundBuffer, 16384);
SoundBuffer := nil;
end;
{$ENDIF}
end;
{This procedure sets up the DMA controller for DMA transfer.
Then it programs the DSP chip to receive the transfer.
Finally it initiates the transfer.}
{procedure Playback (SoundSeg, SoundOfs, size : longint);}
procedure Playback (Location : Pointer; Start, Size : Word);
var
SoundSeg, SoundOfs : Word;
page, offset : longint;
begin
{$IFDEF Sound}
{Calculate offset and segment part of the buffer}
SoundSeg := Seg (Location^);
SoundOfs := Ofs (Location^) + Start;
{Calculate Offset and Page address of Wave-data}
if fmt.BitResolution = 8 then begin
offset := SoundSeg Shl 4 + SoundOfs;
page := (SoundSeg + SoundOfs shr 4) shr 12;
end else begin
size := size shr 1;
page := (SoundSeg + SoundOfs shr 4) shr 12;
offset := (SoundSeg Shl 3 + SoundOfs shr 1) mod 65536;
end;
{Decrease size by one. This is necessary because the
DMA controller sends one byte/word more than it is told to}
{Setup DMA Controller for transfer}
Port [DMAPort [Channel, 1]] := 4 or (Channel and 3);
if fmt.BitResolution = 16 then Port [$D8] := 0;
Port [DMAPort [Channel, 3]] := 0;
Port [DMAPort [Channel, 2]] := $48 or (Channel and 3);
Port [DMAChannel [Channel, 2]] := Lo (offset);
Port [DMAChannel [Channel, 2]] := Hi (offset);
Port [DMAChannel [Channel, 1]] := page;
Port [DMAChannel [Channel, 3]] := Lo (size);
Port [DMAChannel [Channel, 3]] := Hi (size);
Port [DMAPort [Channel, 1]] := (Channel and 3);
{Set DSP}
if Card = SB8 then begin
{Set up 8-bit card, sorry no stereo SBPRO support}
WriteDSP ($14);
end else begin
{Set up 16-bit card}
if fmt.BitResolution = 8 then begin
{8-Bit file}
WriteDSP ($C0);
if fmt.Channels = 1 then WriteDSP ($00); {Mono}
if fmt.Channels = 2 then WriteDSP ($20); {Stereo}
end else begin
{16-Bit file
Perhaps this also needs to be changed}
WriteDSP ($B0);
if fmt.Channels = 1 then WriteDSP ($10); {Mono}
if fmt.Channels = 2 then WriteDSP ($30); {Stereo}
end;
end;
{Send the size of the transfer to the SB}
WriteDSP (Lo (size));
WriteDSP (Hi (size));
{Set global variable to indicate playing sound}
Playing := true;
{$ENDIF}
end;
{This procedure is called at the end of a DMA transfer. It starts the
playing of the next portion of the wave-file and reads in another block.}
procedure ServiceIRQ; interrupt;
var
b, t : Byte;
begin
{$IFDEF Sound}
{relieve card}
if Card = SB16 then begin
Port [base + $4] := $82;
t := Port [base + $5];
if t and 1 = 1 then b := Port [base + $E]; { 8bit interrupt}
if t and 2 = 2 then b := Port [base + $F]; {16bit interrupt}
end else begin
{8bit interrupt}
b := Port [base + $E];
end;
{Acknowledge hardware interrupt}
Port [$20] := $20;
{Stop playing}
Playing := false;
if FreeBuffer then begin
Dispose (SoundBuffer);
SoundBuffer := nil;
end;
{The following is done when the remaining part of the file
is less than 16K.}
if OverHead>0 then begin
{Play the last part of the sound}
if Upper then
PlayBack (SoundBuffer, 0, OverHead)
else
PlayBack (SoundBuffer, 16384, OverHead);
{The file may be closed}
Close (SoundFile);
WavFileOpen:=False;
OverHead := 0;
{The next time this routine is called, the sound buffer must
be freed so that the memory it occupies is available to the
calling programme.}
FreeBuffer := true;
end;
{If there is more than 16K to be played and/or read, it will
be done in chunks of 16K.}
if dataC.SoundLength - SoundRead > 0 then begin
if dataC.SoundLength - SoundRead > 16384 then begin
{Load into appropriate part of the buffer}
if Upper then begin
PlayBack (SoundBuffer, 0, 16384);
BlockRead (SoundFile, SoundBuffer^ [16384], 16384);
end else begin
PlayBack (SoundBuffer, 16384, 16384);
BlockRead (SoundFile, SoundBuffer^, 16384);
end;
{Update position indicators}
inc (SoundRead, 16384);
Upper := Not Upper;
end else begin
{Load in the last part of the Wave-file and play it.}
OverHead := dataC.SoundLength-SoundRead;
if Upper then begin
PlayBack (SoundBuffer, 0, 16384);
BlockRead (SoundFile, SoundBuffer^ [16384], Overhead);
end else begin
PlayBack (SoundBuffer, 16384, 16384);
BlockRead (SoundFile, SoundBuffer^, Overhead);
end;
inc (SoundRead, Overhead);
Upper := Not Upper;
end;
end;
{$ENDIF}
end;
procedure PlayWave (FileName : String);
begin
{$IFDEF Sound}
{Assume no error}
WaveError := 0;
{Return error if no sound card found}
if Base = 0 then begin
WaveError := NoCard;
Exit;
end;
{Stop any DMA-transfer that might be in progress}
DMAStop;
{Initialize settings}
FreeBuffer := false;
OverHead := 0;
{Allow access to read-only files}
FileMode := 0;
{$I-}
{Check for existence of file}
Assign (SoundFile, FileName);
Reset (SoundFile, 1);
{If it doesn't exist, maybe the extension should be added}
{ if IOResult <> 0 then begin
Assign (SoundFile, FileName + '.WAV');
Reset (SoundFile, 1);
end;}
{$I+}
FileMode:=2;
{If it doesn't resist, return an error}
if IOResult <> 0 then begin
WaveError := FileNotFound;
Exit;
end;
WavFileOpen:=True;
{Read the RIFF header}
BlockRead (SoundFile, Header, 8);
{Check for 'RIFF', if not found : don't play}
if Header.RIFF <> rId then begin
WaveError := InvalidWAVE;
Close (SoundFile);
WavFileOpen:=false;
Exit;
end;
{Read the WAVE header}
BlockRead (SoundFile, Wave, 4);
{Check for 'WAVE', if not found : don't play}
if Wave.WAVE <> wId then begin
WaveError := InvalidWAVE;
Close (SoundFile);
WavFileOpen:=False;
Exit;
end;
{Search for the fmt chunk, that starts with 'fmt '}
repeat
BlockRead (SoundFile, fmtH, 8);
if fmtH.fmt <> fId then Seek (SoundFile, FilePos (SoundFile)-7);
until fmtH.fmt = fId;
{Read format specifier}
BlockRead (SoundFile, fmt, fmtH.fmtDataLength);
{Check format}
with fmt do begin
if (Card = SB8) then begin
{16bit files can't be played through 8bit card}
if (BitResolution = 16) then begin
WaveError := No16BitCard;
Close (SoundFile);
WavFileOpen:=False;
Exit;
end;
{Stereo files are only played over 16bit card}
if (Channels = 2) then begin
WaveError := NoStereoCard;
Close (SoundFile);
WavFileOpen:=False;
Exit;
end;
end;
{Can only play uncompressed WAVs}
if WaveType <> 1 then begin
WaveError := InvalidWAVE;
Close (SoundFile);
WavFileOpen:=False;
Exit;
end;
end;
{Search for data chunk, starting with 'data'}
datac.data := 0;
repeat
BlockRead (SoundFile, dataC, 8);
if dataC.data <> dId then Seek (SoundFile, FilePos (SoundFile)-7);
until datac.data = dId;
{Some wave-files have an incorrect SoundLength. This makes sure
that the SoundLength is never larger than actually fits in the
wave file.}
if dataC.SoundLength>FileSize (SoundFile)-FilePos (SoundFile)-1 then
dataC.SoundLength := FileSize (SoundFile)-FilePos (SoundFile)-1;
WaveType.Length := dataC.SoundLength;
{The WaveLength (not SoundLength) indicates the number of Samples,
not the number of bytes, so this needs to be adjusted for the
number of channels (Mono/Stereo) and the bit-resolution (8/16-Bit)}
if WaveType.Stereo = true then WaveType.Length := WaveType.Length shr 1;
if WaveType.Resolution = 16 then WaveType.Length := WaveType.Length shr 1;
{set DMAChannel}
if fmt.BitResolution = 8 then Channel := DMA8;
if fmt.BitResolution = 16 then Channel := DMA16;
{Update global variables so that calling programs can identify
the wave being played. Pretty useless for games though}
WaveType.SampleRate := fmt.SampleRate;
WaveType.Resolution := fmt.BitResolution;
WaveType.Stereo := fmt.Channels = 2;
SoundRead := 0;
{Allocate 32K of memory to the sound buffer}
getmem (SoundBuffer,16384);
{If there was an error allocating memory, don't play.}
if SoundBuffer = nil then begin
WaveError := NoMemory;
Close (SoundFile);
WavFileOpen:=False;
Exit;
end;
{set sample rate}
case Card of
{Original SB requires a special 'time-frame' computation}
SB8 : begin
WriteDSP ($40);
WriteDSP (256 - 1000000 div fmt.SampleRate);
end;
{SB16 just needs the samplerate. Much easier}
SB16 : begin
WriteDSP ($41);
WriteDSP (hi (fmt.SampleRate));
WriteDSP (lo (fmt.SampleRate));
end;
end;
{check length of file}
if dataC.SoundLength>32768 then begin
{must be played in parts}
BlockRead (SoundFile, SoundBuffer^, 32768);
SoundRead := 32768;
PlayBack (SoundBuffer, 0, 16384);
Upper := false;
end else begin
{can be played at once}
BlockRead (SoundFile, SoundBuffer^, dataC.SoundLength);
PlayBack (SoundBuffer, 0, dataC.SoundLength);
SoundRead := dataC.SoundLength;
{$I-}
close(Soundfile);
if ioresult>0 then;
WavFileOpen:=False;
{$I+}
end;
{$ENDIF}
end;
{Stops playing the sound file}
procedure StopWave;
begin
DMAStop;
end;
{$F+}
procedure ExitWavePlayer;
begin
{$IFDEF Sound}
{Restores the ExitProc pointer to the original value}
ExitProc := OldEP;
{Stops any DMA-transfer that might be in progress}
DMAStop;
{Free interrupt vectors used to service IRQs}
case IRQ of
2 : SetIntVec($71, OldIRQ);
10 : SetIntVec($72, OldIRQ);
11 : SetIntVec($73, OldIRQ);
else
SetIntVec (8 + IRQ, OldIRQ);
end;
{Mask IRQs}
case IRQ of
2 : Port[$A1] := Port[$A1] or 2;
10 : Port[$A1] := Port[$A1] or 4;
11 : Port[$A1] := Port[$A1] or 8;
else
Port[$21] := Port[$21] or (1 shl IRQ);
end;
{$ENDIF}
end;
{$F-}
Procedure FindBlaster;
var
BLASTER : String;
p : Byte;
begin
{$IFDEF Sound}
Playing := false;
Base := 0;
{Get BLASTER environment string}
(*BLASTER := GetEnv ('BLASTER');
if (BLASTER = '') then Exit;*)
{Extract type of card from BLASTER string}
Card := SB8;
(* p := 0;
repeat inc (p) until (BLASTER [p] = 'T') or (p > length (BLASTER));
if BLASTER [p + 1] > '5' then Card := SB16; *)
if Konfig.SBHiDMA>0 then Card:=SB16;
{Extract base address from BLASTER string}
(* p := 0;
repeat inc (p) until (BLASTER [p] = 'A') or (p > length (BLASTER));
Base := Ord (BLASTER [p + 2]) - Ord ('0');
Base := (Base shl 4) + $200; *)
Base:=konfig.SBBaseADR;
{Extract IRQ level from BLASTER string}
(* p := 0;
repeat inc (p) until (BLASTER [p] = 'I') or (p > length (BLASTER));
IRQ := Ord (BLASTER [p + 1]) - Ord ('0'); *)
IRQ:=konfig.SBIRQ;
{Extract low DMA channel from BLASTER string}
(*p := 0;
repeat inc (p) until (BLASTER [p] = 'D') or (p > length (BLASTER));
DMA8 := Ord (BLASTER [p + 1]) - Ord ('0'); *)
DMA8:=konfig.SBLoDMA;
{Extract high DMA channel from BLASTER string}
(*p := 0;
repeat inc (p) until (BLASTER [p] = 'H') or (p > length (BLASTER));
DMA16 := Ord (BLASTER [p + 1]) - Ord ('0'); *)
DMA16:=Konfig.SBHiDMA;
{Enable speaker}
SpeakerOn;
{Save old IRQ vector}
case IRQ of
2 : GetIntVec($71, OldIRQ);
10 : GetIntVec($72, OldIRQ);
11 : GetIntVec($73, OldIRQ);
else
GetIntVec (8 + IRQ, OldIRQ);
end;
{Set new IRQ vector}
case IRQ of
2 : SetIntVec($71, Addr (ServiceIRQ));
10 : SetIntVec($72, Addr (ServiceIRQ));
11 : SetIntVec($73, Addr (ServiceIRQ));
else
SetIntVec (8 + IRQ, Addr (ServiceIRQ));
end;
{Enable IRQ}
case IRQ of
2 : Port[$A1] := Port[$A1] and not 2;
10 : Port[$A1] := Port[$A1] and not 4;
11 : Port[$A1] := Port[$A1] and not 8;
else
Port[$21] := Port[$21] and not (1 shl IRQ);
end;
if IRQ in [2, 10, 11] then Port[$21] := Port[$21] and not 4;
{Save ExitProc pointer and set it to our own exit procedure.
The ExitProc procedure is called after the main (calling)
programme terminates. The main programme doesn't have to take
care of resetting the IRQs and so on.}
OldEP := ExitProc;
ExitProc := Addr (ExitWavePlayer);
{$ENDIF}
end;

512
XPXBIN.PAS Executable file
View file

@ -0,0 +1,512 @@
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³
³ X - P a c k e t ³
³ ³
³ ³
³ X P X B I N . P A S ³
³ ³
³ X-Protokoll-Verarbeitung ³
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
Function CRC_Zeile (CRCZeile : string) : String;
var CRC : Word;
z : word;
Begin
CRC:=0;
for z := 1 to length(CRCZeile)
do CRC := g^.crcFeld[(CRC shr 8)] xor ((CRC shl 8) or ORD(CRCZeile[z]));
{if xbtest then crc:=0;
xbtest:=false;}
CRC_zeile:=HEx(CRC,4);
End;
Procedure XBinAbbruch(kanal : byte);
begin
with k[kanal]^ do
begin
s_pac(kanal,nu,true,#13+Meldung[10]+#13);
s_pac(kanal,nu,true,M1+'XBIN-TX abgebrochen.'+m1);
{ xbtest:=true;}
CloseXBinProt(kanal);
FiResult := CloseBin(TxFile);
xbin.an:=false;
xbin.rx:=false;
xbin.tx:=false;
xbin.eof:=false;
xbin.rtxok:=true;
rx_save:=false;
BoxZaehl:=5;
setzeflags(kanal);
end;
end;
Function Endung(Kanal:byte) : Str8;
begin
Endung:= sfillstr(3,'0',int_str(Kanal));
end;
Procedure OpenXBinProt {(Kanal:byte)};
begin
with K[kanal]^ do
begin
assign(XbinPFile, Sys1Pfad+XBinProtokoll+Endung(Kanal));
rewrite(XBinPfile);
xbin.ProtPos:=0;
xbin.pdat:=true;
xbin.retries:=0;
xbin.datpos:=0;
end;
end;
Procedure CloseXBinProt {(Kanal:byte)};
begin
with K[kanal]^ do
begin
close(XBinPfile);
xbin.pdat:=false;
end;
end;
{XBinCheck (kanal : Byte; XBinZ:string; DtPos:longint; XZeile:string);}
Procedure XBinCheck;
VAR CRC1, CRC2 : Str8;
i,
frNr : byte;
proto:xbinfile_;
Art : char;
bef:integer;
rept:string;
firesult:word;
begin
with K[kanal]^ do
begin
if not xbin.pdat then
begin
OpenXBinProt(kanal);
xbin.ProtPos:=0;
end;
delete (XBinZ, 1,2);
art:=xbinz[1];
delete(xbinz,1,1);
if Art=#255 then
begin
frnr:=ord(XbinZ[1]);
if frnr>XBin.FrameNr then
begin
i:=Length(XZeile);
rept:=EFillStr(i,#0,rept);
while frnr>xbin.framenr do
begin
BlockWrite(RXFile,rept,i,bef);
if xbin.pdat then
begin
Proto.DatPos:=DtPos;
Proto.FrameNr:=XBin.FrameNr;
Proto.OK:=false;
proto.rxcrc:='FAIL';
proto.crc:='URE!';
write(XBinPfile, Proto);
end;
DtPos:=FilePos(RxFile);
inc(Xbin.FrameNr);
end;
rept:='';
end else Proto.FrameNr:=frnr;
delete(XbinZ,1,1);
CRC1:=XBinZ;
if xbin.pdat then
begin
Proto.DatPos:=DtPos;
if not xbin.RTXOK then
begin
seek(XBinPFile, Proto.FrameNr);
read (xbinpfile, proto);
seek(RXFile, Proto.DatPos);
seek(XBinPFile, Proto.FrameNr);
end;
crc2:=CRC_Zeile(XZeile);
if CRC2<>CRC1 then Proto.OK:=false else Proto.OK:=true;
proto.rxcrc:=CRC1;
proto.crc:=crc2;
write(XBinPfile, Proto);
end;
inc(Xbin.FrameNr);
end {if art=255}
else begin {art=0}
bef:=ord(XBinZ[1]);
case bef of
TRASK:
begin
if xbin.rtxok then XBin.DatPosA:=filePos(RXFile);
xbin.rtxok:=true;
{xbin.pdat:=false;}
reset(XbinPFile);
rept:='';
while not EOF(xbinpfile) do
begin
read(xbinpfile, proto);
if not proto.ok then rept:=rept+chr(Proto.framenr);
end;
if rept<>'' then
begin
xbin.rtxok:=false;
if length(rept)>5 then
begin
rept:=copy(rept,1,5);
end;
s_pac(kanal,nu,true,xprot+COMD+chr(REP)+rept);
{xbin.pdat:=true;}
end else
begin
s_pac(kanal,nu,true,xprot+COMD+chr(TROK));
{rewrite(XBinPFile);}
xbin.ProtPos:=FilePos(XBinPFile);
seek(RXFile, XBin.DatPosA);
xbin.FrameNr:=0;
end;
end; {TRASK}
TROK:
begin
if XBin.EOF then
begin
s_pac(kanal,nu,true,xprot+COMD+chr(XEOF));
s_pac(kanal,nu,true,M1+'XBIN-TX abgeschlossen.'+m1);
{ xbtest:=true;}
CloseXBinProt(kanal);
FiResult := CloseBin(TxFile);
xbin.an:=false;
xbin.rx:=false;
xbin.tx:=false;
xbin.eof:=false;
xbin.rtxok:=true;
rx_save:=false;
BoxZaehl:=5;
setzeflags(kanal);
end else
begin
{Rewrite(XbinPFile);}
xbin.ProtPos:=FilePos(XBinPFile);
seek(TXFile, XBin.DatPosA);
end;
filesendwait:=false;
xbin.FrameNr:=0;
end; {TROK}
REP:
begin
xbin.Nachford:=xbin.Nachford+copy(xbinZ, 2, length(xbinz));
filesendwait:=false;
xbin.rtxok:=false;
end; {REP}
XEOF:
begin
xbin.rx:=false;
xbin.tx:=false;
rx_save:=false;
xbin.eof:=false;
xbin.rtxok:=true;
BoxZaehl:=5;
CloseXBinProt(kanal);
CloseRxFile(Kanal,0);
xbin.an:=false;
setzeflags(kanal);
s_pac(kanal,nu,true,M1+'XBIN-RX abgeschlossen.'+m1);
end; {xeof}
end;
end;
end; {with kanal...}
end;
{**}
{Function XBinStr (Kanal : Byte; Zeile : String; TXPos:longint) : String;}
Function XBinStr;
var hstr:string;
proto:xbinfile_;
begin
with K[kanal]^ do
begin
hstr:=xprot+#255+chr(XBin.FrameNr)+CRC_Zeile(Zeile);
XBinStr:=HStr;
if not XBin.pdat then OpenXBinProt(kanal);
if (XBin.PDat) and (Xbin.RTXok) then
begin
Proto.retries:=0;
Proto.FrameNr:=XBin.FrameNr;
Proto.DatPos :=TXPos;
Proto.RXCRC:='XBTX';
Proto.CRC:='XBTX';
Proto.OK:=true;
write(XBinPFile, Proto);
end;
inc(xbin.FrameNr)
end;
end;
Function Position(Fnr :Byte; kanal : Byte) : longint;
var proto:xbinfile_;
begin
with k[kanal]^ do
begin
close (XbinPFile); reset(XbinPFile);
seek(xbinPfile, fnr);
read(xbinpfile, Proto);
if xbin.tx then
begin
seek(xbinPfile, fnr);
inc(proto.retries);
write(xbinpfile, Proto);
if proto.retries=11 then XBinAbbruch(kanal);
end;
xbin.framenr:=fnr;
Position:=proto.DatPos;
end;
end;
procedure XBinWrite {(kanal:Byte; Zeile:string)};
Var i,i1 : Integer;
Free : LongInt;
DatPos:longint;
Result : Word;
Hstr : String[80];
VC : Char;
Bstr : String;
XBinRX : string;
begin
with k[kanal]^ do
begin
if MldOk in [5,6,10] then
begin
if MldOk = 10 then
begin
FiResult := CloseBin(RxFile);
FiResult := EraseBin(RxFile);
if xbin.pdat then closeXBinProt(kanal);
S_PAC(Kanal,NU,false,InfoZeile(41) + M1);
Send_Prompt(Kanal,FF);
end else CloseRxFile(Kanal,1);
xbin.rx:=false; xbin.an:=false; xbin.tx:=false; xbin.framenr:=0;
setzeFlags(kanal);
end
else
begin
if length(zeile)>8 then
begin
XBinRX := copy (Zeile, 1, 8);
delete (Zeile,1,8);
end else
begin
XBinRX := Zeile;
zeile:='';
end;
DatPos:=filePos(RXFile);
XBinCHECK(Kanal, XBinRX, DatPos, Zeile);
i1 := length(Zeile);
{if (RX_Count + i1) > RX_Laenge then i1 := Byte(RX_Laenge - RX_Count);}
BlockWrite(RXFile,Zeile[1],i1,Result);
RX_CRC := Compute_CRC(RX_CRC,copy(Zeile,1,Result));
if XBin.RTXOk then RX_Count := RX_Count + i1;
FileInfo(Kanal,0,RX_Laenge,RX_Count,0,0);
if RX_Count >= RX_Laenge then
begin
{if xbin.pdat then closeXbinprot(kanal);}
Result := Word(RX_CRC);
BoxZaehl:=5;
AutoBinOn := AutoBin;
Ignore := false;
SetzeFlags(Kanal);
(*
Hstr := Time_Differenz(RX_Time,Uhrzeit);
Zeile := FName_aus_FVar(RxFile);
While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
Zeile := M1 + B1 + InfoZeile(103) + B1 +
EFillStr(14,B1,Zeile) + InfoZeile(100) +
int_str(Result) + B2 + LRK + Hex(Result,4) + B1 +
BdStr + FileBaud(Hstr,int_str(RX_Count)) + B2 +
LRK + Hstr + RRK + M1;
if (RX_Soll_CRC > 0) and (Result <> RX_Soll_CRC)
then Zeile := Zeile + B1 + InfoZeile(113) + ^G + M1;
if SysArt in [1..6,14,18] then
S_PAC(Kanal,NU,true,M1)
else
begin
{S_PAC(Kanal,NU,false,Zeile);
Send_Prompt(Kanal,FF);}
end; *)
end;
end; {else (mldok)}
end;{with kanal}
end; {procedure xbinwrite}
Procedure XBinSend (* Kanal : Byte; OFlag : Boolean; *);
Var Zeile : String;
Hstr : String[9];
i,l : Byte;
ch : Char;
FileEnde : Boolean;
Result : Word;
XBTrans : Boolean;
TXSpos,
DatPos : longint;
Begin
FileEnde := false;
Zeile := '';
with K[Kanal]^ do
Begin
XBTrans:=(XBIN.tx);
FileFlag := false;
if XBin.TX then
Begin
if TxComp then l := maxCompPac
else l := FF;
if XBTrans then l:=paclen-8;
if xbtrans and txcomp then l:=Paclen-10;
if (not xbin.rtxok) and (xbin.nachford<>'') then
begin
reset(TXFile, t);
TXSPos:=Position(ord(xbin.Nachford[1]), kanal);
if xbin.tx then seek(TxFile, TXSPos);
delete(xbin.Nachford,1,1);
end;
if xbin.tx then
begin
if xbtrans then DatPos:=filepos(TXFile);
BlockRead(TxFile,Zeile[1],l,Result);
{if ((TX_Count + Result) > TX_Laenge) and (xbin.rtxok) then Result := TX_Laenge - TX_Count;}
Zeile[0] := chr(Byte(Result));
if XBTRANS then Zeile:=XBinStr(Kanal, Zeile, DatPos)+Zeile;
{if XBTrans then Zeile[0] := chr(Byte(Result+7));}
if xbin.rtxok then
begin
TX_Count := TX_Count + Result;
TX_CRC := Compute_CRC(TX_CRC,Zeile);
end;
IF (not XBin.EOF) and (eof(TXFile)) then
begin
FileEnde := true;
xbin.eof:=true;
end;
{ if xbtest then Zeile[10]:='A';
xbtest:=false;}
S_PAC(Kanal,NU,true,Zeile);
FileInfo(Kanal,1,TX_Laenge,TX_Count,0,0);
if (not xbin.rtxok) and (xbin.nachford='') then
begin
fileende:=true;
end;
{ 255 }
if (xbin.rtxok) and (xbin.frameNr=XBinMaxFrame) then
begin
s_pac(kanal,nu,true,xprot+COMD+chr(TRASK));
FileSendWait:=true;
xbin.DatPosA:=FilePos(TXFile);
end;
if FileEnde then
Begin
TNC_Puffer := false;
FileSend := false;
Result := Word(TX_CRC);
boxzaehl:=5;
if not DirScroll then SetzeFlags(Kanal);
(* Hstr := Time_Differenz(TX_Time,Uhrzeit);
Zeile := FName_aus_FVar(TxFile);
While pos(BS,Zeile) > 0 do delete(Zeile,1,pos(BS,Zeile));
Zeile := M1 + B1 + InfoZeile(102) + B1 +
EFillStr(14,B1,Zeile) + InfoZeile(100) +
int_str(Result) + B2 + LRK + Hex(Result,4) + B1 +
BdStr + FileBaud(Hstr,int_str(TX_Count)) + B2 +
LRK + Hstr + RRK + M1;
if OFlag then _aus(Attrib[20],Kanal,Zeile);
{ if FileSendRem then
begin }
if SysArt in [1..6,14,18] then
S_PAC(Kanal,NU,true,M1)
else
begin if not XBin.An then
begin
S_PAC(Kanal,NU,false,Zeile);
Send_Prompt(Kanal,FF);
end else
begin *)
S_pac(kanal,NU,TRUE,'');
s_pac(kanal,nu,true,xprot+COMD+chr(TRASK));
xbin.Nachford:='';
xbin.framenr:=0;
xbin.ok:=false;
{xbin.pdat:=false;}
xbin.datpos:=0;
xbin.retries:=0;
xbin.rtxok:=true;
fileende:=false;
filesendwait:=true;
(*
end;
end; *)
{ end else S_PAC(Kanal,NU,true,''); }
FileSendRem := false;
End;
End;
end; {if xbin.tx}
FileFlag := false;
End;
End;

147
XPXMS.PAS Executable file
View file

@ -0,0 +1,147 @@
Unit XPXMS;
{$F+}
Interface
Const ixms = $2F;
Var XMS_Version,
XMS_Treiber,
HMA : Word;
XMS_installed : Boolean;
Failure : Byte;
XmsControl : Pointer;
RecXms : record { XMS-INFOBLOCK }
Len : LongInt; { length of Bytes }
fr_Handle : Word; { source handle }
fr_Adr : LongInt; { source pointer }
to_Handle : Word; { destination handle }
to_Adr : LongInt; { destination pointer }
end;
Procedure get_XMS_Install;
Function get_XMS_Free : Word;
Function get_XMS_Ram(SizeKb : Word) : Word;
Procedure Free_XMS_Ram(Handle : Word);
Procedure Data_To_XMS(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
Procedure Xms_To_Data(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
Procedure Init_XMS;
Implementation
Procedure get_XMS_Install;
var Erg : Byte;
Begin
Erg := 0;
if not XMS_installed then
begin
asm mov ax, $4300
int ixms
mov Erg, al
cmp al, $80
jne @NoDrv
mov ax, $4310
int ixms
mov Word(XmsControl),bx
mov Word(XmsControl+2),es
xor ah,ah
call XmsControl
mov XMS_Version,ax
mov XMS_Treiber,bx
mov HMA,dx
@NoDrv:
end;
XMS_installed := (Erg = $80);
end;
End;
Function get_XMS_Free : Word;
var Free : Word;
Begin
asm mov ah,$08
call XmsControl
mov Free,ax
mov Failure,bl
end;
get_XMS_Free := Free;
End;
Function get_XMS_Ram(SizeKb : Word) : Word;
var Handle : Word;
Begin
asm mov ah, $09
mov dx, SizeKb
call XmsControl;
mov Handle, dx
end;
get_XMS_Ram := Handle;
End;
Procedure Free_XMS_Ram(Handle : Word);
Begin
asm mov ah, $0A
mov dx, Handle
call XmsControl;
end;
End;
Procedure Data_To_XMS(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
var Erg : Word;
m : Pointer;
Begin
m := Addr(RecXms);
If Count mod 2 <> 0 then inc(Count);
RecXms.Len := count;
RecXms.fr_Handle := 0;
RecXms.fr_Adr := LongInt(Source);
RecXms.to_Handle := handle;
RecXms.to_adr := Adresse;
asm mov ah, $0b
mov si, Word [m]
mov bl,0
call XmsControl
mov Erg, ax
mov Failure,bl
end;
End;
Procedure Xms_To_Data(Source : Pointer; Handle : Word; Adresse,Count : LongInt);
var Erg : Word;
m : Pointer;
Begin
m := Addr(RecXms);
If Count mod 2 <> 0 then inc(Count);
RecXms.Len := count;
RecXms.to_Handle := 0;
RecXms.to_adr := LongInt(Source);
RecXms.fr_Handle := Handle;
RecXms.fr_Adr := Adresse;
asm mov ah, $0b
mov si, Word [m]
mov bl,0
call XmsControl
mov Erg, ax
mov Failure,bl
end;
End;
Procedure Init_XMS;
Begin
XMS_installed := false;
get_XMS_Install;
End;
End.