home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / sigisoft / codierer / versch16.lst < prev    next >
File List  |  1987-04-21  |  8KB  |  328 lines
  1. ' ********************************************
  2. ' * Datei Verschlüsseler/Entschlüsseler      *
  3. ' ********************************************
  4. ' * Dies ist ein Public Domain Programm von  *
  5. ' ********************************************
  6. ' * (c) 1991 by       Siegfried Hübner       *
  7. ' *                   Obere Vorstadt 21      *
  8. ' *                   8812 Windsbach         *
  9. ' ********************************************
  10. ' * Datum 07.01.1990                         *
  11. ' ********************************************
  12. IF XBIOS(4)=0
  13.   ALERT 3,"Bitte auf|mittlere |Auflösung|umschalten !",1,"Okay",d%
  14. ENDIF
  15. CLEAR
  16. x=0
  17. l=0
  18. b=0
  19. a=0
  20. z=0
  21. emil=0
  22. geheim$=""
  23. geheim=0
  24. ON ERROR GOSUB fehler
  25. HIDEM
  26. DEFFILL 1,2,2
  27. IF XBIOS(4)=2
  28.   PBOX -1,-1,640,400
  29.   DEFFILL 1,2,3
  30.   PBOX 100,100,370,270
  31.   DEFTEXT 1,3,3,32
  32.   TEXT 10,40,612," Datei - Verschlüsseler/Entschlüsseler "
  33.   PRINT CHR$(27)+"p";
  34.   PRINT AT(2,4);" ----- (c) 1991 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ----- "
  35.   PRINT AT(18,9);" 1 = Datei verschlüsseln "
  36.   PRINT AT(18,11);" 2 = Datei entschlüsseln "
  37.   PRINT AT(18,13);" 3 = Geheimzahl          "
  38.   PRINT CHR$(27)+"q";
  39.   PRINT AT(18,15);" 4 = Programmende        "
  40.   PRINT AT(50,7);"Dies ist ein Public Domain   "
  41.   PRINT AT(50,8);"Programm. (frei kopierbar)   "
  42.   PRINT AT(50,10);"Alle die dieses Programm be- "
  43.   PRINT AT(50,11);"nutzen, sollten mir aber ein "
  44.   PRINT AT(50,12);"kleines Anerkennungshonorar  "
  45.   PRINT AT(50,13);"zukommen lassen. Sonst könnte"
  46.   PRINT AT(50,14);"es sein, das bald keine      "
  47.   PRINT AT(50,15);"weiteren Public Domain       "
  48.   PRINT AT(50,16);"Programme mehr von mir       "
  49.   PRINT AT(50,17);"erscheinen werden.           "
  50.   PRINT AT(50,19);"Und das wollt Ihr doch nicht "
  51.   PRINT AT(50,20);"oder ???????????             "
  52.   start:
  53.   PRINT AT(13,19);" --> Ihre Eingabe (1,2,3 oder 4) ";
  54.   DO
  55.     FORM INPUT 1,ein$
  56.     IF ein$="1"
  57.       GOSUB ver_sc
  58.     ENDIF
  59.     IF ein$="2"
  60.       GOSUB ent_sc
  61.     ENDIF
  62.     IF ein$="3"
  63.       PRINT AT(33,13);
  64.       FORM INPUT 8,geheim$
  65.       geheim=VAL(geheim$)
  66.       emil=1
  67.     ENDIF
  68.     IF ein$="4"
  69.       ALERT 3,"Wollen Sie dieses|Programm wirklich|verlassen      ??",2," Ja | Nein ",d%
  70.       IF d%=1
  71.         END
  72.       ELSE
  73.         GOTO start
  74.       ENDIF
  75.     ENDIF
  76.     GOTO start
  77.   LOOP
  78. ENDIF
  79. IF XBIOS(4)=1
  80.   PBOX -1,-1,640,200
  81.   DEFFILL 1,2,3
  82.   PBOX 50,55,285,125
  83.   DEFTEXT 1,3,3,30
  84.   TEXT 18,35,612," Datei - Verschlüsseler/Entschlüsseler "
  85.   PRINT CHR$(27)+"p";
  86.   PRINT AT(3,6);" ----- (c) 1991 by Siegfried Hübner, Obere Vorstadt 21, 8812 Windsbach ----- "
  87.   PRINT AT(10,9);" 1 = Datei verschlüsseln "
  88.   PRINT AT(10,11);" 2 = Datei entschlüsseln "
  89.   PRINT AT(10,13);" 3 = Geheimzahl          "
  90.   PRINT CHR$(27)+"q";
  91.   PRINT AT(10,15);" 4 = Programmende        "
  92.   PRINT AT(44,8);" Dies ist ein Public Domain   "
  93.   PRINT AT(44,9);" Programm. (frei kopierbar)   "
  94.   PRINT AT(44,11);" Alle die dieses Programm be- "
  95.   PRINT AT(44,12);" nutzen, sollten mir aber ein "
  96.   PRINT AT(44,13);" kleines Anerkennungshonorar  "
  97.   PRINT AT(44,14);" zukommen lassen. Sonst könnte"
  98.   PRINT AT(44,15);" es sein, das bald keine      "
  99.   PRINT AT(44,16);" weiteren Public Domain       "
  100.   PRINT AT(44,17);" Programme mehr von mir       "
  101.   PRINT AT(44,18);" erscheinen werden.           "
  102.   PRINT AT(44,20);" Und das wollt Ihr doch nicht "
  103.   PRINT AT(44,21);" oder ???????????             "
  104.   start1:
  105.   PRINT AT(4,18);" --> Ihre Eingabe (1,2,34 oder 4) ";
  106.   DO
  107.     FORM INPUT 1,ein$
  108.     IF ein$="1"
  109.       GOSUB ver_sc1
  110.     ENDIF
  111.     IF ein$="2"
  112.       GOSUB ent_sc1
  113.     ENDIF
  114.     IF ein$="3"
  115.       PRINT AT(25,13);
  116.       FORM INPUT 8,geheim$
  117.       geheim=VAL(geheim$)
  118.       emil=1
  119.     ENDIF
  120.     IF ein$="4"
  121.       ALERT 3,"Wollen Sie dieses|Programm wirklich|verlassen      ??",2," Ja | Nein ",d%
  122.       IF d%=1
  123.         END
  124.       ELSE
  125.         GOTO start1
  126.       ENDIF
  127.     ENDIF
  128.     GOTO start1
  129.   LOOP
  130. ENDIF
  131. ' *************************************************************
  132. ' * DATEI Verschlüsseler                                      *
  133. ' *************************************************************
  134. PROCEDURE ver_sc
  135.   CLS
  136.   BOX 157,15,482,52
  137.   BOX 159,17,480,50
  138.   DEFFILL 1,2,2
  139.   PBOX 160,18,479,49
  140.   DEFTEXT 1,0,3,30
  141.   GRAPHMODE 2
  142.   TEXT 160,45,310," Datei verschlüsseln"
  143.   ' ************ LÄNGE ERMITTELN ***********
  144.   FILESELECT "\*.*",a$,a$
  145.   PRINT AT(1,1);STRING$(80,32)
  146.   OPEN "I",#1,a$
  147.   z=LOF(#1)
  148.   CLOSE #1
  149.   ' ************ DATEI EINLADEN **************
  150.   OPEN "I",#1,a$
  151.   b=LEN(a$)
  152.   c$=LEFT$(a$,b-4)
  153.   IF emil=0
  154.     OPEN "O",#2,c$+".VER"
  155.   ELSE
  156.     OPEN "O",#2,c$+".GEH"
  157.   ENDIF
  158.   REPEAT
  159.     n$=INPUT$(1,#1)
  160.     ADD x,7
  161.     INC l
  162.     PRINT AT(1,1);"Schreibe ";x/7
  163.     a=ASC(n$)+z+geheim
  164.     IF l=5
  165.       PRINT #2,CHR$(a+x)
  166.     ELSE
  167.       IF l=17
  168.         PRINT #2,CHR$(a+z+x+l);
  169.       ELSE
  170.         PRINT #2,CHR$(a+z+x);
  171.         l=0
  172.       ENDIF
  173.     ENDIF
  174.   UNTIL EOF(#1)
  175.   CLOSE #1
  176.   CLOSE #2
  177.   RUN
  178. RETURN
  179. ' *************************************************************
  180. ' * DATEI ENTSCHLÜSSELER                                      *
  181. ' *************************************************************
  182. PROCEDURE ent_sc
  183.   CLS
  184.   BOX 157,15,482,52
  185.   BOX 159,17,480,50
  186.   DEFFILL 1,2,2
  187.   PBOX 160,18,479,49
  188.   DEFTEXT 1,0,3,30
  189.   GRAPHMODE 2
  190.   TEXT 160,45,310," Datei entschlüsseln"
  191.   ' ************ LÄNGE ERMITTELN ***********
  192.   IF emil=0
  193.     FILESELECT "\*.VER",a$,a$
  194.   ELSE
  195.     FILESELECT "\*.GEH",a$,a$
  196.   ENDIF
  197.   PRINT AT(1,1);STRING$(80,32)
  198.   OPEN "I",#1,a$
  199.   z=LOF(#1)
  200.   CLOSE #1
  201.   ' ************ DATEI EINLADEN **************
  202.   OPEN "I",#1,a$
  203.   PRINT AT(21,1);" Bitte Orginal Namen der Datei eingeben "
  204.   FILESELECT "\*.*",a$,a$
  205.   OPEN "O",#2,a$
  206.   PRINT AT(1,1);STRING$(80,32)
  207.   REPEAT
  208.     n$=INPUT$(1,#1)
  209.     a=ASC(n$)-z-geheim
  210.     DEC l
  211.     SUB x,7
  212.     PRINT AT(1,1);"Schreibe ";ABS(x/7)
  213.     IF l=-5
  214.       PRINT #2,CHR$(a+x)
  215.     ELSE
  216.       IF l=-17
  217.         PRINT #2,CHR$(a-z+x+l);
  218.       ELSE
  219.         PRINT #2,CHR$(a-z+x);
  220.         l=0
  221.       ENDIF
  222.     ENDIF
  223.   UNTIL EOF(#1)
  224.   CLOSE
  225.   CLOSE #1
  226.   CLOSE #2
  227.   RUN
  228. RETURN
  229. PROCEDURE ver_sc1
  230.   CLS
  231.   BOX 157,1,482,26
  232.   DEFFILL 1,2,2
  233.   GRAPHMODE 2
  234.   PBOX 160,4,479,26
  235.   DEFTEXT 1,0,3,18
  236.   TEXT 158,24,310," Datei - verschlüsseln"
  237.   ' ************ LÄNGE ERMITTELN ***********
  238.   FILESELECT "\*.*",a$,a$
  239.   PRINT AT(1,1);STRING$(80,32)
  240.   OPEN "I",#1,a$
  241.   z=LOF(#1)
  242.   CLOSE #1
  243.   ' ************ DATEI EINLADEN **************
  244.   OPEN "I",#1,a$
  245.   b=LEN(a$)
  246.   c$=LEFT$(a$,b-4)
  247.   IF emil=0
  248.     OPEN "O",#2,c$+".VER"
  249.   ELSE
  250.     OPEN "O",#2,c$+".GEH"
  251.   ENDIF
  252.   REPEAT
  253.     n$=INPUT$(1,#1)
  254.     ADD x,7
  255.     INC l
  256.     PRINT AT(1,1);"Schreibe ";x/7
  257.     a=ASC(n$)+z+geheim
  258.     IF l=5
  259.       PRINT #2,CHR$(a+x)
  260.     ELSE
  261.       IF l=17
  262.         PRINT #2,CHR$(a+z+x+l);
  263.       ELSE
  264.         PRINT #2,CHR$(a+z+x);
  265.         l=0
  266.       ENDIF
  267.     ENDIF
  268.   UNTIL EOF(#1)
  269.   CLOSE #1
  270.   CLOSE #2
  271.   RUN
  272. RETURN
  273. ' *************************************************************
  274. ' * DATEI ENTSCHLÜSSELER                                      *
  275. ' *************************************************************
  276. PROCEDURE ent_sc1
  277.   CLS
  278.   BOX 157,1,482,26
  279.   DEFFILL 1,2,2
  280.   GRAPHMODE 2
  281.   PBOX 160,4,479,26
  282.   DEFTEXT 1,0,3,18
  283.   TEXT 158,24,310," Datei - entschlüsseln"
  284.   ' ************ LÄNGE ERMITTELN ***********
  285.   IF emil=0
  286.     FILESELECT "\*.VER",a$,a$
  287.   ELSE
  288.     FILESELECT "\*.GEH",a$,a$
  289.   ENDIF
  290.   PRINT AT(1,1);STRING$(80,32)
  291.   OPEN "I",#1,a$
  292.   z=LOF(#1)
  293.   CLOSE #1
  294.   ' ************ DATEI EINLADEN **************
  295.   OPEN "I",#1,a$
  296.   PRINT AT(21,1);" Bitte Orginal Namen der Datei eingeben "
  297.   FILESELECT "\*.*",a$,a$
  298.   OPEN "O",#2,a$
  299.   PRINT AT(1,1);STRING$(80,32)
  300.   REPEAT
  301.     n$=INPUT$(1,#1)
  302.     a=ASC(n$)-z-geheim
  303.     DEC l
  304.     SUB x,7
  305.     PRINT AT(1,1);"Schreibe ";ABS(x/7)
  306.     IF l=-5
  307.       PRINT #2,CHR$(a+x)
  308.     ELSE
  309.       IF l=-17
  310.         PRINT #2,CHR$(a-z+x+l);
  311.       ELSE
  312.         PRINT #2,CHR$(a-z+x);
  313.         l=0
  314.       ENDIF
  315.     ENDIF
  316.   UNTIL EOF(#1)
  317.   CLOSE
  318.   CLOSE #1
  319.   CLOSE #2
  320.   RUN
  321. RETURN
  322. PROCEDURE fehler
  323.   ALERT 3,"Fehler ist aufgetreten|Ich fange Fehler ab",1,"Restart",d%
  324.   CLOSE #1
  325.   CLOSE #2
  326.   RUN
  327. RETURN
  328.