Zurück
Das Chiffriergerät GRETAG TC-850 BStU*654, Sammler*144

TC-850
GRETAG TC-850 und das Softwarepakte Simulationen - Dekryptier-
software.
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, sowie die
softwaremäßige Umsetzung, die in Vorarbeit 1983 durch
Kuba realisiert worden. Für die Sprachchiffriergeräte VERICRYPT bzw.
CRYPTOPHON erfolgte die automatisierte Dechiffrierung bereits 1983.
Laut Angaben, des Schweizer Botschaftsfunk von 1974 bis 1991, war
das TC-850 beim schweizer Botschaftsdienst im Einsatz. Sammler*145
In der schweitzer Armee: MilVo 58.112 d, gültig ab 1984, 1985 und
die letzte Ausgabe ab 01.01.1986. Sammler*146
Der höheren Führung der schweizer Armee wurde ab 1973 bzw. 1975 zugeführt.  Sammler*147

Grundparameter die für die Simulation wichtig sind:

- Strukturschlüssel (interner Sschlüssel) 128 bit,
- Grundschlüssel 10 Zeichen und
- Spruchschlüssel (Initialisierungsvektor) 10 Buchstaben (Zeichen).

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 Grunschlü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
     Initialisierungvektor             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. Letzeres
macht en Anschluß eines Druckers erforderlich.

Das Programm HzVarS03.exe wird von der Systemebene aus aufge-
rufen.

Die Führung durch das Programm erfolg über ein Hauptmenü, wel-
ches über weitere Menüs
  - Eingaben
  - Ausgaben
abfordert und Programmstar und -end ermögicht.

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) weren 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 sekdunden bemötigt.

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 HAUPTMENU }
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;                      { Registerausgange }
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) and 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.

Menu Menu1
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ößge 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 fur 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 fur 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üsseln }
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 {---------------------------------  lnitialisieren 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 {-----------------------------------------------  Erzeuaung 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 fur 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 {----------------------------------------------------- Ummandlung 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 {------------------------------------------------------ Einagben 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.

Menu Menu1
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 and 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;              { Verarbeitunglä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;               { Registerausgange 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 Gieichung 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;   { PrUfvariable 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; { Steurkombination 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üsseln }
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 and 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 {------------------------------------------------------- Hauptmenu }
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.

Menu Menu1
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;                  { Verarbeitunglange der Dateien }
0221   Gt1,Gt2:Gtfeld;                 { Felder fur 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;                   { Registerausgange 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 Programs startet }
0242   check:boolean;                  { mit(=false) and 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; { Steurkombination 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üsseln }
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 and 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.

Menu Menu1
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 and obere Taktgrenze }
0026   AnzGt:integer;               { Anzahl der zu kombinierenden Gt }
0027   p1,p2:shortint;              { Nr des jeweiliegen 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;                                      { Verarbeitunglä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;                           { Prlfvariable 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üsseln }
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 {------------------------------------------------- Initiaiisierung 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 and 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 {----------------------------------------------------------------------- Hauptmenu }
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.

HZV3.1 HZV3.1
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 and 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 fur 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;              { Verarbeitunglange der Dateien }
0219    Gt1,Gt2:Gtfeld;             { Felder fur 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;          { Spruchschlusselmatrizen }
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) and 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 Schü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üsseln }
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 and 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('Spruchschlussel 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

Filesort
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('Rrogramm  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, 2 und 3.

TC-850
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ührbahre
Programme geladen und auf einem PC mit DOS oder der DOS-BOX
0,74-3 gestartet werden. 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.