initial commit
This commit is contained in:
commit
c0f9ca4017
64 changed files with 47368 additions and 0 deletions
674
LICENSE
Executable file
674
LICENSE
Executable 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
323
OVERXMS.ASM
Executable 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
21
OVERXMS.PAS
Executable 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
4
README.md
Executable 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
223
XP7PL.PAS
Executable 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
314
XPACKET.PAS
Executable 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<EFBFBD>r Fehler, insbesondere f<EFBFBD>r eventuelle Datenverluste, kann ³
|
||||
³ KEINERLEI HAFTUNG <EFBFBD>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<EFBFBD>r Code-Fassung, Deaktiv f<EFBFBD>r offizielle
|
||||
auch XPACT, XPOVR6}
|
||||
{-$DEFINE Sound} {**Wenn aktiv, wird SB-Unterst<EFBFBD>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
4561
XPACKSET.PAS
Executable file
File diff suppressed because it is too large
Load diff
109
XPACT.PAS
Executable file
109
XPACT.PAS
Executable 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
162
XPACT1.PAS
Executable 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.
|
||||
296
XPAUTO.PAS
Executable file
296
XPAUTO.PAS
Executable file
|
|
@ -0,0 +1,296 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P A U T O . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>r die Abarbeitung der automatischen CMD-Dateien. ³
|
||||
ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ}
|
||||
|
||||
|
||||
Procedure Auto_Init (* Kanal : Byte *);
|
||||
Begin
|
||||
with K[Kanal]^ do
|
||||
begin
|
||||
{
|
||||
Werte f<EFBFBD>r CSelf:
|
||||
----------------
|
||||
1 = Auto startet zu einer bestimmten Zeit.
|
||||
2 = Auto startet alle X Minuten.
|
||||
3 = Bedingung 1 oder 2 sind erf<EFBFBD>llt.
|
||||
4 = Auto befindet sich im Wartestadium und wartet X Minuten ab.
|
||||
5 = Auto erwartet den Empfang der Abfragezeile (einfache Pr<EFBFBD>fung)
|
||||
6 = Auto erwartet den Empfang der Abfragezeile (strenge Pr<EFBFBD>fung,
|
||||
die Abfragezeile muá mit Return beendet sein).
|
||||
7 = Bedingung 5 oder 6 sind erf<EFBFBD>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<EFBFBD>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
123
XPBUF.PAS
Executable 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
730
XPCHR.PAS
Executable file
|
|
@ -0,0 +1,730 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P C H R . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
185
XPCOL.PAS
Executable file
|
|
@ -0,0 +1,185 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P C O L . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
298
XPCOMP.PAS
Executable 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
435
XPCONV.PAS
Executable file
|
|
@ -0,0 +1,435 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P C O N V . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
126
XPCOPY.PAS
Executable 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
252
XPCRC.PAS
Executable 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
161
XPDEBUG.PAS
Executable file
|
|
@ -0,0 +1,161 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P D E B U G . P A S ³
|
||||
³ ³
|
||||
³ Verschiedene Systemausk<EFBFBD>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
2504
XPDEFS.PAS
Executable file
File diff suppressed because it is too large
Load diff
216
XPDOS.PAS
Executable file
216
XPDOS.PAS
Executable file
|
|
@ -0,0 +1,216 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P D O S . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
309
XPEMS.PAS
Executable file
|
|
@ -0,0 +1,309 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ UNIT: X P E M S . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
1196
XPFILE.PAS
Executable file
File diff suppressed because it is too large
Load diff
863
XPFRX.PAS
Executable file
863
XPFRX.PAS
Executable 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
735
XPFTX.PAS
Executable 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<EFBFBD>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
639
XPHELP.PAS
Executable file
|
|
@ -0,0 +1,639 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P H E L P . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
495
XPINI.PAS
Executable 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;
|
||||
277
XPKEY.PAS
Executable file
277
XPKEY.PAS
Executable file
|
|
@ -0,0 +1,277 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P K E Y . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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<EFBFBD>ckt |
|
||||
| Bit 1 = 1 : Linke Shift-Taste gedr<EFBFBD>ckt |
|
||||
| Bit 2 = 1 : Crtl-Taste gedr<EFBFBD>ckt |
|
||||
| Bit 3 = 1 : Alt-Taste gedr<EFBFBD>ckt |
|
||||
| Bit 4 = 1 : [Scroll Lock] gedr<EFBFBD>ckt |
|
||||
| Bit 5 = 1 : [Num Lock] gedr<EFBFBD>ckt |
|
||||
| Bit 6 = 1 : [Caps Lock] gedr<EFBFBD>ckt |
|
||||
| Bit 7 = 1 : [Ins] gedr<EFBFBD>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;
|
||||
|
||||
3819
XPLIB1.PAS
Executable file
3819
XPLIB1.PAS
Executable file
File diff suppressed because it is too large
Load diff
869
XPLINK.PAS
Executable file
869
XPLINK.PAS
Executable file
|
|
@ -0,0 +1,869 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P L I N K . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
2065
XPLOAD.PAS
Executable file
File diff suppressed because it is too large
Load diff
280
XPLOG.PAS
Executable file
280
XPLOG.PAS
Executable 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
849
XPMAIL.PAS
Executable 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
149
XPMAKRO.PAS
Executable file
|
|
@ -0,0 +1,149 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P M A K R O . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
663
XPMH.PAS
Executable file
|
|
@ -0,0 +1,663 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P M H . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
362
XPMON.PAS
Executable file
|
|
@ -0,0 +1,362 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P M O N . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
985
XPMRK.PAS
Executable 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
482
XPNETROM.PAS
Executable 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
137
XPOVR.PAS
Executable 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
120
XPOVR1.PAS
Executable 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
99
XPOVR2.PAS
Executable 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
127
XPOVR3.PAS
Executable 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
71
XPOVR4.PAS
Executable 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
118
XPOVR5.PAS
Executable 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
65
XPOVR6.PAS
Executable 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
113
XPPACK.PAS
Executable 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
551
XPPASS.PAS
Executable 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
974
XPQTH.PAS
Executable 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;
|
||||
2042
XPSCROL.PAS
Executable file
2042
XPSCROL.PAS
Executable file
File diff suppressed because it is too large
Load diff
213
XPSETTAS.PAS
Executable file
213
XPSETTAS.PAS
Executable 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
336
XPSPEAK.PAS
Executable file
|
|
@ -0,0 +1,336 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P S P E A K . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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
351
XPSTOP.PAS
Executable file
|
|
@ -0,0 +1,351 @@
|
|||
{ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
|
||||
³ ³
|
||||
³ X - P a c k e t ³
|
||||
³ ³
|
||||
³ ³
|
||||
³ X P S T O P . P A S ³
|
||||
³ ³
|
||||
³ Routinen f<EFBFBD>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 <EFBFBD>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
255
XPSTR.PAS
Executable 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<EFBFBD>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
1050
XPTAST.PAS
Executable file
File diff suppressed because it is too large
Load diff
932
XPUSEDIT.PAS
Executable file
932
XPUSEDIT.PAS
Executable 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
1591
XPUSER.PAS
Executable file
File diff suppressed because it is too large
Load diff
892
XPV24.PAS
Executable file
892
XPV24.PAS
Executable 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<EFBFBD>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<EFBFBD>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
506
XPWAV.PAS
Executable 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
512
XPXBIN.PAS
Executable 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
147
XPXMS.PAS
Executable 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.
|
||||
|
||||
Loading…
Reference in a new issue