Das Chiffriergerät GRETAG TC-521, TC-850
BArch*654, *724, Sammler*144, …, *147, *152, Online-Archiv*10
GRETAG TC-850 und das Softwarepakte
Simulationen - Dekryptiersoftware.
Im ZCO bestand die Aufgaben Dekryptieraufgaben zu Automatisieren.
Dazu ist schon 1987 für die B-011 und B-018, 1988 für ein
unbekanntes, ?Crypto AG?, Chiffriergerät, der SP 300 GCA
und die softwaremäßige Umsetzung, die in Vorarbeit 1983
auch durch Kuba realisiert worden ist. Für die Sprachchif-
friergeräte VERICRYPT bzw. CRYPTOPHON erfolgte die automa-
tisierte Dechiffrierung bereits 1983.
Laut Angaben, des Schweizer Botschaftsfunk von 1974 bis 1991, war
das TC-850 beim Schweizer Botschaftsdienst im Einsatz.
In der Schweitzer Armee: MilVo 58.112 d, gültig ab 1984, 1985 und
die letzte Ausgabe ab 01.01.1986.
Der höheren Führung der Schweizer Armee wurde ab 1973 bzw. 1975
zugeführt.
Aus welchem Grund die Chiffriergeräte und Fernschreiber,
HALSER - GRETAG & Co., bis 1991 vernichtet wurden kann nur
gemutmaßt werden. RUBICON wird neben der, ab 1990 bekannt-
gewordenen, Kompromittierung ein Grund gewesen sein.
Das Chiffriergerät GRETAG GC-521 in der Fernschreibmaschine HALSER SP 300
Aus dem Prospekt der GRETAG über den SP 300 GCA:
Die Chiffrierfernschreibmaschine SP 300 GCS besteht aus der
Fernschreibmaschine HASLER SP-300 mit dem Chiffrierzusatz-
Modul GRETACODER 521, deren Arbeitsweise kompatibel mit den
GRETACODER 505, 805 und 906 ist.
Laut Messebericht von der MEDE 80 der Fa. HASLER ist es der
GRETACODER 505 oder 805, der an den Fernschreiber angebaut wird.
Abb.: HASLER SP 300 mit GCA
Der Chiffrieraufsatz GRETACODER 521 verfügt über einen
nichtlinearen Verschlüsselungsalgorithmus mit garantierten
kryptologischen Spezifikationen. Für höchste Sicherheit wird
ein dreifaches Schlüsselsystem verwendet:
- Elementarschlüssel,
- Kombinationsschlüssel
- Spruchschlüssel
gewährleisten maximalen Schutz auch gegen ausgeklügelte
computerbasierte Dekryptier-Methoden.
Ein Schlüsselmodul enthält den Kombinationsschlüssel und 194
elementare Schlüssel, die beide geheime Schlüsselelemente sind.
Das Schlüsselmodul kann entfernt und separat aufbewahrt werden,
wenn die Sicherheit dies erfordert. Schlüssel-Programmiergeräte
für Schlüsselmodule stehen den Benutzern zur Verfügung; sie
erzeugen Schlüssel automatisch und ohne Zutun des Benutzers.
Fünf weitere elementare können über die Tastatur eingegeben
und im Betrieb beliebig oft abgerufen werden.
Der Spruchschlüssel, der automatisch durch einen physikalischen
Zufallsgenerator generiert wird.
Dieses Prinzip ist eines der wesentlichen kryptologische
Sicherheitsmerkmale.
Abb.: Frontansicht GCA und Rückansicht SP300 mit GCA
Abb.: Lage des Chiffriermoduls aus den Serviceunterlagen
Die chiffrierten Nachrichten bestehen ausschließlich aus Buchstaben.
Mittels eines geheimen Password kann die Chiffrierfernschreib-
maschine gegen unbefugte Nutzung geschützt werden.
Technische Daten
Parameter der Übertragung
Code: Baudot oder ASCII (wahlweise)
Übertragungsgeschwindigkeit: 50/75/100/110/150/200/300 Baud
Betriebsarten: - Telexbetrieb, Tastaturwahl A oder B
- DATEX-Betrieb
- Standleitungsbetrieb (Punkt-zu-Punkt)
Leitungsschnittstelle: - Doppelstrom ± 20 mA
- Einfachstrom 40 mA
- Datenschnittstelle DATEX-X.20
- Tonfrequenz nach V.21, MODEM
- Tonfrequenz für EDW (ED-1000)
- Datenschnittstelle V24
Empfangsspielraum: > 45% abhängig von der gewählten Schnittstelle
Sendeverzerrung: < 5% abhängig von der gewählten Schnittstelle
Spannungsversorgung
Netzspannung: 110/220 VAC ± 10%
Netzfrequenz: 50 oder 60 Hz
Verlustleistung: 150 W max., 30 W im Leerlauf
Funkentstörung: Rauschkategorie N nach VDE 0875
Kontinuierlicher Betrieb
Geräuschpegel < 60 dB (A) bei 50 Baud
Umgebungsbedingung
Temperaturbereich: im Betrieb 0 - 50°C
Lagerung und Transport -30 bis + 70°C
Abmessungen und Masse
Höhe Breite Tiefe Masse
ASR (mit Papier 190/280 545 655mm 24 kg
Bandbefestigung)
MSR (ohne Papier 190/280 395 655mm 20 kg
Bandbefestigung)
RO 190/280 395 505mm 18 kg
Drucker
Prinzip: 9-Punkt-Matrixdrucker
Max. nutzbare
Geschwindigkeit: 30 Zeichen pro Sek.
Wartungsintervall: 108 Zeichen oder 4 Jahre
Schriftart: Lateinischer ECMA-Standard
(andere auf Anfrage)
Zeichen
Darstellung: 9 x 9 Matrix für Groß- und Kleinbuchstaben
Großbuchstaben für lateinische Schrift
9 x 14-Matrix
für arabische Schrift
Zeichenabstand 10, 12 oder 15 Zeichen pro Zoll
Zeichensatz: 96 Zeichen einschließlich Sonderzeichen
Zeichen pro
Zeile: 69, 72, 80, 104 (schmale Schrift)
Zeilenabstand: 4,3; 6,4; 8,5 mm, umschaltbar
Papierbreite: 210, 216, 250 mm Formularpapier
Farbband: Farbbandkassette, schwarz
Kopien: Original und 3 Kopien
Tastatur:
Prinzip: - Tasten mit Hall-Generatoren
- n-Tasten-Roll-over
Tastenfeld: - 5-Bit-Version, 4-reihige Volltastatur
- 8 Bit mit Doppelbelegung
Sondertasten: - für Signalisierung und Nachrichtenvorbereitung
kombinierte Tasten wie "neue Zeile", etc.
Fingerdruck: 42 ... 85 gr
Tastenhub: 4 mm (0,16")
Puffer: 44 Zeichen
Elektronik
Prozessorsystem: Intel 8080 Mikroprozessorsystem
PIO 8255; SIO 8251, USART-CTC 8253,
Timer 8253, Controler 8228, RAM 5101,
Chiffrieraufsatz
Chiffriergenerator: - nichtlinearer Chiffriergenerator für höchste Sicherheitsstufen
- Periode: 1054 Bits (1045 Jahre bei 300 Baud)
- Gesamtschlüsselvielfalt: 1060
- Rekursionslänge: 7 * 109 Bit
Elementarschlüssel: - 194 Elementarschlüssel im Schlüsselmodul (PROM) gespeichert.
Mannigfaltigkeit 1,2 · 1024
- 5 weitere Elementartasten über Tastatur definiert
(16 Buchstaben) Mannigfaltigkeit 1,6 · 1021
Kombinationsschlüssel: - Mannigfaltigkeit: 1,7 · 1038
- gespeichert im Schlüsselmodul (PROM)
Spruchschlüssel: - wird automatisch für jede Nachricht erzeugt und
mit Fehlerschutz übertragen
Überwachung: - kontinuierliche Überwachung des Chiffrierverfahrens
und des Zufallsgenerators. Abschaltung der Übertragung und
Alarm im Falle eines Fehlers.
Benutzeridentifikation: - mit programmierbarem Passwort (bis zu 15 Buchstaben)
Statusanzeige: - über LEDs am Chiffrieraufsatz
- Klartext, Chiffre TX, Chiffre RX
Locher für Papierstreifen
Bedienung
Prinzip: nonstop rotierender Stanzantrieb mit Codierung durch
von Rollenankermagneten
Codeblock: 5, 6 oder 8 Bit
Arbeitsgeschwindigkeit: 30 Zeichen pro Sek.
Steuerung: 8048 Microprozessor
Papierstreifenleser
Abtastprinzip: opto-elektronisch
Betriebsgeschwindigkeit: 30 Zeichen pro Sek.
Steuerelemente: Ein, Aus, Schritt (Überspringen)
Bandüberwachung: Bandspannung, Ende der Spule
Automatische Abfrage
Modus: für TOR- oder MUX-Betrieb
Steuerung: 8048 Microprozessor
Zusatzausstattung (programmierbar)
Textspeicher: 4, 8, 12 oder 16 kByte
Kurztext-Speicher: 32 Zeichen
Sonderschnittstelle: - Magnetplattenspeicher (Floppy-Disc 5 1/4", 154 kByte, MFM)
mit 8085A Microprozessor
- Magnetbandspeicher
- Chiffriergerät
Rückmelder: 48 Zeichen
Seriennummer
Generator: eingehend und/oder ausgehend, max. 8 Dekaden
Zeitausdruck: Ortszeit
Tabulator: horizontal und vertikal bis max. DIN A4
Automatische Zeilenende
Zeilenende: durch Wortendungserkennung
Kurzwahl
Kurzwahlsystem: - 15 frei wählbare und programmierbare
Rufnummern (16-stellig bei internationaler Anwahl)
- Respekt-Taste für letzte Rufnummer
Alpha-Numerische
Anzeige: VFD-Zeilendisplay 40 Zeichen, als Erweiterung
8085 Microprozessor
Beschreibung zweier Methoden zur Berechnung von Schlüssel-
elementen für den Chiffrator SP 300 GCA unter besonderen
Voraussetzungen
1. Voraussetzungen und Ziel der Methoden
In beiden Methoden wird vorausgesetzt, daß eine Anzahl von
m Geheimtexten C1, …, Cm zur Verfügung steht, die alle
mit dem gleichen Strukturschlüssel K und mit dem gleichen
Grundschlüssel B, jedoch mit unterschiedlichen Spruchschlüsseln
D1, …, Dm erzeugt wurden. Mit Hilfe vermutlicher Klar-
textfragmente (z. B. Textanfängen) der Länge n, O1, …, Om
mit Oi = (Oi,1, …, Oi,n) (i = 1,m) werden die vermutlichen
Additionsreihenstücke G1,1, … G1,n
G2,1, … G2,n
.
.
.
Gm,1, … Gm,n
berechnet.
Methode I:
Zusätzlich wird vorausgesetzt, daß der Strukturschlüssel be-
kannt sei. Es besteht das Ziel, den unbekannten Grundschlüssel
B zu ermitteln.
Methode II:
Es wird vorausgesetzt, daß der Grundschlüssel bekannt sei.
Das Ziel besteht in der Berechnung des jetzt als unbekannt
vorausgesetzten Strukturschlüssel K.
2. Bemerkungen zur Realisierbarkeit der Voraussetzungen
Vorläufig habe beide Methoden nur theoretischen Wert,da bisher
noch keine echten Schlüsselelemente eines konkreten Nutzer-
bereichs rekonstruiert werden konnten.
Es ist jedoch bekannt, daß es mindestens einen Nutzer gibt,
der einen Grundschlüssel mehrmals benutzt (Zeitschlüssel),
was aus den offen übermittelten Schlüsselnummern im Grund-
text ersichtlich ist. Von diesem Nutzer sind auch aus einem
früher benutzten Chiffrierverfahren (TC 803) häufige Klar-
textanfänge bekannt, die auch bei dem neuen Chiffrierverfahren
angenommen werden könnten.
Beide Methoden erfordern zur Erfüllung der Voraussetzungen
vorhergehende operative Aktivitäten, so z. B. bei Methode I
die Beschaffung des Strukturschlüssels bzw. bei Methode II
mindestens einen Grundschlüssels. Sie können aber dazu ge-
eignet sein, weitere operative Aktivitäten durch analytische
Erarbeitung von geheimen Schlüsselelementen zu ersetzen.
Die Realisierbarkeit beider Methoden mit Hilfe einer EDVA
wird wesentlich von der erforderlichen Anzahl m und der Länge
n der benötigen Additionsreihen abhängen. Nach vorläufigen
Schätzungen wird mit m = 8 und n = 15 - 20 (bit) eine ein-
deutige Lösung oder eine nur geringe Lösungsmenge erwartet.
Trotzdem wird die Berechnung auf eine eingeschränkte Pro-
biermethode hinauslaufen.
So bedeutet z. B. m = 8 und n = 15, alle möglichen Klartext-
anfänge aus 3 Zeichen in die 8 Texte einzusetzen. Es wurde
festgestellt, daß bei einem Nutzer ca 75 - 80% der Klartexte
mit den Zeichenkombinationen "_ _ <", "<*<", "ALA", "<*L"
(4 Arten) und die restlichen 10 - 15% mit "<*.", "LIN", "BIN",
"ALY" beginnen.
( "_" Leerzeichen, "<" Wagenrücklauf, "*" Zeilenvorschub,
"." beliebiges Zeichen).
Wird nur mit den 4 wahrscheinlichsten Textanfängen gearbeitet
(was ein Risiko für den Versuchsausgang darstellt), gibt es
48 = 65.536 Möglichkeiten der Zuordnung von Klar- und Geheim-
text, die durch probiert werden müssen. Wenn es gelingt, daß
die EDVA mit einem schnellen Programm in 10 sec einen Versuch
durchführt, sind dafür ca 182 Stunden Rechenzeit erforderlich
(das in der Versuchsphase benutzte allgemeine Programm zur
Lösung nichtlinearer boolscher Gleichungssysteme benötigt
noch die 30-fache Zeit).
Eine Verlängerung der Klartextanfänge auf 4 Zeichen würde bei
nur noch 60%-iger Sicherheit mit 7 wahrscheinlichen Textan-
fängen eine etwa 100 mal längere Rechenzeit erfordern.
Ähnliches gilt für die Erhöhung der Sicherheit der Methode
durch Hinzunahme der weniger wahrscheinlichen Textanfänge,
die aber unter den 8 Texten nicht ausgeschlossen werden können.
Weiterer Probieraufwand entsteht durch mehrdeutige Lösungen,
insbesondere wenn die durchschnittliche Anzahl von Texten (8)
nicht erreichbar ist.
3. Grundidee der Methode I
Bekanntlich gilt in Takt t die Chiffrierformel
Die rein linearen Registerausgänge Ck (k = 1,8) sind in jedem
Takt nur von gesuchten Grundschlüssel B und von Spruchschlüssel
D abhängig. Es gilt
Das Matrixelement 
hängt von Strukturschlüssel K und
von Grundschlüssel B ab, die Indizes i,j jedoch vom Grund-
schlüssel B und Spruchschlüssel D. Zur besseren Beschreibung
dieses Elementes wird eine Funktion
mit
Das entspricht der Auffassung der Matrix P als 128-stelliger
Vektor und der Argumente 
als Adresse des Elementes,
das im Takt t in diesem Vektor ausgewählt wird.
Diese Argumente sind die Registerausgänge im Takt t.
Es ist also
Zur Verkürzung der Schreibweise wird weiterhin
eingeführt.
Die Formel (1) hat dann die Form
bzw.
berechenbar, da Gt als bekannt vorausgesetzt.
Für zwei unterschiedliche Spruchschlüssel D1, D2 gilt bei
gleichen Grund- und Strukturschlüssel
Die Funktionswerte von f1 und f2 sind die berechenbaren Elemente
der Matrizen P1 und P2, gesucht ist die Menge der Argumente
, die für die Gleichung (4) erfüllt ist.
Bei annähernder Gleichverteilung der Elemente 0,1 in P1 und P2
sind bei unabhängigen Funktionen f1, f2 im Durchschnitt 64
Lösungen zu erwarten. Durch hinzunahme weiterer Funktionen
f3, …, fm wird sich der Durchschnitt der Lösungen mit
jeder Funktion etwa halbieren, woraus die Schätzung resultiert,
daß mit 8 Funktionen (bzw. 8 Texten) im Durchschnitt eine ein-
deutige Lösung erhalten wird. Es ist möglich, daß in einzelnen
Texten schon mit weniger Funktionen eine Lösung gefunden wird,
aber auch mit 8 Funktionen noch zwei oder mehrere Lösungen
vorliegen.
Wenn mit t = 0 begonnen wird, lassen sich auch nachträglich
aus (4) die 
berechnen, womit über n Takte, eine
Folge der nur durch den Grundschlüssel B bestimmten Register-
ausgänge
vorliegt. Diese 
sind Linearkombinationen der Grund-
schlüsselbits, die durch die Rückkopplungsgesetze der 8 Register
und durch die Initialfüllung bestimmt sind (vergl. Anlage zur
Registerentwicklung).
Folgende Probleme sind noch zu untersuchen:
a) Wie groß muß n sein, damit ein Gleichungssystem mit den
Grundschlüsselbit als Unbekannte möglichst eindeutig ge-
löst werden kann?
Offensichtlich wäre n = 30 ausreichend, da alle Register
nach spätestens 30 Takten aufgrund ihrer Länge (Rückwärts-
lauf) bestimmt sind. Auf Grund des im Pkt. 2 erwähnten
Rechenzeitaufwandes muß aber das erforderliche n soweit
wie möglich reduziert werden.
b) Welche Gesetzmäßigkeiten können zum Ausschluß unmöglicher
Folgen
benutzt werden, um einerseits mehrdeutige Lösungen in ein-
zelnen Takten zu reduzieren und andererseits falsche Kombi-
nationen von Klartextanfängen zu verwerfen?
Zur Beantwortung beider Fragen werden die Eigenschaften der
Registerausgangsfolgen untersucht, die sich aus der Initial-
füllung ergeben.
Zurvor zur Erläuterung der bisherigen Methode in Beispiel.
Beispiel zur Methode I.
Mit den, in der GVS 1343 im Beispiel benutzten Struktur- und
Grundschlüssel wurden zu den in der Anlage 1 aufgeführten
Spruchschlüsseln D0 bis D7 die 8 Additionsreihen G1 bis G8
über die ersten 15 Takte berechnet. Ebenso die nur durch die
Spruchschlüssel bestimmten Registerausgänge 
für die 8
Register (k = 1,8), für die 8 Spruchschlüssel (i = 0,7) und
für die Takte t = 1,15.
Außerdem wurden aus dem als bekannt vorausgesetzten Struktur-
schlüssel und aus den Spruchschlüsseln die Funktionswerte f2
für alle Argumente (0000000), (0000001), …, (1111111).
Diese Hilfsmittel sind in der Anlage 2 dargestellt.
Für t = 1 gilt:
entnimmt man der Anlage 2 für t = 1:
| i |  |  |  |
|---|
| 0 | 0 | 0 |  | + | (1100011) |
| 1 | 1 | 1 | (0000101 |
| 2 | 0 | 0 | (1011011 |
| 3 | 0 | 1 | (0010011) |
| 4 | 1 | 1 | (1011001) |
| 5 | 1 | 0 | (1100101) |
| 6 | 1 | 1 | (1101101) |
| 7 | 1 | 1 | (0001110) |
Es sollen die Argumente bestimmt werden, die für
Diese Gleichungskette wird für jedes der Argumente (000000)
bis (1111111) geprüft und es wird jedes Argument verworfen,
für das diese Kette durch eine Funktion f1 entsprechend der
Funktionstabelle in der Anlage 2 unterbrochen wird.
Angedeutetes Vorgehen:
-------------------------
g0(x) = (1100011), f0(g0(x)) = 1
g1(x) = (0000101), f1(g1(x)) = 1
g2(x) = (1011011), f2(g2(x)) = 1
g3(x) = (0010011), f3(g3(x)) = 1 ⊕ 1 = 1
g4(x) = (1011001), f4(g4(x)) = 0 !
Damit entfällt x = (0000000) als Lösung.
In der Anlage 3 sind die Ergebnisse für alle 128 Argumente
x aufgeführt. Es werden dabei spätestens bei den Funktionen
f6 und g6 alle Argumente verworfen, bis auf das richtige
Da
ist, ist auch dieser Registerausgang bestimmt.
Werden die 16 Grundschlüsselbuchstaben mit b0, …, b15
bezeichnet und (bi,0; …; bi,4) ist die bitweise Darstellung
des i-ten Grundschlüsselbuchstabens, dann gelten jetzt die
Gleichungen
(vergl. Registerentwicklung in Anlage 4).
Das ist ein Teil des Gleichungssystems, das mit Hilfe weiterer
Takte t = 2, 3, …, n so erweitert werden soll, daß es möglichst
eindeutig lösbar ist und damit den Grundschlüssel liefert.
Mit einem allgemeinen EDV-Programm zur Lösung boolscher
nichtlinearer Gleichungssysteme wurden so die Takte t = 1, 2,
…, 15 berechnet. Dieses Programm hat sich für Untersuchungs-
zwecke als geeignet erwiesen. Es ist jedoch aufgrund der
Rechenzeit für eine praktische Dekryptiermethode ungeeignet.
Es benötigt pro Takt ca 17,7 sec Rechenzeit, über 15 Takte
also ca 4½ min.
Bei der Rechenzeitabschätzung im Pkt. 2 wurden aber nur 10
sec pro Versuch angesetzt, woraus sich die Notwendigkeit
eines mindestens 30 mal schnelleren Programms ableitet,
außerdem umfaßt 1 Versuch nicht nur die Lösung von 15
Gleichungssystemen.
Die berechneten Folgen
sind:
Aufstellen der Matrizen O, R, R, S, T, U, V, W
Es werden zunächst für jede Register so viele Gleichungen
für die Registerausgänge aufgestellt, wie nötig sind, um
die Anfangsfüllungen eindeutig bestimmen zu können.
Allgemein gilt: H = B · b,
wobei H eine (l,e)-Matrix und
B die l,16)-Koeffizientenmatrix der bi,j ist, wenn
l die Anzahl der benötigten Gleichungen mit Erhält man die Matrix B nach Gauß,
10 ergibt sich bei eindeutiger Lösung
b = B' · h, wobei B' die inverse Matrix zu B ist.
b und h sind Vektoren der Dimension 16 bzw. e.
Grundparameter die für die Simulation wichtig sind:
- Strukturschlüssel (interner Schlüssel) 128 bit,
- Grundschlüssel 10 Zeichen und
- Spruchschlüssel (Initialisierungsvektor) 10 Buchstaben (Zeichen).
Für die Delphi-Version gibt es eine Erweiterung, diese
dient dem Abspeichern der Additionsreihe sowie der vollständigen
Additionsreihe.
Beim Chiffrieren bzw. Dechiffrieren wird je nach Zeichen ein
Leertakt
eingefügt. Dieser Leertakt verwirft das nächste
Additionselement. Bei der abgespeicherten vollständigen
Additionsreihe sind alle erzeugten Additionselemente, auch
die verworfenen, gespeichert.
Anhand dieser Datei ist ersichtlich das bei gleichem Initiali-
sierungsvektor alle Sprüche mit den gleichen Additionselementen
chiffriert wurden. Aufgrund des Verwurfes von Additionselementen
kommt es zu Verschiebungen. Diese sind mittels dieser Erweiterung
gut sichtbar.
Auch werden zyklische Wiederholungen sichtbar.
Das ist Grundlage für die Hintertür-Funktion.
Aus dem User-Manual zum TC-850 kann man entnehmen:
- Gerät ohne Chiffriereinheit ist dann eine
Schreibmaschine mit Lochstreifeneinheit,
- zwei fest eingebaute Strukturschlüsselspeicher,
- Strukturschlüsselspeicher ist austauschbar in der Chiffriereinheit,
- zwei fest eingebaute Grundschlüsselspeicher
RAM-Speicher A
und B
,
- Steuerbefehl SSSSS
ermöglicht das Einlesen bzw.
Eingeben des Grundschlüssel
(Tagesschlüssel)
- der Grundschlüssel wird beim Einlesen nie ausgedruckt oder gestanzt,
- der Grundschlüssel besteht aus 10 Zeichen (Buchstaben, Zeichen
oder Steuerzeichen),
- Löschen des Grundschlüssels über das Ausschalten des Gerätes
oder SSSSS
und anschließend Taste STOP drücken,
- Steuerbefehl HHHHH
startet den De-, bzw. Chiffrierung,
- Testfunktion bzw. Ausgeben - Stanzen einer Zufallsfolge bzw.
Zusatzschlüssel
(Initialisierungsvektor),
- dreifach Ausdrucken des Zusatzschlüssel
- automatisches Auffüllen der letzten unvollständigen
Geheimtextgruppe mit dem Zeichen Y
,
- das Zeichen Y
tritt im Geheimtext nur zur Auffüllung auf,
- Geheimtexte sind immer Fünfergruppen Buchstabentexte,
- Geheimtextstruktur:
HHHHH »Startet Chiffrator
WWWNN NOOOL LLRRR KKKAA APPPS SSBBB OQYPN PRYJM VXLJZ
Initialisierungsvektor Geheimtext
oder:
HHHHH »Startet Chiffrator
WNOLR KAPSB WNOLR KAPSB WNOLR KAPSB OQYPN PRYJM VXLJZ
Nutzerdokumentation zum Programm HzVars03
Das Programm generiert Daten zur statistischen Auswertung durch
Folgeprogramme HORIZONT.
Es werden Geheimtexte verarbeitet, die mit dem Gerät TC 850
erzeugt wurden.
Im Ergebnis entsteht eine Datei und ein Protokoll. Letzteres
macht en Anschluß eines Druckers erforderlich.
Das Programm HzVarS03.exe
wird von der Systemebene aus aufge-
rufen.
Die Führung durch das Programm erfolgt über ein Hauptmenü,
welches über weitere Menüs
- Eingaben
- Ausgaben
abfordert und Programmstart und -ende ermöglicht.
Einschränkungen
Die Länge jedes Textes ist auf 10 000 Zeichen begrenzt.
Durch Programmänderung läßt sich diese Grenze variieren.
Eingaben
1. Anzahl der Geheimtextdateien:
Es ist eine Zahl zwischen 2 und 99 möglich.
2. Dateiname der Geheimtextdateien:
Es wird gefordert, daß die Namen der Geheimtextdateien in den
ersten 6 Stellen identisch sind. Die rechtlichen zwei Stellen
werden automatisch zur Numerierung genutzt, wobei dies in der
Reihenfolge der Speicherung auf der Diskette, beginnend mit
01, 02, … erfolgt.
Eine Laufwerksangabe kann erfolgen. Geschieht das nicht, wird
das aktuelle Laufwerk (einschließliche Pfad) angenommen.
Aus Effektivitätsgründen sollten die Geheimtexte ihrer Länge
nach, beginnend mit dem längsten geordnet sein.
Anforderungen an einen Geheimtext:
Der Aufbau einer Datei ist identisch dem vom Originalgerät
erzeugten Text. Die Datei ist vom Typ 'txt'.
Als Anfangskennung ist 'HHHHH' gefordert.
Das Textende wird durch EOF oder das letzte, von 'Y' ver-
schiedene Zeichen, definiert.
Als Spruchschlüssel werden aus dem Text die nächsten 10, je-
weils 3-fach wiederholten Buchstaben entnommen.
Werden diese Forderungen nicht eingehalten, erfolgen Aus-
schriften, die mit Unterprogrammabruch enden.
Danach sind über Programmende
die notwendigen Korrekturen
in den Textdateien vorzunehmen.
4. Anzahl Tmax:
Tmax (>0) ist die maximale Anzahl von Takten, die statistisch
ausgewertet werden sollen.
Tmax ist vom Typ longint. Damit wird diese Zahl praktisch nur
von dem zur Verfügung stehenden Platz auf der Zieldiskette
begrenzt.
Ausgaben
Es wird ein Dateiname für die Datendatei gefordert. Eine Lauf-
werksangabe ist wahlfrei.
Die Datei enthält die statistisch zu untersuchenden Werte
in Form:
- den Daten für jedes Textpaar n,m steht eine Längenangabe
im Format word voran, wobei das niederwertige Byte zuerst
steht.
Die Längenangabe bezeichne die Anzahl der zu einem Paar
erzeugten Doppelbyte.
- zu jedem Takt t (t wird während des Programmlaufes auf dem
Bildschirm angezeigt) werden 2 byte erzeugt:
1. (d7(t),d6(t),…,d1(t),g(t))
2. (d11(t),d12(t),…,d17(t),flag)
wobei gilt:
di(t) = d1i(t) XOR d2i(t), i=1,7,
flag aus {0,1}
und die d1i(t), d2(t) sind die Registerausgänge bezüglich der
Spruchschlüssel 1 und 2 eines Paares.
g(t) = g1(t) XOR g2(t) XOR di(t) XOR z1(t) XOR z2(t)
ist die Summe der Geheimtextbits, die aus den Geheimtexten
eines Paares nach der verfahrensspezifischen Konvertierung
hervorgegangen sind, zuzüglich der aus den Registern be-
kannten Anteile.
Protokoll
Im Protokoll werden alle Eingaben nachgewiesen und System-
datum, -zeit zu Programmbeginn und -ende festgehalten.
Außerdem werden zu jedem Paar n,m die
- Spruchschlüssel
- Textlängen in Zeichen und Bit
- Verarbeitungslängen in Zeichen je nach Konvertierung
- Gesamtsumme der aktuell erzeugen Takte
ausgelistet.
Zeitabschätzung
Für 1 000 Takte t werden ca. 60 Sekunden benötigt.
REM NAS-SYS-3 Basic
REM DOKE 3187,1912 = Aktivierung User-Schreiben auf I/O im U-Mode
REM DOKE 3187,1913 = Deaktivierung User-Schreiben auf I/O im U-Mode
10 DOKE 3187,1913
20 CLEAR 1000
30 WIDTH 120
40 FL = 1
50 CLS
60 PRINT "LOESUNGSVIELFALT fuer 0,1-Matrix"
70 PRINT "================================"
80 PRINT "Dimensionierung 1"
90 PRINT "Eingabe der Matrix 2"
100 PRINT "Korrektur der Matrix 3"
110 PRINT "Eingabe der rechten Seite 4"
120 PRINT "Korrektur der rechten Seite 5"
130 PRINT "Druck Matrix und rechte Seite 6"
140 PRINT "Start Loesungsvielfalt 7"
170 PRINT "Speichern auf Band 8"
180 Print "Lesen vom Band 9"
190 INPUT Z
200 IF Z = 0 GOTO 50
210 ON Z GOSUB 250, 450, 800, 950, 1350, 1500, 1600
220 ON Z-7 GOSUB 3100, 3300
230 GOTO 50
250 CLS
260 IF AL = 0 GOTO 300
280 PRINT "Bereits (" ;M;", " ;N ") dimensioniert!"
280 FOR Q = 1 TO 1500:NEXT Q
290 GOTO 390
300 PRINT "Dimensionierung:"
310 PRINT "================"
320 PRINT
330 INPUT "Anzahl der Zeilen M = ";M
335 IF M <= 0 GOTO 330
342 N = 7
380 DIM A(M,N),R(M),HV(N),LT(128,8),DV(7)
385 DIM NO(M),T(128,8)
390 FL = 0
400 Z = 15
410 RETURN
450 CLS
460 PRINT "Matrix"
470 FOR I = 1 TO M
480 GOSUB 550
490 NEXT I
500 Z = 15
510 RETURN
550 PRINT I;
555 NO(I) = I
560 ZL = 0
590 AI = 1
600 AL = 0
605 A$ = ""
610 PRINT TAB(3)AI;
620 INPUT A$:IF A$ = "H" GOTO 50
630 AL = LEN(A$)
635 IF U = 0:GOTO 640
636 IF AL = 0 GOTO 600
637 U = 0:GOTO 640
640 IF FK = 0 GOTO 660
645 IF AI = 1 GOTO 650
648 GOTO 660
650 IF AL = 0 GOTO 652
651 GOTO 660
652 IF U = 1 GOTO 600
653 A$ = "":FOR I = 1 TO N
654 A$ = A$+MID$(STR$(A(I,J)),2)
655 NEXT: U = 0:GOTO 730
660 ZL = ZL + AL
670 IF ZL > N GOTO 740
680 EI = AI + AL - 1
685 IF AL = 0 GOTO 600
690 FOR J = AI TO EI
700 A(I,J) = ASC(MID$(A$,J - AI + 1, 1)) - 48
702 IF A(I,J) = 0 OR A(I,J) = 1 GOTO 708
703 PRINT "Unerlaubtes Zeichen!"
704 U = 1: EI = J - 1 : ZL = J - 1 : GOTO 710
708 NEXT J
710 AI = EI + 1
720 IF ZL < N GOTO 600
730 RETURN
740 PRINT "Zeilenlaenge ueberschritten!"
750 ZL = ZL - AL:GOTO 600
800 CLS
810 FK = 1
820 PRINT "Korrektur:"
830 FOR I = 1 TO M
840 PRINT I;
850 FOR J = 1 TO N
860 PRINT MID$(STR$(A(I,J)),2);
870 NEXT J
880 PRINT
890 GOSUB 550
900 NEXT I
910 FK = 0
920 Z = 15
930 RETURN
950 CLS
960 PRINT "Rechte Seite:"
970 PRINT
980 GOSUB 1010
990 Z = 15
1000 RETURN
1010 ZL = 0
1020 AI = 1
1030 AL = 0
1040 PRINT AI;
1045 R$ = ""
1050 INPUT R$:IF R$ = "H" GOTO 50
1060 AL = LEN(R$)
1070 IF AL = 0 GOTO 1040
1160 ZL = ZL + AL
1170 IF ZL > M GOTO 1300
1180 EI = AI + AL - 1
1200 FOR I = AI TO EI
1210 R(I) = ASC(MID$(R$,I-AI+1,1))-48
1230 IF R(I) = 0 OR R(I) = 1 GOTO 1260
1240 PRINT "Unerlaubtes Zeichen!"
1250 U = 1 : EI = I - 1 : ZL = I - 1 : GOSUB 1270
1260 NEXT I
1270 AI = EI + 1
1280 IF ZL < M GOTO 1030
1290 RETURN
1300 PRINT "Anzahl M ueberschritten !"
1310 ZL = ZL - AL
1320 GOTO 1030
1350 CLS
1360 PRINT "Korrektur rechte Seite:"
1370 PRINT
1380 FK = 1
1390 FOR I = 1 TO M
1400 PRINT MID$(STR$(R(I)),2);
1410 NEXT
1415 PRINT
1420 GOSUB 1010
1430 FK = 0
1440 Z = 15
1450 RETURN
1500 DOKE 3187,1912
1510 FOR I = 1 TO M
1515 PRINT NO(I);
1520 FOR J = 1 TO N
1525 X$ = MID$(STR$(A(I,J)),2)
1527 IF X$ = "0" THEN X$ = "."
1530 PRINT TAB(J + 4) X$;:NEXT J
1540 PRINT TAB(J + 6) MID$(STR$(R(I)),2)
1550 NEXT I
1560 PRINT
1570 DOKE 3187,1913
1580 Z = 15
1590 RETURN
1600 REM==============================
1601 REM Start Loesungsvielfalt
1602 REM==============================
1610 GOSUB 4000:REM Tabelle lesen
1620 GOSUB 2000:REM Loesungstab laden
1640 G = 1: REM Gleich.-Zaehler
1650 G = G + 1
1651 D = l:REM relat. Druckposition
1652 DOKE 3187,1912:PRINT:PRINT:REM Aktivierung User-Schreiben auf I/O im U-Mode
1653 PRINT "GLEICHUNG " ; MID$(STR$(G), 2):PRINT
1654 DOKE 3187,1913:REM Deaktivierung User-Schreiben auf I/O im U-Mode
1660 Q = 0:REM Zaehler 1-128
1670 Q = Q + 1
1680 IF LT(Q, 8) = 0 GOTO 1770:REM Vgl-Vek aus LT
1690 FOR I = 1 TO 7
1700 VG(I) = LT(Q,I)
1710 NEXT
1720 GOSUB 2300:REM VG auf Lsg pruefen
1730 IF J = 1 GOTO 1750:REM Loesung
1740 LT(Q, 8) = 0:GOTO 1770:REM keine Lsg
1750 LT(Q, 8) = 1:REM Lsg
1760 GOSUB 2800:REM Druck
1770 IF Q < l28 GOTO 1670:REM naechstes Q
1780 IF G < M GOTO 1650:REM naechstes G
1785 DOKE 3187,1912:REM Aktivierung User-Schreiben auf I/O im U-Mode
1786 PRINT:PRINT:PRINT
1790 PRINT TAB(16) "=====ALLE LOESUNGEN DES SYS";
1795 PRINT "TEMS====="
1800 PRINT:PRINT
1805 DOKE 3187,1913:REM Deaktivierung User-Schreiben auf I/O im U-Mode
1810 PRINT "Neues Gleichungssystem? J/N"
1820 INPUT F$
1830 IF F$ = "J" THEN Z = 15:RETURN
1840 PRINT "==========PROGRAMMENDE=========="
1850 END
2000 REM--------------------------------------
2001 REM Menge der Loesungsvektoren laden
2002 REM--------------------------------------
2010 FOR LZ = 0 TO 127
2020 GOSUB 2100:REM Dualkonvartierung
2030 FOR I = 1 TO 7
2040 LT(LZ + 1, I) = DV(I)
2050 NEXT I
2055 LT(LZ + 1, I) = 1
2057 NEXT LZ
2060 RETURN
2100 REM--------------------------------------
2101 REM Dez-Dual-Konv von LZ
2102 REM--------------------------------------
2110 Z = 64
2120 FOR I = 1 TO 7
2130 B = SGN(Z AND LZ)
2140 DV(I) = B
2150 Z = Z/2
2160 NEXT I
2170 RETURN
2300 REM--------------------------------------
2301 REM Fkt-Werte bestimmen und vergleichen
2302 REM--------------------------------------
2310 FOR GZ = 1 TO G
2320 FOR I = 1 TO 7
2340 HV(I) = VG(I)
2350 NEXT I
2360 FOR I = 1 TO 7
2370 HV(I) = (HV(I)ORA(GZ,I)) - (HV(I) * A(GZ ,I))
2380 NEXT I
2390 GOSUB 2500:REM Fkt-Wert aus Tab T
2400 NEXT GZ
2410 W = F(1)
2420 J = 1:REM Lsg-Flag
2430 FOR GZ = 1 TO G
2440 IF W <> F(GZ) THEN J = 0
2450 NEXT GZ
2460 RETURN
2500 REM--------------------------------------
2501 REM Fkt-Wert aus T(128.8)
2502 REM--------------------------------------
2510 DZ = 1
2520 FOR I = 0 TO 6
2530 IF HV(7-I) = 0 GOTO 2550
2540 DZ=DZ + 2 * I
2550 NEXT I
2560 F(GZ) = (T(DZ,GZ)ORR(GZ))-(T(DZ,GZ)*R(GZ))
2570 RETURN
2800 REM-------------------------------------
2801 REM Duck der Lsg-Vektoren
2802 REM-------------------------------------
2810 DOKE 3187,1912
2820 P = (D - 1) * 8 + D:REM relative Druckposition
2830 FOR I = 1 TO 7
2840 PRINT TAB (P-1+J) MID$(STR$(LT(Q,I)),2);
2850 NEXT I
2870 D = D + 1
2880 IF D = 9 THEN D = 1:PRINT
2885 DOKE 3187,1913:
2890 RETURN
3100 REM--------------------------------------
3101 REM Ausgabe auf Band
3102 REM--------------------------------------
3105 CLS
3110 PRINT "Speichern auf Band:"
3120 PRINT:OUT 0,4
3130 PRINT "TB auf Aufnahme schalten !"
3140 PRINT "Druecke Taste 'A' !"
3150 INPUT T$
3160 IF T$ = "A" GOTO 3180
3170 GOTO 3140
3180 OUT 2,1
3190 CSAVE*A
3200 CSAVE*R
3210 OUT 2,0
3220 Z=15
3230 RETURN
3300 REM---------------------------------
3301 REM Eingabe vom Band
3302 REM--------------------------------
3305 CLS
3310 PRINT "Lesen vom Band:"
3320 PRINT:OUT 0,4
3330 PRUNT "TB auf Wiedergabe schalten!"
3340 PRINT "druecke Taste 'W' !"
3350 INPUT W$
3360 IF W$="W" GOTO 3380
3370 GOTO 3340
3380 OUT 2,1
3390 CLOAD*A
3410 CLOAD*R
3420 OUT 2,0
3430 FOR I = 1 TO M
3440 NO(I) = I
3450 NEXT I
3460 Z = 15
3470 RETURN
4000 REM-----------------------------------
4001 REM Tabelle T der Fkt-Werte laden
4003 REM-----------------------------------
4010 DATA 0,0,1,0,1,1,1,1, 0,1,1,1,0,1,1,1
4020 DATA 0,0,1,1,0,0,0,0, 0,0,1,1,1,1,0,0
4030 DATA 0,0,1,0,0,1,1,0, 1,1,0,0,0,0,0,0
4040 DATA 1,0,0,0,0,0,1,1, 0,1,1,0,1,0,1,1
4050 DATA 0,1,0,0,0,0,1,0, 0,1,1,1,1,1,0,1
4060 DATA 0,0,1,0,1,1,1,1, 1,0,0,0,1,0,0,0
4070 DATA 0,0,1,1,0,0,0,0, 0,0,1,1,1,1,0,0
4080 DATA 0,0,1,0,0,1,1,0, 1,1,0,0,0,0,0,0
4090 DATA 1,0,0,0,1,0,0,0, 0,1,0,1,1,0,1,0
4100 DATA 0,1,1,0,1,1,0,0, 1,1,1,0,0,0,1,0
4110 DATA 1,1,0,1,1,1,1,1, 1,1,0,0,0,0,0,0
4120 DATA 0,1,0,1,0,0,0,1, 0,1,1,1,0,0,0,1
4130 DATA 0,0,0,0,0,0,1,0, 0,1,1,0,1,0,1,1
4140 DATA 1,0,0,0,1,0,0,0, 0,1,0,1,1,0,1,0
4150 DATA 0,1,1,0,1,1,0,0, 0,0,0,1,1,1,0,1
4160 DATA 0,0,1,0,0,0,0,0, 1,1,0,0,0,0,0,0
4170 DATA 0,1,1,0,0,1,0,0, 0,0,1,1,1,0,0,1
4180 DATA 0,1,1,1,0,1,0,1, 1,1,1,1,1,0,0,0
4190 DATA 0,0,1,0,0,1,0,1, 1,0,0,0,1,1,0,1
4200 DATA 0,1,0,0,0,0,0,0, 0,1,1,0,0,1,1,0
4210 DATA 1,0,0,1,0,0,0,1, 1,0,1,1,0,1,1,0
4220 DATA 0,1,1,0,0,1,0,0, 0,0,1,1,1,0,0,1
4230 DATA 0,1,1,1,0,1,0,1, 0,0,0,0,0,1,1,1
4240 DATA 1,1,0,1,1,0,1,0, 1,0,0,0,1,1,0,1
4250 DATA 0,0,0,0,0,0,1,1, 1,1,0,0,1,0,1,1
4260 DATA 1,1,0,1,0,1,1,1, 1,1,0,0,0,0,0,1
4270 DATA 0,0,1,1,0,0,1,0, 0,0,1,0,0,1,0,0
4280 DATA 1,1,1,0,1,1,1,0, 1,0,1,0,1,0,1,1
4290 DATA 0,1,1,0,0,0,1,1, 1,1,0,1,1,1,0,1
4300 DATA 1,1,1,1,1,1,0,0, 0,0,1,1,0,1,0,0
4310 DATA 1,1,0,1,0,1,1,1, 1,1,0,0,0,0,0,1
4320 DATA 0,0,1,1,0,0,1,0, 1,1,0,1,1,0,1,1
4330 DATA 1,1,0,1,1,0,1,1, 1,0,1,1,1,0,0,1
4340 DATA 0,1,1,0,1,1,0,0, 1,1,1,0,0,0,1,1
4350 DATA 1,1,1,1,1,1,0,1, 0,1,1,1,1,1,1,1
4360 DATA 0,1,0,0,0,0,0,1, 1,0,1,1,1,1,1,1
4370 DATA 0,0,0,0,0,0,1,0, 1,1,0,1,0,0,1,1
4380 DATA 0,0,1,0,0,1,0,0, 0,1,0,0,0,1,1,0
4390 DATA 1,0,0,1,0,1,1,1, 1,1,1,0,0,0,1,1
4400 DATA 0,0,0,0,0,0,1,0, 1,0,0,0,0,0,0,0
4410 DATA 0,1,1,0,0,1,0,0, 0,0,1,1,1,0,0,1
4420 DATA 0,1,1,1,0,1,0,1, 0,0,0,0,0,1,1,1
4430 DATA 0,0,1,0,0,1,0,1, 1,0,0,0,1,1,0,1
4440 DATA 0,1,0,0,0,0,0,0, 0,1,1,0,0,1,1,0
4450 DATA 0,1,1,0,1,1,1,0, 1,0,1,1,0,1,1,0
4460 DATA 0,1,1,0,0,1,0,0, 0,0,1,1,1,0,0,1
4470 DATA 1,0,0,0,1,0,1,0, 1,1,1,1,1,0,0,1
4480 DATA 1,1,0,1,1,0,1,0, 0,1,1,1,0,0,1,0
4490 DATA 1,1,0,1,0,0,1,1, 1,0,1,1,1,1,0,0
4500 DATA 1,1,1,0,0,1,1,1, 1,1,1,1,1,1,0,1
4510 DATA 1,0,0,1,1,1,0,0, 1,1,1,0,0,1,0,0
4520 DATA 0,1,1,0,1,1,1,1, 0,0,1,1,1,1,1,1
4530 DATA 1,1,0,1,1,0,1,0, 1,0,1,0,0,0,0,0
4540 DATA 1,1,0,1,0,0,1,1, 1,0,1,1,1,1,0,0
4550 DATA 1,0,0,1,1,0,0,0, 0,0,0,0,0,0,1,0
4560 DATA 0,0,0,1,0,1,0,1, 0,0,0,1,1,0,1,1
4570 DATA 1,0,1,0,1,1,0,0, 1,1,1,0,0,0,1,1
4580 DATA 0,0,0,0,0,1,0,0, 1,1,1,1,1,1,1,0
4590 DATA 0,0,1,0,0,0,1,0, 0,1,0,0,0,0,0,0
4600 DATA 1,0,0,1,0,0,0,0, 1,1,0,0,1,1,1,0
4610 DATA 1,1,1,1,1,1,1,1, 0,1,0,0,0,1,1,1
4620 DATA 0,1,0,1,0,0,1,1, 1,1,1,0,0,0,1,1
4630 DATA 0,0,0,0,0,1,0,0, 1,1,1,1,1,1,1,0
4640 DATA 0,0,1,0,0,0,1,0, 1,0,1,1,1,1,1,1
4650 FOR I = 1 TO 128
4660 FOR J = 1 TO 8
4670 READ T(I, J)
4680 NEXT J
4690 NEXT I
4700 RETURN
10 REM=========================================
20 REM NASCOM 2
30 REM TABELLE (C XOR B) der Registeraus-
40 REM gaenge
41 REM DOKE 3187,1912 - Aktivierung User-Schreiben auf I/O im U-Mode
42 REM DOKE 3187,1913 - Deaktivierung User-Schreiben auf I/O im U-Mode
50 REM
60 REM==========================================
70 CLS
75 WIDTH 170
80 DOKE 3187,1912
82 PRINT "TABELLE DER BINAEREN XOR-VERKNUEPF";
83 PRINT "UNGEN 0 ... 127"
84 PRINT "----------------------------------";
85 PRINT "-------------"
86 PRINT:PRINT
87 PRINT "ZEILE - SPALTE"
88 PRINT:PRINT
90 FOR I = 0 TO 127
100 PRINTTAB (5)
110 FOR J = 0 TO 127
120 GOSUB 500:REM dez-dual I
130 GOSUB 600:REM dez-dual J
140 GOSUB 700:REM XOR
150 GOSUB 800:REM dual-dez X
160 IF J/32 = INT(J/32) AND J > 0 THEN PRINT:PRINT TAB(5);
170 X$ = MID$(STR$(X) ,2)
172 Y$ = " "
173 Z$ = Y$+X$
174 IF LEN(Z$) > 4 THEN Z$ = RIGHT$(Z$,4)
175 PRINT Z$;
180 NEXT
185 PRINT
190 NEXT
195 DOKE 3187,1913
200 END
500 REM--------------------------------------
501 REM I dual in VI(L)
502 REM--------------------------------------
510 Z=64
520 FOR L = 1 TO 7
530 B = SGN(Z AND I)
540 VI(L) = B
550 Z = Z/2
560 NEXT
570 RETURN
600 REM--------------------------------------
601 REM J dual in VJ(L)
602 REM--------------------------------------
610 Z = 64
620 FOR L = 1 TO 7
630 B = SGN(Z AND J)
640 VJ(L) = B
650 Z = Z/2
660 NEXT
670 RETURN
700 REM--------------------------------------
701 REM VI(L)= VI(L) XOR VJ(L)
702 REM--------------------------------------
710 FOR L = 1 TO 7
720 VI(L) = (VI(L) OR VJ(L))-VI(L) * VJ(L)
730 NEXT
740 RETURN
800 REM--------------------------------------
801 REM VI(L) dez in X
802 REM--------------------------------------
810 X = 0
820 FOR L = 7 TO 1 STEP -1
830 X = X + VI(L) * 2^(7-L)
840 NEXT
850 RETURN
0001 {Bearbeitungsstand: 10.01.90
0002
0003 SIMULATIONEN - einheitliche Menügestaltung und Bedienerführung
0004 für alle Gerätesimulationen }
0005
0006 program SIMULAV1;
0007
0008 uses dos,crt,printer,windows,menue,cursor,maske,help,ted,readext,readchr;
0009
0010 Type
0011 string15=string[15];
0012 Dtname=string[60];
0013 Verfahren=string[22];
0014 VerfFeld=array[1..10] of Verfahren;
0015 datind=(vf,sl,pr,gh,kl);
0016 mm=set of char;
0017 zeile=string[60];
0018
0019 Var
0020 w1,w2,w3,w4,w5,wmain:byte;
0021 Taste,maintaste:char;
0022 rcode:word; { Tasten-Rückgabecode }
0023 i, MpktX,MpktY,Mpkt,Mpkttxt,mainpkt:integer;
0024 tag,monat,jahr,stunde,min,dayofw,sec,sec100:word;
0025 ltag,lmonat,lstunde,lmin:string[1];
0026 altstr,lesestr:zeile;
0027 Verffile,schlfile,progfile:text; { Verzeichnisse }
0028 Verftext:array[1..20] of Verfahren; { Feld Verfahrensbezeichnungen }
0029 Schltext,progtext:array[1..20] of dtname; { Feld Schlüssel,Programme }
0030 Akt_Dat:array[datind] of Dtname; { aktuelle Dateien Schl,Prog }
0031 lw:char;
0032 verf_Ausw_li:VerfFeld;
0033 Verf_Ausw_re:VerfFeld;
0034 Verfbez:verfahren;
0035 TxTK,TxtG,TxtS:textliste;
0036 TxTfile:text;
0037 druckfile:text;
0038 drucktext:char;
0039 ktname,gtname:dtname;
0040 dw,ok:boolean; { Dateinamenwechsel,Verzeichnisse }
0041
0042 Const
0043 Buausw:set of char=['A'..'T','a'..'t'];
0044 Farbe:array[1..5] of byte=(2,1,2,1,1);
0045 eintrag:mm=[' '..'z'];
0046 Ziffern:mm=[' ', '.', '0'..'9'];
0047 edzeil:integer=24;
0048 edspalt:integer=70;
0049 altd:word=32;
0050 altc:word=46;
0051
0052 {#########################################################}
0053
0054 procedure verzeichnisse(Var ok:boolean); { VERZEICHNISSE LESEN }
0055
0056 Var
0057 i:integer;
0058
0059 begin
0060 assign(verffile,'d:verf_dat.txt');
0061 assign(schlfile,'d:schl_dat.txt');
0062 assign(progfile,'d:prog_dat.txt');
0063 {$I-} reset(verffile); if ioresult=0 then ok:=true else ok:=false;
0064 reset(schlfile); if ioresult=0 then ok:=ok and true
0065 else ok:=ok and false;
0066 reset(progfile); if ioresult=0 then ok:=ok and true
0067 else ok:=ok and false; {$I+}
0068 for i:=1 to 20 do
0069 begin
0070 readln(verffile,verftext[i]);
0071 readln(schlfile,schltext[i]);
0072 readln(progfile,progtext[i]);
0073 end;
0074 close(verffile); close(schlfile); close(progfile);
0075 end;
0076
0077 procedure CRon; { CURSOR AN }
0078 begin
0079 inline($b1/6/$b5/6/$b4/1/$cd/$10);
0080 end;
0081
0082 procedure CRoff; { CURSOR AUS }
0083 begin
0084 inline($b1/8/$b5/8/$b4/1/$cd/$10);
0085 end;
0086
0087 procedure einzeil(var st:zeile; tex:zeile; m:mm; l,ze,sp:integer; var cc:char);
0088
0089 const s:set of byte=[8,75,77];
0090 var i:integer;
0091 ta:string[2];
0092 c:char;
0093
0094 procedure cure;
0095
0096 begin
0097 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0098 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
0099 end;
0100
0101 procedure culi;
0102
0103 begin
0104 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0105 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
0106 end;
0107
0108 begin
0109 Cron;
0110 st:='';
0111 for i:=1 to l do st:=st+' ';
0112 for i:=1 to length(tex) do st[i]:=tex[i];
0113 i:=1; gotoxy(ze,sp); write(tex);
0114 repeat
0115 gotoxy(ze+i-1,sp);
0116 c:=readkey; if c<>#27 then begin
0117 case c in m of
0118 true:ta:=c;
0119 false:case ord(c) in s of
0120 true:ta:=chr(27)+c;
0121 false:case ord(c) of
0122 0:begin c:=readkey;
0123 if ord(c) in s then ta:=chr(27)+c
0124 else ta:='' end
0125 else ta:=''
0126 end;
0127 end;
0128 end;
0129 if ta<>''then
0130 begin
0131 if ta[1]<>chr(27) then begin write(c); st[i]:=c;
0132 if i<l then i:=i+1 else culi
0133 end else
0134 case ord(ta[2]) of
0135 8:if i>1 then begin st[i]:=' '; i:=i-1; st[i]:=' ';
0136 culi; write(' '); culi; culi
0137 end;
0138 75:if i>1 then begin i:=i-1; culi end;
0139 77:if i<1 then begin i:=i+1; cure end;
0140 end;
0141 end; end;
0142 until ((c=chr(13)) or (c=chr(27))); cc:=c;
0143 i:=l+1;
0144 repeat
0145 i:=i-1
0146 until (i=0) or (st[i] <> ' ');
0147 if i<>0 then st:=copy(st,1,i)
0148 else st:='';
0149 Croff;
0150 end;
0151
0152 procedure Texthell; { TEXT HELL }
0153
0154 begin
0155 textbackground(black);
0156 textcolor(lightgray);
0157 end;
0158
0159 procedure Textdunkel; { TEXT DUNKEL }
0160
0161 begin
0162 textbackground(lightgray);
0163 textcolor(black);
0164 end;
0165
0166 procedure Faerben(i:byte); { FARBE }
0167
0168 begin
0169 case i of
0170 1:texthell;
0171 2:textdunkel;
0172 end;
0173 end;
0174
0175 procedure Fensterauf(W:byte); { FENSTER }
0176
0177 begin
0178 selwindow(w);
0179 w:=farbe[w];
0180 faerben(w);
0181 end;
0182
0183 procedure Lies_Dat; { DATUM/ZEIT }
0184
0185 begin
0186 gotoxy(1,1);
0187 getdate(jahr,monat,tag,dayofw);
0188 gettime(stunde,min,sec,sec100);
0189 if tag<10 then ltag:=' ' else ltag:='';
0190 if monat<10 then lmonat:='0' else lmonat:='';
0191 if min<10 then lmin:='0' else lmin:='';
0192 if stunde<10 then lstunde:=' ' else lstunde:='';
0193 writeln(' Datum: ',ltag,tag,'.',lmonat,monat,'.',jahr);
0194 write(' Zeit: ',lStunde,stunde,'.',lmin,min,' Uhr');
0195 end;
0196
0197 procedure ChangeDatTime; { DAT/TIME WECHSEL }
0198
0199 Var
0200 sttag,stmonat,ststunde,stmin:string[2];
0201 stjahr:string[4];
0202 code:integer;
0203
0204 begin
0205 wmain:=screenptr;
0206 openwindowheader(20,15,42,18,' Dat/Time andern ');
0207 clrscr;
0208 Lies_Dat;
0209 str(tag,sttag); str(monat,stmonat); str(jahr,stjahr);
0210 str(stunde,ststunde);str(min,stmin);
0211 if monat<10 then stmonat:='0'+copy(stmonat,1,1);
0212 if min<10 then stmin:='0'+copy(stmin,1,1);
0213 if tag<10 then sttag:=' '+copy(sttag,1,1);
0214 if stunde<10 then ststunde:=' '+copy(ststunde,1,1);
0215 altstr:=sttag+'.'+stmonat+'.'+stjahr;
0216 einzeil(altstr,altstr,ziffern,10,9,1,taste); if taste<>#27 then
0217 begin
0218 Val(copy(altstr,1,2),tag,code);
0219 Val(copy(altstr,4,2),monat,code);
0220 Val(copy(altstr,7,4),jahr,code);
0221 altstr:=ststunde+'.'+stmin;
0222 einzeil(altstr,altstr,ziffern,5,9,2,taste);
0223 Val(copy(altstr,1,2),stunde,code);
0224 Val(copy(altstr,4,2),min,code);
0225 setdate(jahr,monat,tag);
0226 settime(stunde,min,sec,sec100);
0227 end;
0228 fensterauf(w2);
0229 Lies_dat;
0230 fensterauf(wmain);
0231 closewindow;
0232 end;
0233
0234 procedure Zeitfenster; { DAT/TIME-FENSTER }
0235
0236 begin
0237 openwindow(55,3,77,6);
0238 w2:=screenptr;
0239 faerben(farbe[w2]);
0240 clrscr;
0241 Lies_Dat;
0242 end;
0243
0244 procedure Simkopf; { KOPFAUSSCHRIFT }
0245
0246 begin
0247 openwindow(1,1,80,8);
0248 w1:=screenptr;
0249 faerben(farbe[w1]);
0250 clrscr;
0251 gotoxy(5,3);
0252 write('Programmpaket S I M U L A T I O N E N /1');
0253 gotoxy(20,4);
0254 write('Vers 1.0 (12.12.89)');
0255 zeitfenster;
0256 end;
0257
0258 procedure Schreibausw(Feld:verffeld;x,y:integer); { AUSWAHLTEXT }
0259
0260 Var
0261 i:integer;
0262
0263 begin
0264 for i:=1 to 10 do begin
0265 gotoxy(x,y-1+i);
0266 write(feld[i]);
0267 end;
0268 end;
0269
0270 procedure SimAuswahl; { AUSWAHLFENSTFR }
0271
0272 begin
0273 openwindow(1,8,80,25);
0274 w3:=screenptr;
0275 faerben(farbe[w3]);
0276 clrscr;
0277 gotoxy(6,2);
0278 textcolor(black);
0279 write('Verfahren:');
0280 texthell;
0281 gotoxy(6,16);
0282 write(' Fl: Help '); gotoxy(wherex+3,wherey);
0283 write(' F2: Dat/Time '); gotoxy(wherex+3,wherey);
0284 write(' F3: Eintr änd '); gotoxy(wherex+3,wherey);
0285 write(' ESC: Quit ');
0286 openwindow(7,11,30,22);
0287 w4:=screenptr;
0288 faerben(farbe[w4]);
0289 clrscr;
0290 schreibausw(verf_ausw_li,1,1);
0291 openwindow(31,11,54,22);
0292 w5:=screenptr;
0293 faerben(farbe[w5]);
0294 clrscr;
0295 schreibausw(verf_ausw_re,1,1);
0296 end;
0297
0298 {#################################################### HAUPTMENÜ }
0299
0300 procedure Hauptmenue (Var Menue_PktX, Menue_PktY:integer);
0301
0302 Var
0303 x,y,breite,spalten,anzbyte,anzahl,punkt:word;
0304 bool:boolean;
0305 name:verffeld;
0306
0307 procedure ChangeEintrag; { EINTRAG ANDERN }
0308
0309 begin
0310 altstr:=name[punkt];
0311 lesestr:=altstr;
0312 openwindowheader(20,15,43,17,' Eintrag ändern ');
0313 einzeil(lesestr,lesestr,eintrag,21,1,1,taste);
0314 if wmain=4 then verf_ausw_li[punkt]:=copy(altstr,1,4)+copy(lesestr,5,16)+' '
0315 else verf_ausw_re[punkt]:=copy(altstr,1,4)+copy(lesestr,5,16)+' ';
0316 name[punkt]:=copy(altstr,1,4)+copy(lesestr,5,16)+' ';
0317 if LetztesZeichen = #27 then name[punkt]:=altstr;
0318 closewindow;
0319 end;
0320
0321 begin { START HAUPTMENÜ }
0322 Simkopf;
0323 Simauswahl;
0324 punkt:=menue_pkty;
0325 if Menue_pktx=1 then begin
0326 fensterauf(w4);
0327 x:=1;
0328 name:=verf_ausw_li;
0329 end
0330 else begin
0331 fensterauf(w5);
0332 x:=1;
0333 name:=verf_ausw_re;
0334 end;
0335 y:=1;
0336 breite:=21;spalten:=1;anzahl:=10;bool:=true;
0337 repeat
0338 Auswahl(x,y,breite,spalten,sizeof(name[punkt]),name,anzahl,punkt,bool);
0339 taste:=readkey;
0340 case taste of
0341 #0:begin
0342 taste:=readkey;
0343 case taste of
0344 #59:begin
0345 assign(helpfile,'d:Simausw.hlp');
0346 hilfe('#hilfef1');
0347 end;
0348 #60:begin
0349 maintaste:=taste;
0350 wmain:=screenptr;
0351 ChangedatTime;
0352 fensterauf(wmain);
0353 taste:=maintaste;
0354 end;
0355 #61:begin
0356 maintaste:=taste;
0357 wmain:=screenptr;
0358 changeeintrag;
0359 fensterauf(wmain);
0360 taste:=maintaste;
0361 end;
0362 #72:begin
0363 if punkt>1 then punkt:=punkt-1
0364 else punkt:=10;
0365 end;
0366 #80:begin
0367 if punkt<10 then punkt:=punkt+1
0368 else punkt:=1;
0369 end;
0370 #75:begin
0371 x:=1;
0372 name:=verf_ausw_li;
0373 schreibausw(verf_ausw_re,1,1);
0374 fensterauf(w4);
0375 end;
0376 #77:begin
0377 x:=1;
0378 name:=verf_ausw_re;
0379 schreibausw(verf_ausw_li,1,1);
0380 fensterauf(w5);
0381 end;
0382 end;
0383 end;
0384 'A'..'J','a'..'j':begin
0385 punkt:=(ord(taste) and 15);
0386 x:=1;
0387 taste:=#13;
0388 fensterauf(w4);
0389 end;
0390 'K'..'T','k'..'t':begin
0391 punkt:=(ord(taste) and 31)-10;
0392 x:=1;
0393 taste:=#13;
0394 fensterauf(w5);
0395 end;
0396 end;
0397 until((taste=#13) or (taste=#27));
0398 if screenptr=w4 then menue_pktx:=1
0399 else menue_pktx:=2;
0400 menue_pkty:=punkt;
0401 while maxscreen>0 do closewindow;
0402 end;
0403
0404 {************************************************* ENDE HAUPTMENÜ }
0405
0406 procedure Akt_lw(var lw:char); { LAUFWERK }
0407
0408 Var
0409 regs:registers;
0410 lwby:byte;
0411
0412 begin
0413 regs.ah:=$19;
0414 intr($21,regs);
0415 lwby:=regs.al;
0416 lw:=chr(65+lwby);
0417 end;
0418
0419 procedure Copyyerf; { EINTR4GE LESEN }
0420
0421 Var
0422 i:integer;
0423
0424 begin
0425 for i:=1 to 10 do verf_ausw_li[i]:=verftext[i];
0426 for i:=11 to 20 do verf_ausw_re[i-10]:=verftext[i];
0427 end;
0428
0429 procedure Recopy_verf; { EINTRAGE SCHREIBEN }
0430
0431 Var
0432 i:integer;
0433
0434 begin
0435 for i:=1 to 10 do Verftext[i]:=verf_ausw_li[i];
0436 for i:=11 to 20 do Verftext[i]:=verf_ausw_re[i-10];
0437 end;
0438
0439 {################################################ MENÜ FUNKTIONEN }
0440
0441 procedure Menue_fkt(Var Menue_Pkt:integer);
0442
0443 Type
0444 Auswzeile=string[18];
0445
0446 Var
0447 wf1,wf2,wf3,wf4:integer;
0448 i,j:integer;
0449 x,y:integer;
0450 wahl:word;
0451 code:boolean;
0452
0453 Const
0454 Wahlbu:set of char=['C','D','S','T', 'Z','c' ,'d','s','t','z'];
0455 Ftext:array[1..5] of Auswzeile=(' Texte ',
0456 ' Schlüssel ',
0457 ' Dechiffrieren ',
0458 ' Chiffrieren ',
0459 ' Zusatzfunktionen ');
0460
0461 begin
0462 openwindow(1,1,80,5);
0463 wf1:=screenptr;
0464 textdunkel;
0465 clrscr;
0466 gotoxy(5,2);
0467 write('VERFAHREN ',Akt_dat[vf]);
0468 openwindow(1,21,80,25);
0469 wf2:=screenptr;
0470 textdunkel;
0471 clrscr;
0472 texthell;
0473 gotoxy(5,2);
0474 write('F1: Help');
0475 gotoxy(wherex+55,wherey);
0476 write('ESC: Quit');
0477 openwindow(1,6,80,20);
0478 wf3:=screenptr;
0479 textbackground(green);
0480 clrscr;
0481 openwindow(10,10,30,16);
0482 wf4:=screenptr;
0483 texthell;
0484 clrscr;
0485 x:=1;y:=1;
0486 wahl:=menue_pkt;code:=true;
0487 repeat
0488 Auswahl(x,y,18,1,sizeof(ftext[wahl]),ftext,5,wahl,code);
0489 if rcode<>0 then taste:=#13 else
0490 taste:=readkey;
0491 case taste of
0492 'C','c':begin wahl:=4;
0493 taste:=#13;
0494 end;
0495 'D','d':begin wahl:=3;
0496 taste:=#13;
0497 end;
0498 'S','s':begin wahl:=2;
0499 taste:=#13;
0500 end;
0501 'T','t':begin wahl:=1;
0502 taste:=#13;
0503 end;
0504 'Z','z':begin wahl:=5;
0505 taste:=#13;
0506 end;
0507 #0:begin taste:=readkey;
0508 case taste of
0509 #72:if wahl>1 then wahl:=wahl-1
0510 else wahl:=5;
0511 #80:if wahl<5 then wahl:=wahl+1
0512 else wahl:=1;
0513 #59:begin
0514 assign(helpfile,'d:Simfkt.hlp');
0515 hilfe('#hilfef1');
0516 end;
0517 end;
0518 end;
0519 end;
0520 until ((taste=#13) or (taste=#27));
0521 menue_pkt:=wahl;
0522 while maxscreen>0 do closewindow;
0523 end;
0524
0525 procedure ChangeDatei(Var Name:dtname); { DATEINAMENWECHSEL }
0526
0527 Var
0528 altstring:zeile;
0529 zeichen:set of char;
0530 vglstring:dtname;
0531 Pospkt:byte;
0532
0533 begin
0534 altstring:='';
0535 vglstring:=name;
0536 zeichen:=eintrag+ziffern;
0537 openwindowheader(6,10,70,12,' Change Dt-Name ');
0538 altstring:=copy(altstring,1,0)+name;
0539 einzeil(altstring,altstring,zeichen,60,1,1,taste);
0540 name:=altstring;
0541 { pospkt:=pos(',',name);
0542 if ((pospkt=0) and (name<>'')) then name:=name+',txt'; }
0543 if name=vglstring then dw:=false else dw:=true;
0544 closewindow;
0545 end;
0546
0547 {################################################ DATEIVERARBEITUNG }
0548
0549 procedure Aufruf_Editor(name:dtname;Var txt:textliste); { EDITOR }
0550
0551 var
0552 x,y,z:word;
0553 c:char;
0554
0555 begin
0556 if name='' then begin
0557 openwindow(20,10,60,13);
0558 texthell; clrscr;
0559 write(' Dateiname leer !');
0560 taste:=readkey;
0561 closewindow;
0562 end
0563 else begin
0564 openwindow(1,1,80,25);
0565 clrscr;
0566 cron;
0567 if dw=true then neuertext(txt);
0568 x:=1;y:=1;z:=1;clrscr;
0569 edittext(txt,x,y,z,79,23,true);
0570 croff;
0571 closewindow;
0572 end;
0573 taste:=#0;
0574 end;
0575
0576 procedure Disk_Lesen(Name:dtname;Var txt:textliste); { DATEI LESEN }
0577
0578 Var
0579 code:integer;
0580
0581 begin
0582 assign(txtfile,name);
0583 {$I-} reset(txtfile);{$I+}
0584 code:=ioresult;
0585 if name='' then code:=2;
0586 case code of
0587 0:begin close(txtfile);
0588 openwindow(18,10,58,13);
0589 textdunkel;clrscr;
0590 write(' Datei wird gelesen !');
0591 Liestext(txtfile,txt);
0592 closewindow;
0593 end;
0594 2,3:begin openwindow(18,10,58,13);
0595 write(' Datei/Suchweg nicht gefunden !');
0596 taste:=readkey;taste:=#0;
0597 closewindow;
0598 end;
0599 end;
0600 taste:=#0;
0601 end;
0602
0603 procedure Disk_Schreiben(name:dtname;Var txt:textliste); { DATEI SCNREIBEN }
0604
0605 Var
0606 code:integer;
0607
0608 begin
0609 assign(txtfile,name);
0610 {$I-} reset(txtfile);{$I+}
0611 code:=ioresult;
0612 if name='' then begin
0613 openwindow(20,10,60,13);
0614 texthell;clrscr;
0615 write(' Dateiname leer ! ');
0616 taste:=readkey;
0617 closewindow;
0618 code:=3;
0619 end;
0620 if code=0 then
0621 begin openwindow(14,10,61,13);
0622 write(' Datei ',name,' überschreiben ? J/N ');
0623 repeat
0624 taste:=readkey;
0625 taste:=upcase(taste);
0626 until taste in ['J','N'];
0627 write(taste);
0628 closewindow;
0629 end;
0630 if code=2 then taste:='J';
0631 if taste='J' then begin openwindow(20,10,60,13);
0632 textdunkel;clrscr;
0633 write(' Datei wird geschrieben ! ');
0634 schreibtext(txtfile,txt);
0635 closewindow;
0636 end;
0637 taste:=#0;
0638 end;
0639
0640 procedure Datei_drucken(name:dtname); { DATEI DRUCKEN }
0641
0642 Var i:integer;
0643
0644 begin
0645 if name='' then begin
0646 openwindow(20,10,60,13);
0647 texthell;clrscr;
0648 write(' Dateiname leer !');
0649 taste:=readkey;
0650 closewindow;
0651 end
0652 else begin
0653 openwindow(14,10,61,13);
0654 textdunkel;
0655 clrscr;
0656 write(' Datei ',name,' wird gedruckt !');
0657 assign(druckfile,name);
0658 {$I-} reset(druckfile);{$I+}
0659 if ioresult=0 then begin
0660 repeat
0661 read(druckfile,drucktext);
0662 write(lst,drucktext);
0663 until drucktext=^Z;
0664 end;
0665 write(lst,#12);
0666 close(druckfile);
0667 closewindow;
0668 end;
0669 taste:=#0;
0670 end;
0671
0672 procedure Edit(Dateiname:zeile); { DATEIVERARBEITUNG
0673 Hauptprogramm }
0674 Var
0675 x,y,breite,wpkt:word;
0676
0677 Const
0678 Editausw:array[1..4] of string[20]=(' Editieren ',
0679 ' Lesen von Disk ',
0680 ' Speichern auf Disk ',
0681 ' Drucken ');
0682
0683 begin
0684 dw:=false;
0685 case mpkttxt of
0686 1:openwindowheader(10,8,65,21,' KLARTEXT ');
0687 2:openwindowheader(10,8,65,21,' GEHEINTEXT ');
0688 3:openwindowheader(10,8,65,21,' SCHLÜSSEL ');
0689 end;
0690 wpkt:=1;
0691 repeat
0692 textbackground(green);
0693 textcolor(white);
0694 clrscr;
0695 gotoxy(4,2);
0696 case mpkttxt of
0697 1:write(' Datei: ',akt_dat[kl]);
0698 2:write(' Datei: ',akt_dat[gh]);
0699 3:write(' Datei: ',akt_dat[sl]);
0700 end;
0701 texthell;
0702 x:=7;y:=5;breite:=20;
0703 Auswahl(x,y,breite,1,sizeof(editausw[wpkt]),editausw,4,wpkt,true);
0704 taste:=readkey;
0705 case taste of
0706 #0:begin taste:=readkey;
0707 case taste of
0708 #32:begin rcode:=altd;taste:=#27; end;
0709 #46:begin rcode:=altc;taste:=#27; end;
0710 #72:if wpkt>1 then wpkt:=wpkt-1 else wpkt:=4;
0711 #80:if wpkt<4 then wpkt:=wpkt+1 else wpkt:=1;
0712 #60:begin
0713 case mpkttxt of
0714 1:begin changedatei(akt_dat[kl]);
0715 if dw=true then neuertext(txtk);
0716 dw:=false;
0717 end;
0718 2:begin changedatei(akt_dat[gh]);
0719 if dw=true then neuertext(txtg);
0720 dw:=false;
0721 end;
0722 3:begin changedatei(akt_dat[sl]);
0723 if dw=true then neuertext(txts);
0724 dw:=false;
0725 end;
0726 end;
0727 taste:=#0;
0728 end;
0729 end;
0730 end;
0731 'E','e':begin wpkt:=1; case mpkttxt of
0732 1:Aufruf_Editor(akt_dat[kl],txtk);
0733 2:Aufruf_Editor(akt_dat[gh],txtg);
0734 3:Aufruf_Editor(akt_dat[sl],txts);
0735 end;
0736 end;
0737 'L','l':begin wpkt:=2;case mpkttxt of
0738 1:Disk_lesen(akt_dat[kl],txtk);
0739 2:Disk_lesen(akt_dat[gh],txtg);
0740 3:Disk_lesen(akt_dat[sl],txts);
0741 end;
0742 end;
0743 'S','s':begin wpkt:=3;case mpkttxt of
0744 1:Disk_schreiben(akt_dat[kl],txtk);
0745 2:Disk_schreiben(akt_dat[gh],txtg);
0746 3:Disk_schreiben(akt_dat[sl],txts);
0747 end;
0748 end;
0749 'D','d':begin wpkt:=4;case mpkttxt of
0750 1:Datei_drucken(akt_dat[kl]);
0751 2:Datei_drucken(akt_dat[gh]);
0752 3:Datei_drucken(akt_dat[sl]);
0753 end;
0754 end;
0755 #13:case wpkt of
0756 1:begin case mpkttxt of
0757 1:Aufruf_Editor(akt_dat[kl],txtk);
0758 2:Aufruf_Editor(akt_dat[gh],txtg);
0759 3:Aufruf_Editor(akt_dat[sl],txts);
0760 end;
0761 end;
0762 2:begin case mpkttxt of
0763 1:Disk_lesen(akt_dat[kl],txtk);
0764 2:Disk_lesen(akt_dat[gh],txtg);
0765 3:Disk_lesen(akt_dat[sl],txts);
0766 end;
0767 end;
0768 3:begin case mpkttxt of
0769 1:Disk_schreiben(akt_dat[kl],txtk);
0770 2:Disk_schreiben(akt_dat[gh],txtg);
0771 3:Disk_schreiben(akt_dat[sl],txts);
0772 end;
0773 end;
0774 4:begin wpkt:=4;case mpkttxt of
0775 1:Datei_drucken(akt_dat[kl]);
0776 2:Datei_drucken(akt_dat[gh]);
0777 7:datei_drucken(akt_dat[sl]);
0778 end;
0779 end;
0780 end;
0781 end;
0782 until taste=#27;taste:=#0;
0783 while maxscreen>0 do closewindow;
0784 end;
0785
0786 {####################################################### AUSWAHL TEXTART }
0787
0788 procedure Menue_Texte(Var Menue_Pkt:integer);
0789
0790 Type
0791 Auswzeile=string[43];
0792
0793 Var
0794 wf1,wf2,wf3,wf4:integer;
0795 i,j:integer;
0796 x,y:integer;
0797 wahl:word;
0798 code:boolean;
0799
0800 Const
0801 Wahlbu:set of char=['G','K','g','k'];
0802 Auswtext:array[1..2] of
0803 auswzeile=('Klartext bearbeiten ',
0804 'Geheimtext bearbeiten ');
0805
0806 begin
0807 if ((rcode=altd) or (rcode=altc)) then
0808 else
0809 begin
0810 openwindow(1,1,80,5);
0811 wf1:=screenptr;
0812 textdunkel;
0813 clrscr;
0814 gotoxy(5,2);
0815 write('TEXTE ',Akt_dat[vf]);
0816 openwindow(1,21,80,25);
0817 wf2:=screenptr;
0818 textdunkel;
0819 clrscr;
0820 texthell;
0821 gotoxy(5,2);
0822 write('F1: Help');
0823 gotoxy(wherex+10,wherey);
0824 write('F2: Datei ');
0825 gotoxy(wherex+35,wherey);
0826 write('ESC: Quit');
0827 openwindow(1,6,80,20);
0828 wf3:=screenptr;
0829 textbackground(green);
0830 clrscr;
0831 openwindow(10,10,55,13);
0832 wf4:=screenptr;
0833 texthell;
0834 clrscr;
0835 x:=1;y:=1;
0836 wahl:=menue_pkt;code:=true;
0837 repeat
0838 Auswahl(x,y,43,1,sizeof(auswtext[wahl]),auswtext,2,wahl,code);
0839 taste:=readkey;
0840 case taste of
0841 'K','k':begin wahl:=1;
0842 taste:=#13;
0843 end;
0844 'G','g':begin wahl:=2;
0845 taste:=#13;
0846 end;
0847 #0:begin taste:=readkey;
0848 case taste of
0849 #32:begin rcode:=altd;taste:=#27; end;
0850 #46:begin rcode:=altc;taste:=#27; end;
0851 #72:if wahl=2 then wahl:=1 else wahl:=2;
0852 #80:if wahl=1 then wahl:=2 else wahl:=1;
0853 #59:begin
0854 assign(helpfile,'d:simtxt.h1p');
0855 hilfe('#hilfef1');
0856 end;
0857 #64:begin
0858 if wahl=1 then changedatei(akt_dat[kl])
0859 else changedatei(akt_dat[gh]);
0860 taste:=#0;
0861 end;
0862 end;
0863 end;
0864 end;
0865 until ((taste=#13) or (taste=#27));
0866 menue_pkt:=wahl;
0867 end; {else }
0868 end;
0869
0870 procedure Menue_Schl; { MENÜ SCHLÜSSEL }
0871
0872 Var
0873 wf1,wf2,wf3:integer;
0874
0875 begin
0876 openwindow(1,1,80,5);
0877 wf1:=screenptr;
0878 textdunkel;
0879 clrscr;
0880 gotoxy(5,2);
0881 write('SCHLÜSSEL ',Akt_dat[sl]);
0882 openwindow(1,21,80,25);
0883 wf2:=screenptr;
0884 textdunkel;
0885 clrscr;
0886 texthell;
0887 gotoxy(5,2);
0888 write('F1: Help');
0889 gotoxy(wherex+10,wherey);
0890 write('F2: Datei');
0891 gotoxy(wherex+35,wherey);
0892 write('ESC: Quit');
0893 openwindow(1,6,80,20);
0894 wf3:=screenptr;
0895 textbackground(green);
0896 clrscr;
0897 end;
0898
0899 {######################################################## FUNKTIONEN CHIFF/DECH }
0900
0901 procedure Fkt_DC(Art:char);
0902
0903 Var
0904 kdostring,verfname:string;
0905
0906 begin
0907 openwindow(1,1,80,5);
0908 textdunkel;
0909 clrscr;
0910 gotoxy(5,2);
0911 case art of
0912 'c':write(' CHIFFRIEREN - ');
0913 'd':write(' DECHIFFRIEREN - ');
0914 end;
0915 write(verfbez);
0916 openwindow(1,21,80,25);
0917 textdunkel;
0918 clrscr;
0919 texthell;
0920 gotoxy(5,2);
0921 write('Abbruch: CTRL PAUSE');
0922 gotoxy(63,2);
0923 write('Taste: Quit');
0924 openwindow(1,6,80,20);
0925 textbackground(green);
0926 clrscr;
0927 textcolor(white);
0928 gotoxy(10,2);
0929 writeln('Geheimtext: ',akt_dat[gh]);
0930 gotoxy(10,wherey);
0931 writeln('Klartext: ',akt_dat[kl]);
0932 gotoxy(1,5);
0933 case art of
0934 'd':openwindowheader(1,11,80,20,' Klartext ');
0935 'c':openwindowheader(1,11,80,20,' Geheimtext ');
0936 end;
0937 texthell;clrscr;
0938 verfname:=copy(akt_dat[vf],1,6);
0939 kdostring:=verfname+' '+akt_dat[sl]+' '+akt_dat[gh]+' '+akt_dat[kl];
0940 case art of
0941 'd':kdostring:='d '+kdostring;
0942 'c':kdostring:='c '+kdostring;
0943 end;
0944 case art of
0945 'd':exec(akt_dat[pr],kdostring);
0946 'c':exec(akt_dat[pr],kdostring);
0947 end;
0948 taste:=readkey;
0949 case art of
0950 'd':begin
0951 neuertext(txtk);
0952 Disk_lesen(akt_dat[kl],txtk);
0953 Aufruf_Editor(akt_dat[kl],txtk);
0954 end;
0955 'c':begin
0956 neuertext(txtg);
0957 Disk_lesen(akt_dat[gh],txtg);
0958 Aufruf_Editor(akt_dat[gh],txtg);
0959 end;
0960 end;
0961 taste:=#27;
0962 while maxscreen>0 do closewindow;
0963 end;
0964
0965 {************************************************************* HAUPTPROGRAMM
0966 ****************************************************************************}
0967
0968 begin
0969 clrscr;
0970 akt_lw(lw);
0971 neuertext(txts);
0972 neuertext(txtk);
0973 neuertext(txtg);
0974 verzeichnisse(ok);
0975 if ok=false then begin
0976 openwindow(15,8,55,12);
0977 write(' Dateifehler Verzeichnisse !');
0978 closewindow;
0979 end;
0980 recopy_verf;
0981 Akt_Dat[gh]:='';Akt_Dat[kl]:='';Akt_Dat[sl]:='';
0982 croff;
0983 mpktx:=1;mpkty:=1;rcode:=0;
0984 repeat
0985 hauptmenue(mpktx,mpkty);
0986 if taste<>#27 then
0987 begin
0988 maintaste:=taste;
0989 if mpktx=1 then verfbez:=copy(verf_ausw_li[mpkty],5,16)
0990 else verfbez:=copy(verf_ausw_re[mpkty],5,16);
0991 akt_dat[vf]:=verfbez;
0992 akt_dat[sl]:=schltext[(mpktx-1)*10+mpkty];
0993 akt_dat[pr]:=progtext[(mpktx-1)*10+mpkty];
0994 if akt_dat[sl]<>'' then begin
0995 assign(txtfile,akt_dat[sl]);
0996 {$I-} reset(txtfile); {$I+}
0997 if ioresult=0 then liestext(txtfile,txts);
0998 end;
0999 mpkt:=1;
1000 repeat
1001 if rcode<>0 then begin
1002 case rcode of
1003 32:mpkt:=3;
1004 46:mpkt:=4;
1005 end;
1006 taste:=#0;
1007 end;
1008 menue_fkt(mpkt);
1009 if taste<>#27 then
1010 case mpkt of
1011 1:begin
1012 mpkttxt:=1;
1013 repeat
1014 menue_texte(mpkttxt);
1015 if taste<>#27 then
1016 case mpkttxt of
1017 1:edit(akt_dat[kl]);
1018 2:edit(akt_dat[gh]);
1019 end;
1020 if rcode<>0 then taste:=#27;
1021 until taste=#27;
1022 taste:=#0;
1023 end;
1024 2:begin mainpkt:=mpkttxt; { Schlüsselbereitstellung }
1025 menue_schl;
1026 mpkttxt:=3;
1027 edit(akt_dat[sl]);
1028 mpkttxt:=mainpkt;
1029 taste:=#0;
1030 end;
1031 3:begin fkt_dc('d'); taste:=#0; rcode:=0; end; { Dechiffrieren }
1032 4:begin fkt_dc('c'); taste:=#0; rcode:=0; end; { Chiffrieren }
1033 5:begin end; { Zusatzfunktionen }
1034 end;
1035 until taste=#27; taste:=maintaste;
1036 end;
1037 until taste=#27;
1038 recopy_verf;
1039 rewrite(verffile);
1040 for i:=0 to 20 do writeln(verffile, verftext[i]);
1041 close(verffile);
1042 cron;
1043 end.
0001 { SIMULATION - Variante "S" - TC 850 - 29.12.1989
0002 Programm zur Chiff/Dechiffrierung von Texten der Kennung 'HHHHH'
0003 Dateinamen werden Ifo_Satz (record-Typ) entnommen:
0004 - Datei_Kt: Klartext
0005 - Datei_Gt: Geheimtext
0006 - Datei_Sl: Struktur- und Grundschlüssel
0007 Spruchschlüssel wird dem Text nach Kennung entnommen und muß
0008 in der Form 'AAABB BCCCD DDEEE FFFGG GHHHI IIJJJ' stehen, wobei
0009 Steuerzeichen ignoriert werden
0010 Das jeweils chiff/dechiffrierte Element wird mit write(…)
0011 angezeigt }
0012 {========================= Rahmenprogramm ====================================}
0013
0014 program simrahmen;
0015
0016 uses crt, dos, printer, windows;
0017
0018 Type
0019 verfahren = string[22];
0020 Dtname = string[60];
0021 ifo_typ = record Verf_bez:verfahren;
0022 datei_kt:dtname;
0023 datei_gt:dtname;
0024 datei_sl:dtname;
0025 end;
0026
0027 Var
0028 taste:char;
0029 betrart:string;
0030 ifo_satz:ifo_typ;
0031
0032 procedure stoi;
0033 begin taste := readkey; end;
0034 {====================================================================}
0035
0036 procedure SimvarS(art:char; ifo_satz:ifo_typ); { Variante "S" TC 850 }
0037
0038 type
0039 matrix = array[0..7, 0..15] of byte;
0040 slmat = array[1..16, 1..8] of byte;
0041 vektor = array[1..8] of byte;
0042 allreg = array[1..31] of byte;
0043 RegSatz = array[1..8] of allreg;
0044 Rcnum = array[1..18] of byte; { 18=max Anzahl Rückkopplungen }
0045 RcSatz = array[1..8] of Rcnum;
0046 SlMatrix = array[1..16, 1..8] of byte;
0047 string16 = string[16];
0048 string10 = string[10];
0049 string13 = string[13];
0050 string128 = string[128];
0051 zeile60 = string[60];
0052 menge = set of char;
0053 Bytefile = file of byte;
0054 ITA_Reg = array[1..26] of byte;
0055 ITA_Zei = array[1..26] of char;
0056 regtyp = array[1..31] of byte;
0057
0058 var
0059 OK:zeile60; { Grundschlüssel }
0060 DK:zeile60; { Spruchschlüssel }
0061 SK:matrix; { Strukturschlüssel }
0062 MTXB:slmat; { OK-Matrix }
0063 MTXD:slmat; { DK-Matrix }
0064 MtxP:matrix; { Matrix P }
0065 C:vektor; { Registerausgänge }
0066 Gam:byte; { Additionseinheit }
0067 K:byte; { Element Klartext }
0068 G:byte; { Element Geheimtext }
0069 i,j,m,gr:integer; { Zähler }
0070 t,tmax,poszei,poskenn:longint; { Zähler, Positionen in Datei }
0071 Reg:RegSatz; { Registersatz }
0072 zt:byte; { zt:=Summe(Ci(t-1)) }
0073 Ende,EinOk,AusOk:boolean; { Prüfvariable bevor Programm startet }
0074 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0075 Nameskdat:zeile60; { Name des Files Skdat }
0076 SKDat:File of byte; { File der Strukturmatrix }
0077 Quelldatei,Zieldatei,Sldatei:file of byte; { Files der Textdateien }
0078 Taste:char;
0079 vek128:string128;
0080 Rueck, Alt:zeile60;
0081 BitVar:integer; { 5- oder 7-bit-Variante }
0082 Feld5Gt:array[1..5] of byte; { für Subst Y-Bigramm }
0083 ByteGt:byte; { aus FeldSGt gebildetes Byte }
0084 st_in_gt, textende:boolean; { Merker für Steuerkombination,textende }
0085 index:integer;
0086 codeq,codez,codes:integer; { ioresult-codes }
0087 ghel, ghelnf, klareinheit, addel:byte; { Textelemente,Nachfolger }
0088 leertakte, buflag, wrzv:boolean;
0089 regist:regtyp;
0090
0091 const
0092 maske:regtyp=($14,$73,$A3,$33,$8F,$25,$67,$BD,$16,$B6,$B4,$4C,$0C,$B4,$51,
0093 $90,$6B,$1A,$6B,$09,$E0,$59,$0D,$A8,$18,$E1,$70,$61,$C1,$01,$81);
0094 Skok:boolean=false;
0095 Okok:boolean=false;
0096 Dkok:boolean=false;
0097 Tok:Boolean=false;
0098 Tsok:boolean=false;
0099 Dateibz:menge=['A' .. 'Z', 'a' .. 'z', '0'..'9', '.', '_', ' ', ':'];
0100 Bu:menge=['A'..'Z', 'a'..'z'];
0101 ITA2_Hex:ITA_Reg=($18,$13,$0E,$12,$10,$16,$0B,$05,$0C,$1A,$1E,$09,$07,$06,
0102 $03,$0D,$1D,$0A,$14,$01,$1C,$0F,$19,$17,$15,$11);
0103 ITA2_Bu:ITA_Zei=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
0104 'P','Q','R','S','T','U','V','W','X','Y','Z');
0105 ITA2_ZZ:ITA_Zei=('-','?',':','@','3','@','@','@','8','@','(',')','.',',','9','0',
0106 '1','4','`','5','7','=','2','/','6','+');
0107 Steuerkomb_hex:array[1..6] of byte=($00,$02,$04,$08,$1B,$1F);
0108 Steuerkomb_zei:array[1..6] of char=('|', '<', ' ', '*', '#', '%');
0109 dech:char='D'; { Dechiffr.}
0110 chif:char='C'; { Chiffr. }
0111
0112 { ...................................................................SCHLÜSSEL }
0113
0114 procedure LiesSchl;
0115 Type
0116 mtyp=set of char;
0117 bytefile=file of byte;
0118
0119 Var
0120 zeile:string;
0121 i,j:integer;
0122
0123 Const
0124 KennSk:string[17]='STRUKTURSCHLÜSSEL';
0125 KennOk:string[14]='GRUNDSCHLÜSSEL';
0126 Kenndk:string[5]='HHHHH';
0127 chrsk:mtyp=['0','1'];
0128 chrok:mtyp=['A'..'Z', 'a'..'z'];
0129
0130 function posit(vglstring:string;
0131 var datei:bytefile;
0132 dateiname:zeile60):longint;
0133
0134 Var
0135 n:integer;
0136 i:longint;
0137 ch:byte;
0138
0139 begin
0140 assign(datei,dateiname);
0141 {$I-} reset(datei); {$I+}
0142 if ioresult=0 then begin
0143 i:=0;n:=1;
0144 repeat
0145 read(datei,ch);
0146 inc(i);
0147 if char(ch)=vglstring[n] then inc(n)
0148 else n:=1;
0149 until ((eof(datei)) or (n=length(vglstring)+1));
0150 if eof(datei) then posit:=0
0151 else posit:=i+1;
0152 end
0153 else begin
0154 openwindowheader(30,10,50,12,' ERROR ');
0155 clrscr;
0156 write(' Dateifehler ! ');
0157 taste:=readkey;
0158 closewindow;
0159 posit:=0;
0160 end;
0161 close(datei);
0162 end;
0163
0164 procedure LiesabPos(Var Feld:string;pos:longint;menge:mtyp;
0165 Var datei:bytefile;lg:integer);
0166
0167 Var
0168 i:longint;
0169 ch:byte;
0170
0171 begin
0172 reset(datei);
0173 seek(datei,pos);
0174 feld:='';
0175 for i:=1 to lg do begin
0176 repeat
0177 read(datei,ch);
0178 until ((char(ch) in menge) or (i=lg));
0179 feld:=feld+char(ch);
0180 end;
0181 poszei:=filepos(datei);
0182 close(datei);
0183 end;
0184
0185 procedure Sl_lesen(Var feld:string; name:zeile60; kennung:string128;
0186 menge:mtyp; sl_laenge:integer);
0187
0188 Var
0189 datei:bytefile;
0190 p:longint;
0191 i:integer;
0192 begin
0193 p:=posit(kennung,datei,name);
0194 if p=0 then Fillchar(feld,sizeof(feld),#32)
0195 else LiesabPos(feld,p,menge,datei,sl_laenge);
0196 end;
0197
0198 begin
0199 skok:=true;dkok:=true;okok:=true;
0200 zeile:='';
0201 Sl_lesen(zeile,ifo_satz.datei_sl,kennsk,chrsk,128);
0202 for i:=0 to 7 do
0203 for j:=0 to 15 do SK[i,j]:=ord(zeile[i*16+j+1]);
0204 if sk[0,0]=32 then skok:=FALSE;
0205 zeile:='';
0206 Sl_lesen(zeile,ifo_satz.datei_sl,kennok,chrok,10);
0207 Ok:=copy(zeile,1,10);
0208 if ok[1]=#32 then okok:=false;
0209 zeile:='';
0210 case art of
0211 'C':Sl_lesen(zeile,ifo_satz.datei_kt,kenndk,chrok,30);
0212 'D':Sl_lesen(zeile,ifo_satz.datei_gt,kenndk,chrok,30);
0213 end;
0214 dk:='';
0215 for i:=1 to 10 do if zeile[3*(i-1)+1]=zeile[3*(i-1)+2] then
0216 if zeile[3*(i-1)+2]=zeile[3*(i-1)+3] then
0217 dk:=dk+zeile[3*(i-1)+1]
0218 else dkok:=false
0219 else dkok:=false;
0220 if ((skok and okok) and dkok) then Einok:=true
0221 else Einok:=false;
0222 end;
0223
0224 {............................................................F(X)= 2 HOCH X }
0225
0226
0227 Function Pot2(x:integer):integer;
0228 Var
0229 i:integer;
0230 Erg:integer;
0231
0232 begin
0233 if x=0 then pot2:=1
0234 else
0235 begin
0236 Erg:=1;
0237 for i:=1 to x do Erg:=Erg*2;
0238 Pot2:=Erg;
0239 end;
0240 end;
0241
0242 {.............................................................. REGISTERSATZ }
0243
0244 procedure RegVerSatz;
0245
0246 Var
0247 i:integer;
0248 rk:byte;
0249
0250 begin
0251 i:=31;
0252 rk:=regist[i] and maske[i];
0253 repeat
0254 dec(i);
0255 rk:=rk xor (regist[i] and maske[i]);
0256 regist[i+1]:=regist[i];
0257 until i=1;
0258 regist[i]:=rk;
0259 for i:=1 to 8 do c[i]:=$00 or ((rk and pot2(8-i)) shr (8-i));
0260 end;
0261
0262 {............................................................ BU IN VEK(1..8) }
0263
0264 procedure Mzeile(Var Zeile:vektor;Bu:char);
0265
0266 Var
0267 i:integer;
0268 By:real;
0269 hiz:vektor;
0270
0271 begin
0272 bu:=upcase(bu);
0273 by:=ita2_hex[ord(bu)-64];
0274 for i:=8 downto 1 do
0275 begin
0276 if (by/Pot2(i-1)<1) then zeile[9-i]:=0
0277 else begin
0278 zeile[9-i]:=1;
0279 by:=by-Pot2(i-1);
0280 end;
0281 end;
0282 for i:=1 to 5 do
0283 hiz[i]:=zeile[i+3];
0284 for i:=6 to 8 do
0285 hiz[i]:=0;
0286 for i:=1 to 8 do
0287 zeile[i]:=(zeile[i] xor hiz[i]) and 1;
0288 end;
0289
0290 {............................................................MATRIX B }
0291
0292 procedure MatrixB (Var mat:slmat; Grsl:string10);
0293
0294 Var
0295 i,j:integer;
0296 bu:char;
0297 zeile:vektor;
0298
0299 begin
0300 for i:=1 to 10 do
0301 begin
0302 bu:=grsl[i];
0303 mzeile(zeile,bu);
0304 for j:=1 to 8 do mat[i,j]:=zeile[j];
0305 end;
0306 for i:=2 to 7 do
0307 begin
0308 bu:=grsl[i];
0309 mzeile(zeile,bu);
0310 for j:= 1 to 8 do mat[9+i,j]:=zeile[j];
0311 end;
0312 end;
0313
0314 {.............................................................MATRIX D }
0315
0316 procedure MatrixD (Var mat:slmat;Spsl:string10);
0317
0318 Var
0319 i,j:integer;
0320 bu: char;
0321 zeile:vektor;
0322
0323 begin
0324 for i:=1 to 10 do
0325 begin
0326 bu:=spsl[i];
0327 mzeile(zeile,bu);
0328 for j:=1 to 8 do mat[i,j]:=zeile[j];
0329 end;
0330 for i:=11 to 16 do
0331 begin
0332 bu:=spsl[i-10];
0333 mzeile(zeile,bu);
0334 for j:=1 to 8 do mat[i,j]:=zeile[j];
0335 end;
0336 end;
0337
0338 { MATRIZEN B,D }
0339
0340 procedure GenMatx (var MTXB, MTXD:slmat; OK:string10; DK:string10);
0341
0342 begin
0343 matrixb(mtxb,ok);
0344 matrixd(mtxd,dk);
0345 end;
0346
0347 {...........................................................INITIALFÜLLUNG }
0348
0349 { procedure InitRegSatz (Var rset:regsatz;mtxb,mtxd:slmat); }
0350 procedure initregsatz (var re:regtyp; mb, md:slmat);
0351
0352 var
0353 i,j:integer;
0354
0355 begin
0356 re[1]:=$ff;
0357 for i:=1 to 10 do begin
0358 re[i+1]:=$00;
0359 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or (mb[i,9-j]
0360 xor md[i,9-j]);
0361 end;
0362 for i:=11 to 16 do begin
0363 re[i+1]:=$00;
0364 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or (mb[i,9-j]
0365 xor md[i-10,9-j]);
0366 end;
0367 for i:=17 to 20 do begin
0368 re[i+1]:=$00;
0369 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or (mb[i-16,9-j]
0370 xor md[i-10,9-j]);
0371 end;
0372 for i:=21 to 26 do begin
0373 re[i+1]:=$00;
0374 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or (mb[i-16,9-j]
0375 xor md[i-20,9-j]);
0376 end;
0377 for i:=27 to 30 do begin
0378 re[i+1]:=$00;
0379 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or (mb[i-25,9-j]
0380 xor md[i-20,9-j]);
0381 end;
0382 end;
0383
0384 {.....................................................................MATRIX P }
0385
0386 procedure GenMtxP (Var SPMat:matrix;SKMat:matrix;OKMat,DkMat:slmat);
0387
0388 Var
0389 i,j,Anz1:integer;
0390 Ptest:boolean;
0391
0392 begin
0393 repeat
0394 Anz1:=0;
0395 for i:=0 to 7 do
0396 for j:=0 to 15 do
0397 begin
0398 SPMat[i,j]:=((ord(SkMat[i,j])-48) xor DKMat[j+1,8-i] xor OKMat[j+1,8-i]) and 1;
0399 Anz1:=Anz1 + SPMat[i,j];
0400 end;
0401 if ((Anz1<33) or (Anz1>95)) then ptest:=false
0402 else ptest:=true; {keine Änderung notwendig}
0403 if ptest=false then for i:=0 to 7 do
0404 for j:=0 to 14 do Skmat[i,j]:=Skmat[i,j+1];
0405 until ptest=true;
0406 if ((Anz1/2)=int(anz1/2)) then spmat[0,0]:=spmat[0,0] xor 1;
0407 end;
0408
0409 {.........................................................................ELEMENT P(I,J) }
0410
0411 procedure ElmPij (Var el:byte; mtxp:matrix; vek:vektor);
0412
0413 var
0414 i,zeile,spalte:integer;
0415
0416 begin
0417 zeile:=0; spalte:=0;
0418 for i:=1 to 4 do spalte:=spalte+vek[i]*Pot2(i-1);
0419 for i:=5 to 7 do zeile:=zeile+vek[i]*Pot2(i-5);
0420 el:=mtxp[zeile,spalte];
0421 end;
0422
0423 {............................................................................GAMMA }
0424
0425 procedure Gamma (Var Gamma:byte; mtxp:matrix; vek:vektor; zt:byte);
0426
0427 Var Pij:byte;
0428
0429 begin
0430 ElmPij(Pij,mtxp,vek);
0431 Gamma:=Pij xor vek[8];
0432 Gamma:=Gamma xor zt;
0433 end;
0434
0435
0436 {........................................................................ELEMENT ZT }
0437
0438 procedure Elmzt (Var zt:byte; vek:vektor);
0439
0440 Var i:integer;
0441
0442 begin
0443 zt:=0;
0444 for i:=1 to 8 do zt:=zt xor vek[i];
0445 end;
0446
0447 {..................................................................BYTE IN VEK(1..8) }
0448
0449 procedure Konv(var Feld:vektor; b:byte);
0450
0451 Var
0452 i,y:integer;
0453
0454 begin
0455 for i:=1 to 8 do
0456 begin
0457 y:=Pot2(8-i);
0458 if ((b-y)>=0) then begin
0459 b:=b-y;
0460 Feld[i]:=1;
0461 end
0462 else Feld[i]:=0;
0463 end;
0464 end;
0465
0466 {........................................................................IMPULS }
0467
0468 procedure Impuls(Var kombi:byte; Var flag:boolean);
0469
0470 Var i:integer;
0471
0472 begin
0473 for i:=1 to 26 do
0474 if ((kombi=byte(ITA2_Bu[i])) or (kombi=byte(ITA2_ZZ[i])))
0475 then kombi:=ITA2_hex[i];
0476 for i:=1 to 6 do
0477 if kombi=byte(steuerkomb_zei[i]) then kombi:=steuerkomb_hex[i];
0478 end;
0479
0480 {..............................................................ADDITIONSEINHEIT }
0481
0482 procedure Addeinheit(Var AR:byte);
0483
0484 Var i:integer;
0485
0486 begin
0487 addel:=0;
0488 for i:=1 to bitvar do
0489 begin
0490 regversatz;
0491 gamma(gam,mtxp,c,zt);
0492 addel:=addel shl 1;
0493 addel:=addel xor gam;
0494 elmzt(zt,c);
0495 end;
0496 ar:=addel and 31;
0497 end;
0498
0499 {..............................................................GRUPPENEINTEILUNG }
0500
0501 procedure gruppeneinteilung(Var Anz:integer);
0502
0503 const
0504 wr:byte=13;
0505 zv:byte=10;
0506 zw:byte=32;
0507
0508 begin
0509 inc(m);
0510 if m=5 then begin
0511 inc(anz);
0512 if anz=10 then begin
0513 write(char(wr),char(zv));
0514 write(zieldatei,wr,zv);
0515 anz:=0;
0516 end
0517 else begin
0518 write(char(zw));
0519 write(zieldatei,zw);
0520 end;
0521 m:=0;
0522 end;
0523 end;
0524
0525 {..................................................................ZEICHEN }
0526
0527 procedure zeichen(Var z:byte; Var flag:boolean);
0528
0529 Var i:integer;
0530
0531 begin
0532 for i:=1 to 26 do if z=ITA2_hex[i] then if flag then z:=ord(ITA2_bu[i])
0533 else z:=ord(ITA2_ZZ[i]);
0534 for i:=1 to 6 do if z=steuerkomb_hex[i] then z:=ord(steuerkomb_zei[i]);
0535 if z=ord('%') then flag:=true;
0536 if z=ord('#') then flag:=false;
0537 end;
0538
0539 {..................................................................KLARTEXT }
0540
0541 procedure Klartext;
0542
0543 Var
0544 ch,chn:char;
0545
0546 Const
0547 wr:byte=13;
0548 zv:byte=10;
0549
0550 begin {1}
0551 if filepos(quelldatei)<=poszei then
0552 begin {2}
0553 repeat
0554 read(quelldatei,ghel);
0555 until ((char(ghel) in bu) or ((filepos(quelldatei)>poszei)
0556 or eof(quelldatei)));
0557 if char(ghel) in bu then
0558 begin {3}
0559 ch:=char(ghel);
0560 ch:=upcase(ch);
0561 ghel:=ord(ch);
0562 if ghel=ord('Y') then
0563 begin {4}
0564 if ((filepos(quelldatei)<=poszei) or not eof(quelldatei)) then
0565 repeat
0566 read(quelldatei,ghelnf);
0567 until ((char(ghelnf) in bu) or ((filepos(quelldatei)>poszei)
0568 or eof(quelldatei)))
0569 else textende:=true;
0570 if not textende then
0571 begin {5}
0572 chn:=char(ghelnf);
0573 chn:=upcase(chn);
0574 ghelnf:=ord(chn);
0575 case ghelnf of
0576 83:ghel:=ord('Y');
0577 75:ghel:=ord('%');
0578 74:ghel:=ord('#');
0579 72:ghel:=ord(' ');
0580 79:ghel:=ord('<');
0581 76:ghel:=ord('*');
0582 84:ghel:=ord('|');
0583 end;
0584 leertakte:=true;
0585 end; {5}
0586 end {4}
0587 else leertakte:=false;
0588 impuls(ghel,buflag); { Für 1:1 Dechiff. sind folgende // -> Kommentar zu setzen }
0589 addeinheit(addel);
0590 klareinheit:=ghel xor addel;
0591 zeichen(klareinheit,buflag);
0592 case klareinheit of { // hier aufzu }
0593 {<} 60:klareinheit:=0; { // hier aufzu }
0594 {*} 42:begin write(chr(wr),chr(zv)); { // hier auf }
0595 write(zieldatei,wr,zv);
0596 end;
0597 else begin
0598 case klareinheit of
0599 35,37:klareinheit:=0;
0600 end;
0601 if klareinheit<>0 then begin { // hier zu }
0602 write(char(klareinheit));
0603 write(zieldatei,klareinheit);
0604 end; { // hier auf }
0605 end;
0606 end; {case} { // hier zu }
0607 end {3}
0608 else textende:=true;
0609 if leertakte then addeinheit(addel);
0610 end {2}
0611 else
0612 textende:=true;
0613 end; {1}
0614
0615 {.......................................................................GEHEIMTEXT }
0616
0617 procedure geheimtext;
0618
0619 Var ch:char;
0620
0621 begin
0622 read(quelldatei,klareinheit);
0623 ch:=char(klareinheit);
0624 ch:=upcase(ch);
0625 klareinheit:=ord(ch);
0626 impuls(klareinheit,buflag);
0627 Addeinheit(addel);
0628 ghel:=klareinheit xor addel;
0629 case ghel of
0630 21:ghelnf:=20; { YS - Y }
0631 02:ghelnf:=03; { YO - WR }
0632 08:ghelnf:=09; { YL - ZV }
0633 31:ghelnf:=30; { YK - EU }
0634 27:ghelnf:=26; { YJ - ZZ }
0635 04:ghelnf:=05; { YH - ZW }
0636 00:ghelnf:=01; { YT - 32 }
0637 end;
0638 case ghel of
0639 21,02,08,31,27,04,00:begin ghel:=21;
0640 leertakte:=true;
0641 end
0642 else leertakte:=false;
0643 end;
0644 buflag:=true;
0645 zeichen(ghel,buflag);
0646 write(char(ghel));
0647 write(zieldatei,ghel);
0648 gruppeneinteilung(gr);
0649 if leertakte then
0650 begin
0651 zeichen(ghelnf,buflag);
0652 write(char(ghelnf));
0653 write(zieldatei,ghelnf);
0654 gruppeneinteilung(gr);
0655 addeinheit(addel);
0656 end;
0657 end;
0658
0659 {....................................................................KOPIEREN }
0660
0661 procedure Kopybis(pos:longint);
0662
0663 Var el:byte;
0664 i:longint;
0665 ch:char;
0666
0667 begin
0668 seek(quelldatei,0);
0669 seek(zieldatei,0);
0670 for i:=0 to pos do
0671 begin
0672 read(quelldatei,el);
0673 ch:=char(el);
0674 ch:=upcase(ch);
0675 el:=byte(ch);
0676 write(zieldatei,el);
0677 write(char(el));
0678 end;
0679 end;
0680
0681 procedure Kopyab(pos:longint);
0682
0683 Var el:byte;
0684 code:integer;
0685
0686 begin
0687 seek(quelldatei,pos);
0688 {$I-}code:=ioresult;{$I+}
0689 if code <> 0 then
0690 repeat
0691 read(quelldatei,el);
0692 write(zieldatei,el);
0693 write(char(el));
0694 until eof(quelldatei);
0695 end;
0696
0697 {..........................................................VORLAUF }
0698
0699 procedure vorlauf;
0700
0701 Var t:integer;
0702
0703 begin
0704 t:=0;
0705 zt:=0;
0706 repeat
0707 inc(t);
0708 regversatz;
0709 elmzt(zt,c);
0710 until t=150;
0711 end;
0712
0713 {.......................................................DATEIEN CLOSE }
0714
0715 procedure Closeqzsdat;
0716
0717 begin
0718 close(quelldatei);
0719 close(zieldatei);
0720 close(sldatei);
0721 end;
0722
0723 {........................................................GEHEIMTEXTENDE }
0724
0725 procedure Endgt(Var Pos:longint);
0726
0727 Var
0728 lgr:longint;
0729 i:integer;
0730 ng:boolean;
0731 by:byte;
0732
0733 Const
0734 yps:byte=89;
0735 bu:set of byte=[65..90];
0736
0737 begin
0738 lgr:=0;i:=5;ng:=true;
0739 repeat
0740 read(quelldatei,by);
0741 inc(pos);
0742 if ((by in bu) and (i<=5)) then
0743 begin
0744 if ng then begin i:=0;
0745 ng:=false;
0746 end;
0747 i:=i+1;
0748 if i=5 then begin
0749 lgr:=pos;
0750 ng:=true;
0751 end;
0752 end;
0753 until ((eof(quelldatei)) or ((i>5) or ((i<>5) and not(by in bu))));
0754 if i=5 then
0755 begin
0756 if lgr>0 then begin
0757 repeat
0758 seek(quelldatei,lgr);
0759 read(quelldatei,by);
0760 dec(lgr);
0761 until by<>yps;
0762 inc(lgr);
0763 end;
0764 end;
0765 pos:=lgr;
0766 end;
0767
0768 {........................................................................DECHIFFRIERUNG }
0769
0770 procedure Dechiff;
0771
0772 Var
0773 p:longint;
0774
0775 begin
0776 with ifo_satz do
0777 begin
0778 assign(quelldatei,datei_gt);
0779 assign(zieldatei,datei_kt);
0780 assign(sldatei,datei_sl);
0781 {$I-} reset(quelldatei);
0782 codeq:=ioresult;
0783 rewrite(zieldatei);
0784 codez:=ioresult;
0785 reset(sldatei);
0786 codes:=ioresult; {$I+}
0787 end;
0788 if (codeq+codez+codes)=0 then
0789 begin
0790 LiesSchl;
0791 kopybis(poszei);
0792 poskenn:=poszei;
0793 endgt(poszei);
0794 seek(quelldatei,poskenn);
0795 Genmatx(mtxb, mtxd, ok, dk);
0796 initregsatz(regist,mtxb,mtxd);
0797 genmtxp(mtxp,sk,mtxb,mtxd);
0798 vorlauf;
0799 textende:=false;buflag:=true;
0800 wrzv:=false;
0801 while not textende do
0802 Klartext;
0803 Kopyab(poszei);
0804 end
0805 else
0806 begin
0807 openwindow(3,3,23,13);
0808 write('Dateifehler in ');
0809 if codeq>0 then writeln('Quelldatei');
0810 if codez>0 then writeln('Zieldatei');
0811 if codes>0 then writeln('Schlüsseldatei');
0812 write('...weiter mit Taste');
0813 taste:=readkey;
0814 closewindow;
0815 end;
0816 closeqzsdat;
0817 end;
0818
0819 {......................................................................CHIFFRIEREN }
0820
0821 procedure Chiff;
0822
0823 Var
0824 i:integer;
0825
0826 Const
0827 yps:byte=89;
0828
0829 begin
0830 with ifo_satz do
0831 begin
0832 assign(quelldatei,datei_kt);
0833 assign(zieldatei,datei_gt);
0834 assign(sldatei,datei_sl);
0835 {$I-} reset(quelldatei);
0836 codeq:=ioresult;
0837 rewrite(zieldatei);
0838 codez:=ioresult;
0839 reset(sldatei);
0840 codes:=ioresult; {$I+}
0841 end;
0842 if (codeq+codez+codes)=0 then
0843 begin
0844 LiesSchl;
0845 Kopybis(poszei);
0846 Genmatx(mtxb,mtxd,ok,dk);
0847 initregsatz(regist,mtxb,mtxd);
0848 genmtxp(mtxp,sk,mtxb,mtxd);
0849 vorlauf;
0850 m:=0;gr:=6;
0851 repeat
0852 geheimtext;
0853 until eof(quelldatei);
0854 if m>0 then
0855 for i:=m to 4 do
0856 begin
0857 write(char(yps));
0858 write(zieldatei,yps);
0859 end;
0860 end
0861 else
0862 begin
0863 openwindow(3,3,23,13);
0864 write('Dateifehler in ');
0865 if codeq>0 then writeln('Quelldatei');
0866 if codez>0 then writeln('Zieldatei');
0867 if codes>0 then writeln('Schlüsseldatei');
0868 write('....weiter mit Taste');
0869 taste:=readkey;
0870 closewindow;
0871 end;
0872 closeqzsdat;
0873 end;
0874
0875 {*****************************************************************************
0876 HAUPTPROGRAMM
0877 *****************************************************************************}
0878
0879 begin
0880 bitvar:=5;
0881 with Ifo_satz do
0882 begin
0883 case art of
0884 'C':chiff;
0885 'D':dechiff;
0886 end;
0887 end;
0888 end;
0889
0890 {..............................................................RAHMENPRGGRAMM }
0891
0892 begin
0893 betrart:=paramstr(1);
0894 taste:=betrart[1];
0895 taste:=upcase(taste);
0896 with ifo_satz do begin
0897 verf_bez:=paramstr(2);
0898 datei_kt:=paramstr(5);
0899 datei_gt:=paramstr(4);
0900 datei_sl:=paramstr(3);
0901 end;
0902 window(2,12,79,19);
0903 simvars(taste,Ifo_satz);
0904 window(1,1,80,25);
0905 end.
0001 { HORIZONT - Variante "S" - TC 850
0002 Programm zur Erzeugung der Matrizen MTXP1.MTXP2 aus den
0003 Spruchschlüsseln DK1, DK2 und Grundschlüssel OK sowie von
0004 Vektoren (d1,d2,…,d7,g),(0,d11,d12,…,d17) mit Klartext1,2
0005 verschieden von 0 bis Ts<=65520, identisch 0 ab Ts.
0006 Tmax nur durch Diskettengröße begrenzt }
0007
0008 program HZVerS01; { Variante "S" TC 850 mit Pointer }
0009
0010 uses crt,dos,printer;
0011
0012 type
0013 matrix=array[0..7,0..15] of byte;
0014 slmat=array[1..16,1..8] of byte;
0015 vektor=array[1..8] of byte;
0016 allreg=array[1..31] of byte;
0017 RegSatz=array[1..8] of allreg;
0018 Rcnum=array[1..18] of byte; { 18=max Anzahl Rückkopplungen }
0019 RcSatz=array[1..8] of Rcnum;
0020 SlMatrix=array[1..16,1..8] of byte;
0021 string16=string[16];
0022 string10=string[10];
0023 string13=string[13];
0024 string128=string[128];
0025 zeile60=string[60];
0026 menge=set of char;
0027 Bytefeld=array[1..65520] of byte;
0028 Bytefile=file of byte;
0029 Pointer_of_Bytefeld=^Bytefeld;
0030 ITA_Reg=array[1..26] of byte;
0031 ITA_Zei=array[1..26] of char;
0032
0033 var
0034 OK:zeile60; { Grundschlüssel }
0035 DK1:zeile60; { Spruchschlüssel1 }
0036 DK2:zeile60; { Spruchschlüssel2 }
0037 SK:matrix; { Strukturschlüssel }
0038 MTXB:slmat; { OK-Matrix }
0039 MTXD1:slmat; { DK1-Matrix }
0040 MTXD2:slmat; { DK2-Matrix }
0041 MtxP1,MtxP2:matrix; { Matrizen P1,P2}
0042 X,D1,D2,C1,C2:vektor; { Registerausgänge x,d1,d2,x+d1,x+d2 }
0043 Gamma1,Gamma2:byte; { Additionseinheiten für DKI,DK2 }
0044 K1,K2:byte; { Elemente Klartexte 1,2 }
0045 G1,G2:byte; { Elemente der Geheimtexte G1,G2 }
0046 gt:byte; { gt aus Gleichung 4 }
0047 resbyte:byte; { Byte, das Vektor (d1,d2,…d7,gt) binär darstellt }
0048 resbyted1:byte; { Byte, das Vektor (0,d11,d12,..,d17) binär darstellt }
0049 i,j,m:integer; { Zähler }
0050 Tmax,Ts,t:longint; { Zähler}
0051 RX:RegSatz; { Registersätze }
0052 RD1:RegSatz;
0053 RD2:RegSatz;
0054 zt1,zt2,zst1,zst2:byte; { zt:=Summe(Ci(t-1)) }
0055 Ende,EinOk,AusOk:boolean; { Prüfvariable bevor Program startet }
0056 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0057 P1Name:zeile60; { Name des Files AusgP1 }
0058 P2Name:zeile60; { Name des Files AusgP2 }
0059 ResName:zeile60; { Name des Files AusgFile }
0060 Nameskdat:zeile60; { Name des Files Skdat }
0061 SKDat:File of byte; { File der Strukturmatrix }
0062 AusgP1:File of byte; { File der Matrix P1 }
0063 AusgP2:File of byte; { File der Matrix P2 }
0064 AusgFile:File of byte; { File der erzeugten Daten }
0065 Kt1file:file of byte; { File der Klartextdatei 1 vom Typ txt }
0066 Kt2file:file of byte; { --.-- 2 --.-- }
0067 Kt1name:zeile60; { Name Klartextdatei1 }
0068 Kt2name:zeile60; { Name Klartextdatei2 }
0069 Kt1,Kt2:Pointer_of_Bytefeld;
0070 Taste:char;
0071 vek128:string128;
0072 Rueck,Alt:zeile60;
0073 BitVar:integer; { 5- oder 7-bit-Variante }
0074 Feld5Gt1,Feld5Gt2:array[1..5] of byte; { für Subst V-Bigramm }
0075 ByteGt1,ByteGt2:byte; { aus Feld5Gtx gebildetes Byte }
0076 st_in_gt1,st_in_gt2:boolean; { Merker für Steuerkombination }
0077 index1,index2:integer;
0078
0079 const
0080 RC:RcSatz=((3,5, 8,10,11,14,16,21,24,26,29,31, 0, 0, 0, 0, 0, 0), { Register 1 }
0081 (2,7,12,15,17,19,21,22,26,27,28,29, 0, 0, 0, 0, 0, 0), { Register 2 }
0082 (2,3, 4, 6, 7, 8,10,11,14,17,19,21,24,26,27,28, 0, 0), { Register 3 }
0083 (1,2, 4, 8, 9,10,11,14,15,16,18,22,25,27, 0, 0, 0, 0), { Register 4 }
0084 (5,8,12,13,17,18,19,20,22,23,24,25, 0, 0, 0, 0, 0, 0), { Register 5 }
0085 (1,5, 6, 7, 8, 9,10,11,12,13,14,23, 0, 0, 0, 0, 0, 0), { Register 6 }
0086 (2,3, 4, 5, 7, 9,10,17,18,19, 0, 0, 0, 0, 0, 0, 0, 0), { Register 7 }
0087 (2,3, 4, 5, 6, 7, 8,15,17,19,20,22,23,26,28,29,30,31)); { Register 8 }
0088 Skok:boolean=false;
0089 Okok:boolean=false;
0090 Dk1ok:boolean=false;
0091 Dk2ok:boolean=false;
0092 Tok:boolean=false;
0093 Tsok:boolean=false;
0094 Dateibez:menge=['A'..'Z','a'..'z','0'..'9', '.', '_', ' ', ':'];
0095 Bu:menge=['A'..'Z','a'..'z'];
0096 ITA2_Hex:ITA_Reg=($18,$13,$0E,$12,$10,$16,$0b,$05,$0C,$1a,$1e,$09,$07,$06,
0097 $03,$0D,$1D,$0A,$14,$01,$1C,$0F,$19,$17,$15,$11);
0098 ITA2_Bu:ITA_Zei=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
0099 'P','Q','R','S','T','U','V','W','X','Y','Z');
0100 ITA2_ZZ:ITA_Zei=('-','?',':','@','3','@','@','@','8','@','(',')','.',',','9',
0101 '0','1','4','"','5','7','=','2','/','6','+');
0102 Steuerkomb_hex:array[1..6] of byte=($00,$02,$04,$08,$1B,$1F);
0103 Steuerkomb_zei:array[1..6] of char=('|', '<', ' ', '*', '#', '%');
0104
0105 {-------------------------------------------------------- Prozedur aus Tools }
0106
0107 procedure einzeil(Var st:zeile60;tex:zeile60;m:menge;l,ze,sp:integer);
0108 const s:set of byte=[8,75,77];
0109 var i:integer;
0110 ta:string[2];
0111 c:char;
0112
0113 procedure cure; begin
0114 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0115 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58);
0116 end;
0117
0118 procedure culi;
0119 begin
0120 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0121 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58);
0122 end;
0123
0124 begin
0125 st:='';
0126 for i:=1 to l do st:=st+' ';
0127 for i:=1 to length(tex) do st[i]:=tex[i];
0128 i:=1;gotoxy(ze,sp);write(tex);
0129 repeat
0130 gotoxy(ze+i-1,sp);
0131 c:=readkey;
0132 case c in m of
0133 true: ta:=c;
0134 false: case ord(c) in s of
0135 true: ta:=chr(27)+c;
0136 false: case ord(c) of
0137 0:begin c:=readkey;
0138 if ord(c) in s then ta:=chr(27)+c
0139 else ta:='' end
0140 else ta:=''
0141 end;
0142 end;
0143 end;
0144 if ta<>''then
0145 begin
0146 if ta[1]<>chr(27) then begin write(c);st[i]:=c;
0147 if i<l then i:=i+1 else culi
0148 end else
0149 case ord(ta[2]) of
0150 8: if i>1 then begin st[i]:=' '; i:=i-1; st[i]:=' ';
0151 culi;write(' ');culi;culi
0152 end;
0153 75: if i>1 then begin i:=i-1;culi end;
0154 77: if i<l then begin i:=i+1;cure end;
0155 end;
0156 end;
0157 until c=chr(13);
0158 i:=l+1;
0159 repeat
0160 i:=i-1
0161 until (i=0) or (st[i]<>' ');
0162 if i<>0 then st:=copy(st,1,i)
0163 else st:='';
0164 end;
0165 {--------------------------------------------------------------------
0166 Registerverschiebung für beliebige Register mit Rückkopplung rück und
0167 dem Ausgang cbit }
0168
0169 procedure regv(var reg:allreg;var cbit:byte;rueck:rcnum);
0170
0171 var
0172 i:integer;
0173 reglaenge:byte;
0174
0175 begin
0176 cbit:=0;
0177 for i:=1 to 18 do
0178 if rueck[i]<>0 then begin
0179 cbit:=cbit xor reg[rueck[i]];
0180 reglaenge:=rueck[i];
0181 end;
0182 for i:=reglaenge downto 2 do reg[i]:=reg[i-1];
0183 reg[1]:=cbit;
0184 end;
0185
0186 {------------------------- Registerverschiebung eines Registersatzes }
0187
0188 procedure RegVerSatz(var register:regsatz;rkopp:rcsatz;var abit:vektor);
0189
0190 var
0191 i:integer;
0192 begin
0193 for i:=1 to 8 do
0194 Regv(register[i],abit[i],rkopp[i]);
0195 end;
0196
0197
0198 {-------------------------- Registerverschiebung der drei Registersätze RX,RD1,RD2 }
0199
0200 procedure AllRegVer;
0201
0202 begin
0203 RegVerSatz(RX,RC,X);
0204 RegVerSatz(RD1,RC,D1);
0205 RegVerSatz(RD2,RC,D2);
0206 end;
0207
0208 {-------------------------- Funktion 2 Koch x }
0209
0210 Function Pot2(x:integer):integer;
0211
0212 Var
0213 i:integer;
0214 Erg:integer;
0215
0216 begin
0217 if x=0 then pot2:=1
0218 else
0219 begin
0220 Erg:=1;
0221 for i:=1 to x do Erg:=Erg*2;
0222 Pot2:=Erg;
0223 end;
0224 end;
0225
0226 {------------------ Erzeugung eines Zeilenvektors aus einem Schlüsselbuchstaben }
0227
0228 procedure Mzeile(var Zeile:vektor;Bu:char);
0229
0230 Var
0231 i:integer;
0232 By:real;
0233 hiz:vektor;
0234
0235 begin
0236 by:=ita2_hex[ord(bu)-64];
0237 for i:=8 downto 1 do
0238 begin
0239 if (by/Pot2(i-1)<1) then zeile[9-i]:=0
0240 else begin
0241 zeile[9-i]:=1;
0242 by:=by-Pot2(i-1);
0243 end;
0244 end;
0245 for i:=1 to 5 do
0246 hiz[i]:=zeile[i+3];
0247 for i:=6 to 8 do
0248 hiz[i]:=0;
0249 for i:=1 to 8 do
0250 zeile[i]:=zeile[i] xor hiz[i] and 1;
0251 end;
0252
0253 {----------------------- Erzeugung der Matrix B aus dem Grundschlüssel }
0254
0255 procedure MatrixB (Var mat:slmat;Grsl:string10);
0256
0257 Var
0258 i,j:integer;
0259 bu:char;
0260 zeile:vektor;
0261
0262 begin
0263 for i:=1 to 10 do
0264 begin
0265 bu:=grsl[i];
0266 mzeile(zeile,bu);
0267 for j:=1 to 8 do mat[i,j]:=zeile[j];
0268 end;
0269 for i:=2 to 7 do
0270 begin
0271 bu:=grsl[i];
0272 mzeile(zeile,bu);
0273 for j:= 1 to 8 do mat[9+i,j]:=zeile[j];
0274 end;
0275 end;
0276
0277 {------------------------ Erzeugung der Matrix D1,D2 aus den Spruchschlüssel }
0278
0279 procedure MatrixD (Var mat:slmat;Spsl:string10);
0280
0281 Var
0282 i,j:integer;
0283 bu:char;
0284 zeile:vektor;
0285
0286 begin
0287 for i:=1 to 10 do
0288 begin
0289 bu:=spsl[i];
0290 mzeile(zeile,bu);
0291 for j:=1 to 8 do mat[i,j]:=zeile[j];
0292 end;
0293 for i:=11 to 16 do
0294 begin
0295 bu:=spsl[i-10];
0296 mzeile(zeile,bu);
0297 for j:=1 to 8 do mat[i,j]:=zeile[j];
0298 end;
0299 end;
0300
0301 {--------------------- Erzeugung der drei Matrizen MTXB,MTXD1,MTXD2 }
0302
0303 procedure GenMatx (var MTXB,MTXD1,MTXD2:slmat;OK:string10;DK1,DK2:string10);
0304
0305 begin
0306 MatrixB(mtxb,ok);
0307 MatrixD(mtxd1,dk1);
0308 MatrixD(mtxd2,dk2);
0309 end;
0310
0311 {--------------------------------- Initialisieren des Registersatzes X }
0312
0313 procedure InitRegSatzX (Var rset:regsatz;mtx:slmat);
0314
0315 var
0316 i,j:integer;
0317
0318 begin
0319 for i:=1 to 8 do
0320 begin
0321 rset[i,1]:=0;
0322 for j:=1 to 16 do rset[i,j+1]:=mtx[j,9-i];
0323 for j:=1 to 14 do rset[i,j+17]:=mtx[j,9-i];
0324 end;
0325 end;
0326
0327 {----------------------------------------- Initialisierung Registersatz D }
0328
0329 procedure InitRegSatzD (Var rset:regsatz;mtx:slmat);
0330
0331 Var
0332 i,j:integer;
0333
0334 begin
0335 for i:=1 to 8 do
0336 begin
0337 rset[i,1]:=1;
0338 for j:=1 to 10 do rset[i,j+1]:=mtx[j,9-i];
0339 for j:=1 to 10 do rset[i,j+11]:=mtx[j,9-i];
0340 for j:=1 to 10 do rset[i,j+21]:=mtx[j,9-i];
0341 end;
0342 end;
0343
0344 {--------------------------------- Initialisieren aller drei Registersätze }
0345
0346 procedure GenReg;
0347
0348 Var
0349 i:integer;
0350
0351 begin
0352 InitRegSatzX(RX,MTXB);
0353 InitRegSatzD(RD1,MTXD1);
0354 InitRegSatzD(RD2,MTXD2);
0355 end;
0356
0357 {----------------------------------------------- Generieren einer Matrix P }
0358
0359 procedure GenMtxP (Var SPMat:matrix;SKMat:matrix;OKMat,DkMat:slmat);
0360
0361 Var
0362 i,j,Anz1:integer;
0363 Ptest:boolean;
0364
0365 begin
0366 repeat
0367 Anz1:=0;
0368 for i:=0 to 7 do
0369 for j:=0 to 15 do
0370 begin
0371 SPMat[i,j]:=((ord(SkMat[i,j])-48) xor DKMat[j+1,8-i] xor OKMat[j+1,8-i]) and 1;
0372 Anz1:=Anz1+SPMat[i,j];
0373 end;
0374 if ((Anz1<33) or (Anz1>95)) then ptest:=false
0375 else ptest:=true; { keine Änderung notwendig }
0376 if ptest=false then for i:=0 to 7 do
0377 for j:=0 to 14 do Skmat[i,j]:=Skmat[i,j+1];
0378 until ptest=true;
0379 if (Anz1/2)=int(anz1/2) then spmat[0,0]:=spmat[0,0] xor 1;
0380 end;
0381
0382 {--------------------------------------------------- Erzeugung x+d1,x+d2 }
0383
0384 procedure Addxd;
0385
0386 Var i:integer;
0387
0388 begin
0389 for i:=1 to 8 do
0390 begin
0391 c1[i]:=x[i] xor d1[i];
0392 c2[i]:=x[i] xor d2[i];
0393 end;
0394 end;
0395
0396 {---------------------------------- Auswahl eines Matrixelementes bezüglich eines Vektors (y1..y8) }
0397
0398 procedure ElmPij (Var el:byte; mtxp:matrix; vek:vektor);
0399
0400 var
0401 i,zeile,spalte:integer;
0402
0403 begin
0404 zeile:=0;spalte:=0;
0405 for i:=1 to 4 do spalte:=spalte+vek[i]*Pot2(i-1);
0406 for i:=5 to 7 do zeile:=zeile+vek[i]*Pot2(i-5);
0407 el:=mtxp[zeile,spalte]; { write(lst,zeile,' ',spalte:2,' ',e1,' '); }
0408 end;
0409
0410 {----------------------------------------------- Erzeugung eines Gamma pro Takt }
0411
0412 procedure Gamma (Var Gamma:byte; mtxp:matrix; vek:vektor; zt:byte);
0413
0414 Var Pij:byte;
0415
0416 begin
0417 ElmPij(Pij,mtxp,vek);
0418 Gamma:=Pij xor vek[8];
0419 Gamma:=Gamma xor zt;
0420 end;
0421
0422 {--------------------------------------------------- Erzeugung zt:=Summe(ci(t-1)) }
0423
0424 procedure Elmzt (Var zt:byte;vek:vektor);
0425
0426 Var i:integer;
0427
0428 begin
0429 zt:=0;
0430 for i:=1 to 8 do zt:=zt xor vek[i];
0431 end;
0432
0433 {--------------------------------------------- Konvertierung eines hex-Byte in 8 0,1-Byte }
0434
0435 procedure Konv(var Feld:vektor;b:byte);
0436
0437 Var
0438 i,y:integer;
0439
0440 begin
0441 for i:=1 to 8 do
0442 begin
0443 y:=Pot2(8-i);
0444 if ((b-y)>=0) then begin
0445 b:=b-y;
0446 Feld[i]:=1;
0447 end
0448 else Feld[i]:=0;
0449 end;
0450 end;
0451
0452 {---------------------------------------- Substitution Bu,ZZ -- ITA-Kombination als hex-Byte }
0453
0454 procedure Impuls(Var kombi:byte;Var flag:boolean);
0455
0456 Var i:integer;
0457
0458 begin
0459 for i:=1 to 26 do
0460 if ((kombi=byte(ITA2_Bu[i])) or (kombi=byte(ITA2_ZZ[i]))) then kombi:=ITA2_hex[i];
0461 for i:=1 to 6 do
0462 if kombi=byte(steuerkomb_zei[i]) then kombi:=steuerkomb_hex[i];
0463 if kombi=$1F then flag:=true;
0464 if kombi=$1B then flag:=false;
0465 end;
0466
0467 {--------------------------- Umwandlung von 2 Klartextfiles in 2 Bytefelder der Länge Ts<=65520 }
0468
0469 procedure GenK1K2;
0470
0471 Var
0472 Bt:byte;
0473 Btfeld:vektor;
0474 i:longint;
0475 j:integer;
0476 Flag1,Flag2:boolean; { true=Buchstaben }
0477
0478 begin
0479 i:=0;
0480 Flag1:=true;Flag2:=true;
0481 repeat
0482 read(Kt1file,Bt);
0483 impuls(bt,flag1);
0484 Konv(Btfeld,Bt);
0485 for j:=1 to Bitvar do Kt1^[i+j]:=Btfeld[8-BitVar+j];
0486 read(Kt2file,Bt);
0487 impuls(bt,flag2);
0488 Konv(Btfeld,Bt);
0489 for j:=1 to BitVar do Kt2^[i+j]:=Btfeld[8-BitVar+j];
0490 i:=i+BitVar;
0491 until ((i>=Ts) or (i+Bitvar>65520) or eof(kt1file) or eof(kt2file));
0492 close(kt1file);close(kt2file);
0493 end;
0494
0495
0496 {--------------------------------------- Fehlerausschrift für Dateifehler }
0497
0498 procedure Dateifehler(Name:string10;x,y:integer);
0499
0500 begin
0501 gotoxy(x,y);
0502 write('Datei "',name,'" existiert nicht! ');
0503 delay(5000);
0504 end;
0505
0506 {------------------------------------------ Erzeugung gt (Gleichung 4) }
0507
0508 procedure TxtAdd (Var gt:byte;gam1,gam2,k1,k2:byte;vek1,vek2:vektor; zt1,zt2:byte);
0509
0510 Var i:integer;
0511
0512 begin
0513 gt:=gam1 xor k1 xor gam2 xor k2 xor zt1 xor zt2 xor vek1[8] xor vek2[8];
0514 gt:=gt and 1;
0515 end;
0516
0517 {--------------------------------- Erzeugung des Ergebnisbytes RESBYT=(d7,…,d1,gt) }
0518
0519 procedure Result (Var Resbyt:byte;D1,D2:vektor;gt:byte);
0520
0521 Var
0522 i:integer;
0523 hv:vektor;
0524
0525 begin
0526 resbyt:=0;
0527 for i:=1 to 7 do hv[i]:=D1[8-i] xor D2[8-i];
0528 hv[8]:=gt;
0529 for i:=8 downto 1 do Resbyt:=Resbyt+hv[i]*Pot2(8-i);
0530 end;
0531
0532 {------------------------ Erzeugung des Ergebnisbytes RESBYTED1=(0,d11,d12,…,d17) }
0533
0534 procedure ResD1(Var Byte:byte);
0535
0536 Var
0537 i:integer;
0538 hv:vektor;
0539
0540 begin
0541 byte:=0;
0542 hv[1]:=0;
0543 for i:=1 to 7 do hv[i+1]:=D1[8-i];
0544 for i:=8 downto 1 do byte:=byte+hv[i]*Pot2(8-i);
0545 end;
0546
0547 {------------------------------------------- Einlesen Strukturschlüsselmatrix }
0548
0549 procedure SKein (var Mtx:matrix);
0550
0551 Var
0552 i,j:integer;
0553 Filein:file of byte;
0554 Filename:string[13];
0555
0556 begin
0557 gotoxy(20,15);
0558 writeln('Filename SK-Datei:');
0559 read(filename);
0560 assign(filein,filename);
0561 reset(filein);
0562 for i:=0 to 7 do
0563 for j:=0 to 15 do
0564 read(filein,mtx[i,j]);
0565 close(filein);
0566 end;
0567
0568 {----------------------------------- Ausgabe einer Matrix P auf File }
0569 procedure Mtxausg(Mtx:matrix; Filename:string10);
0570
0571 Var
0572 i,j:integer;
0573 Fileaus:file of byte;
0574
0575 begin
0576 assign(fileaus,filename);
0577 rewrite(fileaus);
0578 for i:=0 to 7 do
0579 for j:=0 to 15 do
0580 write(fileaus,mtx[i,j]);
0581 close(fileaus);
0582 end;
0583
0584 {---------------------------------------- Hauptmenü }
0585
0586 procedure Menue;
0587
0588 begin
0589 clrscr;
0590 writeln('*********************************************************************************');
0591 gotoxy(7,3);
0592 writeln('HORIZONT - statistische Methode: Erzeugung der Testdaten');
0593 gotoxy(18,4);
0594 writeln('Programm "HzVerS01"-Var "S" TC 850, KT="0" ab 0<=Ts<=65520');
0595 gotoxy(1,6);
0596 writeln('*********************************************************************************');
0597 gotoxy(20,8);
0598 writeln('F1: Eingaben');
0599 gotoxy(20,9);
0600 writeln('F2: Ausgaben');
0601 gotoxy(20,10);
0602 writeln('F3: Programmstart');
0603 gotoxy(20,11);
0604 write('F10: Programmende');
0605 end;
0606
0607 {------------------------------------------------------------------- Übertragung SK }
0608
0609 procedure EingSK(var SK:matrix);
0610
0611 var
0612 i,j:integer;
0613
0614 begin
0615 for i:=0 to 7 do
0616 for j:=0 to 15 do
0617 sk[i,j]:=ord(vek128[i*16+j+1]);
0618 end;
0619
0620 {----------------------------------------------------- Umwandlung Klein- in Großbuchstaben }
0621
0622 procedure grossbu(var Kette:zeile60);
0623
0624 Var
0625 i:integer;
0626
0627 begin
0628 for i:=1 to length(Kette) do
0629 Kette[i]:=upcase(Kette[i]);
0630 end;
0631
0632 {------------------------------------------------------ Eingaben SK,OK,DKI,DK2,T }
0633
0634 procedure Eingaben;
0635
0636 Var
0637 Taste:char;
0638 x,y,i,j,code:integer;
0639 M01:menge;
0640 Mziff:menge;
0641 vekzeil:zeile60;
0642 ch:char;
0643
0644 const
0645 bvz:menge=['5','7'];
0646
0647 begin
0648 M01:=['0','1'];Mziff:=['0'..'9'];
0649 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0650 check:=false;
0651 window(5,7,60,25);
0652 textbackground(lightgray);
0653 textcolor(black);
0654 clrscr;
0655 write('Eingaben: ');
0656 gotoxy(1,wherey+2);x:=wherex;y:=wherey;
0657 repeat
0658 gotoxy(x,y);
0659 write('Gründschlüssel: ');
0660 einzeil(Ok,Ok,Bu,10,wherex,wherey);
0661 until length(Ok)=10;
0662 Grossbu(Ok);
0663 Okok:=true;
0664 gotoxy(1,wherey+1);x:=wherex;y:=wherey;
0665 repeat
0666 gotoxy(x,y);
0667 write('Spruchschlüssel 1: ');
0668 einzeil(Dk1,Dk1,Bu,10,wherex,wherey);Dk1ok:=true;
0669 until length(Dk1)=10;
0670 Grossbu(Dk1);
0671 gotoxy(1,wherey+1);x:=wherex;y:=wherey;
0672 repeat
0673 gotoxy(x,y);
0674 write('Spruchschlüssel 2: ');
0675 einzeil(Dk2,Dk2,Bu,10,wherex,wherey);Dk2ok:=true;
0676 until length(Dk2)=10;
0677 Grossbu(Dk2);
0678 gotoxy(1,wherey+1);
0679 write('Strukturschlüssel: ');
0680 write('Dateiname: ');
0681 einzeil(Nameskdat,Nameskdat,Dateibez,16,wherex,wherey);
0682 {$I-} assign(Skdat,Nameskdat);
0683 reset(Skdat); {$I+}
0684 code:=ioresult;skok:=false;
0685 if code=0 then begin
0686 for i:=0 to 7 do
0687 for j:=0 to 15 do
0688 read(skdat,Sk[i,j]);
0689 close(SKDat);
0690 Skok:=true;
0691 end;
0692 gotoxy(20,wherey+1);
0693 write('Strukturmatrix: ');
0694 window(40,13,55,20);
0695 textcolor(lightgray);
0696 textbackground(black);
0697 clrscr;
0698 window(1,1,80,25);
0699 vek128:='';
0700 for i:=0 to 7 do
0701 for j:=0 to 15 do
0702 if skok then vek128:=vek128+chr(sk[i,j])
0703 else vek128:=vek128+' ';
0704 gotoxy(40,13);x:=wherex;y:=wherey-1;
0705 for i:=1 to 8 do
0706 begin
0707 y:=y+1;
0708 vekzeil:=copy(vek128,((i-1)*16)+1,16);
0709 einzeil(vekzeil,vekzeil,M01,16,x,y);
0710 delete(vek128,((i-1)*16)+1,16);
0711 insert(vekzeil,vek128,((i-1)*16)+1);
0712 end;
0713 EingSk(Sk);
0714 Skok:=true;
0715 assign(Skdat,Nameskdat);
0716 rewrite(Skdat);
0717 for i:=0 to 7 do
0718 for j:=0 to 15 do
0719 write(Skdat,sk[i,j]);
0720 close(skdat);
0721 textcolor(black);textbackground(lightgray);
0722 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0723 gotoxy(5,wherey+1);
0724 write('Anzahl Tmax : ');
0725 x:=wherex;y:=wherey;
0726 repeat
0727 str(Tmax,vekzeil);
0728 einzeil(vekzeil,vekzeil,Mziff,6,x,y);
0729 val(vekzeil,Tmax,code);
0730 if Tmax>0 then Tok:=true;
0731 until Tok;
0732 gotoxy(5,wherey+1);
0733 write('Anzahl Ts : ');x:=wherex;y:=wherey;
0734 repeat str(Ts,vekzeil);
0735 einzeil(vekzeil,vekzeil,Mziff,6,x,y);
0736 val(vekzeil,Ts,code);
0737 Tsok:=true;
0738 until Tsok;
0739 gotoxy(5,wherey+1);x:=wherex;y:=wherey;
0740 if ts<>0 then begin
0741 repeat
0742 begin
0743 gotoxy(x,y);
0744 write('Dateiname der Klartextdatei1: ');
0745 einzeil(Kt1name,Kt1name,Dateibez,16,wherex,wherey);
0746 {$I-} assign(Kt1file,Kt1name);
0747 reset(Kt1file); {$I+}
0748 code:=ioresult;
0749 if code<>0 then begin Dateifehler(Kt1name,x,y);Kt1name:=' ';end;
0750 end;
0751 until code=0;
0752 gotoxy(5,wherey+1);x:=wherex;y:=wherey;
0753 repeat
0754 begin
0755 gotoxy(x,y);
0756 write('Dateiname der Klartextdatei2: ');
0757 einzeil(Kt2name,Kt2name,Dateibez,16,wherex,wherey);
0758 {$I-} assign(Kt2file,Kt2name);
0759 reset(Kt2file); {I+}
0760 code:=ioresult;
0761 if code<>0 then begin Dateifehler(Kt2name,x,y);Kt2name:=' ';end;
0762 end;
0763 until code=0;
0764 end; { von ts<>0 }
0765 Bitvar:=5;
0766 window(1,1,80,25);
0767 textcolor(lightgray);textbackground(black);
0768 if (skok and okok and dk1ok and dk2ok and tok and tsok) then einok:=true;
0769 end;
0770
0771 {------------------------------------------------------ Name des Ausgabefiles }
0772
0773 procedure AusgNamen(Var P1name:zeile60;
0774 Var P2name:zeile60;
0775 Var Resname:zeile60);
0776
0777 begin
0778 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0779 check:=true;
0780 window(20,7,75,12);
0781 textbackground(lightgray);
0782 textcolor(black);
0783 clrscr;
0784 gotoxy(1,wherey+1);
0785 write('Dateiname für Matrix P1: ');
0786 einzeil(P1Name,P1Name,Dateibez,16,wherex,wherey);
0787 gotoxy(1,wherey+1);
0788 write('Dateiname für Matrix P2: ');
0789 einzeil(P2Name,P2Name,Dateibez,16,wherex,wherey);
0790 gotoxy(1,wherey+1);
0791 write('Dateiname für Daten: ');
0792 einzeil(ResName,ResName,Dateibez,16,wherex,wherey);
0793 window(1,1,80,25);
0794 textbackground(black);
0795 textcolor(lightgray);
0796 clrscr;
0797 Ausok:=true;
0798 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0799 end;
0800
0801 {------------------------------------------------------------ Protokollkopf }
0802
0803 procedure protokoll;
0804
0805 var
0806 i,j:integer;
0807 jahr,monat,tag,stunde,min,dayofw,sec,sec100:word;
0808 stelle:integer;
0809 no:string[2];
0810 lmonat,lmin:string[1];
0811
0812 const
0813 doppelpkt:char=':';
0814
0815 begin
0816 writeln(lst);
0817 writeln(lst,'*************************************************************');
0818 writeln(lst);
0819 writeln(lst,'HORIZONT - Variante "S", Vers. 1.0');
0820 Writeln(lst);
0821 getdate(jahr,monat,tag,dayofw);gettime(stunde,min,sec,sec100);
0822 if monat<10 then lmonat:='0' else lmonat:='';
0823 if min<10 then lmin:='0' else lmin:='';
0824 writeln(lst,' Datum: ',tag,'.',lmonat,monat,'.',jahr);
0825 writeln(lst,' Zeit : ',stunde,'.',lmin,min,' Uhr');
0826 writeln(lst);
0827 writeln(lst,'================================= PROTOKOLL =====================================');
0828 writeln(lst);
0829 writeln(lst,' Grundschlüssel :',ok);
0830 writeln(lst,' Spruchschlüssel 1:',Dk1);
0831 writeln(lst,' Spruchschlüssel 2:',Dk2);
0832 writeln(lst,' Strukturschlüsseldatei : ',nameskdat);
0833 write(lst,' Strukturschlüssel : ');
0834 for i:=0 to 7 do begin
0835 for j:=0 to 15 do write(lst,chr(sk[i,j]));
0836 writeln(lst);write(lst,' ');
0837 end;
0838 writeln(lst);
0839 writeln(lst,' Tmax: ',tmax);
0840 writeln(lst,' Ts: ',ts);
0841 if ts<>0 then begin
0842 writeln(lst,' Datei Klartext 1: ',kt1name);
0843 writeln(lst,' Datei Klartext 2: ',kt2name);
0844 end
0845 else writeln(lst,' ### Klartexte identisch "0" ###');
0846 writeln(lst,' Ausgabedatei: ',resname);
0847 writeln(lst,' Matrixdatei P1: ',p1name);
0848 writeln(lst,' Matrixdatei P2: ',p2name);
0849 writeln(lst);writeln(lst);
0850 end;
0851
0852 {------------------------------------------------------ Arbeitsprogramm }
0853
0854 procedure ProgStart;
0855
0856 Var
0857 i,j:integer;
0858 kein_leerlauf:boolean;
0859
0860 begin
0861 if Einok and Ausok then
0862 begin
0863 if ts<>0 then GenK1K2;
0864 t:=0;
0865 assign(AusgFile,ResName);
0866 rewrite(AusgFile);
0867 window(20,12,60,17);
0868 textbackground(lightgray);
0869 textcolor(black);
0870 clrscr;
0871 gotoxy(10,2);
0872 write('Programm läuft !!!');
0873 GenMatx(MtxB,MtxD1,MtxD2,Ok,Dk1,Dk2);
0874 GenReg;
0875 GenMtxp(MtxP1,Sk,MtxB,MtxD1);
0876 GenMtxp(MtxP2,Sk,MtxB,MtxD2);
0877 gotoxy(15,5);write('t= ',t);
0878 zt1:=0;zt2:=0;zst1:=0;zst2:=0;
0879 kein_leerlauf:=true;
0880 repeat { Vorlauf }
0881 begin
0882 t:=t+1;
0883 AllRegVer;
0884 Addxd;
0885 Elmzt(Zt1,D1);
0886 Elmzt(Zt2,D2);
0887 Elmzt(Zst1,C1);
0888 Elmzt(Zst2,C2);
0889 end;
0890 until t=150;
0891 protokoll;
0892 t:=0;m:=0;index1:=0;index2:=0;
0893 st_in_gt1:=false;st_in_gt2:=false;
0894 { writeln(lst,'P1(i,j) P2(i,j) cl(8) z1 ga1 k1 g1 c2(8) z2 ga2 k2 g2 d1(8) d2(8) zd1 zd2 G');
0895 writeln(lst,'---------------------------------------------------------------------------------');
0896 writeln(lst); }
0897 repeat
0898 begin
0899 t:=t+1;m:=m+1;if m=6 then begin m:=1; {writeln(lst)};end;
0900 index1:=index1+1;index2:=index2+1;
0901 gotoxy(15,5);write('t= ',t);
0902 if t>=Ts then begin K1:=0;K2:=0 end
0903 else begin
0904 if st_in_gt1 then begin
0905 index1:=index1-1;
0906 k1:=0;
0907 end
0908 else k1:=kt1^[index1];
0909 if st_in_gt2 then begin
0910 index2:=index2-1;
0911 k2:=0;
0912 end
0913 else k2:=kt2^[index2];
0914 end;
0915 AllRegVer;
0916 Addxd;
0917 Gamma(G1,MtxP1,C1,zst1);
0918 Gamma(G2,MtxP2,C2,zst2);
0919 feld5gt1[m]:=(k1 xor g1) and 1; feld5gt2[m]:=(k2 xor g2) and 1;
0920 if st_in_gt1 then g1:=0;
0921 if st_in_gt2 then g2:=0;
0922 TxtAdd(GT,G1,G2,K1,K2,D1,D2,Zt1,Zt2);
0923 { writel(lst,c1[8],' ',zst1,' ',g1,' ',k1,' ',g1 xor k1,' ',
0924 c2[8],' ',zst2,' ',g2,' ',k2,' ',g2 xor k2,' ',
0925 d1[8],' ',d2[8],' ',zt1,' ',zt2,' ',gt);}
0926 Elmzt(Zt1,D1);
0927 Elmzt(Zt2,D2);
0928 Elmzt(Zst1,C1);
0929 Elmzt(Zst2,C2);
0930 Result(Resbyte,D1,D2,Gt);
0931 ResD1(ResbyteD1);
0932 if (st_in_gt1 or st_in_gt2) then begin
0933 resbyted1:=resbyted1 or 128;
0934 end;
0935 write(AusgFile,Resbyte);
0936 write(AusgFile,ResbyteD1);
0937 if m=5 then begin
0938 if st_in_gt1 then st_in_gt1:=false
0939 else begin
0940 bytegt1:=0;
0941 for i:=5 downto 1 do
0942 bytegt1:=bytegt1+feld5gt1[i]*Pot2(5-i);
0943 for i:=1 to 6 do if bytegt1=steuerkomb_hex[i]
0944 then st_in_gt1:=true;
0945 end;
0946 if st_in_gt2 then st_in_gt2:=false
0947 else begin
0948 bytegt2:=0;
0949 for i:=5 downto 1 do
0950 bytegt2:=bytegt2+feld5gt2[i]*Pot2(5-i);
0951 for i:=1 to 6 do if bytegt2=steuerkomb_hex[i]
0952 then st_in_gt2:=true;
0953 end;
0954 end;
0955 end;
0956 until t=Tmax;
0957 assign(AusgP1,P1Name);
0958 assign(AusgP2,P2Name);
0959 rewrite(AusgP1);
0960 rewrite(AusgP2);
0961 for i:=0 to 7 do
0962 for j:=0 to 15 do
0963 begin
0964 write(AusgP1,MtxP1[i,j]);
0965 write(AusgP2,MtxP2[i,j]);
0966 end;
0967 end
0968 else
0969 begin
0970 gotoxy(5,2);
0971 write('Eingabedaten unvollständig !!!');
0972 end;
0973 textcolor(lightgray);
0974 textbackground(black);
0975 window(1,1,80,25);
0976 end;
0977
0978
0979 {****************************************************************************
0980 HAUPTPROGRAMM
0981 *****************************************************************************}
0982
0983 begin
0984 new(kt1);new(kt2);
0985 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0986 Ende:=false;
0987 Ausok:=false;
0988 Einok:=false;
0989 P1name:=' ';P2name:=' ';Resname:=' ';Nameskdat:=' ';Ok:=' '; Dk1:=' ';
0990 Dk2:=' ';Tmax:=0;Ts:=0;Kt1name:=' ';Kt2name:=' ';BitVar:=5;
0991 repeat
0992 Menue;
0993 repeat
0994 Taste:=readkey;
0995 until taste=#0;
0996 Taste:=readkey;
0997 case Taste of
0998 #59: Eingaben;
0999 #60: AusgNamen(P1Name,P2Name,ResName);
1000 #61: ProgStart;
1001 #68: ende:=true;
1002 end;
1003 until ende;
1004 textcolor(black);textbackground(lightgray);
1005 gotoxy(20,15);
1006 write('P r o g r a m m e n d e ! ! !');
1007 textcolor(lightgray);textbackground(black);
1008 dispose(kt1);dispose(kt2);
1009 end.
0001 { HORIZONT - Variante "S"
0002
0003 Vers 2.0: Programm zur Erzeugung von max longint Bit, gewonnen aus
0004 AnzGt Geheimtexten, die zu Paaren kombiniert werden
0005 Erzeugt werden: - alle AnzGt Matrizen P in einer Datei
0006 - zu jedem Geheimtextpaar ein Abschnitt
0007 mit der Anzahl der Doppel-Byte für
0008 dieses Paar im ersten word
0009 - zu jedem Takt zwei Byte der Form:
0010 (d11,d12,…d17,f1ag) }
0011
0012 program HzVarS02;
0013
0014 uses crt,dos,printer;
0015
0016 Type
0017 Bytefile=file of Byte; { Ausgabefile für Res-Daten }
0018 Matrix=array[0..7,0..15] of byte; { eine Matrix P }
0019 Matrixfeld=array[1..20] of Matrix; { Feld der P-Matrizen }
0020 zeile60=string[60];
0021 menge=set of char;
0022 string8=string[8];
0023 mm=set of char;
0024
0025 Var
0026 t,tmax:longint; { Taktzähler und obere Taktgrenze }
0027 AnzGt:integer; { Anzahl der zu kombinierenden Gt }
0028 p1,p2:shortint; { Nr des jeweiligen Paares }
0029 gtname,resname:zeile60; { Namen der Gt-Eingabe/Resultatsdateien }
0030 Gtfile:bytefile; { File der Geheimtexte }
0031 mtxp1,mtxp2:matrix; { Matrizen P eines Paares }
0032 MtxName:zeile60; { Name der Datei der P-Matrizen }
0033 l,i,j:integer;
0034 Skmat:matrix; { Strukturschlüssel }
0035 SkName:zeile60; { Dateiname des Strukturschlüssels }
0036 Skfile:bytefile; { Strukturschlüsseldatei }
0037 AusgFile:bytefile; { File der erzeugten Daten }
0038 Mpfile:bytefile; { File der Matrizen P }
0039 Mpfeld:matrixfeld; { Feld der Matrizen P }
0040 einok,ausok,ende,ok:boolean; { Prüfvariable }
0041 Taste:char;
0042
0043 Const
0044 Dateibez:menge=['A'..'Z','a'..'z','?','*','.',':','0'..'9'];
0045 Bu:set of char=['A'..'Z','a'..'z'];
0046 max_Feld_lg:integer=10000;
0047 Bitvar:integer=5;
0048
0049 {-------------------------------------------------------------------- aus Tools }
0050
0051 procedure einzeil(var st:zeile60;tex:zeile60;m:mm;l,ze,sp:integer);
0052
0053 const s:set of byte=[8,75,77];
0054
0055 var i:integer;
0056 ta:string[2];
0057 c:char;
0058
0059 procedure cure; begin
0060 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0061 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
0062 end;
0063
0064 procedure culi; begin
0065 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0066 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
0067 end;
0068
0069 begin
0070 st:='';
0071 for i:=1 to l do st:=st+' ';
0072 for i:=1 to length(tex) do st[i]:=tex[i];
0073 i:=1;gotoxy(ze,sp);write(tex);
0074 repeat
0075 gotoxy(ze+i-1,sp);
0076 c:=readkey;
0077 case c in m of
0078 true: ta:=c;
0079 false: case ord(c) in s of
0080 true: ta:=chr(27)+c;
0081 false: case ord(c) of
0082 0: begin c:=readkey;
0083 if ord(c) in s then ta:=chr(27)+c
0084 else ta:='' end
0085 else ta:=''
0086 end;
0087 end;
0088 end;
0089 if ta<>''then
0090 begin
0091 if ta[1]<>chr(27) then begin write(c);st[i]:=c;
0092 if i<1 then i:=i+1 else culi
0093 end else
0094 case ord(ta[2]) of
0095 8: if i>1 then begin st[i]:=' ';i:=i-1;st[i]:=' ';
0096 culi;write(' ');culi;culi
0097 end;
0098 75: if i>1 then begin i:=i-1;culi end;
0099 77: if i<l then begin i:=i+1;cure end;
0100 end;
0101 end;
0102 until c=chr(13);
0103 i:=l+1;
0104 repeat
0105 i:=i-1;
0106 until (i=0) or (st[i]<>' ');
0107 if i<>0 then st:=copy(st,1,i)
0108 else st:='';
0109 end;
0110
0111 {################################################### EINGABEN ##################}
0112
0113 procedure Eingaben;
0114
0115 type
0116 string128=string[128];
0117
0118 Var
0119 Taste:char;
0120 x,y,i,j,code,stelle:integer;
0121 M01:menge;
0122 Mziff:menge;
0123 vekzeil:zeile60;
0124 ch,Doppelpkt:char;
0125 check,tok,anzok,skok,einok:boolean;
0126 no:string[2];
0127 vek128:string128;
0128
0129
0130 {------------------------------------------------ Einlesen Strukturschlüsselmatrix }
0131
0132 procedure SKein (Var Mtx:matrix);
0133
0134 Var
0135 i,j:integer;
0136 Filein:file of byte;
0137 Filename:string[13];
0138
0139 begin
0140 gotoxy(20,15);
0141 writeln('Filename SK-Datei:');
0142 read(filename);
0143 assign(filein,filename);
0144 reset(filein);
0145 for i:=0 to 7 do
0146 for j:=0 to 15 do
0147 read(filein,mtx[i,j]);
0148 close(filein);
0149 end;
0150
0151 {------------------------------------------------------------ Übertragung SK }
0152
0153 procedure EingSK(var SK:matrix);
0154
0155 var
0156 i,j:integer;
0157
0158 begin
0159 for i:=0 to 7 do
0160 for j:=0 to 15 do
0161 sk[i,j]:=ord(vek128[i*16+j+1]);
0162 end;
0163
0164 {---------------------------------------------- Umwandlung Klein- in Großbuchstaben }
0165
0166 procedure grossbu(var Kette:zeile60);
0167
0168 Var
0169 i:integer;
0170
0171 begin
0172 for i:=1 to length(Kette) do
0173 Kette[i]:=upcase(Kette[i]);
0174 end;
0175
0176 {------------------------------------------------ Fehlerausschrift für Dateifehler }
0177
0178 procedure Dateifehler(Name:zeile60;x,y:integer);
0179
0180 begin
0181 gotoxy(x,y);
0182 write('Datei "',name,'" existiert nicht! ');
0183 delay(5000);
0184 end;
0185
0186 {---------------------------------------- Eingaben SK,Bitvar,AnzGt,Name_Gt_Datei,T }
0187
0188 begin
0189 tok:=false;anzok:=false;skok:=false;einok:=false;
0190 M01:=['0','1'];Mziff:=['0'..'9'];
0191 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0192 check:=false;
0193 window(5,7,60,25);
0194 textbackground(lightgray);
0195 textcolor(black);
0196 clrscr;
0197 write('Eingaben: ');
0198 gotoxy(5,wherey+2);x:=wherex;y:=wherey;
0199 repeat
0200 gotoxy(x,y);
0201 write('Anzahl der Geheimtextdateien: ');gotoxy(wherex-1,wherey);
0202 str(anzgt,vekzeil);
0203 einzeil(vekzeil,vekzeil,mziff,2,wherex,wherey);
0204 val(vekzeil,anzgt,code);
0205 if ((anzgt>1) and (anzgt<21)) then anzok:=true;
0206 until anzok=true;
0207 gotoxy(5,wherey+1);x:=wherex;y:=wherey;
0208 Doppelpkt:=':';
0209 repeat
0210 gotoxy(x,y);code:=0;
0211 write('Dateiname der Geheimtextdateien: ');
0212 einzeil(gtname,gtname,Dateibez,14,wherex,wherey);
0213 for i:=1 to anzgt do
0214 begin
0215 stelle:=Pos(Doppelpkt,gtname);
0216 if Stelle=0 then gtname:=copy(gtname,1,6)
0217 else gtname:=copy(gtname,1,8);
0218 str(i:2,no);
0219 if no[1]=' ' then no:='0'+copy(no,2,1);
0220 gtname:=gtname+no;
0221 {$I-} assign(gtfile,gtname);reset(gtfile); {$I+}
0222 code:=code+ioresult;
0223 close(gtfile);
0224 end;
0225 if code<>0 then begin Dateifehler(gtname,x,y);gtname:=' ';end;
0226 until code=0;
0227 gotoxy(1,wherey+2);x:=wherex;y:=wherey;
0228 write('Strukturschlüssel: ');
0229 write('Dateiname: ');
0230 einzeil(skname,skname,Dateibez,16,wherex,wherey);
0231 {$I-} assign(Skfile,skname);
0232 reset(Skfile); {$I+}
0233 code:=ioresult;skok:=false;
0234 if code=0 then begin
0235 for i:=0 to 7 do
0236 for j:=0 to 15 do
0237 read(skfile,Skmat[i,j]);
0238 close(Skfile);
0239 Skok:=true;
0240 end;
0241 gotoxy(20,wherey+1);
0242 write('Strukturmartrix: ');
0243 window(40,13,55,20);
0244 textcolor(lightgray);
0245 textbackground(black);
0246 clrscr;
0247 window(1,1,80,25);
0248 vek128:='';
0249 for i:=0 to 7 do
0250 for j:=0 to 15 do
0251 if skok then vek128:=vek128+chr(skmat[i,j])
0252 else vek128:=vek128+' ';
0253 gotoxy(40,13);x:=wherex;y:=wherey-1;
0254 for i:=1 to 8 do
0255 begin
0256 y:=y+1;
0257 vekzeil:=copy(vek128,((i-1)*16)+1,16);
0258 einzeil(vekzeil,vekzeil,M01,16,x,y);
0259 delete(vek128,((i-1)*16)+1,16);
0260 insert(vekzeil,vek128,((i-1)*16)+1);
0261 end;
0262 EingSk(Skmat);
0263 Skok:=true;
0264 assign(Skfile,skname);
0265 rewrite(Skfile);
0266 for i:=0 to 7 do
0267 for j:=0 to 15 do
0268 write(Skfile,skmat[i,j]);
0269 close(skfile);
0270 textcolor(black);textbackground(lightgray);
0271 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0272 gotoxy(5,wherey+1);
0273 write('Anzahl Tmax :');
0274 x:=wherey; y:=wherey;
0275 repeat
0276 str(Tmax,vekzeil);
0277 einzeil(vekzeil,vekzeil,Mziff,6,x,y);
0278 val(vekzeil,Tmax,code);
0279 if Tmax>0 then Tok:=true;
0280 until Tok;
0281 window(1,1,80,25);
0282 textcolor(lightgray);textbackground(black);
0283 if (skok and tok and anzok) then einok:=true;
0284 end;
0285
0286 {***************************************************************************
0287 WORKPAAR - Verarbeitung eines Geheimtextpaares (UP des Gesamtprogr.)
0288 ****************************************************************************}
0289
0290 procedure WorkPaar(Var T:longint; { Taktzähler für Bit }
0291 P1,P2:shortint; { Nr des aktuellen Paares }
0292 GtName:string8; { Name der Gt-Datei ohne Attribut }
0293 Var Mtxp1,Mtxp2:matrix;
0294 Var ok:boolean);
0295
0296 type
0297 slmat=array[1..16,1..8] of byte;
0298 vektor=array[1..8] of byte;
0299 allreg=array[1..31] of byte;
0300 RegSatz=array[1..8] of allreg;
0301 Rcnum=array[1..18] of byte;
0302 RcSatz=array[1..8] of Rcnum;
0303 SlMatrix=array[1..16,1..8] of byte;
0304 string16=string[16];
0305 string10=string[10];
0306 string13=string[13];
0307 string128=string[128];
0308 zeile60=string[60];
0309 menge=set of char;
0310 Gtfeld=array[1..4000] of byte;
0311 Schluessel=array[1..10] of byte;
0312 ITA_Reg=array[1..26] of byte;
0313 ITA_Zei=array[1..26] of char;
0314
0315 Var
0316 no1,no2:string[2]; { Paarzähler }
0317 Verlg:integer; { Verarbeitungslänge der Dateien }
0318 Gt1,Gt2:Gtfeld; { Felder für Gt-Dateien }
0319 Lgt1,Lgt2:word; { Länge der G-Texte }
0320 Tv,ti1,ti2,Timax,s:integer; { Zähler }
0321 imax:integer; { max Feldgröße }
0322 code:integer; { Fehlercode }
0323 GtDat1,GtDat2:Bytefile; { Files der Geheimtexte }
0324 Sp1,Sp2:Schluessel; { Spruchschlüssel }
0325 Strsp1,Strsp2:string10; { --"-- als string }
0326 MtxD1,Mtxd2:slmat; { Spruchschlüsselmatrizen }
0327 D1,D2:vektor; { Registerausgänge d1,d2 }
0328 Gam1,Gam2:byte; { Additionseinheiten für DK1,DK2 }
0329 G1,G2,gbit1,gbit2:byte; { Elemente der Geheimtexte G1,G2,Bitdarst }
0330 gt:byte; { gt aus Gleichung 4 }
0331 resbyte:byte; { Byte, das Vektor (dl,d2,…,d7,gt) binär darstellt }
0332 resbyted1:byte; { Byte, das Vektor (d11,d12,…,d17,f) binär darstellt }
0333 reslgn:word; { Anzahl der Verarbeitungstakte pro Paar }
0334 i,j,p,stelle:integer; { Zähler }
0335 RD1:RegSatz;
0336 RD2:RegSatz;
0337 zt1,zt2:byte; { zt:=Summe(Ci(t-1)) }
0338 Ende,EinOk,AusOk:boolean; { Prüfvariable bevor Programm startet }
0339 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0340 Taste,doppelpkt:char;
0341 vek128:string128;
0342 gt1name,gt2name:string10; { vollständiger Name Gt-Datei }
0343 Stflag,stflag1,stflag2:boolean; { Steuerkombination im Gt }
0344
0345 const
0346 RC:RcSatz=((3,5, 8,10,11,14,16,21,24,26,29,31, 0, 0, 0, 0, 0, 0), { Register 1 }
0347 (2,7,12,15,17,19,21,22,26,27,28,29, 0, 0, 0, 0, 0, 0), { Register 2 }
0348 (2,3, 4, 6, 7, 8,10,11,14,17,19,21,24,26,27,28, 0, 0), { Register 3 }
0349 (1,2, 4, 8, 9,10,11,14,15,16,18,22,25,27, 0, 0, 0, 0), { Register 4 }
0350 (5,8,12,13,17,18,19,20,22,23,24,25, 0, 0, 0, 0, 0, 0), { Register 5 }
0351 (1,5, 6, 7, 8, 9,10,11,12,13,14,23, 0, 0, 0, 0, 0, 0), { Register 6 }
0352 (2,3, 4, 5, 7, 9,10,17,18,19, 0, 0, 0, 0, 0, 0, 0, 0), { Register 7 }
0353 (2,3, 4, 5, 6, 7, 8,15,17,19,20,22,23,26,28,29,30,31)); { Register 8 }
0354 Skok:boolean=true;
0355 Okok:boolean=true;
0356 Dk1ok:boolean=true;
0357 Dk2ok:boolean=true;
0358 Tok:Boolean=true;
0359 ITA2_Hex:ITA_Reg=($18,$13,$0E,$12,$10,$16,$08,$05,$0C,$1A,$1E,$09,$07,$06,
0360 $03,$0D,$CD,$0A,$14,$01,$1C,$0F,$19,$17,$15,$11);
0361 ITA2_Bu:ITA_zei=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
0362 'P','Q','R','S','T','U','V','W','X','Y','Z');
0363 Steuerkomb_hex:array[1..6] of byte=($00,$02,$04,$08,$11,$1F);
0364 Steuerkomb_zei:array[1..6] of char=('|','<',' ','*','#','%');
0365
0366 {-----------------------------------------------------------------------
0367 Registerverschiebung für beliebige Register mit Rückkopplung rück und
0368 dem Ausgang cbit }
0369
0370 procedure regv(var reg:allreg;var cbit:byte;rueck:rcnum);
0371
0372 var
0373 i:integer;
0374 reglaenge:byte;
0375
0376 begin
0377 cbit:=0;
0378 for i:=1 to 18 do
0379 if rueck[i]<>0 then begin
0380 cbit:=cbit xor reg[rueck[i]];
0381 reglaenge:=rueck[i];
0382 end;
0383 for i:=reglaenge downto 2 do reg[i]:=reg[i-1];
0384 reg[1]:=cbit;
0385 end;
0386
0387 {----------------------------------- Registerverschiebung eines Registersatzes }
0388
0389 procedure RegVerSatz(var register:regsatz;rkopp:rcsatz;var abit:vektor);
0390
0391 Var
0392 i:integer;
0393
0394 begin
0395 for i:=1 to 8 do
0396 Regv(register[i],abit[i],rkopp[i]);
0397 end;
0398
0399 {----------------------- Registerverschiebung der zwei Registersätze RD1,RD2 }
0400
0401 procedure AllRegVer;
0402
0403 begin
0404 RegVerSatz(RD1,RC,D1);
0405 RegVerSatz(RD2,RC,D2);
0406 end;
0407
0408 {---------------------------------------- Funktion 2 hoch x }
0409
0410 Function Pot2(x:integer):integer;
0411
0412 Var
0413 i:integer;
0414 Erg:integer;
0415
0416 begin
0417 if x=0 then pot2:=1
0418 else
0419 begin
0420 Erg:=1;
0421 for i:=1 to x do Erg:=Erg*2;
0422 Pot2:=Erg;
0423 end;
0424 end;
0425
0426 {-------------------------- Erzeugung eines Zeilenvektors aus einem Schlüsselbuchstaben }
0427
0428 procedure Mzeile(var Zeile:vektor;Bu:byte);
0429
0430 Var
0431 i:integer;
0432 By:real;
0433 hiz:vektor;
0434
0435 begin
0436 by:=ita2_hex[ord(bu)-64];
0437 for i:=8 downto 1 do
0438 begin
0439 if (by/Pot2(i-1)<l) then zeile[9-i]:=0
0440 else begin
0441 by:=by-Pot2(i-1);
0442 end;
0443 end;
0444 for i:=1 to 5 do
0445 hiz[i]:=zeile[i+3];
0446 for i:=6 to 8 do
0447 hiz[i]:=0;
0448 for i:=1 to 8 do zeile[i]:=zeile[i] xor hiz[i] and 1;
0449 end;
0450
0451 {----------------------- Erzeugung der Matrix D1,D2 aus den Spruchschlüssel }
0452
0453 procedure MatrixD (Var mat:slmat;Spsl:string10);
0454
0455 Var
0456 i,j:integer;
0457 bu:byte;
0458 zeile:vektor;
0459
0460 begin
0461 for i:=1 to 10 do
0462 begin
0463 bu:=byte(spsl[i]);
0464 mzeile(zeile,bu);
0465 for j:=1 to 8 do mat[i,j]:=zeile[j];
0466 end;
0467 for i:=11 to 16 do
0468 begin
0469 bu:=byte(spsl[i-10]);
0470 mzeile(zeile,bu);
0471 for j:=1 to 8 do mat[i,j]:=zeile[j];
0472 end;
0473 end;
0474
0475 {------------------------------------------ Erzeugung der zwei Matrizen MTXD1,MTXD2 }
0476
0477 procedure GenMatx (var MTXD1,MTXD2:slmat;DK1,DK2:string10);
0478
0479 begin
0480 matrixd(mtxd1,dk1);
0481 matrixd(mtxd2,dk2);
0482 end;
0483
0484 {--------------------------------------------- Initialisierung Registersatz D }
0485
0486 procedure InitRegSatzD (Var rset:regsatz;mtx:slmat);
0487
0488 Var
0489 i,j:integer;
0490
0491 begin
0492 for i:=1 to 8 do
0493 begin
0494 rset[i,1]:=1;
0495 for j:=1 to 10 do rset[i,j+1]:=mtx[j,9-i];
0496 for j:=1 to 10 do rset[i,j+11]:=mtx[j,9-i];
0497 for j:=1 to 10 do rset[i,j+21]:=mtx[j,9-i];
0498 end;
0499 end;
0500
0501 {------------------------------ Initialisieren der zwei Registersätze }
0502
0503 procedure GenReg;
0504
0505 Var
0506 i:integer;
0507
0508 begin
0509 InitRegSatzD(RD1,MTXD1);
0510 InitRegSatzD(RD2,MTXD2);
0511 end;
0512
0513 {----------------------------------- Generieren einer Matrix P }
0514
0515 procedure GenMtxP (Var SPMat:matrix;SKMat:matrix;DkMat:slmat);
0516
0517 Var
0518 i,j:integer;
0519
0520 begin
0521 for i:=0 to 7 do
0522 for j:=0 to 15 do
0523 begin
0524 SPMat[i,j]:=(ord(SkMat[i,j])-48 xor DKMat[j+1,8-i]) and 1;
0525 end;
0526 end;
0527
0528 {---------------------------------- Erzeugung eines Gamma pro Takt }
0529
0530 procedure Gamma (Var Gamma:byte;vek:vektor;zt:byte);
0531
0532 begin
0533 Gamma:=vek[8] xor zt;
0534 end;
0535
0536 {--------------------------------- Erzeugung zt:=Summe(ci(t-1)) }
0537
0538 procedure Elmzt (Var zt:byte;vek:vektor);
0539
0540 var i:integer;
0541
0542 begin
0543 zt:=0;
0544 for i:=1 to 8 do
0545 zt:=zt xor vek[i];
0546 end;
0547
0548 {-------------------------------- Konvertierung eines hex-Byte in 8 0,1-Byte }
0549
0550 procedure Konv(var Feld:vektor;b:byte);
0551
0552 Var
0553 i,y:integer;
0554
0555 begin
0556 for i:=1 to 8 do
0557 begin
0558 y:=Pot2(8-i);
0559 if ((b-y)>=0) then begin
0560 b:=b-y;
0561 Feld[i]:=1;
0562 end
0563 else Feld[i]:=0;
0564 end;
0565 end;
0566
0567 {---------------------------------- Erzeugung des Ergebnisbytes RESBYT=(d7,…,d1,gt) }
0568
0569 procedure Result (Var Resbyt:byte;D1,D2:vektor;gt:byte);
0570
0571 Var
0572 i:integer;
0573 hv:vektor;
0574
0575 begin
0576 resbyt:=0;
0577 for i:=1 to 7 do hv[i]:=D1[8-i] xor D2[8-i];
0578 hv[8]:=gt;
0579 for i:=8 downto 1 do Resbyt:=Resbyt+hv[i]*Pot2(8-i);
0580 end;
0581
0582 {------------------------------ Erzeugung des Ergebnisbytes RESBYTED1=(d11,d12,..,,d17,Flag) }
0583
0584 procedure ResD1(Var Byte:byte;Flag:boolean);
0585
0586 Var
0587 i:integer;
0588 hv:vektor;
0589
0590 begin
0591 byte:=0;
0592 for i:=1 to 7 do hv[i]:=D1[8-i];
0593 if Flag then hv[8]:=1 else hv[8]:=0;
0594 for i:=8 downto 1 do byte:=byte+hv[i]*Pot2(8-i);
0595 end;
0596
0597 {--------------------------------- Textgenerierung GT mit Syntaxtest und Spruchschlüsselübergabe }
0598
0599 procedure GenText(Var Spruchschl:string10;
0600 Var Gtext:gtfeld;
0601 Var ok:boolean;
0602 Var lg:word;
0603 Var Gtdatei:bytefile;Gtname:string8);
0604
0605 Var
0606 Err_kenna,Err_spsl:boolean;
0607 zeichen:byte;
0608 za,zs,i,j:integer;
0609
0610 Const
0611 kenna:string[5]='HHHHH';
0612
0613 begin
0614 spruchschl:='';
0615 assign(Gtdatei,gtname);
0616 reset(gtdatei);
0617 Err_kenna:=false;Err_spsl:=false;
0618 za:=1;
0619 repeat
0620 read(Gtdatei,zeichen);
0621 if zeichen=byte(kenna[za]) then
0622 repeat
0623 za:=za+1;
0624 read(Gtdatei,zeichen);
0625 if zeichen<>byte(kenna[za]) then za:=1;
0626 until((za=5) or (za=1));
0627 until ((za=5) or eof(gtdatei));
0628 if eof(gtdatei) then err_kenna:=true;
0629 if not err_kenna then
0630 for i:=1 to 10 do
0631 begin
0632 repeat
0633 read(gtdatei,zeichen);
0634 until ((chr(zeichen) in bu) or eof(gtdatei));
0635 if not eof(gtdatei) then begin
0636 Spruchschl:=spruchschl+chr(zeichen);
0637 j:=0;
0638 repeat
0639 j:=j+1;
0640 repeat
0641 read(gtdatei,zeichen);
0642 until ((chr(zeichen) in bu) or eof(gtdatei));
0643 if ((chr(zeichen)<>spruchschl[i]) or eof(gtdatei))
0644 then Err_spsl:=true;
0645 until ((j=2) or eof(gtdatei));
0646 end;
0647 end;
0648 if eof(gtdatei) then ok:=false; { kein Geheimtext }
0649 if err_kenna then writeln('Kennung ',kenna,'nicht gefunden!');
0650 if err_spsl then writeln('Spruchschlüssel nicht gefunden!');
0651 if (err_kenna or err_spsl) then begin
0652 delay(4000);
0653 ok:=false;
0654 exit;
0655 end;
0656 i:=0;
0657 repeat
0658 repeat
0659 read(gtdatei,zeichen);
0660 until((chr(zeichen) in bu) or eof(gtdatei));
0661 if not eof(gtdatei) then begin
0662 i:=i+1;
0663 gtext[i]:=zeichen;
0664 end;
0665 until (eof(gtdatei) or (i=imax));
0666 repeat
0667 if gtext[i]=89 then i:=i-1;
0668 until gtext[i]<>89;
0669 lg:=i;
0670 close(gtdatei);
0671 end;
0672
0673 {--------------------------------------- Int-Funktion mit integer-Variablen }
0674
0675 function Ganz(x:integer;d:integer):integer;
0676
0677 Var
0678 y:integer;
0679
0680 begin
0681 y:=0;
0682 repeat
0683 if (x-d)>=0 then y:=y+1;
0684 x:=x-d;
0685 until x<0;
0686 Ganz:=y;
0687 end;
0688
0689 {---------------------------------------------- Substitution in ITA2-Zeichen }
0690
0691 procedure Substitute(Var gts:byte;gtsn:byte;Var Flag:boolean);
0692
0693 Var
0694 i:integer;
0695 ok:boolean;
0696
0697 begin
0698 flag:=false;ok:=false;
0699 if gts=89 then begin
0700 gts:=gtsn;
0701 case gts of
0702 {S} 83:gts:=ita2_hex[25];
0703 {K} 75:gts:=steuerkomb_hex[6];
0704 {J} 74:gts:=steuerkomb_hex[5];
0705 {H} 72:gts:=steuerkomb_hex[3];
0706 {O} 79:gts:=steuerkomb_hex[2];
0707 {L} 76:gts:=steuerkomb_hex[4];
0708 {T} 84:gts:=steuerkomb_hex[1];
0709 end;
0710 flag:=true;
0711 end
0712 else
0713 begin
0714 i:=0;
0715 repeat
0716 i:=i+1;
0717 if gts=byte(ita2_bu[i]) then begin
0718 gts:=ita2_hex[i];
0719 ok:=true;
0720 end;
0721 until ((i=26) or ok);
0722 if not ok then gts:=$00; { undef. Element }
0723 end;
0724 end;
0725
0726 {*********************** Beginn Prozedur WORKPAAR **************************}
0727
0728 begin
0729 imax:=max_Feld_lg;zt1:=0;zt2:=0;
0730 strsp1:='';strsp2:='';
0731 str(p1:2,no1);str(p2:2,no2);
0732 doppelpkt:=':';
0733 stelle:=pos(doppelpkt,gtname);
0734 if stelle=0 then gtname:=copy(gtname,1,6)
0735 else gtname:=copy(gtname,1,8);
0736 if no1[1]=' ' then no1:='0'+copy(no1,2,1);
0737 if no2[1]=' ' then no2:='0'+copy(no2,2,1);
0738 gt1name:=gtname+no1;gt2name:=gtname+no2;
0739 GenText(Strsp1,Gt1,tok,Lgt1,GtDat1,Gt1name);
0740 ok:=tok;
0741 if not tok then begin writeln('Textfehler Text1!');delay(2000);exit;end;
0742 GenText(Strsp2,Gt2,tok,Lgt2,GtDat2,Gt2name);
0743 ok:=ok and tok;
0744 if not tok then begin writeln('Textfehler Text2!');delay(2000);exit;end;
0745 ti1:=lgt1*bitvar;ti2:=lgt2*bitvar;
0746 write(lst,p1:2,',',p2:2,' ',strsp1,' ',strsp2,' ',lgt1:4,' ',lgt2:4,' ',ti1:5,' ',ti2:5,' ');
0747 GenMatx(mtxd1,mtxd2,strsp1,strsp2);
0748 GenReg;
0749 if ((p1=1) and (p2=2)) then begin GenMtxP(mtxp1,skmat,mtxd1);
0750 GenMtxp(mtxp2,skmat,mtxd2);
0751 end;
0752 if ((p1=1) and (p2>2)) then GenMtxp(mtxp2,skmat,mtxd2);
0753 if lgt1>=lgt2 then Verlg:=lgt2 else Verlg:=lgt1;
0754 reslgn:=verlg*bitvar;
0755 resbyte:=lo(reslgn);
0756 resbyted1:=hi(reslgn);
0757 write(AusgFile,resbyte,resbyted1);
0758 write(lst,Verlg,' ');
0759 tv:=0;zt1:=0;zt2:=0;
0760 repeat { Vorlauf }
0761 tv:=tv+1;
0762 AllRegVer;
0763 Elmzt(Zt1,D1);
0764 Elmzt(Zt2,D2);
0765 until tv=150;
0766 s:=0;stflag1:=false;stflag2:=false;stflag:=false;
0767 repeat
0768 s:=s+1;
0769 if stflag1 then g1:=$FF else g1:=Gt1[s];
0770 if stflag2 then g2:=$FF else g2:=Gt2[s];
0771 if not stflag1 then substitute(g1,gt1[s+1],stflag1);
0772 if not stflag2 then substitute(g2,gt2[s+l],stflag2);
0773 if ((g1=$FF) or (g2=$FF)) then stflag:=stflag1 or stflag2
0774 else stflag:=false;
0775 for p:=bitvar-1 downto 0 do
0776 begin
0777 gbit1:=g1 and Pot2(p);if gbit1<>0 then gbit1:=1;
0778 gbit2:=g2 and Pot2(p);if gbit2<>0 then gbit2:=1;
0779 t:=t+1;
0780 gotoxy(10,8);
0781 write('t= ',t);
0782 Allregver;
0783 Gamma(gam1,d1,zt1);
0784 Gamma(gam2,d2,zt2);
0785 gt:=gam1 xor gam2 xor gbit1 xor gbit2 and 1;
0786 Elmzt(Zt1,D1);
0787 Elmzt(Zt2,D2);
0788 Result(Resbyte,D1,D2,Gt);
0789 ResD1(ResbyteD1,stflag);
0790 write(Ausgfile,Resbyte);
0791 write(Ausgfile,ResbyteD1);
0792 end;
0793 if ((g1=$FF) and stflag1) then stflag1:=false;
0794 if ((g2=$FF) and stflag2) then stflag2:=false;
0795 until ((s=Verlg) or (t>=tmax));
0796 write(lst,t:6);writeln(lst);writeln(lst);
0797 end;
0798
0799 {------------------------------------------------- Protokollkopf }
0800
0801 procedure protokoll;
0802 var
0803 i,j:integer;
0804 jahr,monat,tag,stunde,min,dayofw,sec,sec100:word;
0805 stelle:integer;
0806 no:string[2];
0807 lmonat,lmin:string[1];
0808
0809 const
0810 doppelpkt:char=':';
0811
0812 begin
0813 writeln(lst);
0814 writeln(lst,'*********************************************************************************');
0815 writeln(lst);
0816 writeln(lst,'HORIZONT - statistische Methode. Var "S" - Vers. 2.0 (Geheimtextpaare)');
0817 writeln(lst);
0818 getdate(jahr,monat,tag,dayofw);gettime(stunde,min,sec,sec100);
0819 if monat<10 then lmonat:='0' else lmonat:='';
0820 if min<10 then lmin:='0' else lmin:='';
0821 writeln(lst,' Datum: ',tag,'.',lmonat,monat,'.',jahr);
0822 writeln(lst,' Zeit : ',stunde,'.',lmin,min,' Uhr');
0823 writeln(lst);
0824 writeln(lst,'================================= PROTOKOLL =====================================');
0825 writeln(lst);
0826 writeln(lst,' Anzahl Geheimtexte: ',Anzgt);
0827 write(lst,' Geheimtextdateien : ');
0828 for i:=1 to anzgt do begin
0829 stelle:=pos(doppelpkt,gtname);
0830 if Stelle=0 then gtname:=copy(gtname,1,6)
0831 else gtname:=copy(gtname,1,8);
0832 str(i:2,no);
0833 if no[1]=' ' then no:='0'+copy(no,2,1);
0834 gtname:=gtname+no;
0835 write(lst,gtname);
0836 writeln(lst);
0837 write(lst,' ');
0838 end;
0839 writeln(lst);
0840 writeln(lst,' Strukturschlüsseldatei : ',skname);
0841 write(lst,' Strukturschlüssel : ');
0842 for i:=0 to 7 do begin
0843 for j:=0 to 15 do write(lst,chr(skmat[i,j]));
0844 writeln(lst);write(lst,' ');
0845 end;
0846 writeln(lst);
0847 writeln(lst,' Tmax: ',tmax);
0848 writeln(lst,' Bitvariante: ',bitvar);
0849 writeln(lst,' Ausgabedatei: ',resname);
0850 writeln(lst,' Matrixdatei: ',mtxname);
0851 writeln(lst);writeln(lst);
0852 writeln(lst,'Paar Sp-schl1 Sp-sch12 Textlänge Anzahl Bit Verarb.-Lg Takte T');
0853 writeln(lst,' Txt1 Txt2 Txt1 Txt2 in Zeichen gesamt ');
0854 writeln(lst,'---------------------------------------------------------------------------------');
0855 writeln(lst);
0856 end;
0857
0858
0859 {---------------------------------------------- Programmstart des Arbeitsprogramms }
0860
0861 procedure Progstart;
0862
0863 Var
0864 stunde,min,sec,sec100:word;
0865 lmin:string[1];
0866
0867 begin
0868 window(20,12,60,22);
0869 textbackground(lightgray); textcolor(black);
0870 clrscr;
0871 gotoxy(10,2);
0872 write('Programm läuft !!!');
0873 protokoll;
0874 gotoxy(10,4);
0875 write('Tmax= ',tmax);
0876 assign(Ausgfile,resname);
0877 rewrite(Ausgfile);
0878 p1:=0;t:=0;
0879 repeat
0880 p1:=p1+1;p2:=p1;
0881 repeat
0882 p2:=p2+1;ok:=false;
0883 gotoxy(10,6);
0884 write('Paar ',p1,',',p2,' ');
0885 workpaar(t,p1,p2,gtname,mpfeld[p1],mpfeld[p2],ok);
0886 if not ok then begin writeln('Laufzeitfehler bei Paar ',p1,',',p2,'!');
0887 delay(2000);
0888 writeln(lst);
0889 writeln(lst,'Laufzeitfehler bei Paar ',p1,',',p2,'!');
0890 exit;
0891 end;
0892 until ((p2=Anzgt) or (t>=tmax));
0893 until ((p1=Anzgt-1) or (t>=tmax));
0894 close(AusgFile);
0895 assign(mpfile,mtxname);
0896 rewrite(mpfile);
0897 for l:=1 to Anzgt do
0898 for i:=0 to 7 do
0899 for j:=0 to 15 do write(mpfile,mpfeld[l,i,j]);
0900 close(mpfile);
0901 gettime(stunde,min,sec,sec100);
0902 if min<10 then lmin:='0' else lmin:='';
0903 write(lst,'===========================Ende=============================',stunde:2,'.',lmin,min,' Uhr ===');
0904 writeln(lst);writeln(lst);
0905 gotoxy(9,10);writeln(' E N D E ! ! ( Tastendruck )');taste:=readkey;
0906 textcolor(lightgray);
0907 textbackground(black);
0908 window(1,1,80,25);
0909 end;
0910
0911 {--------------------------------------------------- Namen der Ausgabefiles }
0912
0913 procedure AusgNamen(Var Mtxname:zeile60;
0914 Var Resname:zeile60);
0915
0916 begin
0917 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0918 Ausok:=false;
0919 window(10,7,65,12);
0920 textbackground(lightgray);
0921 textcolor(black);
0922 clrscr;
0923 gotoxy(5,wherey+1);
0924 write('Dateiname für Matrixdatei: ');
0925 einzeil(MtxName,MtxName,Dateibez,16,wherex,wherey);
0926 gotoxy(5,wherey+1);
0927 write('Dateiname für Daten: ');
0928 einzeil(ResName,ResName,Dateibez,16,wherex,wherey);
0929 window(1,1,80,25);
0930 textbackground(black);
0931 textcolor(lightgray);
0932 clrscr;
0933 Ausok:=true;
0934 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0935 end;
0936
0937 {------------------------------------------------------- Hauptmenü }
0938
0939 procedure Menue;
0940
0941 begin
0942 clrscr;
0943 writeln('*********************************************************************************');
0944 gotoxy(7,3);
0945 writeln('HORIZONT - statistische Methode: Erzeugung der Testdaten');
0946 gotoxy(18,4);
0947 writeln('Programm "HzVarSa-Vers 2.0 (Geheimtextpaare) ');
0948 gotoxy(1,6); writeln('*********************************************************************************');
0949 gotoxy(20,8);
0950 writeln('F1: Eingaben');
0951 gotoxy(20,9);
0952 writeln('F2: Ausgaben');
0953 gotoxy(20,10);
0954 writeln('F3: Programmstart');
0955 gotoxy(20,11);
0956 write('F10: Programmende');
0957 end;
0958
0959 {*********************************************************************
0960 HAUPTPROGRAMM
0961 ***********************************************************************}
0962
0963 begin
0964 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0965 Ende:=false;
0966 Ausok:=false;
0967 Einok:=false;
0968 Gtname:=' '; Mtxname:=' ';
0969 Resname:=' ';skname:=' ';Ok:=true;Tmax:=0;BitVar:=5;
0970 Anzgt:=0;
0971 repeat
0972 Menue;
0973 Taste:=readkey;
0974 Taste:=readkey;
0975 case Taste of
0976 #59: Eingaben;
0977 #60: AusgNamen(Mtxname,ResName);
0978 #61: ProgStart;
0979 #68:ende:=true;
0980 end;
0981 until ende;
0982 textcolor(black);textbackground(lightgray);
0983 gotoxy(20,15);
0984 write('P r o g r a m m e n d e ! ! !');
0985 textcolor(lightgray);textbackground(black);
0986 end.
0001 { HORIZONT - Variante "S"
0002 Vers 3.0: Programm zur Erzeugung von max longint Bit, gewonnen aus
0003 AnzGt Geheimtexten, die zu Paaren kombiniert werden
0004 Erzeugt werden: - zu jedem Geheimtextpaar ein Abschnitt
0005 mit der Anzahl der Doppel-Byte für
0006 dieses Paar im ersten word
0007 - zu jedem Takt zwei Byte der Form:
0008 (d1,d2,…,d7,g),
0009 (d11,d12,…d17,f1ag) }
0010
0011 program HzVarS03;
0012
0013 uses crt,dos,printer;
0014
0015 Type
0016 Bytefile=file of Byte; {Ausgabefile für Res-Daten}
0017 zeile60=string[60];
0018 menge=set of char;
0019 string8=string[8];
0020 mm=set of char;
0021
0022 Var
0023 t,tmax:longint; { Taktzähler und obere Taktgrenze }
0024 AnzGt:integer; { Anzahl der zu kombinierenden Gt }
0025 p1,p2:shortint; { Nr des jeweiligen Paares }
0026 gtname,resname:zeile60; { Namen der Gt-Eingabe/Resultatsdateien }
0027 Gtfile:bytefile; { File der Geheimtexte }
0028 l,i,j:integer;
0029 AusgFile:bytefile; { File der erzeugten Daten }
0030 einok,ausok,ende,ok:boolean; { Prüfvariable }
0031 Taste:char;
0032
0033 Const
0034 Dateibez:menge=['A'..'Z','a'..'z', '?','*','.',':','0'..'9'];
0035 Bu:set of char=['A'..'Z','a'..'z'];
0036 max_Feld_lg:integer=10000;
0037 Bitvar:integer=5;
0038
0039 {-------------------------------------------------------- aus Tools }
0040
0041 procedure einzeil(var st:zeile60;tex:zeile60;m:mm;l,ze,sp:integer);
0042
0043 const s:set of byte=[8,75,77];
0044
0045 var i:integer;
0046 ta:string[2];
0047 c:char;
0048
0049 procedure cure;
0050
0051 begin
0052 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0053 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
0054 end;
0055
0056 procedure culi;
0057
0058 begin
0059 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0060 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
0061 end;
0062
0063 begin
0064 st:='';
0065 for i:=1 to l do st:=st+' ';
0066 for i:=1 to length(tex) do st[i]:=tex[i];
0067 i:=1;gotoxy(ze,sp);write(tex);
0068 repeat
0069 gotoxy(ze+i-1,sp);
0070 c:=readkey;
0071 case c in m of
0072 true: ta:=c;
0073 false: case ord(c) in s of
0074 true: ta:=chr(27)+c;
0075 false: case ord(c) of
0076 0: begin c:=readkey;
0077 if ord(c) in s then ta:=chr(27)+c
0078 else ta:='' end
0079 else ta:=''
0080 end;
0081 end;
0082 end;
0083 if ta<>''then
0084 begin
0085 if ta[1]<>chr(27) then begin write(c);st[i]:=c;
0086 if i<l then i:=i+1 else culi
0087 end else
0088 case ord(ta[2]) of
0089 8: if i>1 then begin st[i]:=' ';i:=i-1;st[i]:=' ';
0090 culi;write(' ');culi;culi
0091 end;
0092 75: if i>1 then begin i:=i-1;culi end;
0093 77: if i<l then begin i:=i+1;cure end;
0094 end;
0095 end;
0096 until c=chr(13);
0097 i:=l+1;
0098 repeat
0099 i:=i-1
0100 until (i=0) or (st[i]<>' ');
0101 if i<>0 then st:=copy(st,1,i)
0102 else st:='';
0103 end;
0104
0105 {########################### EINGABEN ################################}
0106
0107 procedure Eingaben;
0108
0109 type
0110 string128=string[128];
0111
0112 var
0113 Taste:char;
0114 x,y,i,j,code,stelle:integer;
0115 M01:menge;
0116 Mziff:menge;
0117 vekzeil:zeile60;
0118 ch,Doppelpkt:char;
0119 check,tok,anzok,einok:boolean;
0120 no:string[2];
0121 vek128:string128;
0122
0123 {----------------------------------- Fehlerausschrift für Dateifehler }
0124
0125 procedure Dateifehler(Name:zeile60;x,y:integer);
0126
0127 begin
0128 gotoxy(x,y);
0129 write('Datei "',name,'" existiert nicht! ');
0130 delay(5000);
0131 end;
0132
0133 {---------------------------------Eingaben Bitvar,AnzGti,Name_Gt_Datei,T }
0134
0135 begin
0136 tok:=false;anzok:=false;einok:=false;
0137 M01:=['0','1'];Mziff:=['0'..'9'];
0138 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0139 check:=false;
0140 window(5,7,60,16);
0141 textbackground(lightgray);
0142 textcolor(black);
0143 clrscr;
0144 write('Eingaben: ');
0145 gotoxy(5,wherey+2);x:=wherex;y:=wherey;
0146 repeat
0147 gotoxy(x,y);
0148 write('Anzahl der Geheimtextdateien: ');gotoxy(wherex-1,wherey);
0149 str(anzgt,vekzeil);
0150 einzeil(vekzeil,vekzeil,mziff,2,wherex,wherey);
0151 val(vekzeil,anzgt,code);
0152 if ((anzgt>1) and (anzgt<21)) then anzok:=true;
0153 until anzok=true;
0154 gotoxy(5,wherey+1);x:=wherex;y:=wherey;
0155 Doppelpkt:=':';
0156 repeat
0157 gotoxy(x,y);code:=0;
0158 write('Dateiname der Geheimtextdateien: ');
0159 einzeil(gtname,gtname,Dateibez,14,wherex,wherey);
0160 for i:=1 to anzgt do
0161 begin
0162 stelle:=Pos(Doppelpkt,gtname);
0163 if Stelle=0 then gtname:=copy(gtname,1,6)
0164 else gtname:=copy(gtname,1,8);
0165 str(i:2,no);
0166 if no[1]=' ' then no:='0'+copy(no,2,1);
0167 gtname:=gtname+no;
0168 {$I-} assign(gtfile,gtname);reset(gtfile); {$I+}
0169 code:=code+ioresult;
0170 close(gtfile);
0171 end;
0172 if code<>0 then begin Dateifehler(gtname,x,y);gtname:=' ';end;
0173 until code=0;
0174 gotoxy(1,wherey+2);x:=wherex;y:=wherey;
0175 textcolor(black);textbackground(lightgray);
0176 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0177 gotoxy(5,wherey+1);
0178 write('Anzahl Tmax :');
0179 x:=wherex;y:=wherey;
0180 repeat
0181 str(Tmax,vekzeil);
0182 einzeil(vekzeil,vekzeil,Mziff,6,x,y);
0183 val(vekzeil,Tmax,code);
0184 if Tmax>0 then Tok:=true;
0185 until Tok;
0186 window(1,1,80,25);
0187 textcolor(lightgray);textbackground(black);
0188 if (tok and anzok) then einok:=true;
0189 end;
0190
0191 {***********************************************************************
0192 WORKPAAR - Verarbeitung eines Geheimtextpaares (UP des Gesamtprogr,)
0193 ************************************************************************}
0194
0195 procedure WorkPaar(Var T:longint; { Taktzähler für Bit }
0196 P1,P2:shortint; { Nr. des aktuellen Paares }
0197 GtName:string8; { Name der Gt-Datei ohne Attribut }
0198 Var ok:boolean);
0199
0200 type
0201 slmat=array[1..16,1..8] of byte;
0202 vektor=array[1..8] of byte;
0203 allreg=array[1..31] of byte;
0204 RegSatz=array[1..8] of allreg;
0205 Rcnum=array[1..18] of byte;
0206 RcSatz=array[1..8] of Rcnum;
0207 string16=string[16];
0208 string10=string[10];
0209 string13=string[13];
0210 string128=string[128];
0211 zeile60=string[60];
0212 menge=set of char;
0213 Gtfeld=array[1..4000] of byte;
0214 Schluessel=array[1..10] of byte;
0215 ITA_Reg=array[1..26] of byte;
0216 ITA_Zei=array[1..26] of char;
0217
0218 Var
0219 no1,no2:string[2]; { Paarzähler }
0220 Verlg:integer; { Verarbeitungslänge der Dateien }
0221 Gt1,Gt2:Gtfeld; { Felder für Gt-Dateien }
0222 Lgt1,Lgt2:word; { Länge der G-Texte }
0223 Tv,ti1,ti2,Timax,s:integer; { Zähler }
0224 imax:integer; { max Feldgröße }
0225 code:integer; { Fehlercode }
0226 GtDat1,GtDat2:Bytefile; { Files der Geheimtexte }
0227 Sp1,Sp2:Schluessel; { Spruchschlüssel }
0228 Strsp1,Strsp2:string10; { als string }
0229 MtxD1,MtxD2:slmat; { Spruchschlüsselmatrizen }
0230 D1,D2:vektor; { Registerausgänge dl,d2 }
0231 Gam1,Gam2:byte; { Additionseinheiten für DK1,DK2 }
0232 G1,G2,gbit1,gbit2:byte; { Elemente der Geheimtexte G1,G2,Bitdarst }
0233 gt:byte; { gt aus Gleichung 4 }
0234 resbyte:byte; { Byte, das Vektor (d1,d2,…d7,gt) binär darstellt }
0235 resbyted1:byte; { Byte, das Vektor (d11,d12,…,d17,f) binär darstellt }
0236 reslgn:word; { Anzahl der Verarbeitungstakte pro Paar }
0237 i,j,p,stelle:integer; { Zähler }
0238 RD1:RegSatz;
0239 RD2:RegSatz;
0240 zt1,zt2:byte; { zt:=Summe(Ci(t-1)) }
0241 Ende,Ein0k,AusOk:boolean; { Prüfvariable bevor Programm startet }
0242 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0243 Taste,doppelpkt:char;
0244 vek128:string128;
0245 gt1name,gt2name:string10; { vollständiger Name Gt-Datei }
0246 Stflag,stflag1,stflag2:boolean; { Steuerkombination im Gt }
0247
0248 const
0249 RC:RcSatz=((3,5, 8,10,11,14,16,21,24,26,29,31, 0, 0, 0, 0, 0, 0), { Register 1 }
0250 (2,7,12,15,17,19,21,22,26,27,28,29, 0, 0, 0, 0, 0, 0), { Register 2 }
0251 (2,3, 4, 6, 7, 8,10,11,14,17,19,21,24,26,27,28, 0, 0), { Register 3 }
0252 (1,2, 4, 8, 9,10,11,14,15,16,18,22,25,27, 0, 0, 0, 0), { Register 4 }
0253 (5,8,12,13,17,18,19,20,22,23,24,25, 0, 0, 0, 0, 0, 0), { Register 5 }
0254 (1,5, 6, 7, 8, 9,10,11,12,13,14,23, 0, 0, 0, 0, 0, 0), { Register 6 }
0255 (2,3, 4, 5, 7, 9,10,17,18,19, 0, 0, 0, 0, 0, 0, 0, 0), { Register 7 }
0256 (2,3, 4, 5, 6, 7, 8,15,17,19,20,22,23,26,28,29,30,31)); { Register 8 }
0257 Okok:boolean=true;
0258 Dk1ok:boolean=true;
0259 Dk2ok:boolean=true;
0260 Tok:Boolean=true;
0261 ITA2_Hex:ITA_Reg=($18,$13,$0E,$12,$10,$16,$0B,$05,$0C,$1A,$1E,$09,$07,$06,
0262 $03,$0D,$1D,$0A,$14,$01,$1C,$0F,$19,$17,$15,$11);
0263 ITA2_Bu:ITA_Zei=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
0264 'P','Q','R','S','T','U','V','W','X','Y','Z');
0265 Steuerkomb_hex:array[1..6] of byte=($00,$02,$04,$08,$1B,$1F);
0266 Steuerkomb_zei:array[1..6] of char=(':','<',' ','*','#','%');
0267
0268 {--------------------------- Registerverschiebung für beliebige Register mit Rückkopplung rück und
0269 dem Ausgang cbit }
0270
0271 procedure regv(var reg:allreg;var cbit:byte;rueck:rcnum);
0272
0273 var
0274 i:integer;
0275 reglaenge:byte;
0276
0277 begin
0278 cbit:=0;
0279 for i:=1 to 18 do
0280 if rueck[i]<>0 then begin
0281 cbit:=cbit xor reg[rueck[i]];
0282 reglaenge:=rueck[i];
0283 end;
0284 for i:=reglaenge downto 2 do reg[i]:=reg[i-1];
0285 reg[1]:=cbit;
0286 end;
0287
0288 {---------------------------------------------Registerverschiebung eines Registersatzes }
0289
0290 procedure RegVerSatz(var register:regsatz;rkopp:rcsatz;var abit:vektor);
0291
0292 Var
0293 i:integer;
0294
0295 begin
0296 for i:=1 to 8 do
0297 Regv(register[i],abit[i],rkopp[i]);
0298 end;
0299
0300 {------------------------------------ Registerverschiebung der zwei Registersätze RD1,RD2 }
0301
0302 procedure AllRegVer;
0303
0304 begin
0305 RegVerSatz(RD1,RC,D1);
0306 RegVerSatz(RD2,RC,D2);
0307 end;
0308
0309 {---------------------------------------------------- Funktion 2 hoch x }
0310
0311 Function Pot2(x:integer):integer;
0312
0313 Var
0314 i:integer;
0315 Erg:integer;
0316
0317 begin
0318 if x=0 then pot2:=1 else
0319 begin
0320 Erg:=1;
0321 for i:=1 to x do Erg:=Erg*2;
0322 Pot2:=Erg;
0323 end;
0324 end;
0325
0326 {----------------------- Erzeugung eines Zeilenvektors aus einem Schlüsselbuchstaben }
0327
0328 procedure Mzeile(Var Zeile:vektor;Bu:byte);
0329
0330 Var
0331 i:integer;
0332 By:real;
0333 hiz:vektor;
0334
0335 begin
0336 by:=ita2_hex[ord(bu)-64];
0337 for i:=8 downto 1 do
0338 begin
0339 if (by/Pot2(i-1)<1) then zeile[9-i]:=0
0340 else begin
0341 zeile[9-i]:=1;
0342 by:=by-Pot2(i-1);
0343 end;
0344 end;
0345 for i:=1 to 5 do
0346 hiz[i]:=zeile[i+3];
0347 for i:=6 to 8 do
0348 hiz[i]:=0;
0349 for i:=1 to 8 do zeile[i]:=zeile[i] xor hiz[i] and 1;
0350 end;
0351
0352 {---------------------------------- Erzeugung der Matrix D1,D2 aus den Spruchschlüssel }
0353
0354 procedure Matrixd (Var mat:slmat;Spsl:string10);
0355
0356 Var
0357 i,j:integer;
0358 bu:byte;
0359 zeile:vektor;
0360
0361 begin
0362 for i:=1 to 10 do
0363 begin
0364 bu:=byte(spsl[i]);
0365 mzeile(zeile,bu);
0366 for j:=1 to 8 do mat[i,j]:=zeile[j];
0367 end;
0368 for i:=11 to 16 do
0369 begin
0370 bu:=byte(spsl[i-10]);
0371 mzeile(zeile,bu);
0372 for j:=1 to 8 do mat[i,j]:=zeile[j];
0373 end;
0374 end;
0375
0376 {------------------------------------- Erzeugung der zwei Matrizen MtxD1,MtxD2 }
0377
0378 procedure GenMatx (var MTXD1,MTXD2:slmat;DK1,DK2:string10);
0379
0380 begin
0381 matrixd(mtxd1,dk1);
0382 matrixd(mtxd2,dk2);
0383 end;
0384
0385 {--------------------------------------- Initialisierung Registersatz D }
0386
0387 procedure InitRegSatzD (Var rset:regsatz;mtx:slmat);
0388
0389 Var
0390 i,j:integer;
0391
0392 begin
0393 for i:=1 to 8 do
0394 begin
0395 rset[i,1]:=1;
0396 for j:=1 to 10 do rset[i,j+1]:=mtx[j,9-i];
0397 for j:=1 to 10 do rset[i,j+11]:=mtx[j,9-i];
0398 for j:=1 to 10 do rset[i,j+21]:=mtx[j,9-i];
0399 end;
0400 end;
0401
0402 {------------------------------ Initialisieren der zwei Registersätze }
0403
0404 procedure GenReg;
0405
0406 Var
0407 i:integer;
0408
0409 begin
0410 InitRegSatzD(RD1,MTXD1);
0411 InitRegSatzD(RD2,MTXD2);
0412 end;
0413
0414 {----------------------------------- Erzeugung eines Gamma pro Takt }
0415
0416 procedure Gamma (Var Gamma:byte;vek:vektor;zt:byte);
0417
0418 begin
0419 Gamma:=vek[8] xor zt;
0420 end;
0421
0422 {------------------------------------- Erzeugung zt:=Summe(ci(t-1)) }
0423
0424 procedure Elmzt (Var zt:byte;vek:vektor);
0425
0426 Var i:integer;
0427
0428 begin
0429 zt:=0;
0430 for i:=1 to 8 do
0431 zt:=zt xor vek[i];
0432 end;
0433
0434 {---------------------------------- Konvertierung eines hex-Byte in 8 0,1-Byte }
0435
0436 procedure Konv(var Feld:vektor;b:byte);
0437
0438 Var
0439 i,y:integer;
0440
0441 begin
0442 for i:=1 to 8 do
0443 begin
0444 y:=Pot2(8-i);
0445 if ((b-y)>=0) then begin
0446 b:=b-y;
0447 Feld[i]:=1;
0448 end
0449 else Feld[i]:=0;
0450 end;
0451 end;
0452
0453 {----------------------------------- Erzeugung des Ergebnisbytes RESBYT=(d7,…,d1,gt) }
0454
0455 procedure Result (Var Resbyt:byte;D1,D2:vektor;gt:byte);
0456
0457 Var
0458 i:integer;
0459 hv:vektor;
0460
0461 begin
0462 resbyt:=0;
0463 for i:=1 to 7 do hv[i]:=D1[8-i] xor D2[8-i];
0464 hv[8]:=gt;
0465 for i:=8 downto 1 do Resbyt:=Resbyt+hv[i]*Pot2(8-i);
0466 end;
0467
0468 {-------------------------------- Erzeugung des Ergebnisbytes RESBYTED1=(d11,d12,…,d17,Flag) }
0469
0470 procedure ResD1(Var Byte:byte;Flag:boolean);
0471
0472 Var
0473 i:integer;
0474 hv:vektor;
0475
0476 begin
0477 byte:=0;
0478 for i:=1 to 7 do hv[i]:=D1[8-i];
0479 if Flag then hv[8]:=1 else hv[8]:=0;
0480 for i:=8 downto 1 do byte:=byte+hv[i]*Pot2(8-i);
0481 end;
0482
0483 {------------------------------- Textgenerierung GT mit Syntaxtest und Spruchschlüsselübergabe }
0484
0485 procedure GenText(Var Spruchschl:string10;
0486 Var Gtext:gtfeld;
0487 Var ok:boolean;
0488 Var lg:word;
0489 Var Gtdatei:bytefile;Gtname:string8);
0490
0491 Var
0492 Err_kenna,Err_spsl:boolean;
0493 zeichen:byte;
0494 za,zs,i,j:integer;
0495
0496 Const
0497 kenna:string[5]='HHHHH';
0498
0499 begin
0500 spruchschl:='';
0501 assign(Gtdatei,gtname);
0502 reset(gtdatei);
0503 Err_kenna:=false;Err_spsl:=false;
0504 za:=1;
0505 repeat
0506 read(Gtdatei,zeichen);
0507 if zeichen=byte(kenna[za]) then
0508 repeat
0509 za:=za+1;
0510 read(Gtdatei,zeichen);
0511 if zeichen<>byte(kenna[za]) then za:=1;
0512 until((za=5) or (za=1));
0513 until ((za=5) or eof(gtdatei));
0514 if eof(gtdatei) then err_kenna:=true;
0515 if not err_kenna then
0516 for i:=1 to 10 do
0517 begin
0518 repeat
0519 read(gtdatei,zeichen);
0520 until ((chr(zeichen) in bu) or eof(gtdatei));
0521 if not eof(gtdatei) then
0522 begin
0523 Spruchschl:=spruchschl+chr(zeichen);
0524 j:=0;
0525 repeat
0526 j:=j+1;
0527 repeat
0528 read(gtdatei,zeichen);
0529 until ((chr(zeichen) in bu) or eof(gtdatei));
0530 if ((chr(zeichen)<>spruchschl[i]) or eof(gtdatei))
0531 then Err_spsl:=true;
0532 until ((j=2) or eof(gtdatei));
0533 end;
0534 end;
0535 if eof(gtdatei) then ok:=false; { kein Geheimtext }
0536 if err_kenna then writeln('Kennung ',kenna,'nicht gefunden!');
0537 if err_spsl then writeln('Spruchschlüssel nicht gefunden!');
0538 if (err_kenna or err_spsl) then begin
0539 delay(4000);
0540 ok:=false;
0541 exit;
0542 end;
0543 i:=0;
0544 repeat
0545 repeat
0546 read(gtdatei,zeichen);
0547 until((chr(zeichen) in bu) or eof(gtdatei));
0548 if not eof(gtdatei) then begin
0549 i:=i+1;
0550 gtext[i]:=zeichen;
0551 end;
0552 until (eof(gtdatei) or (i=imax));
0553 repeat
0554 if gtext[i]=89 then i:=i-1;
0555 until gtext[i]<>89;
0556 lg:=i;
0557 close(gtdatei);
0558 end;
0559
0560 {----------------------------------------- Int-Funktion mit integer-Variablen }
0561
0562 function Ganz(x:integer;d:integer):integer;
0563
0564 Var
0565 y:integer;
0566
0567 begin
0568 y:=0;
0569 repeat
0570 if (x-d)>=0 then y:=y+1;
0571 x:=x-d;
0572 until x<0;
0573 Ganz:=y;
0574 end;
0575
0576 {------------------------------------------------- Substitution in ITA 2-2eichen }
0577
0578 procedure Substitute(Var gts:byte;gtsn:byte;Var Flag:boolean);
0579
0580 Var
0581 i:integer;
0582 ok:boolean;
0583
0584 begin
0585 flag:=false;ok:=false;
0586 if gts=89 then begin
0587 gts:=gtsn;
0588 case gts of
0589 {S} 83: gts:=ita2_hex[25];
0590 {K} 75: gts:=steuerkomb_hex[6];
0591 {J} 74: gts:=steuerkomb_hex[5];
0592 {H} 72: gts:=steuerkomb_hex[3];
0593 {O} 79: gts:=steuerkomb_hex[2];
0594 {L} 76: gts:=steuerkomb_hex[4];
0595 {T} 84: gts:=steuerkomb_hex[1];
0596 end;
0597 flag:=true;
0598 end
0599 else
0600 begin
0601 i:=0;
0602 repeat
0603 i:=i+1;
0604 if gts=byte(ita2_bu[i]) then begin
0605 gts:=ita2_hex[i];
0606 ok:=true;
0607 end;
0608 until ((i=26) or ok);
0609 if not ok then gts:=$00; { undef. Element }
0610 end;
0611 end;
0612
0613 {************************ Beginn Prozedur WORKPAAR ************************* }
0614
0615 begin
0616 imax:=max_Feld_lg;zt1:=0;zt2:=0;
0617 strsp1:='';strsp2:='';
0618 str(p1:2,no1);str(p2:2,no2);
0619 doppelpkt:=':';
0620 stelle:=pos(doppelpkt,gtname);
0621 if stelle=0 then gtname:=copy(gtname,1,6)
0622 else gtname:=copy(gtname,1,8);
0623 if no1[1]=' ' then no1:='0'+copy(no1,2,1);
0624 if no2[1]=' ' then no2:='0'+copy(no2,2,1);
0625 gt1name:=gtname+no1;gt2name:=gtname+no2;
0626 GenText(Strsp1,Gt1,tok,Lgt1,GtDat1,Gt1name);
0627 ok:=tok;
0628 if not tok then begin writeln('Textfehler Text1!');delay(2000);exit;end;
0629 GenText(Strsp2,Gt2,tok,Lgt2,GtDat2,Gt2name);
0630 ok:=ok and tok;
0631 if not tok then begin writeln('Textfehler Text2!');delay(2000);exit;end;
0632 ti1:=lgt1*bitvar;ti2:=lgt2*bitvar;
0633 write(lst,P1:2,',',p2:2,' ',strsp1,' ', strsp2,' ',lgt1:4,' ',lgt2:4,' ',ti1:5,' ',ti2:5,' ');
0634 GenMatx(mtxd1,Mtxd2,strsp1,strsp2);
0635 GenReg;
0636 if lgt1>=lgt2 then Verlg:=lgt2 else Verlg:=lgt1;
0637 reslgn:=verlg*bitvar;
0638 resbyte:=lo(reslgn);
0639 resbyted1:=hi(reslgn);
0640 write(AusgFile,resbyte,resbyted1);
0641 write(lst,Verlg:5,' ');
0642 tv:=0;zt1:=0;zt2:=0;
0643 repeat { Vorlauf }
0644 tv:=tv+1;
0645 AllRegVer;
0646 Elmzt(Zt1,D1);
0647 Elmzt(Zt2,D2);
0648 until tv=150;
0649 s:=0;stflag1:=false;stflag2:=false;stflag:=false;
0650 repeat
0651 s:=s+1;
0652 if stflag1 then g1:=$FF else g1:=Gt1[s];
0653 if stflag2 then g2:=$FF else g2:=Gt2[s];
0654 if not stflag1 then substitute(g1,gt1[s+1],stflag1);
0655 if not stflag2 then substitute(g2,gt2[s+1],stflag2);
0656 if ((g1=$FF) or (g2=$FF)) then stflag:=stflag1 or stflag2
0657 else stflag:=false;
0658 for p:=bitvar-1 downto 0 do
0659 begin
0660 gbit1:=g1 and Pot2(p);if gbit1<>0 then gbit1:=1;
0661 gbit2:=g2 and Pot2(p);if gbit2<>0 then gbit2:=1;
0662 t:=t+1;
0663 gotoxy(10,8);
0664 write('t= ',t);
0665 Allregver;
0666 Gamma(gam1,d1,zt1);
0667 Gamma(gam2,d2,zt2);
0668 gt:=gam1 xor gam2 xor gbit1 xor gbit2 and 1;
0669 Elmzt(Zt1,D1);
0670 Elmzt(Zt2,D2);
0671 Result(Resbyte,D1,D2,Gt);
0672 ResD1(ResbyteD1,stflag);
0673 write(AusgFile,Resbyte);
0674 write(Ausgfile,ResbyteD1);
0675 end;
0676 if ((g1=$ff) and stflag1) then stflag1:=false;
0677 if ((g2=$FF) and stflag2) then stflag2:=false;
0678 until ((s=Verlg) or (t>=tmax));
0679 write(lst,t:6);writeln(lst);writeln(lst);
0680 end;
0681
0682 {----------------------------------------------------- Protokollkopf }
0683
0684 procedure protokoll;
0685
0686 var
0687 i,j:integer;
0688 jahr,monat,tag,stunde,min,dayofw,sec,sec100:word;
0689 stelle:integer;
0690 no:string[2];
0691 lmonat,lmin:string[1];
0692
0693 const
0694 doppelpkt:char=':';
0695
0696 begin
0697 writeln(lst); writeln(lst,'*********************************************************************************');
0698 writeln(lst);
0699 writeln(lst,'HORIZONT - statistische Methode, Var "S" - Vers. 3.0 (Geheimtextpaare)');
0700 writeln(lst);
0701 getdate(jahr,monat,tag,dayofw);gettime(stunde,min,sec,sec100);
0702 if monat<10 then lmonat:='0' else lmonat:='';
0703 if min<10 then lmin:='0' else lmin:='';
0704 writeln(lst,' Datum: ',tag,'.',lmonat,monat,'.',jahr);
0705 writeln(lst,' Zeit : ',stunde,'.',lmin,min,' Uhr');
0706 writeln(lst);
0707 writeln(lst,'================================= PROTOKOLL =====================================');
0708 writeln(lst);
0709 writeln(lst,' Anzahl Geheimtexte: ',Anzgt);
0710 write(lst,' Geheimtextdateien : ');
0711 for i:=1 to anzgt do begin
0712 stelle:=pos(doppelpkt,gtname);
0713 if Stelle=0 then gtname:=copy(gtname,1,6)
0714 else gtname:=copy(gtname,1,8);
0715 str(i:2,no);
0716 if no[1]=' ' then no:='0'+copy(no,2,1);
0717 gtname:=gtname+no;
0718 write(lst,gtname);
0719 writeln(lst);
0720 write(lst,' ');
0721 end;
0722 writeln(lst);
0723 writeln(lst);
0724 writeln(lst,' Tmax: ',tmax);
0725 writeln(lst,' Bitvariante: ',bitvar);
0726 writeln(lst,' Ausgabedatei: ',resname);
0727 writeln(lst);writeln(lst);
0728 writeln(lst,'Paar Sp-schl1 Sp-schl2 Textlänge Anzahl Bit Verarb.-Lg Takte T');
0729 writeln(lst,' Txt1 Txt2 Txt1 Txt2 in Zeichen gesamt ');
0730 writeln(lst,'---------------------------------------------------------------------------------');
0731 writeln(lst);
0732 end;
0733
0734 {------------------------------------------------ Programmstart des Arbeitsprogramms }
0735
0736 procedure Progstart;
0737
0738 Var
0739 stunde,min,sec,sec100:word;
0740 lmin:string[1];
0741
0742 begin
0743 window(20,12,60,22);
0744 textbackground(lightgray);
0745 textcolor(black);
0746 clrscr;
0747 gotoxy(10,2);
0748 write('Programm läuft !!!');
0749 protokoll;
0750 gotoxy(10,4);
0751 write('Tmax= ',tmax);
0752 assign(Ausgfile,resname);
0753 rewrite(Ausgfile);
0754 p1:=0;t:=0;
0755 repeat
0756 p1:=p1+1;p2:=p1;
0757 repeat
0758 p2:=p2+1;ok:=false;
0759 gotoxy(10,6);
0760 write('Paar ',p1,',',p2,' ');
0761 workpaar(t,p1,p2,gtname,ok);
0762 if not ok then begin
0763 writeln('Laufzeitfehler bei Paar ',p1,',',p2,'!');
0764 delay(2000);
0765 writeln(lst);
0766 writeln(lst,'Laufzeitfehler bei Paar ',p1,',',p2,'!');
0767 exit;
0768 end;
0769 until ((p2=Anzgt) or (t>=tmax));
0770 until ((p1=Anzgt-1) or (t>=tmax));
0771 close(AusgFile);
0772 gettime(stunde,min,sec,sec100);
0773 if min<10 then lmin:='0' else lmin:='';
0774 write(lst,'====================== Ende=================',stunde:2,'.',lmin,min,' Uhr ===');
0775 writeln(lst);writeln(lst);
0776 gotoxy(9,10);writeln('ENDE ! ( Tastendruck )');taste:=readkey;
0777 textcolor(lightgray);
0778 textbackground(black);
0779 window(1,1,80,25);
0780 end;
0781
0782 {------------------------------------------------- Namen der Ausgabefiles }
0783
0784 procedure AusgNamen(Var Resname:zeile60);
0785
0786 begin
0787 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0788 Ausok:=false;
0789 window(10,7,65,12);
0790 textbackground(lightgray);
0791 textcolor(black);
0792 clrscr;
0793 gotoxy(5,wherey+1);
0794 write('Dateiname für Daten: ');
0795 einzeil(ResName,ResName,Dateibez,16,wherex,wherey);
0796 window(1,1,80,25);
0797 textbackground(black);
0798 textcolor(lightgray);
0799 clrscr;
0800 Ausok:=true;
0801 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0802 end;
0803
0804 {----------------------------------------------------------- Hauptmenü }
0805
0806 procedure Menue;
0807
0808 begin
0809 clrscr;
0810 writeln('*********************************************************************************');
0811 gotoxy(7,3);
0812 writeln('HORIZONT - statistische Methode: Erzeugung der Testdaten');
0813 gotoxy(18,4);
0814 writeln('Programm "HzVarS"-Vers 3.0 (Geheimtextpaare) ');
0815 gotoxy(1,6);
0816 writeln('*********************************************************************************');
0817 gotoxy(20,8);
0818 writeln('F1: Eingaben');
0819 gotoxy(20,9);
0820 writeln('F2: Ausgaben');
0821 gotoxy(20,10);
0822 writeln('F3: Programmstart');
0823 gotoxy(20,11);
0824 write('F1O: Programmende');
0825 end;
0826
0827 {****************************************************************************
0828 H A U P T P R O G R A M M
0829 *****************************************************************************}
0830
0831 begin
0832 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0833 Ende:=false;
0834 Ausok:=false;
0835 Einok:=false;
0836 Gtname:=' ';
0837 Resname:=' ';Ok:=true;Tmax:=0;BitVar:=5;
0838 Anzgt:=0;
0839 repeat
0840 Menue;
0841 Taste:=readkey;
0842 Taste:=readkey; case Taste of
0843 #59: Eingaben;
0844 #60: AusgNamen(ResName);
0845 #61: ProgStart;
0846 #68: ende:=true;
0847 end;
0848 until ende;
0849 textcolor(black);textbackground(lightgray);
0850 gotoxy(20,15);
0851 write('P r o g r a m m e n d e ! ! !');
0852 textcolor(lightgray);
0853 textbackground(black);
0854 end.
0001 { HORIZONT - Vers 3.0: Programm zur Erzeugung von max longint Bit, gewonnen aus
0002 AnzGt Geheimtexten. die zu Paaren kombiniert werden
0003 Erzeugt werden: - alle AnzGt Matrizen P in einer Datei
0004 - num. Ergebnisdateien mit Kennung der
0005 Resultate:Feld des Paares n.m:
0006 FF,FF,n,m,(bytel),(byte2) }
0007
0008 program HzStatV3;
0009
0010 uses crt, dos, printer;
0011
0012 Type
0013 Bytefile=file of Byte; { Ausgabefile für Res-Daten }
0014 Matrix=array[0..7, 0..15] of byte; { eine Matrix P }
0015 Matrixfeld=array[1..20] of Matrix; { Feld der P-Matrizen }
0016 zeile60=string[60];
0017 menge=set of char;
0018 string8=string[8];
0019 Feld5=array[1..5] of byte;
0020 Feld3=array[1..31] of byte;
0021 mm=set of char;
0022
0023 Var
0024 BitVar:integer; { Bitvariante }
0025 t,tmax:longint; { Taktzähler und obere Taktgrenze }
0026 AnzGt:integer; { Anzahl der zu kombinierenden Gt }
0027 p1,p2:shortint; { Nr. des jeweiligen Paares }
0028 gtname,resname:zeile60; { Namen der Gt-Eingabe/Resultatsdateien }
0029 Gtfile:bytefile; { File der Geheimtexte }
0030 mtxp1,mtxp2:matrix; { Matrizen P eines Paares }
0031 MtxName:zeile60; { Name der Datei der P-Matrizen }
0032 l,i,j :integer;
0033 Skmat:matrix; { Strukturschlüssel }
0034 SkName:zeile60; { Dateiname des Strukturschlüssels }
0035 Skfile:bytefile; { Strukturschlüsseldatei }
0036 AusgFile:bytefile; { File der erzeugten Daten }
0037 Mpfile:bytefile; { File der Matrizen P }
0038 Mpfeld:matrixfeld; { Feld der Matrizen P }
0039 einok,ausok,ende,ok:boolean; { Prüfvariable }
0040 Taste:char;
0041
0042 Const
0043 Dateibez:menge=['A'..'Z','a'..'z', '?', '*', ':', ':', '0'..'9'];
0044 Bvz:menge=['5','7'];
0045 Bu:set of byte=[65..90,97..122];
0046 max_Feld_lg:integer=4000; {3000}
0047
0048 procedure einzeil(var st:zeile60; tex:zeile60; m:mm; l,ze,sp:integer);
0049 const s:set of byte=[8,75,77];
0050 var i:integer;
0051 ta:string[2];
0052 c:char;
0053
0054 procedure cure;
0055 begin
0056 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0057 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
0058 end;
0059
0060 procedure culi;
0061 begin
0062 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0063 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
0064 end;
0065
0066 begin
0067 st:='';
0068 for i:=1 to l do st:=st+' ';
0069 for i:=1 to length(tex) do st[i]:=tex[i];
0070 i:=1;gotoxy(ze,sp);write(tex);
0071 repeat
0072 gotoxy(ze+i-1,sp);
0073 c:=readkey;
0074 case c in m of
0075 true: ta:=c;
0076 false: case ord(c) in s of
0077 true: ta:=chr(27)+c;
0078 false: case ord(c) of
0079 0: begin c:=readkey;
0080 if ord(c) in s then ta:=chr(27)+c
0081 else ta:='' end
0082 else ta:=''
0083 end;
0084 end;
0085 end;
0086 if ta<>'' then
0087 begin
0088 if ta[1]<>chr(27) then begin write(c);st[i]:=c;
0089 if i<l then i:=i+1 else culi
0090 end else
0091 case ord(ta[2]) of
0092 8: if i>1 then begin st[i]:=' '; i:=i-1; st[i]:=' ';
0093 culi; write(' '); culi; culi
0094 end;
0095 75: if i>1 then begin i:=i-1; culi end;
0096 77: if i<l then begin i:=i+1; cure end;
0097 end;
0098 end;
0099 until c=chr(13);
0100 i:=l+1;
0101 repeat
0102 i:=i-1;
0103 until (i=0) or (st[i]<>' ');
0104 if i<>0 then st:=copy(st,1,i)
0105 else st:='';
0106 end;
0107
0108 {############################# EINGABEN ##################################}
0109
0110 procedure Eingaben;
0111
0112 type
0113 string128=string[128];
0114
0115 Var
0116 Taste:char;
0117 x,y,i,j,code,stelle:integer;
0118 M01:menge;
0119 Mziff:menge;
0120 vekzeil:zeile60;
0121 ch,Doppelpkt:char;
0122 check,tok,anzok,skok,einok:boolean;
0123 no:string[2];
0124 vek128:string128;
0125
0126 {------------------------------------ Einlesen Strukturschlüsselmatrix }
0127
0128 procedure Skein (Var Mtx:matrix);
0129
0130 Var
0131 i,j:integer;
0132 Filein:file of byte;
0133 Filename:string[13];
0134
0135 begin
0136 gotoxy(20,15);
0137 writeln('Filename SK-Datei:');
0138 read(filename);
0139 assign(filein,filename);
0140 reset(filein);
0141 for i:=0 to 7 do
0142 for j:=0 to 15 do
0143 read(filein,mtx[i,j]);
0144 close(filein);
0145 end;
0146
0147 {----------------------------------------------Übertragung SK }
0148
0149 procedure EingSK(var SK:matrix);
0150
0151 var
0152 i,j:integer;
0153 begin
0154 for i:=0 to 7 do
0155 for j:=0 to 15 do
0156 sk[i,j]:=ord(vek128[i*16+j+1]);
0157 end;
0158
0159 {-------------------------------- Umwandlung Klein- in Großbuchstaben }
0160
0161 procedure grossbu(var Kette:zeile60);
0162
0163 var
0164 i:integer;
0165
0166 begin
0167 for i:=1 to length(Kette) do
0168 Kette[i]:=upcase(Kette[i]);
0169 end;
0170
0171 {------------------------------------- Fehlerausschrift Dateifehler }
0172
0173 procedure Dateifehler(Name:zeile60;x,y:integer);
0174
0175 begin
0176 gotoxy(x,y);
0177 write('Datei "',name,'" existiert nicht! ');
0178 delay(5000);
0179 end;
0180
0181 {-------------------------------Eingaben SK,Bitvar,AnzGt,Name_Gt_Datei,T }
0182
0183 begin
0184 tok:=false;anzok:=false;skok:=false;einok:=false;
0185 M01:=['0','1']; Mziff:=['0'..'9'];
0186 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0187 check:=false;
0188 window(5,7,60,25);
0189 textbackground(lightgray);
0190 textcolor(black);
0191 clrscr;
0192 write('Eingaben: ');
0193 gotoxy(5,wherey+2); x:=wherex; y:=wherey;
0194 repeat
0195 gotoxy(x,y);
0196 write('Anzahl der Geheimtextdateien: ');gotoxy(wherex-1,wherey);
0197 str(anzgt,vekzeil);
0198 einzeil(vekzeil,vekzeil,mziff,2,wherex,wherey);
0199 val(vekzeil,anzgt,code);
0200 if ((anzgt>1) and (anzgt<21)) then anzok:=true;
0201 until anzok=true;
0202 gotoxy(5,wherey+1); x:=wherex; y:=wherey;
0203 Doppelpkt:=':';
0204 repeat
0205 gotoxy(x,y);code:=0;
0206 write('Dateiname der Geheimtextdateien: ');
0207 einzeil(gtname,gtname,Dateibez,14,wherex,wherey);
0208 for i:=1 to anzgt do
0209 begin
0210 stelle:=Pos(Doppelpkt,gtname);
0211 if Stelle=0 then gtname:=copy(gtname,1,6)
0212 else gtname:=copy(gtname,1,8);
0213 str(i:2,no);
0214 if no[1]=' ' then no:='0'+copy(no,2,1);
0215 gtname:=gtname+no;
0216 {$I-} assign(gtfile,gtname);reset(gtfile); {$I+}
0217 code:=code+ioresult;
0218 close(gtfile);
0219 end;
0220 if code<>0 then begin Dateifehler(gtname,x,y);gtname:=' ';end;
0221 until code=0;
0222 gotoxy(1,wherey+2);x:=wherex; y:=wherey;
0223 write('Strukturschllssel: ');
0224 write('Dateiname: ');
0225 einzeil(skname,skname,Dateibez,16,wherex,wherey);
0226 {$I-} assign(Skfile,skname);
0227 reset(Skfile);
0228 code:=ioresult; skok:=false;
0229 if code=0 then begin
0230 for i:=0 to 7 do
0231 for j:=0 to 15 do
0232 read(skfile,Skmat[i,j]);
0233 close(Skfile);
0234 Skok:=true;
0235 end;
0236 gotoxy(20,wherey+1);
0237 write('Strukturmartrix: ');
0238 window(40,13,55,20);
0239 textcolor(lightgray);
0240 textbackground(black);
0241 clrscr;
0242 window(1,1,80,25);
0243 vek128:='';
0244 for i:=0 to 7 do
0245 for j:=0 to 15 do
0246 if skok then vek128:=vek128+chr(skmat[i,j])
0247 else vek128:=vek128+' ';
0248 gotoxy(40,13);x:=wherex; y:=wherey-1;
0249 for i:=1 to 8 do
0250 begin
0251 Y:=Y+1;
0252 vekzeil:=copy(vek128,((i-1)*16)+1,16);
0253 einzeil(vekzeil,vekzeil,M01,16,x,y);
0254 delete(vek128,((i-1)*16)+1,16);
0255 insert(vekzeil,vek128,((i-1)*16)+1);
0256 end;
0257 EingSk(Skmat);
0258 Skok:=true;
0259 assign(Skfile,skname);
0260 rewrite(Skfile);
0261 for i:=0 to 7 do
0262 for j:=0 to 15 do
0263 write(Skfile,skmat[i,j]);
0264 close(skfile);
0265 textcolor(black);textbackground(lightgray);
0266 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0267 gotoxy(5,wherey+1);
0268 write('Anzahl Tmax :');
0269 x:=wherex; y:=wherey;
0270 repeat
0271 str(Tmax,vekzeil);
0272 einzeil(vekzeil, vekzeil,Mziff,6,x,y);
0273 val(vekzeil,Tmax,code);
0274 if Tmax>0 then Tok:=true;
0275 until Tok;
0276 gotoxy(5,wherey+1); x:=wherex; y:=wherey;
0277 repeat
0278 gotoxy(x,y);ch:=chr(BitVar+48);
0279 write('Bitvariante (7/5)? ',ch);gotoxy(wherex-1,wherey);
0280 ch:=readkey;
0281 if ch in bvz then begin write(ch);gotoxy(wherex-1,wherey);
0282 Bitvar:=ord(ch)-48;
0283 end;
0284 until ch=^m;
0285 window(1,1,80,25);write(bitvar);
0286 textcolor(lightgray);textbackground(black);
0287 if (skok and tok and anzok) then einok:=true;
0288 end;
0289
0290 {****************************************************************************
0291 WORKPAAR - Verarbeitung eines Geheimtextpaares (UP des Gesamtprogr.)
0292 *****************************************************************************}
0293
0294 procedure WorkPaar(Var T:longint; { Taktzähler für Bit }
0295 P1,P2:shortint; { Nr des aktuellen Paares. }
0296 GtName:string8; { Name der Gt-Datei ohne Attribut }
0297 Var Mtxpl,Mtxp2:matrix;
0298 Var ok:boolean);
0299
0300 type
0301 slmat=array[1..16,1..8] of byte;
0302 vektor=array[1..8] of byte;
0303 allreg=array[1..31] of byte;
0304 Regsatz=array[1..8] of allreg;
0305 Rcnum=array[1..4] of byte;
0306 RcSatz=array[1..8] of Rcnum;
0307 SlMatrix=array[1..16,1..8] of byte;
0308 string16=string[16];
0309 string10=string[10];
0310 string13=string[13];
0311 string128=string[128];
0312 zeile60=string[60];
0313 menge=set of char;
0314 Gtfeld=array[1..4000] of byte;
0315 Schluessel=array[1..10] of byte;
0316
0317 Var
0318 no1,no2:string[2]; { Paarzähler }
0319 Verlg:integer; { Verarbeitungslänge der Dateien }
0320 Gt1,Gt2:Gtfeld; { Felder für Gt-Dateien }
0321 Anal_gt1,Anal_gt2:Gtfeld; { aufbereitete G-Texte }
0322 Lgt1,Lgt2:integer; { Länge der G-Texte }
0323 Ti,Ti1,Ti2,Timax,s:integer; { Zähler }
0324 imax:integer; { max Feldgröße }
0325 code:integer; { Fehlercode }
0326 i1,i2:integer; { Zähler }
0327 GtDat1,GtDat2:Bytefile; { Files der Geheimtexte }
0328 Sp1,Sp2:Schluessel; { Spruchschlüssel }
0329 Strsp1,Strsp2:string10; { -"- als string }
0330 MtxD1,MtxD2:slmat; { Spruchschlüsselmatrizen }
0331 D1,D2:vektor; { Registerausgänge d1,d2 }
0332 Gam1,Gam2:byte; { Additionseinheiten für DK1,DK2 }
0333 G1,G2,gbit1,gbit2:byte; { Elemente der Geheimtexte G1,G2,Bitdarst }
0334 gt:byte; { gt aus Gleichung 4 }
0335 resbyte:byte; { Byte, das Vektor (dl,d2,…d7,gt) binär darstellt }
0336 resbyted1:byte; { Byte, das Vektor (0,d11,d12,…,d17) binär darstellt }
0337 i,j,stelle,p:integer; { Zähler }
0338 RD1:RegSatz;
0339 RD2:RegSatz;
0340 zt1,zt2:byte; { zt:=Summe(Ci(t-1)) }
0341 Ende,Ein0k,AusOk:boolean; { Prüfvariable bevor Programm startet }
0342 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0343 Taste,doppelpkt:char;
0344 vek128:string128;
0345 Rueck,Alt:zeile60;
0346 gt1name,gt2name:string10; { vollständiger Name Gt-Datei }
0347
0348 const
0349 RC:RcSatz=((28,31,0,0),(27,29,0,0),(25,28,0,0),(22,25,26,27),
0350 (22,25,0,0),(18,23,0,0),(14,17,18,19),(3,31,0,0));
0351 Skok:boolean=true;
0352 Okok:boolean=true;
0353 Dk1ok:boolean=true;
0354 Dk2ok:boolean=true;
0355 Tok:Boolean=true;
0356 Dateibez:menge=['A'..'Z','a'..'z','0'..'9','.','_',' ',':','?'];
0357
0358 {--------------------------------------------------------------------------------------------
0359 Registerverschiebung für beliebige Register mit Rückkopplung rück und dem Ausgang cbit }
0360
0361 procedure regv(var reg:allreg; var cbit:byte; rueck:rcnum);
0362
0363 var
0364 i:integer;
0365 rcbit:byte;
0366 reglaenge:byte;
0367
0368 begin
0369 rcbit:=0;
0370 for i:=1 to 4 do
0371 if rueck[i]<>0 then begin
0372 rcbit:=(rcbit xor reg[rueck[i]]) and 1;
0373 cbit:=rcbit;
0374 reglaenge:=rueck[i];
0375 end;
0376 for i:=reglaenge downto 2 do reg[i]:=reg[i-1];
0377 reg[1]:=rcbit;
0378 end;
0379
0380 {------------------------------------ Registerverschiebung eines Registersatzes }
0381
0382 procedure RegVerSatz(var register:regsatz; rkopp:rcsatz; var abit:vektor);
0383
0384 Var
0385 i:integer;
0386
0387 begin
0388 for i:=1 to 8 do
0389 Regv(register[i],abit[i],rkopp[i]);
0390 end;
0391
0392 {-------------------------------- Registerverschiebung der zwei Registersätze RD1,RD2 }
0393
0394 procedure AllRegVer;
0395
0396 begin
0397 RegVerSatz(RD1,RC,D1);
0398 RegVerSatz(RD2,RC,D2);
0399 end;
0400
0401 {------------------------------------ Funktion 2 hoch x }
0402
0403 Function Pot2(x:integer):integer;
0404
0405 Var
0406 i:integer;
0407 Erg:integer;
0408
0409 begin
0410 if x=0 then pot2:=1
0411 else
0412 begin
0413 Erg:=1;
0414 for i:=1 to x do Erg:=Erg*2;
0415 Pot2:=Erg;
0416 end;
0417 end;
0418
0419 {------------------------------ Erzeugung eines Zeilenvektors aus einem Schlüsselbuchstaben }
0420
0421 procedure Mzeile(Var Zeile:vektor;Bu:byte);
0422
0423 Var
0424 i:integer;
0425 By:byte;
0426 hiz:vektor;
0427
0428 begin
0429 by:=bu-64;
0430 for i:=8 downto 1 do
0431 begin
0432 if (by/Pot2(i-1)<1) then zeile[9-i]:=0
0433 else begin
0434 zeile[9-i]:=1;
0435 by:=by-Pot2(i-1);
0436 end;
0437 end;
0438 for i:=1 to 5 do
0439 hiz[i]:=zeile[i+3];
0440 for i:=6 to 8 do
0441 hiz[i]:=0;
0442 for i:=1 to 8 do
0443 zeile[i]:=zeile[i] xor hiz[i];
0444 end;
0445
0446 {----------------------------------- Erzeugung der Matrix D1,D2 aus den Spruchschlüssel }
0447
0448 procedure MatrixD (Var mat:slmat;Spsl:string10);
0449
0450 Var
0451 i,j:integer;
0452 bu:byte;
0453 zeile:vektor;
0454
0455 begin
0456 for i:=1 to 10 do
0457 begin
0458 bu:=byte(spsl[i]);
0459 mzeile(zeile,bu);
0460 for j:=1 to 8 do mat[i,j]:=zeile[j];
0461 end;
0462 for i:=11 to 16 do
0463 begin
0464 bu:=byte(spsl[i-10]);
0465 mzeile(zeile,bu);
0466 for j:=1 to 8 do mat[i,j]:=zeile[j];
0467 end;
0468 end;
0469
0470 {--------------------------------------- Erzeugung der zwei Matrizen MTXD1,MTXD2 }
0471
0472 procedure GenMatx (var MTXD1,MTXD2:slmat; DK1,DK2:string10);
0473
0474 begin
0475 matrixd(mtxd1,dk1);
0476 matrixd(mtxd2,dk2);
0477 end;
0478
0479 {------------------------------------------------- Initialisierung Registersatz D }
0480
0481 procedure InitRegSatzD (Var rset:regsatz; mtx:slmat);
0482
0483 Var
0484 i,j:integer;
0485
0486 begin
0487 for i:=1 to 8 do
0488 begin
0489 rset[i,1]:=1;
0490 for j:=1 to 10 do rset[i,j+1]:=mtx[j,9-i];
0491 for j:=1 to 10 do rset[i,j+11]:=mtx[j,9-i];
0492 for j:=1 to 10 do rset[i,j+21]:=mtx[j,9-i];
0493 end;
0494 end;
0495
0496 {---------------------------------- Initialisieren aller zwei Registersätze }
0497
0498 procedure GenReg;
0499
0500 Var
0501 i:integer;
0502
0503 begin
0504 InitRegSatzD(RD1,MTXD1);
0505 InitRegSatzD(RD2,MTXD2);
0506 end;
0507
0508 {------------------------------------------- Generieren einer Matrix P }
0509
0510 procedure GenMtxP (Var SPMat:matrix; SKMat:matrix; DkMat:slmat);
0511
0512 Var
0513 i,j,Anz1:integer;
0514
0515 begin
0516 Anz1:=0;
0517 for i:=0 to 7 do
0518 for j:=0 to 15 do
0519 begin
0520 SPMat[i,j]:=(ord(SkMat[i,j])-48) xor DKMat[j+1,8-i];
0521 Anz1:=Anz1+SPMat[i,j];
0522 end;
0523 if ((Anz1/2)=int(Anz1/2)) then SPMat[7,15]:=SPMat[7,15] xor 1;
0524 end;
0525
0526 { gestichen !!
0527 ------------------------ Auswahl eines Matrixelementes bezüglich eines Vektors (y1..y81)
0528
0529 procedure ElmPij (Var el:bvte; mtxp:matrix; vek:vektor);
0530
0531 var
0532 i,zeile,spalte:integer;
0533
0534 begin
0535 zei1e:=0; spalte:=0;
0536 for i:=1 to 4 do spalte:=spalte+veik[i]*Pot2(i-1);
0537 for i:=5 to 7 do zeile:=zeile+vek[i]*Pot2(i-5);
0538 el:=mtxp[zeile,spalte];
0539 end;
0540
0541 ->gestichen }
0542
0543
0544 {------------------------------------------ Erzeugung eines Gamma pro Takt }
0545
0546 procedure Gamma (Var Gamma:byte; vek:vektor; zt:byte); { (Var Gamma:byte;mtxp:matrix;vek:vektor;zt:byte); }
0547
0548 Var
0549 Pij:byte;
0550
0551 begin
0552 { gestrichen
0553 ElmPij(Pij,mtxp,vek);
0554 Gamma:=Pij xor vek[8];
0555 Gamma:=Gamma xor zt;
0556 }
0557
0558 Gamma := vek[8] xor zt;
0559 end;
0560
0561 {------------------------------ Erzeugung zt:=Summe(ci(t-1)) }
0562
0563 procedure Elmzt (Var zt:byte;vek:vektor);
0564
0565 Var
0566 i:integer;
0567
0568 begin
0569 zt:=0;
0570 for i:=1 to 8 do
0571 zt:=zt xor vek[i];
0572 end;
0573
0574 {------------------------------------------------------------- Erzeugung gt (Gleichung 4) }
0575
0576 procedure TxtAdd (Var gt:byte; gam1,gam2,g1,g2:byte);
0577
0578 Var
0579 i:integer;
0580
0581 begin
0582 gt:=gam1 xor g1 xor gam2 xor g2;
0583 gt:=gt and 1;
0584 end;
0585
0586 {------------------------------------------------- Erzeugung des Ergebnisbytes RESBYT=(d7,…,d1,gt) }
0587
0588 procedure Result (Var Resbyt:byte; D1,D2:vektor; gt:byte);
0589
0590 Var
0591 i:integer;
0592 hv:vektor;
0593
0594 begin
0595 resbyt:=0;
0596 for i:=1 to 7 do hv[i]:=D1[8-i] xor D2[8-i];
0597 hv[8]:=gt;
0598 for i:=8 downto 1 do Resbyt:=Resbyt+hv[i]*Pot2(8-i);
0599 end;
0600
0601 {------------------------------------------- Erzeugung des Ergebnisbytes RESBYTED1=(0,d11,d12,…,d17) }
0602
0603 procedure ResD1(Var Byte:byte);
0604
0605 Var
0606 i:integer;
0607 hv:vektor;
0608
0609 begin
0610 byte:=0;
0611 hv[1]:=0;
0612 for i:=1 to 7 do hv[i+1]:=D1[8-i];
0613 for i:=8 downto 1 do byte:=byte+hv[i]*Pot2(8-i);
0614 end;
0615
0616 {----------------------- Textanalyse der GT mit Syntaxtest und Spruchschlüsselübergabe }
0617
0618 procedure Textanalyse(Var Lg_Text:integer;
0619 Var Spruchschl:string10;
0620 Gtext:gtfeld; Lg_GDatei:integer;
0621 Var Anal_Gt:gtfeld;
0622 Var Anz_Bit:integer;
0623 Var ok:boolean);
0624
0625 procedure Such_Str(Var Pos:integer;Su_Begr:string10;
0626 Feld:gtfeld;Lg_Feld:integer);
0627
0628 Var
0629 i,j:integer;
0630 Su_Feld:array[1..10] of byte;
0631 gefunden,ok:boolean;
0632
0633 begin
0634 gefunden:=false;ok:=false;
0635 for i:=1 to length(Su_Begr) do Su_Feld[i]:=ord(Su_Begr[i]);
0636 i:=Pos-1;
0637 repeat
0638 i:=i+1;
0639 if Feld[i]=Su_Feld[1] then begin
0640 gefunden:=true;
0641 for j:=1 to length(Su_Begr) do
0642 begin
0643 if Feld[i-1+j]=Su_Feld[j] then ok:=true
0644 else ok:=false;
0645 gefunden:=gefunden and ok;
0646 end;
0647 end;
0648 until (gefunden or (i=lg_Feld-length(Su_Begr)+1));
0649 if gefunden then Pos:=i
0650 else Pos:=0;
0651 end;
0652
0653
0654 procedure Txt_Anal_5Bit;
0655
0656 Var
0657 Pos,i,j,l,Pos_Sp,Pos_Gt,Pos_end:integer;
0658 el,vorgaenger:byte;
0659 Err_Kenna,Err_Kenne,Err_Spsl,gleich:boolean;
0660
0661 const
0662 Kenna:string[5]='ZSYNZ';
0663 Kenne:string[5]='ZENDZ';
0664 Sub_Menge:set of byte=[65..80];
0665
0666 begin
0667 Err_Kenna:=false;
0668 Err_Kenne:=false;
0669 Err_Spsl:=false;
0670 Pos:=1;
0671 Such_str(pos,kenna,Gtext,lg_gdatei);
0672 if Pos<>0 then Pos_Sp:=Pos+length(kenna)+10 { wegen Gr 'APQAP QAPQG'}
0673 else Err_Kenna:=true;
0674 Such_str(Pos,kenne,gtext,lg_gdatei);
0675 if Pos<>0 then Pos_end:=pos-1
0676 else Err_Kenne:=true;
0677 Spruchschl:='';
0678 for i:=Pos_sp to Pos_sp+9 do Spruchschl:=Spruchschl+char(gtext[i]); { [i-pos_sp+1]:=char(gtext[i]); }
0679 Pos_sp:=i+1;
0680 Such_Str(Pos_sp,Spruchschl,Gtext,lg_gdatei);
0681 if pos<>0 then Pos_sp:=pos_sp+10
0682 else Err_spsl:=true;
0683 Such_Str(pos_sp,Spruchschl,Gtext,lg_gdatei);
0684 if pos<>0 then Pos_gt:=pos_sp+10
0685 else Err_spsl:=true;
0686 if err_kenna then writeln('Kennung ',kenna,'nicht gefunden!');
0687 if err_kenne then writeln('Kennung ',kenne,'nicht gefunden!');
0688 if err_spsl then writeln('Spruchschlüssel nicht gefunden!');
0689 if (err_kenna or err_kenne or err_spsl) then begin
0690 delay(4000);
0691 ok:=false;
0692 exit;
0693 end;
0694 vorgaenger:=gtext[pos_gt];
0695 i:=pos_gt-1;
0696 l:=0;
0697 repeat
0698 i:=i+1;
0699 el:=gtext[i];
0700 l:=l+1;
0701 if el=90 then begin
0702 if ((vorgaenger=67) or (vorgaenger=70)) then el:=vorgaenger;
0703 if vorgaenger in sub_menge then
0704 begin
0705 if i>pos_gt+2 then
0706 for j:=1 to 3 do if vorgaenger=anal_gt[i-j]
0707 then gleich:=true
0708 else gleich:=false;
0709 if gleich then el:=vorgaenger;
0710 end;
0711 end;
0712 Anal_gt[i-Pos_gt+1]:=el;
0713 until i=Pos_end;
0714 lg_text:=1;
0715 Anz_bit:=5*1;
0716 end;
0717
0718 procedure Txt_Anal_7Bit;
0719
0720 Var
0721 Pos,i,l:integer;
0722 el:byte;
0723 Pos_Sp,Pos_gt,Pos_End:integer;
0724 Err_Kenna,Err_Kenne,Err_Spsl,gleich:boolean;
0725
0726 const
0727 Kenna:string[5]='SYNCB';
0728 Kenne:string[5]='ENDSY';
0729
0730 begin
0731 Err_kenna:=false;
0732 Err_kenne:=false;
0733 Err_spsl:=false;
0734 Pos:=1;
0735 Such_str(Pos,kenna,gtext,lg_gdatei);
0736 if Pos<>0 then Pos_sp:=pos+length(kenna)
0737 else Err_kenna:=true;
0738 Such_str(pos,kenne,gtext,lg_gdatei);
0739 if Pos<>0 then Pos_end:=pos-1
0740 else Err_kenne:=true;
0741 spruchschl:='';
0742 for i:=Pos_sp to Pos_sp+9 do
0743 spruchschl:=spruchschl+char(gtext[i]);
0744 Pos_sp:=i+1;
0745 Such_str(Pos_sp,Spruchschl,gtext,lg_gdatei);
0746 if Pos<>0 then Pos_sp:=Pos_sp+10
0747 else Err_spsl:=true;
0748 Such_str(Pos_sp,spruchschl,gtext,lg_gdatei);
0749 if Pos<>0 then Pos_gt:=pos_sp+10
0750 else Err_spsl:=true;
0751 if Err_kenna then writeln('Kennung ',kenna,'nicht gefunden!');
0752 if Err_kenne then writeln('Kennung ',kenne,'nicht gefunden!');
0753 if Err_spsl then writeln('Spruchschlüssel nicht identifizierbar!');
0754 if (err_kenna or err_kenne or err_spsl) then begin
0755 delay(2000);
0756 ok:=false;
0757 exit;
0758 end;
0759 l:=0;i:=pos_gt-1;
0760 repeat
0761 i:=i+1;
0762 el:=gtext[i];
0763 l:=1+1;
0764 Anal_gt[i-pos_gt+1]:=el;
0765 until i=pos_end;
0766 lg_text:=1;
0767 Anz_bit:=7*l;
0768 end;
0769
0770
0771 begin
0772 case BitVar of
0773 5:Txt_Anal_5Bit;
0774 7:Txt_Anal_7Bit;
0775 end;
0776 end;
0777
0778 {--------------------------------------- Konvertierung 5-Bit-Variante von FELD }
0779
0780 procedure KonvFeld5(Var Feld:Feld5);
0781
0782 Var
0783 vop:byte;
0784 i:integer;
0785
0786 begin
0787 for i:=1 to 5 do Feld[i]:=ord(Feld[i])-65;
0788 for i:=1 to 4 do
0789 begin
0790 vop:=Feld[5] and 1;
0791 Feld[i]:=Feld[i] shl 1;
0792 Feld[i]:=Feld[i] xor vop;
0793 Feld[5]:=Feld[5] shr 1;
0794 end;
0795 end;
0796
0797 {----------------------------------------- Int-Funktion mit integer-Variablen }
0798
0799 function Ganz(x:integer;d:integer):integer;
0800
0801 Var
0802 y:integer;
0803
0804 begin
0805 y:=0;
0806 repeat
0807 if (x-d)>=0 then y:=y+1;
0808 x:=x-d;
0809 until x<0;
0810 Ganz:=y;
0811 end;
0812
0813 {----------------------------------------- Konvertierung 7-Bit-Variante von FELD }
0814
0815 procedure KonvFeld7(Var Feld:Feld3);
0816
0817 Var
0818 x,y,z:integer; ch:char;
0819
0820 begin
0821 x:=ord(Feld[3])-65;
0822 y:=Ganz(x,5);
0823 z:=x-y*5;
0824 Feld[1]:=ord(Feld[1])-65+z*26;
0825 Feld[2]:=ord(Feld[2])-65+y*26;
0826 end;
0827
0828 {------------------------------ Konvertierung 5-Bit-Variante des Textfeldes }
0829
0830 procedure Konv5bit(Var Gt:gtfeld;Var Ti:integer;Var si:integer);
0831
0832 Var
0833 i,imax,j:integer;
0834 Feld:Feld5;
0835
0836 begin
0837 imax:=Ganz(si,5);
0838 Ti:=(imax*4)*5;
0839 for i:=0 to imax-1 do
0840 begin
0841 for j:=1 to 5 do Feld[j]:=Gt[i*5+j];
0842 KonvFeld5(Feld);
0843 for j:=1 to 4 do Gt[i*4+j]:=Feld[j];
0844 end;
0845 si:=imax*4;
0846 end;
0847
0848 {---------------------------- Konvertierung 7-Bit-Variante des Textfeldes }
0849
0850 procedure Konv7bit(Var Gt:gtfeld;Var Ti:integer;Var si:integer);
0851
0852 Var
0853 i,imax,j:integer;
0854 Feld:Feld3;
0855
0856 begin
0857 imax:=Ganz(si,3);
0858 Ti:=(imax*2)*7;
0859 for i:=0 to imax-1 do
0860 begin
0861 for j:=1 to 3 do Feld[j]:=Gt[i*3+j];
0862 KonvFeld7(Feld);
0863 for j:=1 to 2 do Gt[i*2+j]:=Feld[j];
0864 end;
0865 si:=imax*2;
0866 end;
0867
0868 {-------------------------------- Konvertierung eines Bytefeldes je nach BitVar }
0869
0870 procedure Konv(Var Gt:gtfeld; BitVar:integer; Var T1:integer; Var Ti:integer);
0871
0872 begin
0873 case BitVar of
0874 5:Konv5bit(Gt,Ti,T1);
0875 7:Konv7bit(Gt,Ti,T1);
0876 end;
0877 end;
0878
0879 (* Einlesen der Geheimtextdateien *)
0880
0881 procedure Lies(Var Gdatei:Bytefile; Var Gtext:gtfeld; Var lg:integer);
0882
0883 Var
0884 i,j:integer;
0885 zeichen:byte;
0886 Gtend:boolean;
0887
0888 begin
0889 i:=0; Gtend:=false;
0890 repeat
0891 read(Gdatei,zeichen);
0892 if zeichen in Bu then
0893 begin
0894 i:=i+1;
0895 gtext[i]:=zeichen;
0896 end;
0897 until (eof(Gdatei) or (i=imax));
0898 lg:=i;
0899 end;
0900
0901 {************************ Beginn Prozedur WORKPAAR ***************************}
0902
0903 begin
0904 imax:=max_Feld_lg;
0905 zt1:=0; zt2:=0;
0906 strsp1:=''; strsp2:='';
0907 str(p1:2,no1); str(p2:2,no2);
0908 doppelpkt:=':';
0909 stelle:=pos(doppelpkt,gtname);
0910 if stelle=0 then gtname:=copy(gtname,1,6)
0911 else gtname:=copy(gtname,1,8);
0912 if no1[1]=' ' then no1:='0'+copy(no1,2,1);
0913 if no2[1]=' ' then no2:='0'+copy(no2,2,1);
0914 gt1name:=gtname+no1; gt2name:=gtname+no2;
0915 assign(Gtdat1,Gt1name);
0916 assign(Gtdat2,Gt2name);
0917 reset(Gtdat1);
0918 reset(Gtdat2);
0919 Lies(Gtdat1,Gt1,i1);close(gtdat1);
0920 Lies(Gtdat2,Gt2,i2);close(gtdat2);
0921 Textanalyse(Lgt1,strsp1,Gt1,i1,Anal_Gt1,Ti1,tok);
0922 ok:=tok;
0923 if not tok then begin writeln('Textfehler Text1!');delay(2000);exit;end;
0924 Textanalyse(Lgt2,strsp2,Gt2,i2,Anal_Gt2,Ti2,tok);
0925 ok:=ok and tok;
0926 if not tok then begin writeln('Textfehler Text2!');delay(2000);exit;end;
0927 Konv(Anal_Gt1,BitVar,lgt1,Ti1);
0928 Konv(Anal_Gt2,BitVar,lgt2,Ti2);
0929 write(lst,p1:2,',',p2:2,' ',strsp1,' ',strsp2,' ',i1:4,' ',i2:4,' ',ti1:5,' ',ti2:5);
0930 GenMatx(mtxd1,mtxd2,strsp1,strsp2);
0931 GenReg;
0932 if ((p1=1) and (p2=2)) then begin GenMtxP(mtxpl,skmat,mtxd1);
0933 GenMtxp(mtxp2,skmat,mtxd2);
0934 end;
0935 if ((p1=1) and (p2>2)) then GenMtxp(mtxp2,skmat,mtxd2);
0936 Resbyte:=255;
0937 write(AusgFile,resbyte,resbyte);
0938 write(AusgFile,byte(p1),byte(p2));
0939 if lgt1<=lgt2 then Verlg:=lgt1 else Verlg:=lgt2;
0940 write(lst,verlg:5,' ');
0941 s:=0;
0942 repeat
0943 s:=s+1;
0944 g1:=Anal_Gt1[s];
0945 g2:=Anal_Gt2[s];
0946 for p:=BitVar-1 downto 0 do
0947 begin
0948 gbit1:=g1 and Pot2(p);if gbit1<>0 then gbit1:=1;
0949 gbit2:=g2 and Pot2(p);if gbit2<>0 then gbit2:=1;
0950 t:=t+1;
0951 gotoxy(10,8);
0952 write('t= ',t);
0953 Allregver;
0954 { Gamma(gam1,mtxii,d1,zti);
0955 Gamma(gam2,Rtx,p2,d2,zt2); }
0956 Gamma(gam1,d1,zt1);
0957 Gamma(gam2,d2,zt2);
0958 Txtadd(gt,gam1,gam2,gbit1,gbit2);
0959 Elmzt(Zt1,D1);
0960 Elmzt(Zt2,D2);
0961 Result(Resbyte,D1,D2,Gt);
0962 ResD1(ResbyteD1);
0963 write(AusgFile,Resbyte);
0964 write(AusgFile,ResbyteD1);
0965 end;
0966 until ((s=Verlg) or (t>=tmax));
0967 write(lst,t:6);writeln(lst);writeln(lst);
0968 end;
0969
0970 {------------------------------------------------------------Protokollkopf }
0971
0972 procedure protokoll;
0973
0974 var
0975 i,j:integer;
0976 jahr,monat,tag,stunde,min,dayofw,sec,sec100:word;
0977 stelle:integer;
0978 no:string[2];
0979 lmonat,lmin:string[1];
0980
0981 const
0982 doppelpkt:char=':';
0983
0984 begin
0985 writeln(lst);
0986 writeln(lst,'*********************************************************************************');
0987 writeln(lst);
0988 writeln(lst,'HORIZONT - statistische Methode, Vers. 3.0 (Geheimtextpaare)');
0989 writeln(lst);
0990 getdate(jahr,monat,tag,dayofw); gettime(stunde,min,sec,sec100);
0991 if monat<10 then lmonat:='0' else lmonat:='';
0992 if min<10 then lmin:='0' else lmin:='';
0993 writeln(lst,' Datum: ',tag,'.',lmonat,monat,'.', 'Jahr',jahr);
0994 writeln(lst,' Zeit : ',stunde,'.',lmin,min,' Uhr');
0995 writeln(lst);
0996 writeln(lst,'================================= PROTOKOLL =====================================');
0997 writeln(lst);
0998 writeln(lst,' Anzahl Geheimtexte: ',Anzgt);
0999 write(lst,' Geheimtextdateien : ');
1000 for i:=1 to anzgt do begin
1001 stelle:=pos(doppelpkt,gtname);
1002 if Stelle=0 then gtname:=copy(gtname,1,6)
1003 else gtname:=copy(gtname,1,8);
1004 str(i:2,no);
1005 if no[1]=' ' then no:='0'+copy(no,2,1);
1006 gtname:=gtname+no;
1007 write(lst,gtname);
1008 writeln(lst);
1009 write(lst,' ');
1010 end;
1011 writeln(lst);
1012 writeln(lst, ' Sturkturschlüsseldatei : ',skname);
1013 write(lst,' Strukturschlüssel : ');
1014 for i:=0 to 7 do begin
1015 for j:=0 to 15 do write(lst,chr(skmat[i,j]));
1016 writeln(lst);write(lst,' ');
1017 end;
1018 writeln(lst);
1019 writeln(lst,' Tmax: ',tmax);
1020 writeln(lst,' Bitvariante: ',bitvar);
1021 writeln(lst,' Ausgabedatei: ',resname);
1022 writeln(lst,' Matrixdatei: ',mtxname);
1023 writeln(lst);writeln(lst);
1024 writeln(lst,'Paar Sp-schl1 Sp-schl2 Textlänge Anzahl Bit Verarb.-Lo Takte T');
1025 writeln(lst,' Txl Tx2 Txl Tx2');
1026 writeln(lst,'---------------------------------------------------------------------------------');
1027 writeln(lst);
1028 end;
1029
1030 {---------------------------------------------- Programmstart des Arbeitsprogramms }
1031
1032 procedure Progstart;
1033
1034 Var
1035 stunde,min,sec,sec100:word;
1036 lmin:string[1];
1037
1038 begin
1039 protokoll;
1040 window(20,12,60,22);
1041 textbackground(lightgray);
1042 textcolor(black);
1043 clrscr;
1044 gotoxy(10,2);
1045 write('Programm läuft !!!');
1046 gotoxy(10,4);
1047 write('Tmax= ',tmax);
1048 assign(Ausgfile,resname);
1049 rewrite(Ausgfile);
1050 p1:=0;t:=0;
1051 repeat
1052 p1:=p1+1; p2:=p1;
1053 repeat
1054 p2:=p2+1;ok:=false;
1055 gotoxy(10,6);
1056 write('Paar ',p1,',',p2,' ');
1057 workpaar(t,p1,p2,gtname,mpfeld[p1],mpfeld[p2],ok);
1058 if not ok then begin writeln('Laufzeitfehler bei Paar ',p1,',',p2,'!');
1059 delay(2000);
1060 writeln(lst);
1061 writeln(lst,'Laufzeitfehler bei Paar..');
1062 exit;
1063 end;
1064 until ((p2=Anzgt) or (t>=tmax));
1065 until ((p1=Anzgt-1) or (t>=tmax));
1066 close(AusgFile);
1067 assign(mpfile,mtxname);
1068 rewrite(mpfile);
1069 for l:=1 to Anzgt do
1070 for i:=0 to 7 do
1071 for j:=0 to 15 do
1072 write(mpfile,mpfeld[l,i,j]);
1073 close(mpfile);
1074 gettime(stunde,min,sec,sec100);
1075 if min<10 then lmin:='0' else lmin:='';
1076 write(lst,'=================================== Ende =========================',stunde:2,'.',lmin);
1077 writeln(lst);writeln(lst);
1078 gotoxy(9,10);writeln('E N D E ! ! ( Tastendruck )');taste:=readkey;
1079 textcolor(lightgray);
1080 textbackground(black);
1081 window(1,1,80,25);
1082 end;
1083
1084 {-----------------------------------------------------------Namen der Ausgabefiles }
1085
1086 procedure AusgNamen(Var Mtxname:zeile60;
1087 Var Resname:zeile60);
1088
1089 begin
1090 inline($b1/05/$b5/00/$b4/1/$cd/$10);
1091 Ausok:=false;
1092 window(20,7,75,12);
1093 textbackground(lightgray);
1094 textcolor(black);
1095 clrscr;
1096 gotoxy(1,wherey+1);
1097 write('Dateiname für Matrixdatei: ');
1098 einzeil(MtxName,MtxName,Dateibez,16,wherex,wherey);
1099 gotoxy(1,wherey+1);
1100 write('Dateiname für Daten: ');
1101 einzeil(ResName,ResName,Dateibez,16,wherex,wherey);
1102 window(1,1,80,25);
1103 textbackground(black);
1104 textcolor(lightgray);
1105 clrscr;
1106 Ausok:=true;
1107 inline($b1/00/$b5/15/$b4/1/$cd/$10);
1108 end;
1109
1110 {----------------------------------------------------------------------- Hauptmenü }
1111
1112 procedure Menue;
1113 begin
1114 clrscr;
1115 writeln('*********************************************************************************');
1116 gotoxy(7,3);
1117 writeln('HORIZONT - statistische Methode: Erzeugung der Testdaten');
1118 gotoxy(18,4);
1119 writeln('Programm "HzstatV3"-Vers 3.0 (Geheimtextpaare) ');
1120 gotoxy(1,6);
1121 writeln('*********************************************************************************');
1122 gotoxy(20,8);
1123 writeln('F1: Eingaben');
1124 gotoxy(20,9);
1125 writeln('F2: Ausgaben');
1126 gotoxy(20,10);
1127 writeln('F3: Programmstart');
1128 gotoxy(20,11);
1129 write('F10: Programmende');
1130 end;
1131
1132 {*****************************************************************************
1133 HAUPTPROGRAMM
1134 *****************************************************************************}
1135 begin
1136 inline($b1/00/$b5/15/$b4/1/$cd/$10);
1137 Ende:=false;
1138 Ausok:=false;
1139 Einok:=false;
1140 Gtname:=' ';Mtxname:=' ';
1141 Resname:=' ';skname:=' ';ok:=true;Tmax:=0;BitVar:=7;
1142 Anzgt:=0;
1143 repeat
1144 Menue;
1145 Taste:=readkey;
1146 Taste:=readkey;
1147 case Taste of
1148 #59:Eingaben;
1149 #60:AusgNamen(Mtxname,ResName);
1150 #61:ProgStart;
1151 #68:ende:=true;
1152 end;
1153 until ende;
1154 textcolor(black);textbackground(lightgray);
1155 gotoxy(20,15);
1156 write('Programmende! ! !');
1157 textcolor(lightgray);textbackground(black);
1158 end.
0001 { HORIZONT - Variante "S" (13.12.89)
0002 Vers 3.1: Programm zur Erzeugung von max longint Bit, gewonnen aus
0003 AnzGt Geheimtexten, die zu Paaren kombiniert werden,
0004 mit Fortsetzung bei Diskettenwechsel.
0005 Erzeugt werden: - zu jedem Geheimtextpaar ein Abschnitt
0006 mit der Anzahl der Doppel-Byte für
0007 dieses Paar im ersten word
0008 - zu jedem 4.,5.Takt zwei Byte der Form:
0009 (d1, d2, …,d7,g);
0010 (d11, d12,..d17,flag) }
0011
0012 program HzVarS31;
0013
0014 uses crt,dos,printer,windows;
0015
0016 Type
0017 Bytefile=file of Byte; { Ausgabefile für Res-Daten }
0018 zeile60=string[60];
0019 menge=set of char;
0020 string8=string[8];
0021 mm=set of char;
0022
0023 Var
0024 t,tmax:longint; { Taktzähler und obere Taktgrenze }
0025 AnzGt:integer; { Anzahl der zu kombinierenden Gt }
0026 p1,p2:shortint; { Nr des jeweiligen Paares }
0027 gtname,resname:zeile60; { Namen der Gt-Eingabe/Resultatsdateien }
0028 Gtfile:bytefile; { File der Geheimtexte }
0029 l,i,j:integer;
0030 AusgFile:bytefile; { File der erzeugten Daten }
0031 einok,ausok,ende,ok:boolean; { Prüfvariable }
0032 Taste:char;
0033
0034 Const
0035 Dateibez:menge=['A'..'Z','a'..'z','?','*','.',':','0'..'9'];
0036 Bu:set of char=['A'..'Z','a'..'z'];
0037 max_Feld_lg:integer=10000;
0038 Bitvar:integer=5;
0039
0040 {-------------------------------------------------aus Tools }
0041
0042 procedure einzeil(var st:zeile60; tex:zeile60; m:mm; l,ze,sp:integer);
0043 const s:set of byte=[8,75,77];
0044 var i:integer;
0045 ta:string[2];
0046 c:char;
0047
0048 procedure cure;
0049 begin
0050 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0051 inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
0052 end;
0053
0054 procedure culi;
0055 begin
0056 inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21);
0057 inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
0058 end;
0059
0060 begin
0061 st:='';
0062 for i:=1 to l do st:=st+' ';
0063 for i:=1 to length(tex) do st[i]:=tex[i];
0064 i:=1; gotoxy(ze,sp); write(tex);
0065 repeat
0066 gotoxy(ze+i-1,sp);
0067 c:=readkey;
0068 case c in m of
0069 true:ta:=c;
0070 false:case ord(c) in s of
0071 true:ta:=chr(27)+c;
0072 false:case ord(c) of
0073 0:begin c:=readkey;
0074 if ord(c) in s then ta:=chr(27)+c
0075 else ta:='' end
0076 else ta:=''
0077 end;
0078 end;
0079 end;
0080 if ta<>'' then
0081 begin
0082 if ta[1]<>chr(27) then begin write(c);st[1]:=c;
0083 if i<1 then i:=i+1 else culi
0084 end else
0085 case ord(ta[2]) of
0086 8:if i>1 then begin st[i]:=' '; i:=i-1; st[i]:=' ';
0087 culi; write(' ');culi;culi
0088 end;
0089 75:if i>1 then begin i:=i-1;culi end;
0090 77:if i<1 then begin i:=i+1;cure end;
0091 end;
0092 end;
0093 until c=chr(13);
0094 i:=l+1;
0095 repeat
0096 i:=i-1
0097 until (i=0) or (st[i]<>' ');
0098 if i<>0 then st:=copy(st,1,i)
0099 else st:='';
0100 end;
0101
0102 {################################## EINGABEN ##################################}
0103
0104 procedure Eingaben;
0105
0106 type
0107 string128=string[128];
0108
0109 var
0110 Taste:char;
0111 x,y,i,j,code,stelle:integer;
0112 M01:menge;
0113 Mziff:menge;
0114 vekzeil:zeile60;
0115 ch,Doppelpkt:char;
0116 check,tok,anzok,gtok:boolean;
0117 no:string[2];
0118 vek128:string128;
0119
0120 {------------------------------------------Fehlerausschrift für Dateifehler }
0121
0122 procedure Dateifehler(Name:zeile60; x,y:integer);
0123
0124 begin
0125 gotoxy(x,y);
0126 write('Datei "',name,'" existiert nicht! ');
0127 delay(5000);
0128 end;
0129
0130 {----------------------------------------Eingaben Bitvar,AnzGt,Name_Gt_Datei,T }
0131
0132 begin
0133 tok:=false; anzok:=false; gtok:=false;
0134 M01:=['0','1']; Mziff:=['0'..'9'];
0135 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0136
0137 check:=false;
0138 window(5,7,60,16);
0139 textbackground(lightgray);
0140 textcolor(black);
0141 clrscr;
0142 write('Eingaben: ');
0143 gotoxy(5,wherey+2); x:=wherex; y:=wherey;
0144 repeat
0145 gotoxy(x,y);
0146 write('Anzahl der Geheimtextdateien: '); gotoxy(wherex-1,wherey);
0147 str(anzgt,vekzeil);
0148 einzeil(vekzeil,vekzeil,mziff,2,wherex,wherey);
0149 val(vekzeil,anzgt,code);
0150 if ((anzgt>1) and (anzgt<99)) then anzok:=true;
0151 until anzok=true;
0152 gotoxy(5,wherey+1); x:=wherex; y:=wherey;
0153 Doppelpkt:=':';
0154 repeat
0155 gotoxy(x,y); code:=0;
0156 write('Dateiname der Geheimtextdateien: ');
0157 einzeil(gtname,gtname,Dateibez,14,wherex, wherey);
0158 for i:=1 to anzgt do
0159 begin
0160 stelle:=Pos(Doppelpkt,gtname);
0161 if Stelle=0 then gtname:=copy(gtname,1,6)
0162 else gtname:=copy(gtname,1,8);
0163 str(i:2,no);
0164 if no[1]=' ' then no:='0'+copy(no,2,1);
0165 gtname:=gtname+no;
0166 assign(gtfile,gtname);
0167 {$I-} reset(gtfile); {$I+}
0168 code:=code+ioresult;
0169 if code=0 then close(gtfile);
0170 end;
0171 if code<>0 then begin Dateifehler(gtname,x,y);gtname:=' ';end;
0172 until code=0;
0173 gtok:=true;
0174 gotoxy(1,wherey+2); x:=wherex; y:=wherey;
0175 textcolor(black);textbackground(lightgray);
0176 inline($b1/00/05/15/$b4/1/$cd/$10);
0177
0178 gotoxy(5,wherey+1);
0179 write('Anzahl Tmax :');
0180 x:=wherex; y:=wherey;
0181 repeat
0182 str(Tmax,vekzeil);
0183 einzeil(vekzeil,vekzeil,Mziff,6,x,y);
0184 val(vekzeil,Tmax,code);
0185 if Tmax>0 then Tok:=true;
0186 until Tok;
0187 window(1,1,80,25);
0188 textcolor(lightgray); textbackground(black);
0189 if (tok and anzok and gtok) then einok:=true else einok:=false;
0190 end;
0191
0192 {****************************************************************************
0193 WORKPAAR - Verarbeitung eines Geheimtextpaares (UP des Gesamtprogr.)
0194 *****************************************************************************}
0195
0196 procedure WorkPaar(Var T:longint; { Taktzähler für Bit }
0197 P1,P2:shortint; { Nr des aktuellen Paares }
0198 GtName:string8; { Name der Gt-Datei ohne Attribut }
0199 Var ok:boolean);
0200
0201 type
0202 slmat=array[1..16,1..8] of byte;
0203 vektor=array[1..8] of byte;
0204 regtyp=array[1..31] of byte;
0205 string16=string[16];
0206 string10=string[10];
0207 string13=string[13];
0208 string128=string[128];
0209 zeile60=string[60];
0210 menge=set of char;
0211 Gtfeld=array[1..10000] of byte;
0212 Schluessel=array[1..10] of byte;
0213 ITA_Reg=array[1..26] of byte;
0214 ITA_Zei=array[1..26] of char;
0215
0216 Var
0217 no1,no2:string[2]; { Paarzähler }
0218 Verlg:integer; { Verarbeitungslänge der Dateien }
0219 Gt1,Gt2:Gtfeld; { Felder für Gt-Dateien }
0220 Lgt1,Lgt2:word; { Länge der G-Texte }
0221 Tv,ti1,ti2,Timax,s:integer; { Zähler }
0222 imax:integer; { max Feldgröße }
0223 code:integer; { Fehlercode }
0224 GtDat1,GtDat2:Bytefile; { Files der Geheimtexte }
0225 Sp1,Sp2:Schluessel; { Spruchschlüssel }
0226 Strsp1,Strsp2:string10; { --||-- als string }
0227 MtxD1,MtxD2:slmat; { Spruchschlüsselmatrizen }
0228 D1,D2:vektor; { Registerausgänge dl,d2 }
0229 Gam1,Gam2:byte; { Additionseinheiten für DK1,DK2 }
0230 G1,G2,gbit1,gbit2:byte; { Elemente der Geheimtexte G1,G2,Bitdarst }
0231 gt:byte; { gt aus Gleichung 4 }
0232 resbyte:byte; { Byte, das Vektor (d1,d2,……d7,gt) binär darstellt }
0233 resbyted1:byte; { Byte, das Vektor (d11,d12,…,d17,f) binär darstellt }
0234 reslgn:word; { Anzahl der Verarbeitungstakte pro Paar }
0235 i,j,p,stelle:integer; { Zähler }
0236 RD1,RD2:Regtyp;
0237 zt1,zt2:byte; { zt1=Summe(Ci(t-11) }
0238 Ende,EinOk,AusOk:boolean; { Prüfvariable bevor Programm startet }
0239 check:boolean; { mit(=false) und ohne(=true) Längenprüfung von Namen }
0240 Taste,doppelpkt:char;
0241 vek128:string128;
0242 gt1name,gt2name:string10; { vollständiger Name Gt-Datei }
0243 Stflag,stflag1,stflag2:boolean; { Steuerkombination im Gt }
0244
0245 const
0246 maske:regtyp=($14,$73,$A3,$33,$8F,$25,$67,$BD,$16,$B6,$B4,$4C,$0C,$B4,$51,
0247 $90,$6B,$1A,$6B,$09,$E0,$59,$0D,$A8,$18,$E1,$70,$61,$C1,$01,$81);
0248 Okok:boolean=true;
0249 Dk1ok:boolean=true;
0250 Dk2ok:boolean=true;
0251 Tok:Boolean=true;
0252 ITA2_Hex:ITA_Reg=($18,$13,$0E,$12,$10,$16,$0B,$05,$0C,$1A,$1E,$09,$07,$06,
0253 $03,$0D,$1D,$0A,$14,$01,$1C,$0F,$19,$17,$15,$11);
0254 ITA2_Bu:ITA_Zei=('A','B','C','D','E','F','G','H','I','J','K','L','M','N','O',
0255 'P','Q','R','S','T','U','V','W','X','Y','Z');
0256 Steuerkomb_hex:array[1..6] of byte=($00,$02,$04,$08,$1B,$1F);
0257 Steuerkomb_zei:array[1..6] of char=('|','<',' ','*','#','%');
0258
0259 {----------------------------------------------------- Funktion 2 hoch x }
0260
0261 Function Pot2(x:integer):integer;
0262
0263 Var
0264 i:integer;
0265 Erg:integer;
0266 begin
0267 if x=0 then pot2:=1
0268 else
0269 begin
0270 Erg:=1;
0271 for i:=1 to x do Erg:=Erg*2;
0272 Pot2:=Erg;
0273 end;
0274 end;
0275
0276 {---------------------------------------- Registerverschiebung eines Registersatzes }
0277
0278 procedure RegVerSatz(Var regist:regtyp; maske:regtyp; Var c:vektor);
0279
0280 Var
0281 i:integer;
0282 rk:byte;
0283
0284 begin
0285 i:=31;
0286 rk:=regist[i] and maske[i];
0287 repeat
0288 dec(i);
0289 rk:=rk xor (regist[i] and maske[i]);
0290 regist[i+1]:=regist[i];
0291 until i=1;
0292 regist[i]:=0;
0293 for i:=1 to 8 do c[i]:=$00 or ((rk and pot2(8-i)) shr (8-i));
0294 end;
0295
0296 {----------------------- Registerverschiebung der zwei Registersätze RD1,RD2 }
0297
0298 procedure AllRegVer;
0299
0300 begin
0301 RegVerSatz(RD1,maske,D1);
0302 RegVerSatz(RD2,maske,D2);
0303 end;
0304
0305 {-------------------------- Erzeugung eines Zeilenvektors aus einem Schlüsselbuchstaben }
0306
0307 procedure Mzeile(Var Zeile:vektor; Bu:byte);
0308
0309 Var
0310 i:integer;
0311 By:real;
0312 hiz:vektor;
0313
0314 begin
0315 by:=ita2_hex[ord(bu)-64];
0316 for i:=8 downto 1 do
0317 begin
0318 if (by/Pot2(i-1)<1) then zeile[9-i]:=0
0319 else begin
0320 zeile[9-i]:=1;
0321 by:=by-Pot2(i-1);
0322 end;
0323 end;
0324 for i:=1 to 5 do
0325 hiz[i]:=zeile[i+3];
0326 for i:=6 to 8 do
0327 hiz[i]:=0;
0328 for i:=1 to 8 do zeile[i]:=zeile[i] xor hiz[i] and 1;
0329 end;
0330
0331 {----------------------- Erzeugung der Matrix D1,D2 aus den Spruchschlüssel }
0332
0333 procedure MatrixD (Var mat:slmat; Spsl:string10);
0334
0335 Var
0336 i,j:integer;
0337 bu:byte;
0338 zeile:vektor;
0339
0340 begin
0341 for i:=1 to 10 do
0342 begin
0343 bu:=byte(spsl[i]);
0344 mzeile(zeile,bu);
0345 for j:=1 to 8 do mat[i,j]:=zeile[j];
0346 end;
0347 for i:=11 to 16 do
0348 begin
0349 bu:=byte(spsl[i-10]);
0350 mzeile(zeile,bu);
0351 for j:=1 to 8 do mat[i,j]:=zeile[j];
0352 end;
0353 end;
0354
0355 {------------------------ Erzeugung der zwei Matrizen MTXD1,MTXD2 }
0356
0357 procedure GenMatx (var MTXD1,MTXD2:slmat;DK1,DK2:string10);
0358
0359 begin
0360 matrixd(mtxd1,dk1);
0361 matrixd(mtxd2,dk2);
0362 end;
0363
0364 {--------------------------- Initialisierung Registersatz D }
0365
0366 procedure InitRegSatzD (var re:regtyp; md:slmat);
0367
0368 var
0369 i,j:integer;
0370
0371 begin
0372 re[1]:=$ff;
0373 for i:=1 to 10 do begin
0374 re[i+1]:=$00;
0375 for j:=1 to 8 do re[i+1]:=(re[i+1] shl 1) or md[i,9-j];
0376 end;
0377 for i:=1 to 10 do begin
0378 re[i+11]:=$00;
0379 for j:=1 to 8 do re[i+11]:=(re[i+11] shl 1) or md[i,9-j];
0380 end;
0381 for i:=1 to 10 do begin
0382 re[i+21]:=$00;
0383 for j:=1 to 8 do re[i+21]:=(re[i+21] shl 1) or md[i,9-j];
0384 end;
0385 end;
0386
0387 {------------------------------------- Initialisieren der zwei Registersatze }
0388
0389 procedure GenReg;
0390
0391 Var
0392 i:integer;
0393
0394 begin
0395 InitRegSatzD(RD1,MTXD1);
0396 initRegSatzD(RD2,MTXD2);
0397 end;
0398
0399 {----------------------------- Erzeugung eines Gamma pro Takt }
0400
0401 procedure Gamma (Var Gamma:byte; vek:vektor; zt:byte);
0402
0403 begin
0404 Gamma:=vek[8] xor zt;
0405 end;
0406
0407 {-------------------------------- Erzeugung zt:=Summe(ci(t-1)) }
0408
0409 procedure Elmzt (Var zt:byte; vek:vektor);
0410
0411 Var i:integer;
0412
0413 begin
0414 zt:=0;
0415 for i:=1 to 8 do
0416 zt:=zt xor vek[i];
0417 end;
0418
0419 {-------------------- Konvertierung eines hex-Byte in 8 0,1-Byte }
0420
0421 procedure Konv(var Feld:vektor; b:byte);
0422
0423 Var
0424 i,y:integer;
0425
0426 begin
0427 for i:=1 to 8 do
0428 begin
0429 y:=Pot2(8-i);
0430 if ((b-y)>=0) then begin
0431 b:=b-y;
0432 Feld[i]:=1;
0433 end
0434 else Feld[i]:=0;
0435 end;
0436 end;
0437
0438 {------------------------ Erzeugung des Ergebnisbytes RESBYT=(d7,..,,d1,gt) }
0439
0440 procedure Result (Var Resbyt:byte; D1,D2:vektor; gt:byte);
0441 Var
0442 i:integer;
0443 hv:vektor;
0444
0445 begin
0446 resbyt:=0;
0447 for i:=1 to 7 do hv[i]:=D1[8-i] xor D2[8-i];
0448 hv[8]:=gt;
0449 for i:=8 downto 1 do Resbyt:=Resbyt+hv[i]*Pot2(8-i);
0450 end;
0451
0452 {--------------------- Erzeugung des Ergebnisbytes RESBYTED1=(d11,d12,…,d17,Flag }
0453
0454 procedure ResDl(Var Byte:byte; Flag:boolean);
0455
0456 Var
0457 i:integer;
0458 hv:vektor;
0459
0460 begin
0461 byte:=0;
0462 for i:=1 to 7 do hv[i]:=D1[8-i];
0463 if Flag then hv[8]:=1 else hv[8]:=0;
0464 for i:=8 downto 1 do byte:=byte+hv[i]*Pot2(8-i);
0465 end;
0466
0467 {----------------------- Textgenerierung GT mit Syntaxtest und Spruchschlüsselübergabe }
0468
0469 procedure GenText(Var Spruchschl:string10;
0470 Var Gtext:gtfeld;
0471 Var ok:boolean;
0472 Var lg:word;
0473 Var Gtdatei:bytefile; Gtname:string8);
0474
0475 Var
0476 Err_kenna,Err_spsl:boolean;
0477 zeichen:byte;
0478 za,zs,i,j:integer;
0479
0480 Const
0481 kenna:string[5]='HHHHH';
0482
0483 begin
0484 spruchschl:='';
0485 assign(Gtdatei,gtname);
0486 reset(gtdatei);
0487 Err_kenna:=false; Err_spsl:=false;
0488 za:=1;
0489 repeat
0490 read(Gtdatei,zeichen);
0491 if zeichen=byte(kenna[za]) then
0492 repeat
0493 za:=za+1;
0494 read(Gtdatei,zeichen);
0495 if zeichen<>byte(kenna[za]) then za:=1;
0496 until((za=5) or (za=1));
0497 until ((za=5) or eof(gtdatei));
0498 if eof(gtdatei) then err_kenna:=true;
0499 if not err_kenna then
0500 for i:=1 to 10 do
0501 begin
0502 repeat
0503 read(gtdatei,zeichen);
0504 until ((chr(zeichen) in bu) or eof(gtdatei));
0505 if not eof(gtdatei) then
0506 begin
0507 Spruchschl:=spruchschl+chr(zeichen);
0508 j:=0;
0509 repeat
0510 j:=j+1;
0511 repeat
0512 read(gtdatei,zeichen);
0513 until ((chr(zeichen) in bu) or eof(gtdatei));
0514 if ((chr(zeichen)<>spruchschl[i]) or eof(gtdatei))
0515 then Err_spsl:=true;
0516 until ((j=2) or eof(gtdatei));
0517 end;
0518 end;
0519 if eof(gtdatei) then ok:=false; { kein Seheimtext }
0520 if err_kenna then writeln('Kennung ',kenna,'nicht gefunden');
0521 if err_spsl then writeln('Spruchschluessel nicht gefunden!');
0522 if (err_kenna or err_spsl) then begin
0523 delay(4000);
0524 ok:=false;
0525 exit;
0526 end;
0527 i:=0;
0528 repeat
0529 repeat
0530 read(gtdatei,zeichen);
0531 until((chr(zeichen) in bu) or eof(gtdatei));
0532 if not eof(gtdatei) then begin
0533 i:=i+1;
0534 gtext[i]:=zeichen;
0535 end;
0536 until (eof(gtdatei) or (i=imax));
0537 repeat
0538 if gtext[i]=89 then i:=i-1;
0539 until gtext[i]<>89;
0540 lg:=i;
0541 close(gtdatei);
0542 end;
0543
0544 {------------------------------------- Int-Funktion mit integer-Variablen }
0545
0546 function Ganz(x:integer; d:integer):integer;
0547
0548 Var
0549 y:integer;
0550
0551 begin
0552 y:=0;
0553 repeat
0554 if (x-d)>=0 then y:=y+1;
0555 x:=x-d;
0556 until x<0;
0557 Ganz:=y;
0558 end;
0559
0560 {------------------------------------------- Substitution in ITA2-Zeichen }
0561
0562 procedure Substitute(Var gts:byte; gtsn:byte; Var Flag:boolean);
0563
0564 Var
0565 i:integer;
0566 ok:boolean;
0567
0568 begin
0569 flag:=false;ok:=false;
0570 if gts=89 then begin
0571 gts:=gtsn;
0572 case gts of
0573 {S} 83:gts:=ita2_hex[25];
0574 {K} 75:gts:=steuerkomb_hex[6];
0575 {J} 74:gts:=steuerkomb_hex[5];
0576 {H} 72:gts:=steuerkomb_hex[3];
0577 {O} 79:gts:=steuerkomb_hex[2];
0578 {L} 76:gts:=steuerkomb_hex[4];
0579 {T} 84:gts:=steuerkomb_hex[1];
0580 end;
0581 flag:=true;
0582 end
0583 else
0584 begin
0585 i:=0;
0586 repeat
0587 i:=i+1;
0588 if gts=byte(ita2_bu[i]) then begin
0589 gts:=ita2_hex[i];
0590 ok:=true;
0591 end;
0592 until ((i=26) or ok);
0593 if not ok then gts:=$00; { undef. Element }
0594 end;
0595 end;
0596
0597 {----------------------- Diskettenwechsel bei Fehler 'Disk write error' }
0598
0599 procedure Diskwechsel;
0600
0601 begin
0602 close(ausgfile);
0603 openwindowheader(20,12,60,22,'Diskette voll !');
0604 clrscr;
0605 gotoxy(4,2);
0606 writeln('Bitte Diskette wechseln !');
0607 gotoxy(4,4);
0608 writeln('Fortsetzung mit Tastendruck !');
0609 taste:=readkey;
0610 assign(ausgfile,resname);
0611 rewrite(ausgfile);
0612 closewindow;
0613 end;
0614
0615 {************************ Beginn Prozedur WORKPAAR **************************}
0616
0617
0618
0619 begin
0620 imax:=max_Feld_lg; zt1:=0; zt2:=0;
0621 strsp1:='';strsp2:='';
0622 str(p1:2,no1); str(p2:2,no2);
0623 doppelpkt:=':';
0624 stelle:=pos(doppelpkt,gtname);
0625 if stelle=0 then gtname:=copy(gtname,1,6)
0626 else gtname:=copy(gtname,1,8);
0627 if no1[1]=' ' then no1:='0'+copy(no1,2,1);
0628 if no2[1]=' ' then no2:='0'+copy(no2,2,1);
0629 gt1name:=gtname+no1; gt2name:=gtname+no2;
0630 GenText(Strsp1,Gt1,tok,Lgt1,GtDat1,Gt1name);
0631 ok:=tok;
0632 if not tok then begin writeln; writeln('Textfehler Text1!'); taste:=readkey; exit; end;
0633 GenText(Strsp2,Gt2,tok,Lgt2,GtDat2,Gt2name);
0634 ok:=ok and tok;
0635 if not tok then begin writeln; Writeln('Textfehler Text2!');taste:=readkey; exit; end;
0636 ti1:=lgt1*bitvar; ti2:=lgt2*bitvar;
0637 write (lst, p1:2,',', p2:2,' ', strsp1,' ',strsp2,' ',lgt1:4,' ',lgt2:4,' ',ti1:5,' ',ti2:5,' ');
0638 GenMatx(mtxd1,mtxd2,strsp1,strsp2);
0639 GenReg;
0640 if lgt1>=lgt2 then Verlg:=lgt2 else Verlg:=lgt1;
0641 reslgn:=verlg*(bitvar-3); { nur 4.,5. Takt werden gezählt }
0642 resbyte:=lo(reslgn);
0643 resbyted1:=hi(reslgn);
0644 write(AusgFile,resbyte,resbyted1);
0645 write(lst,Verlg:5,' ');
0646 tv:=0;zt1:=0;zt2:=0;
0647 repeat { Vorlauf }
0648 tv:=tv+1;
0649 AllRegVer;
0650 Elmzt(Zt1,D1);
0651 Elmzt(Zt2,D2);
0652 until tv=150;
0653 s:=0; stflag1:=false; stflag2:=false; stflag:=false;
0654 repeat
0655 s:=s+1;
0656 if stflag1 then g1:=$FF else g1:=Gt1[s];
0657 if stflag2 then g2:=$FF else g2:=Gt2[s];
0658 if not stflag1 then substitute(g1,gt1[s+1],stflag1);
0659 if not stflag2 then substitute(g2,gt2[s+1],stflag2);
0660 if ((g1=$FF) or (g2=$FF)) then stflag:=stflag1 or stflag2
0661 else stflag:=false;
0662 for p:=bitvar-1 downto 0 do
0663 begin
0664 gbit1:=g1 and Pot2(p); if gbit1<>0 then gbit1:=1;
0665 gbit2:=g2 and Pot2(p); if gbit2<>0 then gbit2:=1;
0666 t:=t+1;
0667 gotoxy(10,8);
0668 write('t= ',t);
0669 Allregver;
0670 Gamma(gam1,d1,zt1);
0671 Gamma(gam2,d2,zt2);
0672 gt:=gam1 xor gam2 xor gbit1 xor gbit2 and 1;
0673 Elmzt(Zt1,D1);
0674 Elmzt(Zt2,D2);
0675 if ((p=1) or (p=0)) then begin { nur jeder 4.,5.Takt }
0676 Result(Resbyte,D1,D2,Gt);
0677 ResDl(ResbyteD1,stflag);
0678 write(AusgFile,Resbyte);
0679 {I-} code:=ioresult; {$I+}
0680 if code=101 then
0681 begin
0682 Diskwechsel;
0683 write(ausgfile,resbyte);
0684 end;
0685 write(AusgFile,ResbyteD1);
0686 {$I-} code:=ioresult; {$I+}
0687 if code=101 then
0688 begin
0689 Diskwechsel;
0690 write(ausgfile,resbyte);
0691 end;
0692 end;
0693 end;
0694 if ((g1=$FF) and stflag1) then stflag1:=false;
0695 if ((g2=$FF) and stflag2) then stflag2:=false;
0696 until ((s=Verlg) or (t>=tmax));
0697 write(lst,t:6);writeln(lst); writeln(lst);
0698 end;
0699
0700 {----------------------------------------------------- Protokollkopf }
0701
0702 procedure protokoll;
0703
0704 var
0705 i,j:integer;
0706 jahr,monat,tag,stunde,min,dayofw,sec,sec100:word;
0707 stelle:integer;
0708 no:string[2];
0709 lmonat,lmin:string[1];
0710
0711 const
0712 doppelpkt:char=':';
0713
0714 begin
0715 write(lst,chr(13));
0716 writeln(lst); writeln(lst,'*********************************************************************************');
0717 writeln(lst);
0718 writeln(lst,'HORIZONT - statistische Methode, Var "S" - Vers. 3.1 (Geheimtextpaare)');
0719 writeln(lst);
0720 getdate(jahr,monat,tag,dayofw); gettime(stunde,min,sec,sec100);
0721 if monat<10 then lmonat:='0' else lmonat:='';
0722 if min<10 then lmin:='0' else lmin:='';
0723 writeln(lst,' Datum: ',tag,'.',lmonat,monat,'.',jahr);
0724 writeln(lst,' Zeit : ',stunde,'.',lmin,min,' Uhr');
0725 writeln(lst);
0726 writeln(lst,'================================= PROTOKOLL =====================================');
0727 writeln(lst);
0728 writeln(lst,' Anzahl Geheimtexte: ',Anzgt);
0729 write(lst,' Geheimtextdateien : ');
0730 for i:=1 to anzgt do begin
0731 stelle:=pos(doppelpkt,gtname);
0732 if Stelle=0 then gtname:=copy(gtname,1,6)
0733 else gtname:=copy(gtname,1,8);
0734 str(i:2,no);
0735 if no[1]=' ' then no:='0'+copy(no,2,1);
0736 gtname:=gtname+no;
0737 write(lst,gtname);
0738 writeln(lst);
0739 write(lst,' ');
0740 end;
0741 writeln(lst);
0742 writeln(lst);
0743 writeln(lst,' Tmax: ',tmax);
0744 writeln(lst,' Bitvariante: ',bitvar);
0745 writeln(lst,' Ausgabedatei: ',resname);
0746 writeln(lst); writeln(lst);
0747 writeln(lst,'Paar Sp-schl1 Sp-schl2 Textlänge Anzahl Bit Verarb.-Lg Takte T');
0748 writeln(lst,' Txt1 Txt2 Txt1 Txt2 in Zeichen gesamt ');
0749 writeln(lst,'---------------------------------------------------------------------------------');
0750 writeln(lst);
0751 end;
0752
0753 {--------------------------------------- Programmstart des Arbeitsprogramms }
0754
0755 procedure Progstart;
0756
0757 Var
0758 stunde,min,sec,sec100:word;
0759 lmin:string[1];
0760
0761 begin
0762 window(20,12,60,22);
0763 textbackground(lightgray);
0764 textcolor(black);
0765 clrscr;
0766 gotoxy(10,2);
0767 if (einok and ausok and ok) then begin
0768 write('Programm läuft !!!');
0769 protokoll;
0770 gotoxy(10,4);
0771 write('Tmax= ',tmax);
0772 assign(Ausgfile,resname);
0773 rewrite(Ausgfile);
0774 p1:=0; t:=0;
0775 repeat
0776 p1:=p1+1; p2:=p1;
0777 repeat
0778 p2:=p2+1; ok:=false;
0779 gotoxy(10,6);
0780 write('Paar ',p1,',',p2,' ');
0781 workpaar(t,p1,p2,gtname,ok);
0782 if not ok then begin writeln('Laufzeitfehler bei Paar ',p1,',',p2,'!');
0783 delay(2000);
0784 writeln(lst);
0785 writeln(lst,'Laufzeitfehler bei Paar ',p1,',',p2,'!');
0786 exit;
0787 end;
0788 until ((p2=Anzgt) or (t>=tmax));
0789 until ((p1=Anzgt-1) or (t>=tmax));
0790 close(AusgFile);
0791 gettime(stunde,min,sec,sec100);
0792 if min<10 then lmin:='0' else lmin:='';
0793 write(lst,'======================== Ende ==============', stunde:2,'.',lmin,min,' Uhr ===');
0794 writeln(lst);writeln(lst);
0795 gotoxy(9,10); writeln('E N D E ! ! ( Tastendruck )');taste:=readkey;
0796 end else begin
0797 writeln('Eingabefehler !');
0798 delay(5000);
0799 end;
0800 textcolor(lightgray);
0801 textbackground(black);
0802 window(1,1,80,25);
0803 end;
0804
0805 {---------------------------------------------- Namen der Ausgabefiles }
0806
0807 procedure AusgNamen(Var Resname:zeile60);
0808
0809 begin
0810 inline($b1/05/$b5/00/$b4/1/$cd/$10);
0811
0812 Ausok:=false;
0813 window(10,7,65,12);
0814 textbackground(lightgray);
0815 textcolor(black);
0816 clrscr;
0817 gotoxy(5,wherey+l);
0818 write('Dateiname für Daten: ');
0819 einzeil(ResName,ResName,Dateibez,16,wherex,wherey);
0820 window(1,1,80,25);
0821 textbackground(black);
0822 textcolor(lightgray);
0823 clrscr;
0824 Ausok:=true;
0825 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0826
0827 end;
0828
0829 {--------------------------------------------------- Hauptmenü }
0830
0831 procedure Menue;
0832
0833 begin
0834 clrscr;
0835 writeln('*********************************************************************************');
0836 gotoxy(7,3);
0837 writeln('HORIZONT - statistische Methode: Erzeugung der Testdaten');
0838 gotoxy(18,4);
0839 writeln('Programm HzVarS'-Vers 3.1 (Geheimtextpaare) ');
0840 gotoxy(1,6);
0841 writeln('*********************************************************************************');
0842 gotoxy(20,8);
0843 writeln('F1: Eingaben');
0844 gotoxy(20,9);
0845 writeln('F2: Ausgaben');
0846 gotoxy(20,10);
0847 writeln('F3: Programmstart');
0848 gotoxy(20,11);
0849 write('F10: Programmende');
0850 end;
0851
0852 {*****************************************************************************
0853 HAUPTPROGRAMM
0854 *****************************************************************************}
0855
0856 begin
0857 inline($b1/00/$b5/15/$b4/1/$cd/$10);
0858
0859 Ende:=false;
0860 Ausok:=false;
0861 Einok:=false;
0862 Gtname:='';
0863 Resname:=''; OK:=true; Tmax:=0; BitVar:=5;
0864 Anzgt:=0; t:=0;
0865 repeat
0866 Menue;
0867 Taste:=readkey;
0868 if Taste=#0 then begin
0869 Taste:=readkey;
0870 case Taste of
0871 #59:Eingaben;
0872 #60:AusgNamen(ResName);
0873 #61:ProgStart;
0874 #68:ende:=true;
0875 end;
0876 end;
0877 until ende;
0878 textcolor(black);textbackground(lightgray);
0879 gotoxy(20,15);
0880 write('P r o g r a m m e n d e ! ! !');
0881 textcolor(lightgray);textbackground(black);
0882 end.
*********************************************************************************
HORIZONT - statistische Methode, Var "S" - Vers. 3.0 (Geheimtextpaare)
Datum: 24.11.1989
Zeit : 8.21 Uhr
================================ PROTOKOLL ======================================
Anzahl Geheimtexte: 5
Geheimtextdateien : gtvart01
gtvart02
qtvart03
gtvart04
gtvart05
Tmax: 1000
Bitvariante: 5
Ausgabedatei: res
Paar Sp-schl1 Sp-schl2 Textlänge Anzahl Bit Verarb.-Lg Takte T
Txt1 Txt2 Txt1 Txt2 in Zeichen gesamt
--------------------------------------------------------------------------------
1, 2 HVNZXMVMSF MURAMKTSNK 19 31 95 155 19 95
1, 3 HVNZXMVMSF VROVUFQDRK 19 25 95 125 19 190
1, 4 HVNZXMVMSF PCKHDOPNET 19 30 95 150 19 285
1, 5 HVNZXMVMSF FXCVJOCPWZ 19 35 95 175 19 380
2, 3 MURAMKTSNK VROVUFQDRK 31 25 155 125 25 505
2, 4 mURAMKTSNK PCKHDOONET 31 30 155 150 30 655
2, 5 MURAMKTSNK FXCVJOCPWZ 31 35 155 175 31 810
3, 4 VROVUFQDRK PCKHDOONET 25 30 125 150 25 935
3, 5 VROVUFQDRK FXCVJOCPWZ 25 35 125 175 25 1000
=================================== Ende ========================= 8.29 Uhr ===
*********************************************************************************
HORIZONT - statistische Methode, Vers. 3.0 (Geheimtextpaare)
Datum: 30.05.1989
Zeit : 09.24 Uhr
======================================= PROTOKOLL ===============================
Anzahl Geheimtexte: 5
Geheimtextdateien : a:gtext301
a:gtext302
a:gtext303
a:gtext304
a:dtext305
Strukturschlüssel : 1101011010111111
1010010011110111
0011000000111110
0100001100001010
0011010001001110
1101011100110001
1100101111101010
1110011100001000
Tmax: 100000
Bitvariante: 7
Ausgabedatei: b:result
Matrixdatei: b:mpmat
Paar Sp-schl1 Sp-schl2 Textlänge Anzahl Bit Verarb.-Lg Takte T
Txl Tx2 Txl Tx2
--------------------------------------------------------------------------------
1, 2 FRTSHJNQGX JTOMPKKTHQ 1255 440 5656 1848 264 1848
1, 3 FRTSHJNQGX CNOBKDSOGD 1255 1090 5656 4886 698 6734
1, 4 FRTSHJNQGX XTTTRVQZFG 1255 680 5656 7968 424 9702
1, 5 FRTSHJNQGX EPGULBXAHQ 1255 505 5656 2170 310 11872
2, 3 JTOMPKKTHQ CNOBKDSOGD 440 1090 1848 4886 264 13720
2, 4 JTOMPKKTHQ XTTTRVQZFG 440 680 1848 7968 264 15568
2, 5 JTOMPKKTHQ EPGULBXAHQ 440 505 1848 2170 264 17416
3, 4 CNOBKDSOGD XTTTPVQZFG 1090 480 4886 2968 424 20384
3, 5 CNOBKDSOGD EPGULBXAHQ 109O 505 4886 2170 310 22554
4, 5 XTTTRVQZFG EPGULBXAHQ 680 505 2968 2170 310 24724
=================================== Ende ============ 9.48 Uhr =====
Zeitbedarf für 1000 Takte ca. 1 min
-- NAS-SYS 3 --
TBA03 BA83 0 8 0011
BA03 00 00 01 00 01 00 01 01 01 00 01 01 00 00 00 01
BA13 01 00 01 00 00 00 01 00 01 00 01 00 00 01 01 01
BA23 01 01 01 00 00 01 00 00 00 01 00 00 01 01 01 01
BA33 00 00 01 01 01 00 00 00 00 00 01 01 00 01 00 01
BA43 01 00 00 01 00 01 00 00 00 01 01 01 00 01 01 01
BA53 00 00 00 01 01 01 01 01 01 01 01 00 00 01 00 01
BA63 00 01 01 00 01 01 00 01 00 00 01 01 00 01 01 00
BA73 00 00 00 01 00 01 01 01 00 00 00 01 01 01 01 01
Text 1 (ktvrs101, gtvs101) Text 2 (ktvrs102, gtvs102)
t i j Pij C8 z Г GT KT | i j Pij C8 z Г GT KT
01 7 10 1 1 0 0 0 0 | 4 12 1 1 0 0 1 1
02 1 8 1 1 0 0 0 0 | 7 3 1 1 0 0 0 0
03 4 8 0 0 1 1 1 0 | 7 4 1 0 0 1 0 1
04 0 2 0 1 0 1 0 1 | 2 11 0 0 0 0 0 0
05 6 2 0 1 0 1 0 1 | 0 13 0 0 0 0 0 0
06 7 14 0 1 0 1 1 0 | 5 3 1 1 1 1 0 1
07 7 7 0 1 1 0 1 1 0d | 5 12 1 0 1 0 1 1 53 = S
08 5 11 0 0 1 1 1 0 | 6 15 0 1 0 1 0 1
09 2 15 1 1 1 1 1 0 | 4 4 0 0 1 1 1 0
10 1 1 1 0 0 1 1 0 | 6 15 0 1 0 1 1 0
11 0 1 1 1 0 0 1 1 | 3 7 0 1 1 0 0 0
12 3 0 1 1 0 0 0 0 | 5 11 0 0 0 0 1 1
13 4 6 0 0 1 1 0 1 | 7 8 1 1 1 1 1 0
14 3 1 0 1 1 0 0 0 0a | 5 8 1 0 0 1 0 1 45 = E
Grundschlüssel: GYFXFMBFJXIDFKMN
Strukturmatrix: SKVRS1
Spruchschlüssel1: ZKYKV YDZEH
Spruchschlüssel2: RRUHR FZQIR
//////////////////////////////////////////////////////////////////
Manuelle Prüfung von RESVRS1 22.06.1989
SPSL1: ZKYKV YDZEH
SPSL2: RRUHR FZRIR
87654321
Z 110 10 11001010
K 010 11 01010011
Y 110 01 11010001
V 101 10 10100110
Y 110 01 11010001
D 001 00 00100100
Z 110 10 11001010
E 001 01 00101101
H 010 00 01001000
R 100 10 10000010
R 100 10 10000010
U 101 01 10111101
H 010 00 01001000
R 100 10 10000010
F 001 10 00110110
Z 110 10 11001000
R 100 10 10000010
I 010 01 01000001
R 100 10 10000010
G1: TQU VBJ
1 3 7 8
13 78 7d 1b 0010011 1111000 1
G2: NCM ISX
4 1 3 6
41 36 56 77 1000001 0110110 1
==============================
1010010 1001110 0
0001 { FILESORT - m,(0<m<100), Dateien mit dem Namen 'xxxxxx??', wobei ?? für
0002 eine Numerierung von '01',…,str(m) steht, werden
0003 der Größe nach absteigend in 'xxxxxx01',…,'xxxxxx+str(m)
0004 umbenannt }
0005
0006 program filesort;
0007
0008 uses crt,windows,printer;
0009
0010 Var
0011 p,m,i,iocode:integer;
0012 gr,maxlg:longint;
0013 merk:byte;
0014 name,hlpname,direc:string;
0015 nr,ni:string[2];
0016 datei:file of byte;
0017 lgfeld:array[1..99] of longint;
0018 markfeld:array[1..99] of byte;
0019 taste,druck:char;
0020
0021 Const
0022 virt:string='hlpnamO1';
0023
0024 begin
0025 clrscr;
0026 openwindow(1,1,80,10);
0027 textbackground(lightgray);textcolor(black);
0028 clrscr;
0029 gotoxy(5,2);
0030 writeln('Sortierung von Dateien in absteigender Größe');
0031 textbackground(black);textcolor(lightgray);
0032 openwindow(1,5,80,25);
0033 clrscr;
0034 gotoxy(5,2);
0035 write('Anzahl der Dateien ? ');
0036 readln(m);
0037 gotoxy(5,wherey);
0038 write('Directory ? ');
0039 readln(direc);
0040 chdir(direc);
0041 gotoxy(5,wherey);
0042 write('Dateiname ? ');
0043 readln(name);
0044 gotoxy(5,wherey);
0045 write('Druck (J/N) ? ');
0046 repeat
0047 readln(druck);
0048 gotoxy(20,wherey-1);
0049 druck:=upcase(druck);
0050 until ((druck='J') or (druck='N'));
0051 if druck='J' then
0052 begin
0053 writeln(lst,'Sortierung von Dateien in absteigender Größe');
0054 writeln(lst,'============================================');
0055 writeln(lst);writeln(lst);
0056 writeln(lst,' Anzahl der Dateien: ',m:2);
0057 writeln(lst,' Directory: ',direc);
0058 name:=copy(name,1,6);
0059 name:=name+'??';
0060 writeln(lst,' Dateiname: ',name);
0061 writeln(lst);writeln(lst);
0062 writeln(lst,'Statistik der Dateilängen: ');
0063 writeln(lst);
0064 end;
0065 writeln;
0066 openwindow(10,10,70,23);
0067 textcolor(black);textbackground(lightgray);
0068 clrscr;
0069 gotoxy(20,2);
0070 writeln('Programm l ä u f t !');
0071 for p:=1 to m do
0072 begin
0073 str(p,nr);
0074 if length(nr)<2 then nr:='0'+nr;
0075 name:=copy(name,1,6);
0076 name:=name+nr;
0077 assign(datei,name);
0078 {$I-} reset(datei);
0079 iocode:=ioresult;
0080 if iocode<>0 then begin
0081 writeln(' Reset - E R R O R ! ! !');
0082 writeln(' Fehler ',iocode,' in Datei ',name);
0083 taste:=readkey;
0084 exit;
0085 end;
0086 lgfeld[p]:=filesize(datei); {$I+}
0087 iocode:=ioresult;
0088 if iocode<>0 then begin
0089 writeln(' FileSize - E R R O R ! ! !');
0090 writeln(' Fehler ',iocode,' in Datei ',name);
0091 taste:=readkey;
0092 exit;
0093 end;
0094 close(datei);
0095 end;
0096 if druck='J' then
0097 for p:=1 to m do
0098 begin
0099 str(p,nr);
0100 if length(nr)<2 then nr:='0'+nr;
0101 name:=copy(name,1,6);
0102 name:=name+nr;
0103 writeln(lst,'Datei ',name,': ',lgfeld[p]:6);
0104 end;
0105 if druck='J' then begin writeln(lst);writeln(lst);end;
0106 fillchar(markfeld,sizeof(markfeld),0);
0107 for p:=1 to m do
0108 begin
0109 maxlg:=0;
0110 for i:=1 to m do
0111 begin
0112 if markfeld[i]=0 then
0113 begin
0114 if lgfeld[i]>maxlg then
0115 begin
0116 merk:=i;
0117 maxlg:=lgfeld[i];
0118 end;
0119 end;
0120 end;
0121 markfeld[merk]:=p;
0122 end;
0123 for p:=1 to m do
0124 begin
0125 str(p,nr);
0126 if length(nr)<2 then nr:='0'+nr;
0127 name:=copy(name,1,6); name:=name+nr;
0128 virt:=copy(virt,1,6);
0129 virt:=virt+nr;
0130 assign(datei,name);
0131 {$I-} rename(datei,virt); {$I+}
0132 iocode:=ioresult;
0133 if iocode<>0 then begin writeln(' Rename - E R R O R !');
0134 writeln(' Fehler ',iocode,' in Datei ',virt);
0135 taste:=readkey;
0136 exit;
0137 end;
0138 end;
0139 for p:=1 to m do
0140 begin
0141 i:=0;
0142 repeat
0143 i:=i+1;
0144 until markfeld[i]=p;
0145 str(i,ni);
0146 if length(ni)<2 then ni:='0'+ni;
0147 virt:=copy(virt,1,6);
0148 virt:=virt+ni;
0149 str(p,nr);
0150 if length(nr)<2 then nr:='0'+nr;
0151 name:=copy(name,1,6);
0152 name:=name+nr;
0153 assign(datei,virt);
0154 {$I-) rename(datei,name); {$I+}
0155 iocode:=ioresult;
0156 if iocode<>0 then begin writeln(' Rename - E R R O R ! ');
0157 writeln(' Fehler ',iocode,' in Datei ',name);
0158 taste:=readkey;
0159 exit;
0160 end;
0161 hlpname:=copy(name,1,6);
0162 hlpname:=hlpname+ni;
0163 writeln(' Datei ',hlpname,' in Datei ',name);
0164 if druck='J' then writeln(lst,'Datei ',hlpname,' in Datei ',name);
0165 end;
0166 gotoxy(6,wherey+1);write(' P r o g r a m m e n d e ! (bel. Taste)');
0167 taste:=readkey;
0168 end.
Sortierung von Dateien in absteigender Größe Beispiel und Protokoll
Anzahl der Dateien: 38
Directory: d:\ha\horizont
Dateiname: gtsvel??
Statistik der Dateilängen:
Datei gtsve101: 1936
Datei gtsve102: 5510
Datei gtsve103: 1651
Datei gtsve104: 5144
Datei gtsve105: 4390
Datei gtsve106: 7161
Datei gtsve107: 2783
Datei gtsve108: 4218
Datei gtsve109: 3914
Datei gtsve110: 3572
Datei gtsvelll: 2567
Datei gtsve112: 1482
Datei gtsve113: 4248
Datei gtsve114: 3726
Datei gtsve115: 8412
Datei gtsve116: 8315
Datei gtsve117: 4984
Datei gtsve118: 9000
Datei gtsvell9: 3342
Datei gtsve120: 2049
Datei gtsve121: 2149
Datei gtsve122: 1751
Datei gtsve123: 5175
Datei gtsvei24: 5653
Datei gtsve125: 3139
Datei gtsve126: 5997
Datei gtsve127: 6773
Datei gtsve128: 6551
Datei gtsvel29: 6103
Datei gtsve130: 5932
Datei gtsve131: 4603
Datei gtsve132: 4276
Datei gtsve133: 5870
Datei gtsve134: 3903
Datei gtsve135: 4725
Datei gtsvel36: 5320
Datei gtsve137: 3368
Datei gtsve138: 2254
Datei gtsvell8 in Datei gtsve101
Datei gtsve115 in Datei gtsve102
Datei gtsvell6 in Datei gtsve103
Datei gtsve106 in Datei gtsve104
Datei gtsve127 in Datei gtsve105
Datei gtsve128 in Datei gtsve106
Datei gtsve129 in Datei gtsve107
Datei gtsve126 in Datei gtsve108
Datei gtsve130 in Datei gtsve109
Datei gtsve133 in Datei gtsve110
Datei gtsve124 in Patel gtsvelll
Datei gtsve102 in Datei gtsve112
Datei gtsve136 in Datei gtsve113
Datei gtsve123 in Datei gtsvell4
Datei gtsve104 in Datei gtsve115
Date: gtsve117 in Datei gtsve116
Datei gtsve135 in Datei gtsvell7
Datei gtsvel3l in Datei gtsve118
Datei gtsve105 in Datei gtsvell9
Datei gtsve132 in Datei gtsve120
Datei gtsvell3 in Datei gtsve121
Datei gtsve108 in Datei gtsvel22
Datei gtsve109 in Datei gtsve123
Datei gtsve134 in Datei gtsve124
Datei gtsve114 in Datei gtsve125
Datei gtsvell0 in Datei gtsve126
Datei gtsvel37 in Datei gtsve127
Datei gtsvell9 in Datei gtsve128
Datei gtsve125 in Datei gtsve129
Datei gtsve107 in Datei gtsve130
Datei gtsve111 in Datei gtsve131
Datei gtsve138 in Datei gtsve132
Datei gtsve121 in Datei gtsvel33
Datei gtsve120 in Datei gtsvel34
Datei gtsve101 in Datei gtsve135
Datei gtsve122 in Datei gtsvel36
Datei gtsve103 in Datei gtsve137
Datei gtsve112 in Datei gtsve138
253/89 Gtver107
SYNCB XCXLD NAKKF XCXLD NAKKF XCXLD NAKKF OTNJV DKNYK RGADB
QDYZU XJPYJ MHUAJ LKEYG KQCDP CBBWF QKHDJ MGNUS OAGHU GTMQW
SHXEM QYLYR BQAEX GFWQO HCYOQ GHYGP SKBVN CNUQI FMQEP BATRZ
UHXZN MBRUX WPDDV MBKLN VQJEJ FBJPV DKZEA DDGEF YLKNX RWDPI
CVDYS HHFST AOUPV LQVBY IYEGQ SRSCH QCRVT UVWYU CEOJR IOOUD
JICNL FKKFO VOPSF JGJKS GTJZR WFCEB FBGBN UAJWN RDEWD KZZMZ
NWAAY KEHRL CBSKZ DXLZO QWRRQ XRMED MRLBG WNIPB IMUSI GLMAP
NGQBW YCHPG GPLVA RNCCM FTNHJ JAEDX XLLIG NSDLI FCJNO KSYLC
MKSXS OWKWL QEHRB LCLUD NPPEM RKWGX FWBAX GBHGI VPHTZ GBUJO
OYHBO NYECT AEEEC ASFAT DJEIY GIVMC RSARS QBDBM DDKBJ NGGIF
XWSAP OSQHA WXNIJ JTQYK HJEMA WOYDP YEKGK PWSVE QMXKF YUWLS
XJETM ZBWGW BROXD ECHLT ANVQA WZKYO QAMAM BRXNV QSMSJ FQIVJ
QINLT YIROQ CKEIC LTAJK OLDNO CERWG PDFMF BIIGW TOQRO MFRFT
VFNOJ WUBLU VEAOF VVHBM USWDG IXMCK TCOXW TITRD HSUMD LWJMA
RPXDD VHHKI XNWDK TZKAS REIVF PPMHX ULLTA DGQPU THBUI VNXST
OBKBJ GMANG GFTGF BHNON EGKUH OIJUT GTACY RHUMB PENDS YYYYY
254/89 Gtver 111
%SYNCB COCAR LZDDK COCAR LZDDK COCAR LZDDK CQYCU ARMXO TVVEL
%EMNEO FNUTI NXNSK VFVQB VVNPW IXYAM FAHVC GTUXT PGUUW TDYBL
%FIWOD TQMMV YEUKD KTFHW TYYSK SMCVO IPTNH VFYTB OZGPJ DIBEJ
%LLPGR SPFIC HQEVD IQOLH WBJYW GTCWX ACPAH GEEVV CUIUS EMKEK
%NTGZX SCIUU XJKWS GABHU IRGAQ ODWTC CVULD BSUOF YBYJA ORBDA
%WMOIE BXZMS TQVAJ JSXXQ SWDUY LFNWU PEHEM IFKMT NDQOW GYCBL
%QWRMK BCXGK FYVPG YCCFV AHUIH KEECZ ZGYLG RGSJR BTITW HYOFX
%PCWVH QRDHP ZLDSN MFXPA DNNXC SGEND SYYYY
257/89 Gtver106
%SYNCB JCYTR CCPLN JCYTR CCPLN JCYTR CCPLN JDXMA SJQBQ NQWAP
%VJUHM SPPCU CAEHM YPIRV VCCUS SYIEN PVAUB QRIAQ YBRXS JXYBX
%MTIOK QNQSB FQUFJ SIVNJ XQLFF ISKCS KALUW KRYLS EQLDM PNMNO
%AJOFC GJHMT KCPLF PHNJB NASPB EXITV WFZID EHIJD WJKWJ PDDMQ
%SCJKD BELHI KVJFG COSEL DBOKN FMUAG MVXZN KDUEW MOXAB ENLTP
%IVJIO HSWTA YSFRR TGUQP HRJIE AMHNB SRMMU LPKCD HQUHI VOJMM
%JUWGC KJVWS LYIQM BVCFH QLLPH UKDVO KANWR CWVWA RXUDC RJINV
%UZRQN YWIFQ IORCP ELJKP PWPJP CXEIX JCAYB UGTLQ XHHMN QMQEC
%FJYDU JQAEA NHLHO TQBQL DVLDN VUPQS XFRNX TUPOG USIDI XQQRC
%ALLRY KENMO RXQEJ CCFRU DJAHE KUIIQ JJGHV KEMKZ DAROU GTSKJ
%QUKOJ WWAJW RXENB WBGBP QWPOQ PYSDE HTGKG GGLGJ GNFQM QZHPY
%LEIAJ MONYB JZDRF TWPIM VNRDG AKIQP VNFLI CJDDY IYPQB UMPRB
%RRLGH TTTHZ SYQRN LLBFL GFDSL JGVST YOBGX QFIVG TIBNM KRTUJ
%DWUIZ CJVTE YRUGG TRAQL IEPDM OCFSX CPWWH OQOMU DRGPQ CSEJD
%OOJES XRSDO TIVDE QXKJX HUXPI UURSB GVQXY DLVXF DMGNA JHHHH
%SYSYH UFCND RYJMM ISIBE SAIQM VEWLI RHHOT FZGBG WWBBV UOJXB
%VRDKB YWRNG RASWJ DMAJM DRDOA PFQYB UOILP NHMEF YHIWP GUQDD
%VATWE NDSYY
252/89 Gtver110
%SYNCB RZUZF LYTJJ RZUZF LYTJJ RZUZF LYTJJ MTPGR FNXND XPFNH
%NSURP MFCJG WJLBE ASXRB YFEWM ILVJF VIPWN NJYPZ OVIFV MSTUW
%ELAYJ CDHPV BUEPM ICBAG UBRPC QJSLU KVNSF PFRWV MWPIX BNPII
%JTRXT XHAXL EKNRE ICDFI CRUUG HAVJN QEDRI KMUTX EZXSO MNHQM
%OKLGE ONOTM PLNZQ PFDEK WSVSH KJNJE TXUIQ QIPPH NCBVW EIBQV
%QVGLL GJMVW DNTXP WOOBS QQMNY XUQXG EOKKF MSUJU FUQEA VDNNU
%UVQDM GDBYF RLCOZ HKNOB OWAGP ASZMI JUYGD BEHUL RHQRE MNSVG
%MAKHE YUMMW MQWDF XXYVW GNLKE NDSYY
251/89 Gtver109
%SYNCB JUUYB IINID JUUYB IINID JUUYB IINID JONIO NOPEG PMVTE
%LYCWT QXOHE XNALF IHNHZ OICSE LIKSV KTYIL UKFLL LKYPF XLJLU
%UCIDW KEDYL LJWBL GMFBM KEAVN EWWKR CLGKF ZNDPH YIPQU WKVVI
%GALUU MQKDU GHADM XMNFL VCSES WFWUP ZRKLT HKJFZ CFDRL LGGGE
%PSYWK GGMYS EYEWH QCISE AJXEH SPPWX GUXVN CXWTU TFVDD QCXGX
%XWODM VOKAF PSQMI XIPJY EKNHF WQVKH DGJBH FIXKB LTCSP OXQYK
%KQJZT ADLCR QCVFT NDOYP PFRVL AAXOB FHWEK OXKHB GYOMY EWNDF
%ZTARS UJNGN EVNNO SWUPJ IGAYE CCLAS GQVUA BLIQF XKJSB SFUAH
%XXIHB QXNJA QIOFG YBKBK FVGHY ZYGBJ PRPBO MINJC PNLLL AIFXX
%WDLFG UESAZ LCDJJ WCGYI KFDQR FNROM OJZHI VNHTW PPTUL NPQEM
%QIRAS QERAE NDSYY
250/89 Gtver108
%SYNCB DOISC VMJOG DOISC VMJOG DOISC VMJOG PMURE IZBMI LOCND
%WLCHP HPMPJ OPAQH FEJLZ PKQHM VFYCQ EXKFG AAOKQ QLWGH WIPTX
%BMLYA AHEHA MVNMT EJDIE OMHIK LSLAN HMIRZ IAGGK SECTI RAUCH
%SMEDA PDNJU RSRWI WKEUL XQERB IZMQQ VTJUW BHLKD YVSRC FLKMD
%QCPEU LDRMZ KURUC AEKLH ETMJN AMMOA CHQYM VIBES YDGOD RIUVI
%RNQBA PVGYM FNTFM KQSYF TXQHA EHKYK DNMTC ITQNY OTJAX ICDMH
%SUTZF KYPPJ LHVYB RTHUR JRVXQ UDSAR LDOTH HHMFC CIDAW QNWST
%LWDCF CKUGD WTNMP VSFHP RCRSZ KGDSQ XHLFB FLXEB RTOOC GMMUF
%CHWEQ IEBPM OHQZM IAUJE AXPYC IHVJI UXEQP AJUEH ZCHFB SVVKI
%UXLGA NCMYI RFJCC TBLGC LCUPY LVZHA TDXSI KIHLJ RDXRE VASBT
%PUOEO EEXJT DSSJC ENDSY
248/89 Gtver112
%SYNCB BTNZY LFUPE BTNZY LFUPE BTNZY LFUPE OBVYV ULCRT OXOVQ
%POKVL PSGRE WGCUD NLWZG HRCFV ACQFO ACVSU LSKDW YFIJG EELHK
%CXMLL UULZL WZMJT SGLNE UEWCQ WZRAJ ASYPS BFXVF KKNMH NEFLO
%GRIBY KEYSW IHKFY FAXXL HQQRP XAYRQ SDTJO HRSQY FWOIJ CBOTS
%NOSOG NNYGH GXNFL EAOUC EAYBJ HGXXY YQDNK GOJTW PFHEK VNHNI
%VYIXI EXQBL AGCLI IBFLH HLCCQ TNTNG NFHMD NAZOK AYFNU YRGLA
%SAKGC VFPDU OHJXA XPGUN WCLAM TENDS YYYYY
247/89 Gtver105
%SYNCB UIZWG VNMMK UIZWG VNMMK UIZWG VNMMK KFYTR RHUDA OODYI
%DRTYA RYVKM ARXEU LVEBC BXCIF YMCDS GUBSG LMUFU QVHTC NIGVD
%IEQWC ADLWK PDOKQ CRWWB ZFJSX LVVKK FFPSS WHVDU CTRXI NLVWX
%VMVQK DTQVF EGFOU ESPDX RPXBX FXZJU NFMVI IOWHY EIYIA QUIJM
%AYLMZ PZUFK QWCRQ UMBJU EJKRQ GCOGU AWOFT OBRGC LLQBU NAEVY
%AYBWT DVUDK IIHTG FVMWY OIIDV HDSLU WUYIP AROQV SUMWC PKCTW
%UIFNQ CHLUG SSTDN YHOHW RVIFM LFXNH EGKEN UNMAN ENXMF KIADO
%DWQHZ GOUYE QKRSG WFHRU DIIDR GODKL WBOJS NTJGC NUHXT AQNPV
%OSOAF WNENE SXDOE HFUYJ GRZKB POJWP GDVUR BDCJX OAHVI DNYAC
%IBHEK QZFJP QOEWM IWICR ONVSW AOZPM MQVLN SULYB IGSMF KHTHH
%IFBFJ RRXKL JLZGN VFOBW RULSN OUSBT XSGCL CRVIC VYEJH OVYKD
%BTWXU HJFSC MZTNJ IIPTR SCRUJ PHQDO KLVES LRHEH XCVMX SEWES
%MKABU DEGCZ OAWJJ OFWTO MEDFB TWZPH FTRGO OWCGN YXNTA OCSXT
%PNYON GXYAC WVQSU DVAEU AEDKX XDCVY OKKVD FXQEM FNYOK EXAYK
%KIUAN KSMVO BDFEE GDRAU TIWHG PHVFO GQXKJ JHSBP CBMJC DJDKE
%VKQLH EGIJP CZYPB TRETE BPKZM BPOJH MTUAA AVUZM MIBRX EXIHD
%SNKIC HCFVG HWTGQ ISKJT OFSSR NBYFD BWUCB IIZAL CNWDF NYOTM
%CNGHF NEQZM AWNVK CFUES VQKLB QAWYZ DSUSI HLTUY STNRC LLYTT
%DSABB NKHBU RXVCE OPJTR ATLGU WHXDO YFMRG QHIKB HBULH UKQCL
%OXRCT RKSOM RKXNO FDKKB AKUOL BCHLJ SWETD JQIHN DMTVE ZJBNQ
%PUNVU LRBSP GDQTU YVPBQ RTLYC XIEZR DMURS REKEN MYFTQ CENDSY
258/89 Gtver104
%SYNCB FASFM RKGCV FASFM RKGCV FASFM RKGCV FYLDY NYQBP HUWSB
%JEINM RAVCO ALVCV GNPIM NCMBR FTUIQ JAWWF NOUTH HQRHD DRQPL
%CYQUQ IXRDL LDMBK HIQTJ WJYLS BNHDW HUZFY BIWPD HUDUM COYBP
%QEKAR ODFDD NDWXJ ENBOM INORC NFKGN ACCZA VBLOR NJGFO EGMDT
%TOIBN HNQAH XKZFM UQMWI DWTWQ FMCBK PRNVD HVTSX PDMQP NKBJZ
%NGAMJ EDRHL IJLDK PBGWG WLUCO FSHWO ELFMF JJZNN YHNVH IYNMB
%KMAIG YUFET WGXFK KAXHV QPITN FZKCQ JAJFN MVNTL QNLRH IGIRV
%ZIFBF IPJOC MTRMF GFWGT VWXWL WPHJY RIXND PZWQP IDRPW ULHEA
%XEZEG GHLDK PJDIZ OXRHX MLTND QOHQO RMUMH HWMQR ARPRC EQVQB
%EOPNQ AQOZJ XRHNW XSEKM KMOPU ARSWS LCOBN QRYUP HNIVI FUPHX
%OHNJJ DNZGN JJLDQ FVDHJ MCEKJ OUHFN GRRLC FYNDS KFXBF QWDMW
%HHLGE EYFKI DVBMP IASWI NISKD JNCAD YIXME MLGFD RQUZI DTFXM
%ZEXJX OJOFB EXVTP XSZTM LHYZJ FNPDB YEAUV YCFLD UROMM CNFLX
%UITEU SVZNO ZLYZN TXLFU EDNWZ AMJXD JRCDN DNPGN PITVQ WXHNU
%PJCUW RKAWO VXVTO KIZOM KFJEP KANBK EYQAK MEOJX GRVAD IYCLS
%GIGRI UPVQJ AWUDS OQNFQ WZFUO OSAMW MVBGJ ZXMVB NNZDE VYROE
%XBGKF RHXCP HNKQB NKHKX OXLHF AQOKP ICQCX WOMYL QIRKO ALCPT
%BIFVN PQZLN EHAWS UACHS BUCBH NOKNC RNKNM TQCDR UQJDH LEVQT
%MNSMQ XXHEY BLSSD IPAQK CQUOC WFGIE BKQZR REXIB XQHIG HXPSE
%VMGEQ LABDR NPLUB ISFBG FKHRM SKIJN SPJYV CQXQG XFQRA QQNSW
%IKSNX TOPVC TAPBK VNXOR CVAXS RWRMJ SRRSJ DLKXD PUUHH KAVBM
%MCYBM ODSGV LJVLZ OLYHF EFUAO UOQQL CGYJV VUGXW BKZCY GIIPF
%WWUDL XWUGW OUTTY NBVCS FYBXB ITLAD BXFMN MPQRZ QXHXR UGHJW
%EGYMI YRCBQ DCLNE RKFMH EIKUS LLYPO HWOQI ICJJS RJOPE VIJKI
%UWTFF JDHJP JTYOJ IEKEA JZBCX VTAYI OUPNR TSOUE JDRLW DEKRK
%RSXFZ BIZNQ KLFNI ARSXL MVYER YDTSA KECXC QJNPC TYSZD VIUSH
%ESCYD ALUBC KPUSY PUIAR DDPOF BVLJY TPZHV BUKTW CFSJX IOEKL
%HFEGK SDFVO PNFTK NPTOU XQVDS HOVVM ZNNHT HFSVS QZDIA IRPHI
%SGYEN HLUYH DIQOY PNVGP SFDDG FHJCH NAUKB IPMXL SERRE BCHSU
%GIYGC AUTVT PNDBW QAQYV XIJBJ VZIBE RIHYO MLVOT SQGHU WOQSC
%JMQPP YHAVI PNACS QQJPJ UTOCJ JEQVJ WJWUM OZRKI DXCJC AOWUR
%KEFCN ALGHE ZAOXH FVVDL IJMNO VNFOI XUHNB FGLSQ LEACJ DWARF
%DEJCX XKMJE QCDCF XWBAA NHCAJ MNPEA LSKCV TOFJP CMJUQ RXMOQ
%MOWRY QUKEP RJFIU HHBFE CDYRC TYANQ FRQWR YWAJZ NLCFC HJHRL
%GHMSQ AQYNV GYAWF FKTEM ELDGZ DCEXF LRCZH DBFEZ MIBXR CSVTM
%XKKGJ FINSR KRTNX AONYH CJRCL HTHPD KUWTL ZIVFR XGEYC KNZNB
%RIXGH AOQNS PAEAU JBFJY RYEUL NWGKP AHJCA UVYHW VNLJK AHAPI
%AOGRG AQLIC ZGPAB IIMWO GUMEH NADEY LBREE CGWRY IMXIA RHFMX
%GKDAG YPHYR ZNUXL LTEQI KPGRY THQJD VAVKD WHNBJ PUADT CYQCP
%IXXGT JIJPC BLVDZ ZHGZE NHYWY OPCNR IBTLJ TXJLN NFPHA BEMPE
%EVQZP LGPJX UQNLI WNTHE OCVPP UNODT DZJVT ESFEI TRVHU ONYHT
%KGREL LJSRB JLCON EHOHC DHMGH KTCBF GIUMI QYJUW VKSGX WCEBR
%MPOQL FYBSX DPTCG GYISW AEHZT RQKTZ OSQFI VKRIC LOKUX EPXBJ
%NUXDU HQYMK RQAMD DNPRY AUUYV WKBGN CDHAO HIRXP AJQSQ WZPPB
%EQWDN ZAETC VKMZH BOXBV GCXRC FOJJD UIQXO RBSOE LOQAM DUXSE
AAAAA||||||||||||||||||||||||||||||||||||||||||||||||||||| %%%%
%TERCERA PAGINA
NO#:%XE#-1%00
SSSSS
256/89 Gtver103
%SYNCB CAABB CZGEI CAABB CZGEI CAABB CZGEI PAREA DHQHA VENSO
%VTTMA UJSUP FNMIR IUYFI GRNOY MARLW CZMGV VPICT QNVMJ UQWKA
%IUTPS FFSRH GRAID JNPQS LPSLF SPDQB IWMHR HIQEk OOQPH DMIAE
%VYMLU SHFNQ UKEWF BPKUV WFHTY RTDUT SNTWQ ZIFPR USWPT LLWZB
%XKVBQ WCEGS SUADA UWEET EOXAK WUERV PUHZV CQULE IEWDN ZCKIJ
%PJZNU XAPWR CLIVV AIIEW QHRJI BNYVL AXUDD HULRR BFCRU UIHFV
%FNWDK DKEMR WTPKQ ZBYKF QCQGK SLPGK UJTBW HLSHT RHBMW OMGHR
%BYNLY CITDX NXWWH WILNI TQRKN WSNMI IEMIG XWRFU AHWIS RCIQO
%MDXKL IBQNF GWEHB TJUIU KJJUX EXSLL ONOGW EPKXO UCIMR XNHGE
%KWNYQ YLKAI VCUJA YGQDM DWKRL PHKMD VYFYT BXJIV TBCVD OHICQ
%CCKQE FIEAW BDPAF JTURC IIJTV QBZFX CVHKT WSSTF ORTAC QQYYL
%MHCAS LICIA MMUQD VJYFO XVERS XQKEG KETVJ UKIOL NXGFG WIQTX
%EUCZO LMDXD JSWKA JRWCH EPYKG XDOPE MSDWQ STDJK LMHPJ IMQAM
%FAJCK CWTLI BDBPB UQVXD NHJFS CTEAA WDATA IQDFQ TPXEJ PGIAE
%MIJBV BYVWA JHYET YMQEC FKMFI HAHDA ARJJB QEPSY OLDLU FGRNU
%MRCWF LPVGP GUUGJ AFAGJ CVRLM ANJEV PCDTH OARWI QVDEL CHTDE
%YLMLD DPWDU ZLZFI IWFUX OLZMV AOWBT QUNRJ OCHPV NIGAH XGFKC
%IAAOC XUPLD WLLZU PPDMK COLJJ ITQWR QCDDN HGNFV TZILQ AYSUN
%QIZAL XVIHJ BXQWP GHTEN UAWPI KXOJQ UJKKE MYTLV DNWWE PGWOM
%BKRMX RAKOF WSBUD WUUGA VNVOY JMTFR LBXZN HXPQI HKTZS WMOEW
%OOBLV MSLGY XKFWE VVDWO EKTFQ ROMKZ OHCLJ JUJAF IAAAI TEWEK
%RFPCW CEIRA BQJSY ZBKNW HECUZ BSMGW NJTLN LFPPF FYPIX YCWAR
%EYSGR BZFBH ORANC XPUBV DJBEP AMJUM JRYNP SJIIC NOQFY RGMIL
%YHNKT KVNRB JWWOX WUEDL FDDJY TLATL KFPKJ BVXGC FUDFF TBSVG
%XQINU FIQQE SNPJZ SICHC BCUPM JBIFN WRFMR YHIHR IUOQM XIGEB
%UPYCX CBEEU FBXTP XWFJE YWAIJ ZRGTI JBDVE YEWQC DETTC BRBGM
%TFVCP GHJNJ BFDZR NFGJJ KDGGG IEFAC QHFDA CBEUD APQVF IIBVU
%XWPVI TYDRD EUVKX ZIDTH DXORG IKNQF TNMYO WEBWC YRBFS NARHW
%HCXZI IIEWP GRPDQ ANYXA WTIIO FROLC QWFWK TPYHM WQTPM LCQRE
%ASVUR WESBM UMIGK LWNWT QRJPL WGOWE HNKTV LVNJP OPLRJ KSELY
%YRMBD ASSCG FKEER KXCIJ HIDOV KYGDO FFHJL IZTFM BDYHO UOKOY
%YUVSU MPXCM EGFXA LNWGI TMNGJ DEHDW URJBK UKOFB DYQYL FGGNU
%IQMWD IJFBT SATUG KUCED QGEKT VYTQL YNOBG ZDYTG MINBK ANTVJ
%OSDZT QWILO HNWWA GHHEP JDOEI COJVF XFWLI NKVPN HKHWU KWMKW
%LUHNR ELXNH HMJKU CFVNS BVFKR CNFRC IJUMN RWJGQ RLTWR VEXBP
%COPRP JLNWW APPXA LOVHQ BAYQC DZSBA UYTSJ IAHIF QNOJV CHRCL
%QCTSB AATLB YAKQU LXHDG JCJBR HBZMP ODRVB VHRZO LYXAU GRFOG
%LVTNV XHMXK XYLOU UNCGG URJVQ PONBP MAWPP SRBKB QCKWO YXKTL
%OIRHC CEODY OWBXQ SQWSH QPTEU UKKXK AZFDR JHWQY DNFLO AVIOY
%JMDCJ GPJJT JNAKY JGXFK UCEQR ERPCT CPURK XEKOP PPGKP GIFLB
%IQULC WOKVM FOIBO XLOKF NXPAD DAWEB BEKAT RAHKL JAXAO YDHUX
%DQNJU BREST NTANI GVZNZ OICIY DROXW IKJFR OOGLL FOGLR RGIJP
%PJWDF NNNRN BVTLM ESVDF LDCIJ TZVCF EYZLN PMANX YRGRQ ABBJH
%OIDPG SUHCN HBYUN JGCCR RVAYO FLLZF LGBLO DHPQE ESZZS TOLWB
%LHEDM GLFBJ KMEPW XGGBH NCBRS KSXIY HDOVI WFIXV XYMOZ DHNRM
%CDJTA WHGWL VEKEA XLUMV YBICX FRJFG XIKOC ECCVQ CFTXW MBDZG
%TIBYL FMRWB JLVRC EKRGH JLTPJ OHXKL WMPPK EBHDG ZKGVG TBAWM
%TLPGL ZRRAS CVJHF ICDVS PIEWH NXEJV NFPDE NDSYY
%CHACIN MEDINA
%
255/89 Teil 1 GTver101
%SYNCB ZKYKV YDZEH ZKYKV YDZEH ZKYKV YDZEH TQUVB JDMHQ WVPRA
%QSFBY SWYIK DEXNS RRLNW FMMEX GWGFN BFKLM EQPWH VYFGY WNOVB
%ABORS QUWVI DCCQB GBTCW MAJQK YLSDY BFBNZ XGBAO PUUIN UOPQF
%OERBK WMOKG FPKWB XVRSE RPIDP NMNNE QIKVO ELIHM WHQPR VWVWW
%MXSES WKGBT NCFXG WCGNC VQNRP QPRIO RYJAX SWFOV XQENP FBDTA
%DPSCO FQIBB RUDWU WOVTQ ZHNFF XSYWF JSAFV LAPOK YJLHH XNVTF
%BDSGJ YRPIH GBENA QAYAV VEPYC ATAUQ WPSSM LINPI TQSIM GXDQQ
%LTPLN VCUNB JKPKE AOQFG IKWYE OXBOP UVJAP OORDX ONGID DRNZY
%FLXHY KNZBH OYAYH NSDAA HGRBJ BQQRJ NWSTW VOUXD VRAUR TQNBI
%HFOSI AMHIY DUYHY EXNLE UGONY QLFAE APTBE ZONPQ HPPHG OHENT
%QJOJC JHMIG NTHCA GJKCM JGWKQ ZHDYJ ZDFTR PCPDU QDLMF BDFJU
%JGLEM TBBRS JFHFL KDTTP NOVRQ ZJBXE LPKHN NICBG WSGCP ARLID
%FPTGY LGRNA UPAPN IDPHH FMLBS OKMVD JVDXD BNETY EXWKW SBHMH
%DSDGH CXWVB KGVXA CMVRC CCERR OTNOF JDTSM CDNSO KJESC AMWOQ
%OKMUI VFYNV KAYJQ LLSMG RFSSU WYEOK DDXUW HYSBB QRIIK LJLHA
%TACNW AIMOB SZJDS TBHII KFYVB RAGJR YSCNM IBUPX DFVYO GTDZF
%TXVGI RWBLB BMXPJ MPMCE IWRPD SOBCF WEBOC RRGEG ONBOY GUTIZ
%SEOTQ MTLHO DSOFH SWFLR OLCVB DLMKC NJYKY MCITD NLQFF UTPXJ
%QKLDQ MXNTP OXHKQ GTUDO TOXIY KVABY RDJRD IKSXZ IWGGC LQVEI
%JDMKS UELPL OEBKR PDMUU IXZRU XRBZQ VOCUL GCMUR QHPQX BFSHQ
%RASBD ZMFTT KQCUD DDDJX OYNUR GYOHO HYLIK TGKAR QECOL QFQYU
%KPPXD NOGOH VYXDU CSOHB USAMS IFOIL SWEVJ QPIYK POEML OUHKG
%HKSAM FYHMS BLHTF PPDFT TSPUQ XAZRR IMVJL CIYMJ MYKUB GOCYL
%BONPY GMGOG XWWYJ PNIKB XUCPN UWHXN CQIXN WYVGK RZLAX CSIBV
%CSBZJ KUEIR TIOOU EIHFN MAEDS SDVWC RHOXL HCEKU GBSGA CCHWA
%ZRFRR OOYPG ERUKT YYRMF FQMJH AXGBQ ROGSF WLMLQ EBMLA VFRDZ
%JYZPN WKTTM LZABP HLBBX VJQTC OMVVN LEGUK AKZLB ZPSVJ UUHPQ
%MXEVY CBOZK MDDYQ BFBTM JAQEQ OWPVY GMXLG EJPRR UKKXV EBIYQ
%MAMWV WJZGE DGZXV BZAPL AUFUT RWJHA DDBUR MAWLA YNTIR GMQWO
%ONYLZ HIPPB LDLMP UIAHG XYVPI KKVFA APSQE ZEPUV XNQXC SUQHY
%DKNRA DIXAB XVPYE SWZEV AQTAF HYMGR JXDRA THSGG XPPCR UJOKL
%RKION XEJYD FPCRA LNSGS RSCDP JEMSA LUYXE QFZPN LSIEO GKFRS
%TQBON DAWYA ABMAV ALAYZ OAKOJ ZNCYO WHZDR HVOAP HTTHR QLMBN
%QTZIL NAQUM EDBQP TNXHK SKIFB IQQUJ SHNMX EPVJR RFDJH IMYNR
%VSGPU LZKFL MNGSJ PAHHX BXCBW TLOLF MHCKQ QLRUF YPHAM GQUTM
%YCNIO QLDNY RRHXV FSMVM JCVVS ZSGQS NEYJZ ILQKG DCHNV KJINS
%HWFSK QKKFG BVFBM GGDOB ZRQCW NWUIO JABPP FYTHU BDOFV ZGCUO
%FTNZR FJWIJ WPRCY WHYUZ SETNY WQSTP RNSGH VNFGP KYDYL SXYYD
%KKITI EJDAV UIWZX RLAOC TGPXO NLTPN CFLTD HGZEM LEGGB IBPDN
%HKOMT PAIMS QTBVN IVAZD RSUHN YXTFO SAFOO XLKDZ PJHKF VEIMO
%CESNQ AOZBB CLIMK TCNZL PGOMR ZEAVG FTREQ CVFUL FAQWF EJHPF
%CUKSK ZTBWL HIJLN DXGTO PMJEE UXQKW UNHEB ADBWU XKBCV YMYFT
%FBURO MNCPX UHODB BSKCL QUYJS IBYLZ CKHLA RJEKW XQFRQ IUOVU
%QFBAD LCOKS IUQJS SUTSC HWITR SWHYG CBQMC ACBMO HGNCJ PVLAC
%GUETJ HJGVB YLHEJ XGIEK DEVZC FXTBC FINOD LORJB DIUTO IPBHK
%FMYNN UJMWK DERJU IEFHJ MVTTY GFZIX JNOXX JWHZZ SBRKD HVDXN
%YLVHJ JNXYD QXVFS LKYSH MEOQK WMWXJ ICQST GZRBP AFDPE MJAQB
%MVOPT TFQPC FHXFC OLQBK NSGFA TGHNO DMBLP OTHXE LQOMQ LSEWQ
%CUMSN BSKNX QOQRA MPZNP TUJUR TWBBI RLJXH HHHLI JCQCP GJOCB
%RUSRY LVLSU FFKIB LBPMU MAGYK IDCRF SJUVP YAEEK YNZKX ZORCN
%FKGFQ NYRSE SOWFI CEFWJ MHNPN XURYC CUDNU BEYCM GCWSV TODAA
%SOMXJ OZEPX PPJUR CBVIU BTSZU XKMQV BIZCS DITEB OCXVQ YQJFK
%JUUQH YNFSD MVDPA NBFIC GURTH MXCPN JXOGT THIPB MVVMX MUYEO
%CJMLN DSQTC IFALJ EJGTC SVMGS UPKXR GSSLA DXQGT VQIEK VMTLE
%NAMWG MUNDB YNYTK FJJAH XOJYI WRUYQ RXFNH XVWLB HIKBL ZKUDR
%SFCXH CVICB KHFZN IDGDT CNVMS UTRHY MHXYQ PRGPT HGJOQ HORMJ
%PYSNM ZJPBY LBBJB JVVWN YLXTX TKRHI PMMUJ TUEHK CEHXM JHKDR
%DGNHR FOWWB WKRLA TSWFA LBSLZ OCWCQ MMZEG DDGPI JKSXF NCEND
255/89 Teil2 Gtver102
%SYNCB RRUHR FZRIR RRUHR FZRIR RRUHR FZRIR NCMIS XPFRP DDOGR
%CDHGI HAXCG HADIH RCEVR MMBDL ILRRK PPWUS BNOMC JVLUA CUGIY
%RLEVP GBPVH MBGDY RDVWT UAANR JKIHW PVPFW YHIEX KHYQF UKCGB
%UPZFC IPWNY AFIHQ GNIHS GENCW OVQMD ZFLOP PQXOE UUOKM RIQCN
%NSXGQ BTRMN THTXR XCDRO MXRHG XMOKT WGEDS ATAOE SEOTJ HSPPK
%TABJF FTZVK NMHTR VDLYD YCHHM KTRCL XEVFG WICBT FLEJA USHXF
%UJVNQ XSNDC MLUKV JYAYB FZJBJ EPHPJ GAUBX SJDCH PIQST XGBPJ
%DHRHV NTAKN PDLJJ PFFCA SKUWG JNXNF UEQSP BFIEQ WQFAX LBILM
%LPDFV LRXCM VXQEX VRJJZ NDLTF RVNSG TSMBY SPHXD NQORA AGDSS
%FSZAH VMROI EZONS PXXYR MNXQA AHLTR PSXPC TPKFE CBPPR UDNKR
%VZTBW SBNQH IPFES IYRIT GPYJU ZLFRT NSLUC SMJAU BTDII OQMJB
%UIAIW QILJK EXGNZ AAKUH HPDCJ LTKZB BVOOB DMMPY WWKPN NWBTY
%FMFMQ RXTUB PKNOX FLPGN PGCAL XVBAE AWYJQ UMGWA HMFYJ HLWCS
%AQKCJ AAQEQ YIBWT VAOGW QNKXH CKFBS HKOVS QFNSO XYRWQ LOQTX
%TLXEK LCRSM TKNRL TZRNT RHJRB PKIQZ MARSY KUISH JXJJP FYQBM
%APZYF GKMXO THVLQ DEEOP SQITK LVMME WVPIV HDHZC AGTRP QSXNN
%AZPGG VLTKZ CIIXD VAFMC TFZQQ ODGNN CLPNO SDRKZ CFMDW RCNXT
%ILYPC RILAS MTYJP YXUWU VVAHG XYLDW AFIUS NAFBA IJYQB NYGME
%USPNN MLDEP DXITI IAFKM RPLGT VJLEZ IICXQ UIHAP YXBXN PMBDD
%UWJQJ PQOMC PLCBC TXNFR TRESJ PCOOW WYAXB HWHKA PYOGA FORVJ
%HMVOC TELAB UJTWK FAWFM CIZQP XIOXA EWHOU AWSGX VFDVL VPFDX
%IGJDW ZBKBK YPWAR JQGRJ EYPSN ALSGY RKSXB AHRVG NXNTP DHFAG
%JPIJV WEWJG UQWTN DMWTT CDFBR CKHXI NCVDU ADDKC KDPII NIODX
%EHZDI HRQTX FMKEI YYCKR SIYIH BNXWM YLVXS IDNGC SVNWK GWXVI
%BVRDL ISHRI QHWTO LDEKY XIJFZ JOAVU BFCVC OXKAW KFMXH LRGSQ
%JGHVN GZNIS GFPMU QSKVC OEWDR ZBJMK HDHQW FDJFW STSCT QSRXI
%PPZRC THBTF USKIV GBLFK LOXGS XLJTF LVQVU OIHIV BOVTH KAVUA
%IMBIS WJUDW HVKHF SQJQC FKNDF EQIOC FSDSQ ACOLC APZQK ULPKD
%UGOVB QLGVG QIHSQ SOTXA RHGXW NTOCK ZPPSH LLAFN JWEPK OXPTF
%RPDWL VNXMD XRRLK EMGEO AECXQ BVOPO SYAGD QDTNX NLSYN INRMK
%VIXEL KJRYK QDRWN ZFZFB QGWPT KVFFW WKRBB IOHNO UEQGZ KQRCL
%TXSEB MIIXQ LJXOE CADNT GCNQC POLXL CUGNI PINMA DQALD HTQXO
%MGOTW NUFCA IZFUB ACAYN XMDUO PQHJM HZPFI PVBFA DEEQS HTFYY
%VKZOK NSQPH SJJLO BPTIW SMPFM ESPTV LLIJQ PNYAJ DTAGS PAEPG
%XLQEQ WWSBF LJNVY IQWRM RDHAJ TOASR HAQFO ODNES TACRX RMYJQ
%RGDWP JFETI RMFFE EHCSK AGCKD LDXQK SAUDO OSIHP UDLIT UGMTE
%HBBKO VJRXD VMRQU AKFLE CJUOW AMSIC KVXJV DWMSM DUDCP UFIUV
%ZLQAA HIOIR ZHVJY FPANU HVRBY KMUXT NAUIK LBMXI HIUYD EKDDW
%YDXXF PTDMM GAUDG BJLYQ XIWGS PKYIP SAJRQ YCIDV RVEDS VOADI
%AHSTB PPMTX GCLID IGMFL EZRFY RHZEH MERIS KBAOH TFLSA PEARP
%ZIANZ FBTPS MPLIE SPQBI XXBLZ SBTMC WKKLI FJSEI ZLRJE SFRWV
%DKJMM QVMYP WAMSL PXGQY VRYEN CXNLK KOBHA AYZGA YXIXU AMCBK
%UPRTC MDUBD VVNMF YQNIQ LZAKP HOLVF BXERY TQRRD DONKE EJZCQ
%LPGWV FOWFW APELP DIXYS KADHO EFMGF GBRIN KGNKB HSKVQ NKYNA
%QABAO OBKZD QEHNN RXVIJ LMDEN TSUSO KPIMZ RPJZR WDIHT USNCN
%YICIK TAFKM CFMYM BKVFT WINUO QFVCH DYQDV DEALX NOFMG MNXUK
%ZESVD QVINT YBJAD ZGMGM IVQSN SDNJS UBCZH MTOHX BPJRB WGQBJ
%AXUFB HDRRJ ZNKEF WNJPI KLSYD QKCJA SLTIP QSDAH BRHZF RNPLG
%KVGEB WDPFM UYMCB UOBKT DFEXU HGJMB BIFKD SQEMT BGHWA KKFKD
%UMVML SQMYA BTTTN XIIKB QYQQQ JYFXJ ORAEN DSYYY
Interner Schlüssel
Sector 0000000
0000(0000) FFFF01026D7ED61A-787E5363DF40543F
0016(0010) 574B6977D72EFD14-677ED61A787ED263
0032(0020) 5F005B7F560BE817-566EBC14EC7EC72A
0048(0030) 482E13132F4C241F-0219BD000F4DBE58
0064(0040) 04112613804C9A5B-1804337114577201
0080(0050) 880F3D788530E673-010CCA2BE834F261
0096(0060) B44F2251984F8C04-3458370330143671
0112(0070) AC1A4F08A85CB87D-8903FD24F6146A6C
0128(0080) 7A176F1F6A3C1759-5E2C7D6F7B6B0F44
0144(0090) A4042B2D1B47FF47-AA1896618E74FC33
0160(00A0) 134BDE2058665F5F-030D770A9719092B
0176(00B0) 073574622E59461B-6E77802B914A1D20
0192(00C0) 90434E6B4056C52A-6C19542E5D67C35B
0208(00D0) F073D5105127E727-C846480C691F385E
0224(00E0) 6935972CD518B350-C57D7A355A60D16A
0240(00F0) 861596402F530B55-1102230920581D77
0256(0100) 9A50C03E0D1D562C-841F685DEA3A3B58
0272(0110) E54201618B1A7926-ED375779ED2C9A49
0288(0120) 331D8F69990A5C39-3D0AC0722F397C0C
0304(0130) 1B0C181206673069-7C55A440D47AA93E
0320(0140) FD050D447938D601-5865AE15B942F568
0336(0150) 9506704775648618-EC4482431B592700
0352(0160) F727394666226D48-7F360727D34F435B
0368(0170) 85493B07CD4F006F-FC6F250030341B00
0384(0180) D80DDA33DA6DF445-D767580BF52EEA58
0400(0190) 5C4F072555576722-EC26726114263A4D
0416(01A0) 947E5545CF69BC47-6234602A6B6C3048
0432(01B0) 170E2C2F0C1D434D-0843BA150427B522
0448(01C0) BD4E624CF043397D-2C040B69E37F5345
0464(01D0) 36236A743310E70D-4461853329428709
0480(01E0) B7550325630B6F0E-470AB2470533B56B
0496(01F0) 986017100742E069-872B3E69A8218C03
Sector 0000001
0000(0000) 6B700E026A506605-502CDD477509AD44
0016(0010) 2243D677DB27C64A-2E10F70724460D4D
0032(0020) 252929449751B66B-5B6BC623DE393821
0048(0030) FC194553504AB310-996D3A0D224FE115
0064(0040) 7A6AFF6573663402-E24A3A74DA215507
0080(0050) 417D912E7A2A9B3F-B770E124361A4E42
0096(0060) F3018C02DD72FB08-4F32BE168D4FD30F
0112(0070) 8950026749214178-6C0178006A639B40
0128(0080) 252F18627E770B6D-2F01F2579A6D6E1E
0144(0090) 8B5A92665C13F402-6A61D732264E500D
0160(00A0) CE46D36CFF09FD6F-AB387A0C134EEC68
0176(00B0) 3218BC232369972D-1903D371B923526A
0192(00C0) 32672C5CBD00910F-9C697D2D4F712646
0208(00D0) F86D2F2F667A1B0C-E060893657367E29
0224(00E0) 84027917BE05BA12-70269229E31BD91F
0240(00F0) 6C68A044737E1B01-0552F527C7666B5C
0256(0100) 5D1720019206B72D-8038CD2E1C5EAF63
0272(0110) 9B4B7E5E5C7A726D-5D4A6B5BF9440F12
0288(0120) F9232828F0570C13-426B674773713E25
0304(0130) 2D5E2A313437CA28-B9106671CC60EB42
0320(0140) 285B776EB2597621-8A0DD71C577B0868
0336(0150) 630AE733B6454B1E-676AA84806335968
0352(0160) DA156A724B6A5D6A-D76D01185204E74A
0368(0170) 17591F38BF2EFF22-6F588A6A611FE348
0384(0180) F04DF53705589F05-5D6E650ABF5DE846
0400(0190) 196B1235F9715612-0227A9279F401E3F
0416(01A0) 446FF630AF663C25-9B3B415AA12E990F
0432(01B0) ED706D4EB33B611A-3F33EC40F26AB24A
Chiffriereinheit, Block mit den Nr. 1 und 3.
Abb.: Rückseite des Gerätes mit Chiffriereinheit.
Software Paket
Auf der Seite Freeware kann, die mit Turbo-Pascal 7.0-de
unter Einbeziehung der Bibliotheken der Toolbox aus dem
CHIP-SECIAL Heft 1993 kompilierte Software, als ausführbare
Programme geladen und auf einem PC mit DOS oder der DOS-BOX
0,74-3 gestartet werden.
Das gleiche gilt für die NASCOM-2 Baisc-Programme.
Dem Paket liegen die Bibliotheken nicht bei!
inline($b1/6/$b5/6/$b4/1/$cd/$10)
Disassembliert
0000:0000 b1 06 MOV CL,0x6;
0000:0002 b5 06 MOV CH,0x6;
0000:0004 b4 01 MOV AH,0x1
0000:0006 cd 10 INT 0x10; set cursor ON
inline($b1/8/$b5/8/$b4/1/$cd/$10);
Disassembliert
0000:0000 b1 08 MOV CL,0x8;
0000:0002 b5 08 MOV CH,0x8;
0000:0004 b4 01 MOV AH,0x1
0000:0006 cd 10 INT 0x10; set cursor OFF
inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21)
inline($b2/$31/$cd/$21/$b2/$43/$cd/$21/$5a/$58)
Disassembliert
0000:0000 50 PUSH AX
0000:0001 52 PUSH DX
0000:0002 b4 02 MOV AH,0x2
0000:0004 b2 1b MOV DL,0x1b Sonderzeichen ESCAPE
0000:0006 cd 21 INT 0x21 AH 0x02 Display Output
0000:0008 b2 5b MOV DL,0x5b Sonderzeichen [
0000:000a cd 21 INT 0x21 AH 0x02 Display Output
0000:000c b2 31 MOV DL,0x31 Sonderzeichen 1
0000:000e cd 21 INT 0x21 AH 0x02 Display Output
0000:0010 b2 31 MOV DL,0x31 Sonderzeichen 1
0000:0012 cd 21 INT 0x21 AH 0x02 Display Output
0000:0014 b2 43 MOV DL,0x43 Sonderzeichen C
0000:0016 cd 21 INT 0x21 AH 0x02 Display Output
0000:0018 5a POP DX
0000:0019 58 POP AX set cursor right
inline($50/$52/$b4/02/$b2/$1b/$cd/$21/$b2/$5b/$cd/$21)
inline($b2/$31/$cd/$21/$b2/$44/$cd/$21/$5a/$58)
Disassembliert
0000:0000 50 PUSH AX
0000:0001 52 PUSH DX
0000:0002 b4 02 MOV AH,0x2
0000:0004 b2 1b MOV DL,0x1b Sonderzeichen ESCAPE
0000:0006 cd 21 INT 0x21 AH 0x02 Display Output
0000:0008 b2 5b MOV DL,0x5b Sonderzeichen [
0000:000a cd 21 INT 0x21 AH 0x02 Display Output
0000:000c b2 31 MOV DL,0x31 Sonderzeichen 1
0000:000e cd 21 INT 0x21 AH 0x02 Display Output
0000:0010 b2 31 MOV DL,0x31 Sonderzeichen 1
0000:0012 cd 21 INT 0x21 AH 0x02 Display Output
0000:0014 b2 44 MOV DL,0x44 Sonderzeichen D
0000:0016 cd 21 INT 0x21 AH 0x02 Display Output
0000:0018 5a POP DX
0000:0019 58 POP AX set cursor left
inline($b1/05/$b5/00/$b4/1/$cd/$10)
Disassembliert
0000:0000 b1 05 MOV CL,0x5; cursor ending scan line (cursor bottom) (low order 5 bits)
0000:0002 b5 00 MOV CH,0x0; cursor starting scan line (cursor top) (low order 5 bits)
0000:0004 b4 01 MOV AH,0x1
0000:0006 cd 10 INT 0x10; set cursor type
inline($b1/00/$b5/15/$b4/1/$cd/$10)
0000:0000 b1 00 MOV CL,0x0; cursor ending scan line (cursor bottom) (low order 5 bits)
0000:0002 b5 15 MOV CH,0x15; cursor starting scan line (cursor top) (low order 5 bits)
0000:0004 b4 01 MOV AH,0x1
0000:0006 cd 10 INT 0x10; set cursor type
Entsprechend den Fehlermeldung des Turbo-Pascal-Compiler
wurden einige Variablen von integer
in WORD
umbenannt.
