home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 06 / heimwerk / sysinfo.bas < prev    next >
Encoding:
BASIC Source File  |  1989-03-29  |  36.4 KB  |  995 lines
  1. '* ------------------------------------------------------- *
  2. '*                    SYSINFO.BAS                          *
  3. '*     Ermittelt die Rechnerkonfiguration über PEEKs,      *
  4. '*      Interruptaufrufe und das Auslesen von Ports.       *
  5. '*            (c) 1989  J.Braun   &  TOOLBOX               *
  6. '* ------------------------------------------------------- *
  7. '*            Compiler: Turbo Basic 1.10                   *
  8. '* ------------------------------------------------------- *
  9. DEFINT a-z : DIM monat$ (1:12)
  10.  
  11. SUB QPrint INLINE
  12. '* Quickprint-Routine aus TBWINDO.INC von Turbo Basic 1.1  *
  13.   $INLINE &H55, &H8B, &HEC, &H1E, &H06, &HC4, &H7E, &H0A
  14.   $INLINE &H26, &H8B, &H0D, &H81, &HE1, &HFF, &H7F, &HE3
  15.   $INLINE &H5B, &H51, &H8B, &H16, &H00, &H00, &H52, &HB4
  16.   $INLINE &H0F, &HCD, &H10, &H3C, &H07, &H75, &H08, &HBB
  17.   $INLINE &H00, &HB0, &HBA, &HBA, &H03, &HEB, &H06, &HBB
  18.   $INLINE &H00, &HB8, &HBA, &HDA, &H03, &H53, &H07, &H52
  19.   $INLINE &H33, &HDB, &H8A, &HDC, &HC5, &H76, &H12, &H8B
  20.   $INLINE &H04, &H48, &HF7, &HE3, &HD1, &HE0, &HC5, &H76
  21.   $INLINE &H0E, &H8B, &H1C, &H4B, &HD1, &HE3, &H03, &HD8
  22.   $INLINE &H8B, &HFB, &HC5, &H76, &H06, &H8B, &H1C, &HC5
  23.   $INLINE &H76, &H0A, &H8B, &H74, &H02, &H5A, &H1F, &H59
  24.   $INLINE &HFC, &HFA, &HEC, &HA8, &H01, &H75, &HFB, &HEC
  25.   $INLINE &HA8, &H01, &H74, &HFB, &HA4, &H26, &H88, &H1D
  26.   $INLINE &H47, &HE2, &HEF, &HFB, &H07, &H1F, &H5D
  27. END SUB
  28.  
  29. SUB ClearBuffer                ' Löschen des Tastaturpuffers
  30. LOCAL i
  31.   DEF SEG = &H40               ' BIOS-Datensegment
  32.   FOR i = &H1E TO &H3D         ' Adresse des Puffers
  33.     POKE i, 0                  ' Gesamten Puffer mit 0
  34.   NEXT i                       ' überschreiben
  35.   DEF SEG
  36. END SUB
  37.  
  38. SUB SubMen (uebergabe$)
  39.   CALL QPRINT (3, 1, uebergabe$ + ":", 14)
  40. END SUB
  41.  
  42. SUB Titelbild
  43.   COLOR 7,0
  44.   CALL QPrint (1, 1, SPACE$(12) + "Systeminfo V. 1.00" +_
  45.        SPACE$(7) + "(c) 1989 J. Braun & TOOLBOX" + _
  46.        SPACE$(13),31)
  47.   LOCATE 2, 1, 0 : PRINT
  48. END SUB
  49.  
  50. SUB ClrScr
  51. LOCAL i
  52.   FOR i = 2 TO 24
  53.     CALL QPrint (i, 1, SPACE$(80), 0)
  54.   NEXT i
  55. END SUB
  56.  
  57. SUB Zeitdisplay(zeile, vogr, higr)
  58. ' Datum mit Uhrzeit in angegebener Bildschirmzeile mit
  59. ' Vorder- (vogr) und Hintergrundfarbe (higr).
  60. ' Angaben: Wochentag, Datum, Uhrzeit. Ausgabe eines
  61. ' Tones zu jeder vollen und halben Stunde.
  62. LOCAL wochentag$, tag$, jahr$, datum$, zeit$, zeile$, f, xL
  63. LOCAL s$, laenge, i, voll.std, voll.min
  64. SHARED monat$()
  65.   DIM monat(12) :  s$ = CHR$(32)
  66.   monat = VAL(LEFT$(DATE$, 2))  :  tag$  = MID$(DATE$, 4, 2)
  67.   jahr$ = RIGHT$(DATE$, 4)      :  zeit$ = TIME$
  68.   voll.std = VAL(MID$(TIME$, 4, 2))
  69.   voll.min = VAL(RIGHT$(TIME$, 2))
  70.   f = VAL(tag$) + 4 + INT(monat/.39) + (VAL(jahr$)-1) / .8 _
  71.                     - (monat>2)*21/4
  72.   f = f - INT(f/7)*7
  73.   wochentag$ = MID$("---Sonntag----Montag--Dienstag--" + _
  74.                     "MittwochDonnerstag---Freitag---" +_
  75.                     "Samstag", 10 * INT(f) + 1, 10)
  76.   WHILE LEFT$(wochentag$, 1) = CHR$(45)
  77.     wochentag$ = RIGHT$(wochentag$, (LEN(wochentag$) - 1))
  78.   WEND
  79.   IF LEFT$(tag$, 1) = "0" THEN tag$ = RIGHT$(tag$, 1)
  80.   IF LEFT$(zeit$,1) = "0" THEN zeit$= s$ + RIGHT$(zeit$, 7)
  81.   datum$ = " Es ist " + wochentag$+ " der " + tag$+ _
  82.            ". " + monat$(monat) + s$ + jahr$
  83.   IF voll.min = 0 AND voll.std =  0 THEN SOUND 450, .5
  84.   IF voll.min = 0 AND voll.std = 30 THEN SOUND 450, .25
  85.   zeile$ = datum$ + " um " + zeit$ + " Uhr "
  86.   laenge = (CINT((80 - (LEN(zeile$))) / 2))
  87.   zeile$ = SPACE$(laenge) + zeile$ + SPACE$(laenge)
  88.   IF LEN(zeile$) > 80 THEN zeile$ = LEFT$(zeile$, 80)
  89.   CALL QPrint(zeile, 1, zeile$, higr*16 + vogr)
  90. END SUB
  91.  
  92. SUB Taste
  93. LOCAL a$
  94.   CALL ClearBuffer                  ' Tastaturpuffer löschen
  95.   CALL QPrint (23, 59, "Weiter mit bel. Taste", 7)
  96.   WHILE a$ = ""
  97.     CALL Zeitdisplay(25, 14, 1)  :  a$ = INKEY$
  98.   WEND
  99.   CALL QPrint (23, 59, SPACE$(21), 0)
  100. END SUB
  101.  
  102. SUB Sicherheitsabfrage
  103. LOCAL a$
  104.   CALL QPrint (8, 30, "Wollen Sie wirklich" +_
  105.                       " zum DOS zurück? (J/N) ", 14)
  106.   LOCATE 8, 72, 1                            ' Cursor zeigen
  107.   DO
  108.     a$ = UCASE$(INKEY$)              ' Tastaturabfrage
  109.     CALL Zeitdisplay(25, 14, 1)      ' Uhrzeit aktualisieren
  110.     IF a$ = CHR$(27) OR a$ = CHR$(13) THEN a$ = "J"
  111.                                      ' Emulation von J
  112.   LOOP UNTIL a$ = "J" OR a$ = "N"
  113.   IF A$="J" THEN COLOR 7,0 : CLS : END ' Ende
  114.   CALL QPrint (8, 30, SPACE$(50), 0)   ' sonst Zeile löschen
  115. END SUB
  116.  
  117. DEF FN Akt.Laufwerk$
  118.             ' Ermitteln, welches Laufwerk zur Zeit aktiv ist
  119. LOCAL i, al$
  120.   REG 1, &H1900                       ' 19H nach AH laden
  121.   CALL INTERRUPT &H21                 ' MS-DOS Interrupt
  122.   al$ = RIGHT$(STR$(REG(1)),2)        ' Ergebnis in AL
  123.   i = VAL(al$)                        ' Umformungen
  124.   i = i + 65                          ' In Laufwerksbezeich-
  125.   FN Akt.Laufwerk$ = CHR$(i) + ":"    ' nung umwandeln
  126. END DEF
  127.  
  128. DEF FN Max.Laufwerk
  129.      ' Ermitteln der maximal von DOS unterstützten Laufwerke
  130. LOCAL i, al$
  131.   REG 1, &H0E00                     ' 0Eh nach AH laden
  132.                                     ' aktiviert gleichzeitig
  133.                                     ' Laufwerk A: (DL=0) !!!
  134.   REG 4, 0                          ' 0 nach DL laden
  135.   CALL INTERRUPT &H21               ' MS-DOS Interrupt
  136.   al$ = RIGHT$(HEX$(REG(1)), 2)     ' Ergebnis in AL
  137.   i = VAL("&H" + al$)               ' Umformungen
  138.   FN Max.Laufwerk = i
  139. END DEF
  140.  
  141. SUB AktivesLW (laufwerk$)
  142.        '  Wiederanmelden des ursprünglich aktiven Lauf-
  143.        '  werkes, dies ist unbedingt notwendig nach dem Auf-
  144.        '  ruf von FN Max.Laufwerk!
  145. LOCAL i
  146.        ' Ergebnis aus FN Akt.Laufwerk$ wieder in die
  147.        ' ursprüngliche Zahl zurückverwandeln:
  148.   laufwerk$ = UCASE$(laufwerk$)    ' wird hier im Programm
  149.                                    ' nicht benötigt !
  150.   i = ASC(LEFT$(RIGHT$(laufwerk$,2), 1)) - 65
  151.   IF i < 0 THEN i = 0              ' Fehler abfangen
  152.   REG 1, &H0E00                    ' DOS-Funktion 0Eh
  153.   REG 4, i                         ' Laufwerksnummer nach DL
  154.   CALL INTERRUPT &H21              ' MS-DOS Interrupt
  155. END SUB
  156.  
  157. DEF FN Lightpen           ' Ermittelt, ob ein Lightpen ange-
  158.          ' schlossen ist. Vor Ausführung des Interrupt 10h
  159.          ' muß unbedingt der richtige Wert für den aktuellen
  160.          ' Bildschirmmodus nach AL geladen werden. Der Wert
  161.          ' ist im BIOS-Datensegment an der Adresse $0040:$49
  162.          ' gespeichert.
  163. LOCAL al, ax$, ah$
  164.   DEF SEG = &H40             ' Wert für AL aus der Hardware
  165.   al = PEEK(&H49)            ' (garantiert die Grafikkarten-
  166.   DEF SEG                    ' unabhängigkeit der Funktion)
  167.   REG 1, &H0400 + al
  168.   CALL INTERRUPT &H10        ' Bildschirminterrupt aufrufen
  169.   ax$ = BIN$((REG(1)))       ' Binärumwandlung des Resultats
  170.   WHILE LEN(ax$) < 16
  171.     ax$ = "0" + ax$          ' auf 16 Stellen ergänzen
  172.   WEND
  173.   ah$ = "&B" + LEFT$(ax$, 8) ' AH aus AX extrahieren
  174.   FN LightPen = VAL(ah$)   ' in Dezzahl wandeln und Übergabe
  175. END DEF
  176.  
  177. DEF FN Printers         ' Ermitteln der Druckerport-Adresse:
  178.                         ' wenn die Schnittstelle nicht vor-
  179.          ' handen ist, wird als Portadresse 0 zurückgegeben.
  180. LOCAL p.port.1&, p.port.2&, p.port.3&, p.port.4&, i
  181.   i = 0
  182.   DEF SEG = &H40                         ' BIOS-Datensegment
  183.   p.port.1& = PEEK(&H8) + PEEK(&H9) * 256     ' LPT1
  184.   p.port.2& = PEEK(&HA) + PEEK(&HB) * 256     ' LPT2
  185.   p.port.3& = PEEK(&HC) + PEEK(&HD) * 256     ' LPT3
  186.   p.port.4& = PEEK(&HE) + PEEK(&HF) * 256     ' LPT4
  187.   DEF SEG
  188.   IF p.port.1& > 0 THEN INCR i
  189.   IF p.port.2& > 0 THEN INCR i
  190.   IF p.port.3& > 0 THEN INCR i
  191.   IF p.port.4& > 0 THEN INCR i
  192.   FN Printers = i
  193. END DEF
  194.  
  195. SUB Bildschirm(monitor$)
  196.         ' Bestimmen des Monitortyps: CGA, EGA oder Monochrom
  197. LOCAL i
  198.   DEF SEG = &H40                       ' BIOS-Datensegment
  199.   i = PEEK(&H88)                       ' Monitor-ID auslesen
  200.     DEF SEG
  201.     IF i = 248 THEN
  202.       monitor$ = "Standard-Farbmonitor (CGA)"
  203.     ELSEIF i = 249 THEN
  204.       monitor$ = "EGA-Farbmonitor"
  205.     ELSEIF i = 251 THEN
  206.       monitor$ = "Monochrom"
  207.     ELSEIF i = 247 THEN
  208.       monitor$ = "Amiga-Color-Monitor"
  209.     ELSE
  210.       monitor$ = "unbekannte Type, Wert:" + STR$(i)
  211.     END IF
  212. END SUB
  213.  
  214. SUB Adapter(karte$)
  215.            ' Ermitteln der Grafikkarte über Schaltung in den
  216.            ' höchstmöglichen Grafikmodus
  217. LOCAL i
  218.   karte$ = ""
  219.   DEF SEG = 0  :  i = PEEK(&H449)  :  DEF SEG
  220.   ON ERROR GOTO detect
  221.   SELECT CASE i
  222.     CASE 1 TO 6
  223.       karte$ = "IBM-Farbgrafikkarte (CGA) 640x200 Pixel"
  224.       ON ERROR GOTO Olivetti
  225.       SCREEN 3
  226.       karte$ = "Olivetti-Farbgrafikkarte 640x400 Pixel"
  227.       EXIT SUB
  228. Egadriver:
  229.       ON ERROR GOTO Detect
  230.       SCREEN 9
  231.       karte$ = "Enhanced Graphics Adapter (EGA) " +_
  232.                "640x350 Pixel"
  233.       SCREEN 11
  234.       karte$ = "MCGA-Karte (IBM PS/2 Modell" +_
  235.                " 30) 640x480 Pixel"
  236.       SCREEN 12
  237.       karte$ = "Video Graphics Array Adapter" +_
  238.                " (VGA) 640x480 Pixel"
  239.       EXIT SUB
  240.     CASE 7
  241.       karte$ = "Monochrom-Textkarte (MDA)" +_
  242.                " (kein Grafikdisplay)"
  243.       SCREEN 2
  244.       karte$ = "Hercules-Monochromgrafikkarte" +_
  245.                " 735x348 Pixel"
  246.       EXIT SUB
  247.     CASE 8 TO 10
  248.       karte$ = "IBM-PCjr Spezialgrafikkarte" +_
  249.                " 640x200 Pixel"
  250.       EXIT SUB
  251.     CASE 11, 12, >15
  252.       karte$ = "Grafikkarte nicht vorhanden" +_
  253.                " oder unbekannter Typ"
  254.       EXIT SUB
  255.     CASE 13 TO 15
  256.       karte$ = "Enhanced Graphics Adapter" +_
  257.                " (EGA) 640x350 Pixel"
  258.       SCREEN 11
  259.       karte$ = "MCGA-Karte (IBM PS/2 Modell" +_
  260.                " 30) 640x480 Pixel"
  261.       SCREEN 12
  262.       karte$ = "Video Graphics Array Adapter"+_
  263.                " (VGA) 640x480 Pixel"
  264.    END SELECT
  265.    EXIT SUB
  266. Olivetti:
  267.   RESUME EgaDriver
  268. Detect:
  269.   RESUME Erkannt
  270. Erkannt:
  271. END SUB
  272.  
  273. DEF FN Mouseok$        ' Test ob Mausinterrupt initialisiert
  274.   REG 1,0              ' Funktion 1 = Mausinitialisierung
  275.   CALL INTERRUPT &H33  ' Mausinterrupt 51
  276.   IF REG(1) = -1 THEN
  277.     FN Mouseok$ = " vorhanden und Maustreiber aktiv"
  278.   ELSE
  279.     FN Mouseok$ = " nicht vorhanden bzw. nicht aktiviert"
  280.   END IF
  281. END DEF
  282.  
  283. DEF FN Maustastenzahl$
  284.              ' eine 3-Tastenmaus im MS-Mouse-Emulationsmodus
  285.              ' (z.B. Genius) wird als 2-Tasten-Maus erkannt.
  286.   REG 1,0  :  CALL INTERRUPT &H33
  287.   FN Maustastenzahl$ = STR$(REG(2)) + "-Tasten Maus"
  288. END DEF
  289.  
  290. DEF FN Aktiv1$                       ' LPT 1 eingeschaltet ?
  291. ' INP (&H379) = Port für Drucker-Statusbyte der
  292. '               Parallelschnittstelle 1
  293. '  71: Gerät angeschlossen aber nicht selektiert
  294. '  79: Gerät wird gerade initialisiert
  295. ' 127: Schnittstelle ist frei, kein Drucker
  296. ' 135: angeschlossen, Gerät aus
  297. ' 223: Gerät angeschlossen und Online
  298. LOCAL a$
  299.   SELECT CASE INP(&H379)
  300.     CASE 127
  301.       a$ = "frei"
  302.     CASE 140, 200 TO 255
  303.       a$ = "on Line"
  304.     CASE ELSE
  305.       a$ = "off Line"
  306.   END SELECT
  307.   FN Aktiv1$ = "LPT(1) " + a$
  308. END DEF
  309.  
  310. DEF FN Aktiv2$                       ' LPT 2 eingeschaltet ?
  311. ' INP (&H279) = Port für Drucker-Statusbyte der
  312. '               Parallelschnittstelle 2
  313. LOCAL a$
  314.   SELECT CASE INP(&H279)
  315.     CASE 127
  316.       a$ = "frei"
  317.     CASE 140, 200 TO 255
  318.       a$ = "on Line"
  319.     CASE ELSE
  320.       a$ = "off Line"
  321.   END SELECT
  322.   FN Aktiv2$ = "LPT(2) " +a$
  323. END DEF
  324.  
  325. DEF FN Seriell1$
  326. ' INP (&H3F9) = Port für Statusbyte der
  327. '               seriellen Schnittstelle 1
  328. LOCAL a$
  329.   SELECT CASE INP(&H3F9)
  330.     CASE 1
  331.       a$ = "belegt"
  332.     CASE ELSE
  333.       a$ = "frei"
  334.   END SELECT
  335.   FN Seriell1$ = "COM(1) " + a$
  336. END DEF
  337.  
  338. DEF FN Seriell2$
  339. ' INP (&H2F9) = Port für Statusbyte der
  340. '               seriellen Schnittstelle 2
  341. LOCAL a$
  342.   SELECT CASE INP(&H2F9)
  343.     CASE 1
  344.       a$ = "belegt"
  345.     CASE ELSE
  346.       a$ = "frei"
  347.   END SELECT
  348.   FN Seriell2$ = "COM(2) " + a$
  349. END DEF
  350.  
  351. DEF FN DOSVers$             ' Ermitteln der DOS Version über
  352.                             ' Funktion 30h des Interrupt 21h
  353. LOCAL ax$, ah$, al$, ah, al, bx$, bx, bh, bh$, produzent$
  354. LOCAL dosversion$, mainnumber$, vernumber$, ms$, m$
  355.   REG 1, &H3000             ' DOS Funktion &H30
  356.   CALL INTERRUPT &H21       ' MS-DOS Interrupt
  357.   ax$ = BIN$(REG(1))        ' AX lesen (binär)
  358.   WHILE LEN(ax$) < 16
  359.     ax$ = "0" + ax$         ' auf 16 Stellen ergänzen
  360.   WEND
  361.   al = VAL("&B" + RIGHT$(ax$, 8))    ' AL und AH aus AX
  362.   ah = VAL("&B" + LEFT$(ax$, 8))     ' extrahieren
  363.   bx$ = BIN$(REG(2))                 ' BX lesen (binär)
  364.   mainnumber$ = STR$(al)     ' DOS-Hauptversionsnummer in AL
  365.   vernumber$ = STR$(ah)      ' DOS-Releasenummer in AH
  366.   WHILE LEFT$(mainnumber$, 1) = CHR$(32)
  367.                              'führende Leerzeichen abtrennen
  368.     mainnumber$ = RIGHT$(mainnumber$, LEN(mainnumber$) - 1)
  369.   WEND
  370.   WHILE LEFT$(vernumber$, 1) = CHR$(32)
  371.     vernumber$ = RIGHT$(vernumber$, LEN(vernumber$) - 1)
  372.   WEND                       ' Versionsstring erstellen:
  373.   dosversion$ = mainnumber$ + "." + vernumber$
  374.   WHILE LEN(bx$) < 16        ' jetzt den Produzenten
  375.     bx$ = "0" + bx$          ' ermitteln (ist im BH-Reister)
  376.   WEND
  377.   bh$ = "&B" + LEFT$(bx$, 8)   ' BH aus BX extrahieren
  378.   bh = VAL(bh$)                ' in Dezimalzahl wandeln
  379.   ms$ = "-DOS Version "  :  m$ = " MS"
  380.   SELECT CASE bh          ' Produzent aus Liste heraussuchen
  381.     CASE 0    :    produzent$ = "IBM PC" + ms$
  382.     CASE 1    :    produzent$ = "Microsoft" + m$ + ms$
  383.     CASE 25   :    produzent$ = "Olivetti"  + m$ + ms$
  384.     CASE &HFF :    produzent$ = "Zenith"    + m$ + ms$
  385.     CASE else :    produzent$ = m$ + ms$
  386.   END SELECT
  387.   FN DOSVers$ = produzent$ + dosversion$
  388. END DEF
  389.  
  390. DEF FN BiosVers$  ' Auslesen des BIOS auf die Versionsnummer
  391. LOCAL b.name$, c, i
  392.   b.name$ = ""
  393.   DEF SEG = &HFE00
  394.   FOR i = 0 TO 8192
  395.     IF PEEK(i) > 31 AND PEEK(i) < 155 THEN
  396.       b.name$ = b.name$ + CHR$(PEEK(i))
  397.     END IF
  398.   NEXT i
  399.   DEF SEG
  400.   IF INSTR(UCASE$(b.name$), "VER") THEN
  401.     b.name$ = RIGHT$(b.name$, LEN(b.name$)-_
  402.               INSTR(UCASE$(b.name$), "VER") + 1)
  403.   ELSEIF INSTR(UCASE$(b.name$), "V.") THEN
  404.     b.name$ = RIGHT$(b.name$, LEN(b.name$)-_
  405.               INSTR(UCASE$(b.name$), "V.") + 1)
  406.   ELSE
  407.     FN Biosvers$ = "nicht gefunden"
  408.     EXIT DEF
  409.   END IF
  410.   IF UCASE$(LEFT$(b.name$,(INSTR(b.name$,".")+1)))<>"V" THEN
  411.     IF INSTR(b.name$,".") THEN
  412.       b.name$ = LEFT$(b.name$,(INSTR(b.name$, ".") + 2))
  413.     END IF
  414.   END IF
  415.   FN BiosVers$ = b.name$
  416. END DEF
  417.  
  418. DEF FN BIOSDatum$  ' ermittelt das Erstellungsdatum des BIOS
  419. LOCAL i, biosdate$, tag$, monat$, jahr$
  420.   DEF SEG = &HF000          ' das Datum steht an einer fixen
  421.   FOR i = 0 TO 7            ' Adresse im BIOS
  422.     biosdate$ = biosdate$ + CHR$(PEEK(&HFFF5 + i))
  423.   NEXT i
  424.   DEF SEG
  425.   tag$ = MID$(biosdate$, 4, 2)
  426.   IF LEFT$(tag$, 1) = "0" THEN tag$ = RIGHT$(tag$, 1)
  427.   monat$ = LEFT$(biosdate$, 2)
  428.   IF LEFT$(monat$, 1) = "0" THEN monat$ = RIGHT$(monat$, 1)
  429.   jahr$ = RIGHT$(biosdate$, 2)
  430.   IF LEFT$(tag$, 1) < "0" OR LEFT$(tag$, 1) > "9" THEN
  431.     FN BIOSDatum$ = "nicht gefunden"
  432.   ELSE
  433.     FN BIOSDatum$ = tag$ + "." + monat$ + ".19" + jahr$
  434.   END IF
  435. END DEF
  436.  
  437. SUB Bioscopyright(bioscpr$)    ' BIOS-Hersteller
  438. LOCAL a,b,c,i
  439.   b.name$ = ""  :  c = 0  : i = 0
  440.   DEF SEG = &HFE00
  441.   WHILE i <= 4096
  442.     IF PEEK(i) > 31 AND PEEK(i) < 155 THEN
  443.       b.name$ = b.name$ + CHR$(PEEK(i))
  444.     END IF
  445.     INCR i
  446.   WEND
  447.   DEF SEG
  448.   IF INSTR(UCASE$(b.name$), "COPY") THEN
  449.     b.name$ = RIGHT$(b.name$, LEN(b.name$) -_
  450.     INSTR(UCASE$(b.name$), "COPY") + 1) : c = 1
  451.   ELSEIF INSTR(UCASE$(b.name$), "(C)") THEN
  452.     b.name$ = RIGHT$(b.name$, LEN(b.name$) -_
  453.     INSTR(UCASE$(b.name$), "(C)") + 1) :  c = 1
  454.   ELSEIF INSTR(UCASE$(b.name$), "COPR") THEN
  455.     b.name$=RIGHT$(b.name$, LEN(b.name$) -_
  456.     INSTR(UCASE$(b.name$), "COPR") + 1) : c = 1
  457.   ELSE
  458.     b.name$ = ""
  459.     bioscpr$ = "Copyrightvermerk nicht gefunden."
  460.   END IF
  461.   IF c THEN
  462.     IF INSTR(b.name$, "19") THEN a = INSTR(b.name$, "19")+4
  463.     IF INSTR(UCASE$(b.name$), "PLC") THEN
  464.       b = INSTR(UCASE$(b.name$), "PLC") + 3
  465.     ELSEIF INSTR(UCASE$(b.name$), "INC") THEN
  466.       b = INSTR(UCASE$(b.name$), "INC") + 3
  467.     ELSEIF INSTR(UCASE$(b.name$), "LTD") THEN
  468.       b = INSTR(UCASE$(b.name$), "LTD") + 3
  469.     ELSEIF INSTR(UCASE$(b.name$), "CORP") THEN
  470.       b = INSTR(UCASE$(b.name$), "CORP") + 4
  471.     ELSEIF INSTR(UCASE$(b.name$), "COMPANY") THEN
  472.       b = INSTR(UCASE$(b.name$), "COMPANY") + 7
  473.     END IF
  474.     IF b > a THEN SWAP a, b
  475.     bioscpr$ = LEFT$(b.name$, a)
  476.   END IF
  477.   IF RIGHT$(bioscpr$, 1) <> "." THEN
  478.     bioscpr$ = LEFT$(bioscpr$, LEN(bioscpr$) - 1)
  479.   END IF
  480. END SUB
  481.  
  482. SUB EGACopyRight(egacpr$)        ' Ermitteln des EGA-Karten-
  483.                    ' Herstellers über das Lesen des EGA-BIOS
  484. LOCAL eganame$, Copyright, a, b, i
  485.   eganame$ = ""  :  Copyright = 0
  486.   DEF SEG=&HC000 :  i = 0
  487.   WHILE i <= 2024
  488.     IF PEEK(i) > 31 AND PEEK(i) < 155 THEN
  489.       eganame$ = eganame$ + CHR$(PEEK(i))
  490.     END IF
  491.     INCR i
  492.   WEND
  493.   DEF SEG
  494.   IF INSTR(UCASE$(eganame$), "COPY") THEN
  495.     eganame$ = RIGHT$(eganame$, LEN(eganame$) -_
  496.                INSTR(UCASE$(eganame$), "COPY") + 1)
  497.     copyright = 1
  498.   ELSEIF INSTR(UCASE$(eganame$), "COPR") THEN
  499.     eganame$ = RIGHT$(eganame$, LEN(eganame$) -_
  500.                INSTR(UCASE$(eganame$), "COPR") + 1)
  501.     copyright = 1
  502.   ELSEIF INSTR(UCASE$(eganame$), "(C)") THEN
  503.     eganame$ = RIGHT$(eganame$, LEN(eganame$) -_
  504.                INSTR(UCASE$(eganame$), "(C)") + 1)
  505.     copyright = 1
  506.   ELSE
  507.     egacpr$ = "Grafik-Copyright nicht gefunden."
  508.   END IF
  509.   IF copyright THEN
  510.     IF INSTR(eganame$, "19") THEN a = INSTR(eganame$,"19")+4
  511.     IF INSTR(UCASE$(eganame$), "INC") THEN
  512.       b = INSTR(UCASE$(eganame$), "INC") + 3
  513.     ELSEIF INSTR(UCASE$(eganame$), "LTD") THEN
  514.       b = INSTR(UCASE$(eganame$), "LTD") + 3
  515.     ELSEIF INSTR(UCASE$(eganame$), "CORP") THEN
  516.       b = INSTR(UCASE$(eganame$), "CORP") + 4
  517.     ELSEIF INSTR(UCASE$(eganame$), "PLC") THEN
  518.       b = INSTR(UCASE$(eganame$), "PLC") + 3
  519.    END IF
  520.     IF b > a THEN SWAP a, b
  521.     egacpr$ = LEFT$(eganame$, a)
  522.     IF RIGHT$(egacpr$, 1) <> "." THEN
  523.       egacpr$ = LEFT$(egacpr$, LEN(egacpr$) - 1)
  524.     END IF
  525.   END IF
  526. END SUB
  527.  
  528. DEF FN FreeSpace!(lw)   ' aus Turbo Basic Handbuch angepaßt
  529.   REG 4, lw             ' Gibt den freien Speicher von
  530.   REG 1, &H3600         ' Laufwerk lw aus
  531.   CALL Interrupt &H21
  532.   FN FreeSpace! = CSNG(REG(2)) * REG(3) * REG(1) / 1024
  533. END DEF
  534.  
  535. DEF FN Speicherbaenke           ' Anzahl der RAM-Speicher-
  536.   CALL INTERRUPT &H11         ' bänke auf der Hauptplatine
  537.   FN Speicherbaenke=VAL("&B"+LEFT$ _
  538.     (RIGHT$(BIN$(reg(1)),4),2))+1
  539. END DEF
  540.  
  541. SUB Hardwaresetting
  542. SHARED dosversion$, textmodus$, bs$, biosver$
  543. SHARED karte$,landescode$
  544. LOCAL register$, koprozessor$, sys$, Lw, tag$, monat$, jahr$
  545. LOCAL printer1$, xL, printer2$, disklw$, seriell$, conf
  546. LOCAL gameport$, x$, a, sx$, cmos.rtc$, lightpen$, nein$
  547. LOCAL parallel$, i, bioscpr$, egacpr$, biosversion$
  548. LOCAL max.laufwerke, laufwerksnamen$, akt.lw$max.laufwerke$
  549.   nein$ = "nicht"
  550.   CALL ClrScr
  551.   CALL Titelbild
  552.   GOSUB Zeitdarstellung
  553.   ON TIMER(1) GOSUB Zeitdarstellung ' Während der Arbeit die
  554.   TIMER ON                          ' Uhrzeit aktualisieren
  555.   CALL QPrint(9, 26, "Konfiguration wird ermittelt", 15)
  556.   CALL QPrint(17, 34, "Bitte warten", 143)
  557.   CALL BIOSCopyRight(bioscpr$)
  558.   biosversion$ = FN Biosvers$
  559.   IF karte$="Enhanced Graphics Adapter (EGA) 640x350 Pixel"_
  560.   OR karte$="MCGA-Karte (IBM PS/2 Modell 30) 640x480 Pixel"_
  561.   OR karte$=("Video Graphics Array Adapter (VGA) 640x480 "+_
  562.              "Pixel") THEN CALL EGACopyRight(egacpr$)
  563.   CALL INTERRUPT &H11
  564.   IF LEFT$(RIGHT$(BIN$(REG(1)),2),1)="0" THEN
  565.     koprozessor$ = nein$
  566.   END IF
  567.   DEF SEG = &HF000  :  conf = PEEK(&HFFFE) ' Rechner ID-Byte
  568.   DEF SEG
  569.   SELECT CASE conf
  570.     CASE &HD9 : sys$ = "Peacock XT"
  571.     CASE &H4B : sys$ = "Micromint XT"
  572.     CASE &HFC : sys$ = "PC AT oder kompatibler AT 286/386"
  573.     CASE &HFD : sys$ = "IBM PC Jr"
  574.     CASE &HFE : sys$ = "IBM PC-XT oder kompatibler PC-XT"
  575.     CASE &HFF : sys$ = "IBM PC oder kompatibler PC"
  576.     CASE ELSE : sys$ = "kompatibler PC-XT. ID-Byte: " + _
  577.                         HEX$(conf)
  578.   END SELECT
  579.   biosdate$ = FN BIOSDatum$
  580.   DEF SEG = 0
  581.   seriell$  = STR$((PEEK(&H0411) AND 14)/2)
  582.   gameport$ = STR$(SGN(PEEK(&H0411) AND 16))
  583.   IF PEEK(1040) AND 1 = 0 THEN
  584.     Lw = 0
  585.   ELSE
  586.     Lw = ((PEEK(1040) AND 192)/64) + 1
  587.   END IF
  588.   disklw$ = STR$(Lw)
  589.   DEF SEG
  590.   parallel$ = STR$(FN Printers)
  591.   TIMER OFF
  592.   CALL ClrScr
  593.   sx$ = ": "
  594.   CALL Titelbild
  595.   CALL SubMen("Hardwarekonfiguration")
  596.   CALL QPrint(05,1,"Gerätetyp"+ STRING$(17,46) +sx$+sys$,7)
  597.   CALL QPrint(06, 1, "DOS-Version" + STRING$(15,46) +_
  598.               sx$ + dosversion$, 7)
  599.   CALL QPrint(07, 1, "Math. Co-Prozessor" +_
  600.               STRING$(8,46)+sx$+koprozessor$+" vorhanden",7)
  601.   CALL QPrint(08, 1, "BIOS-Copyright" + STRING$(12,46) +_
  602.               sx$ + bioscpr$, 7)
  603.   CALL QPrint(09, 1, "BIOS-Datum" + STRING$(16,46)+_
  604.               sx$ + biosdate$,7)
  605.   CALL QPrint(10, 1, "BIOS-Version" + STRING$(14,46)+_
  606.               sx$ + biosversion$, 7)
  607.   CALL QPrint(11, 1, "Bildschirmmodus im DOS" +_
  608.               STRING$(4,46) + sx$ + textmodus$, 7)
  609.   CALL QPrint(12, 1, "Grafikadapter" + STRING$(13,46) +_
  610.               sx$ + karte$, 7)
  611.   IF egacpr$="" THEN egacpr$ = "kein eigenes BIOS vorhanden"
  612.   CALL QPrint(13, 1, "Grafikkartencopyright" +_
  613.               STRING$(5,46) + sx$ + egacpr$, 7)
  614.   CALL QPrint(14, 1, "Monitor-Typ" + STRING$(15,46) +_
  615.               sx$ + bs$, 7)
  616.   CALL QPrint(15, 1, "Diskettenlaufwerk(e)" +_
  617.               STRING$(6,46) + ":" + disklw$, 7)
  618.   IF VAL(disklw$) = 1 THEN
  619.     DEF SEG = 0
  620.     xL = PEEK(&H504)        ' Bei nur einem Laufwerk
  621.                             ' emuliert Diskettenlaufwerk
  622.     DEF SEG                 ' A: auch B:. Überprüfen,
  623.                             ' welches als aktiv vermerkt ist
  624.     CALL QPrint(15, 1, "(Virtuelles Laufwerk " +_
  625.             CHR$(xL+65) + sx$ + "ist aktiv.)", 7)
  626.   END IF
  627.   akt.lw$ = FN Akt.Laufwerk$
  628.   CALL QPRINT(16,1,"derzeit aktives Laufwerk..: "+akt.lw$,7)
  629.   max.laufwerke  = FN Max.Laufwerk
  630.   max.laufwerke$ = STR$(max.laufwerke)
  631.   laufwerksnamen$ = CHR$(max.laufwerke+64) + ":"
  632.   IF max.laufwerke > 0 THEN
  633.     laufwerksnamen$ = "A: - " + laufwerksnamen$
  634.   END IF
  635.   CALL Qprint(16, 35, "Zahl der max. unterst. Laufwerke:" +_
  636.               max.laufwerke$ + " (" + laufwerksnamen$+")",7)
  637.   CALL aktiveslw(akt.lw$)
  638.   CALL QPrint(17, 1, "parallele Schnittstelle(n):" +_
  639.               parallel$, 7)
  640.   IF VAL(parallel$)>0 THEN  ' nur LPT(1) und LPT(2) testen,
  641.                             ' wer hat schon 3 oder 4 Drucker
  642.     CALL QPrint(17, 35, FN Aktiv1$, 7)
  643.     IF VAL(parallel$)>1 THEN CALL QPrint(17,55,FN Aktiv2$,7)
  644.   END IF
  645.   CALL QPrint(18,1,"serielle  Schnittstelle(n):"+seriell$,7)
  646.   IF VAL(seriell$)>0 THEN    ' nur COM(1) und COM(2) testen.
  647.                              ' COM(3) und COM(4) sind nicht
  648.                              ' genormt und auch erst ab DOS
  649.                              ' V. 3.3 überhaupt möglich.
  650.     CALL QPrint(18, 35, FN Seriell1$, 7)
  651.     IF VAL(seriell$) > 1 THEN
  652.       CALL QPrint(18, 55, FN Seriell2$, 7)
  653.     END IF
  654.   END IF
  655.   CALL QPrint(19, 1, "Gameport(s)" + STRING$(15,46)+ ":" +_
  656.               gameport$, 7)
  657.   IF VAL(gameport$) > 0 THEN ' Joystick 1 und 2 werden zwar
  658.                              ' überprüft, aber nur allgemein
  659.                              ' ausgegeben.
  660.     IF (STICK(0) > 0 AND STICK(1) > 0) OR _
  661.                         (STICK(2) > 0 AND STICK(3) > 0) THEN
  662.       CALL QPrint(19, 35, _
  663.                       "Analog-Joystick(s) angeschlossen", 7)
  664.     ELSE
  665.       CALL QPrint(19, 35, _
  666.                     "kein Analog-Joystick angeschlossen", 7)
  667.     END IF
  668.   END IF
  669.   CALL QPrint(20, 1, "Maus und Maustreiber" +_
  670.               STRING$(6,46) + sx$, 7)
  671.   LOCATE 20,28  :  COLOR 7,0
  672.   IF INSTR (FN MouseOk$,"nicht") THEN
  673.     PRINT "";
  674.   ELSE
  675.     PRINT FN Maustastenzahl$;
  676.   END IF
  677.   PRINT FN MouseOK$
  678.   IF INP(&H70)=0 THEN cmos.rtc$=nein$  ' CMOS-RAM-Port lesen
  679.   CALL QPrint(21, 1, "Batteriegepuffertes RAM..." +_
  680.               sx$ + cmos.rtc$ + " vorhanden", 7)
  681.   IF FN LightPen = 0 THEN Lightpen$ = nein$
  682.   CALL QPrint(22, 1, "Lightpen" + string$(18,46) +_
  683.               sx$ + Lightpen$ + " angeschlossen", 7)
  684.   EXIT SUB
  685.  
  686. Zeitdarstellung:
  687.     CALL Zeitdisplay (25, 14, 1)
  688.   RETURN
  689. END SUB
  690.  
  691. SUB Memorysetting
  692. SHARED Graf.Bs.Speicher, freiram
  693. LOCAL arbsp$, arbsp1$, arbsp2$, baenke$, tm.ram, a.bs.s
  694. LOCAL tmram$, ggs$, s$, sx$, fuellaenge
  695.   sx$ = ": "
  696.   DEF SEG = 0
  697.   arbsp1$ = STR$(PEEK(&H0413) + PEEK(&H0414)*256)
  698.   CALL INTERRUPT &H12
  699.   arbsp2$ = STR$(REG(1))
  700.   DEF SEG
  701.   CALL SubMen("Arbeits- und Bildschirmspeicher")
  702.   CALL QPrint(06, 1, "Arbeitsspeicher:", 15)
  703.   CALL QPrint(07, 2, "von DOS insgesamt erkannt" +_
  704.               STRING$(41,46) + sx$ + arbsp1$ + " kB", 7)
  705.   CALL QPrint(08, 2, "Speicher auf der Hauptplatine" +_
  706.          STRING$(37,46)+sx$+STR$(CINT(ENDMEM/1024))+" kB",7)
  707.   baenke$ = STR$(FN Speicherbaenke)
  708.   CALL QPrint(09, 2, "Anzahl der Speicherbänke auf der" +_
  709.           " Hauptplatine"+STRING$(21,46)+sx$+"  "+baenke$,7)
  710.   CALL QPrint(10, 2, "RAM-Speicher auf Hauptplatine &" +_
  711.               " Steckkarten (ohne Extended Memory)" +_
  712.               sx$ + arbsp2$ + " kB", 7)
  713.   CALL QPrint(11, 1, "davon:", 7)
  714.   CALL QPrint(12, 2, "frei" + STRING$(62,46) + sx$ +_
  715.               STR$(freiram) + " kB", 7)
  716.   CALL QPrint(13, 2, "bereits belegt"+STRING$(52,46)+sx$ +_
  717.               STR$(CINT(ENDMEM/1024)-freiram) + " kB", 7)
  718.   gss$ = STR$(graf.bs.speicher)
  719.   fuellaenge = 5 - LEN(gss$)
  720.   CALL QPrint(16, 1, "Bildschirmspeicher:", 15)
  721.   CALL QPrint(17, 2, "Bildschirmspeicher im " +_
  722.           "höchstauflösenden Grafikmodus je Seite .....:" +_
  723.           SPACE$(Fuellaenge) + gss$ + " kB", 7)
  724.   DEF SEG = &H40
  725.   tm.ram = PEEK(&H4C)*100 + PEEK(&H4D)
  726.   a.bs.s = PEEK(&H62)
  727.   DEF SEG
  728.   tmram$ = STR$(tm.ram)
  729.   fuellaenge = 5 - LEN(tmram$)
  730.   CALL QPrint(18, 2, "Bildschirmspeicher im Textmodus " +_
  731.        STRING$(34,46)+":"+SPACE$(Fuellaenge)+tmram$+" kB",7)
  732.   CALL QPrint(19, 2, "Zur Zeit aktive Bildschirmseite " +_
  733.        STRING$(34,46) + ": Seite" + STR$(a.bs.s), 7)
  734. END SUB
  735.  
  736. $INCLUDE "BENCHMK.INC"
  737.  
  738. SUB DiskInformation
  739. LOCAL ax, al, al$, ah, bx, cx, cx!, dx, dx!, ds, i, j, check
  740. LOCAL x$, xL, hk$, id.byte, aktiv$,kap!, sx$, h$, v$
  741. SHARED dosversion$
  742.   sx$ = ": "  :  hk$ = CHR$(34)          ' Anführungszeichen
  743.   v$  = "5 " + CHR$(172) + " " + hk$ + " Disk"     ' 5 1/4 "
  744.   h$  = "3 " + CHR$(171) + " " + hk$               ' 3 1/2 "
  745.   CALL ClrScr
  746.   CALL TitelBild
  747.   CALL QPrint(12,22,"Bitte legen Sie in alle Laufwerke",15)
  748.   CALL QPrint(13,25,"des Systems Disketten ein !",15)
  749.   CALL Taste
  750.   COLOR 7,0
  751.   CALL ClrScr
  752.   aktiv$ = FN akt.laufwerk$    ' Aktives Laufwerk festhalten
  753.   j = FN Max.Laufwerk          ' Zahl der vom DOS unter-
  754.   DEF SEG = 0                  ' stützten Laufwerke
  755.   IF PEEK(1040) AND 1 > 0 THEN ' mindestens ein Laufwerk?
  756.     IF((PEEK(1040) AND 192)/64) + 1 = 1 THEN
  757.                                ' nur 1 Disk.-Laufwerk
  758.       xL = PEEK(&H504)   ' ist aktuelles Laufwerk A oder B ?
  759.       check = 1          ' Testvariable: nur ein Laufwerk !
  760.     END IF
  761.   END IF
  762.   DEF SEG
  763.   FOR i = 1 TO j             ' 0=aktuell!, 1=A, 2=B, 3=C ...
  764.     IF check = 1 THEN      ' Wenn nur ein Diskettenlaufwerk:
  765.       IF xl = 0 AND i = 2 THEN INCR i
  766.                          ' Laufwerk B ist aktiv, A übergehen
  767.       IF xl = 1 AND i = 1 THEN INCR i
  768.                          ' Laufwerk A ist aktiv, B übergehen
  769.     END IF
  770.     REG 1,&H1C00       ' DOS Funktion 1C (für beliebiges LW)
  771.     REG 4,i                ' Laufwerksnummer anwählen in DL
  772.     CALL INTERRUPT &H21    ' DOS Interrupt aufrufen
  773.     ax = REG(1)            ' Register auslesen und umwandeln
  774.     al$ = RIGHT$(HEX$(ax), 2)  ' AL = Sektoren je Cluster
  775.     al = VAL("&H" + al$)
  776.     bx = REG(2)            ' BX = ID-Byte-Adr. in Segment DS
  777.     cx = REG(3)            ' CX = Bytes pro Cluster
  778.     dx = REG(4)            ' DX = Cluster pro Disk
  779.     ds = REG(8)            ' DS = Segment für FAT-ID
  780.     DEF SEG = ds
  781.     id.byte = PEEK(bx)     ' ID-Byte auslesen
  782.     DEF SEG
  783.     CALL TitelBild
  784.     CALL SubMen("Disketteninfo")
  785.     LOCATE 5,1  :  PRINT "Ihr Betriebssystem (";dosversion$;
  786.     PRINT ") unterstützt";j;" Laufwerke."  :  LOCATE 7,1
  787.     PRINT "Nummer der Laufwerkseinheit:    "; i-1
  788.     PRINT "Laufwerkskennbuchstabe.....:     ";CHR$(i+64)" ";
  789.     IF check = 1 THEN     ' Wenn nur ein Laufwerk vorhanden,
  790.       IF i=1 THEN PRINT "= B";   ' anzeigen, daß es noch ein
  791.       IF i=2 THEN PRINT "= A";   ' virtuelles Laufwerk gibt
  792.     END IF
  793.     IF al <> 255 THEN
  794.       PRINT  :  PRINT
  795.       PRINT "Clustergröße"; STRING$(15,46); sx$;
  796.       PRINT USING "##### Bytes"; cx*al
  797.       PRINT "Sektorgröße"; STRING$(16,46); sx$;
  798.       PRINT USING "##### Bytes"; cx
  799.       PRINT "Sektoren pro Cluster"; STRING$(7,46); sx$;
  800.       PRINT USING "#####"; al
  801.       PRINT "Verfügbare Cluster"; STRING$(9,46); sx$;
  802.       PRINT USING "#####"; dx-1
  803.       PRINT "Adresse des ID-Bytes  (hex):  ";HEX$(ds);":";
  804.       PRINT HEX$(bx)
  805.       PRINT "ID-Byte des Laufwerks (hex):   ";HEX$(id.byte)
  806.       dx! = dx  :  cx!=cx
  807.       kap! = CSNG(dx! * cx! *al / 1024)
  808.       PRINT  :  PRINT "Nettokapazität";STRING$(13,46);sx$;
  809.       IF kap! < 1024 THEN
  810.         PRINT USING "#####.# kByte"; kap!
  811.       ELSE
  812.         PRINT USING "#####.## MByte"; kap!/1024
  813.       END IF
  814.       kap! = FN FreeSpace!(i)
  815.       PRINT "Freie Kapazität"; STRING$(12,46); sx$;
  816.       IF kap! < 1024 THEN
  817.         PRINT USING "#####.# kByte"; kap!
  818.       ELSE
  819.         PRINT USING "#####.## MByte"; kap!/1024
  820.       END IF
  821.       SELECT CASE id.byte
  822.         CASE 255
  823.           x$ = v$ + " doppelseitig: 8 Sektoren, 40 Spuren."
  824.         CASE 254
  825.           x$ = v$ + " einseitig: 8 Sektoren, 40 Spuren."
  826.         CASE 253
  827.           x$ = v$ + " doppelseitig: 9 Sektoren, 40 Spuren."
  828.         CASE 252
  829.           x$ = v$ + " einseitig: 9 Sektoren, 40 Spuren."
  830.         CASE 251
  831.           x$ = h$ + " / " + v$ + " doppelseitig: 8 " +_
  832.                     " Sektoren, 80 Spuren."
  833.         CASE 250
  834.           x$ = h$ + " / " + v$ + " einseitig: " +_
  835.                     "8 Sektoren, 80 Spuren."
  836.         CASE 249
  837.           x$ = h$ + " / " + v$ + "doppels.: 9 Sekt." +_
  838.                     " 80 Sp. / 15 Sekt.  80 Sp."
  839.         CASE 248
  840.           x$ = "nicht herausnehmbarer Datenträger: " +_
  841.                "Festplatte oder RAM-Disk."
  842.         CASE ELSE
  843.           x$ = "unbekannter Diskettentyp"
  844.       END SELECT
  845.       PRINT  :  PRINT "Diskettentyp"; sx$; x$
  846.     ELSE
  847.       PRINT " nicht belegt!"     ' oder Diskettenfehler !
  848.                                  ' Wenn keine Diskette ein-
  849.                ' gelegt ist, stürzt das Programm nicht ab !
  850.     END IF
  851.     IF i < j THEN
  852.       CALL Taste  :  COLOR 7,0  :  CALL ClrScr
  853.     END IF
  854.   NEXT i
  855.             ' Ursprünglich aktives Laufwerk wieder anmelden:
  856.   CALL AktivesLW(aktiv$)
  857. END SUB
  858.  
  859. '* ------------------------------------------------------- *
  860. '*                Das Hauptprogramm                        *
  861.  
  862. dosversion$ = FN DOSVers$        ' Ermitteln der DOS-Version
  863. DEF SEG = 0                      ' Bildschirmmodus bei
  864. modus = (PEEK(&H410) AND 48)/16  ' Programmstart ermitteln
  865. DEF SEG
  866. SELECT CASE modus
  867.   CASE 1: textmodus$ = "40x25, Farbe"
  868.   CASE 2: textmodus$ = "80x25, Farbe"
  869.   CASE 3: textmodus$ = "80x25, Monochrom"
  870. END SELECT
  871. CALL ClearBuffer                 ' Tastaturpuffer löschen
  872. FOR i = 1 TO 12                  ' die Monatsnamen aus den
  873.   READ monat$(i)                 ' DATA-Zeilen einlesen
  874. NEXT i
  875. CALL ADAPTER(karte$)             ' Grafikkarte ermitteln
  876. DEF SEG=&H40                     ' im Grafikmodus Größe des
  877.   Graf.Bs.Speicher = PEEK(&H4C)*100 + PEEK(&H4D)
  878.                                  ' aktuellen (HiRes)
  879. DEF SEG                     ' Bildschirmspeichers ermitteln
  880. CALL Bildschirm(bs$)             ' Monitortyp ermitteln
  881. freiram = CINT((FRE(-1) + FRE(-2) + FRE(s$))/1024) + 12
  882. ' jetzt ist der Speicher noch von Variablen weitgehend unbe-
  883. ' lastet. Nach dem Aufruf des Programmpunkts 'Konfiguration'
  884. ' kommen noch einige kByte dazu. Es soll aber der freie
  885. ' Speicher unter DOS ermittelt werden.
  886. SCREEN 0                         ' Grafikmodus verlassen
  887. ON ERROR GOTO 0            ' Fehlerabfangroutinen abschalten
  888. COLOR 7,0 : CLS : WIDTH 80
  889.                          ' Standard-80-Zeichenmodus anwählen
  890. DO
  891.   CALL TitelBild
  892.   LOCATE 2, 1, 0                 ' Cursor ausschalten
  893.   CALL QPrint(3,1,CHR$(201)+STRING$(78,205)+CHR$(187),15)
  894.   FOR i = 4 TO 6
  895.     CALL QPrint(i,  1, CHR$(186), 15)
  896.     CALL QPrint(i, 80, CHR$(186), 15)
  897.   NEXT i
  898.   CALL QPrint(4,25, "Auswahl mit dem Anfangsbuchstaben:",14)
  899.   CALL QPrint(6, 7, "K", 15)
  900.   CALL QPrint(6, 8, "onfiguration", 7)
  901.   CALL QPrint(6, 21, "R", 15)
  902.   CALL QPrint(6, 22, "AM-Speicher",7)
  903.   CALL QPrint(6, 34, "E", 15)
  904.   CALL QPrint(6, 35, "nvironment", 7)
  905.   CALL QPrint(6, 46, "S", 15)
  906.   CALL QPrint(6, 47, "peed-Test", 7)
  907.   CALL QPrint(6, 57, "D", 15)
  908.   CALL QPrint(6, 58, "isk-Info", 7)
  909.   CALL QPrint (6,67,"Q",15)
  910.   CALL QPrint (6,68,"uitt",7)
  911.   CALL QPrint (7,1,CHR$(200)+STRING$(78,205)+CHR$(188),15)
  912.   CALL QPrint (10,1,CHR$(201)+STRING$(78,205)+CHR$(187),7)
  913.   FOR i=11 TO 22
  914.     CALL QPrint (i,1,CHR$(186),7)
  915.     CALL QPrint (i,80,CHR$(186),7)
  916.   NEXT i
  917.   CALL QPrint (11,35,"Informationen:",14)
  918.   CALL QPrint (12,1,CHR$(199)+STRING$(78,196)+CHR$(182),7)
  919.   CALL QPrint (13,5,"Unter »Konfiguration« erhalten Sie "+_
  920.        "detaillierte Auskunft über die Hard-",7)
  921.   CALL QPrint (14,6,"warekonfiguration des Rechners.",7)
  922.   CALL QPrint (15,5,"Unter »RAM-Speicher« erfahren Sie"+_
  923.        " alles über die Speicher-Konfiguration",7)
  924.   CALL QPrint (16,6,"des Systems.",7)
  925.   CALL QPrint (17,5,"Unter »Environment« werden die"+_
  926.        " gesetzten  Environmentvariablen und  die",7)
  927.   CALL QPrint (18,6,"Länge des verwendeten DOS Umgebungs"+_
  928.        "speichers (Environment) angezeigt.",7)
  929.   CALL QPrint (19,5,"Unter »Speed-Test« wird die Rechner"+_
  930.        "geschwindigkeit mit der eines IBM-XT",7)
  931.   CALL QPrint (20,6,"(8088, 4,77 MHz) verglichen.",7)
  932.   CALL QPrint (21,5,"»Diskinfo« informiert über die an"+_
  933.        "geschlossenen Laufwerke.",7)
  934.   CALL QPrint (22,5,"Mit »Quit« verlassen Sie das Programm.",7)
  935.   CALL QPrint (23,1,CHR$(200)+STRING$(78,205)+CHR$(188),7)
  936.   DO                              ' Tastenschleife
  937.     a$=""                         ' Löschen von alten Eingaben
  938.     CALL Zeitdisplay(25,14,1)     ' ständige Aktualisierung der Uhrzeit
  939.     a$=UCASE$(INKEY$)             ' Tastaturabfrage (GROSS/klein ignorieren)
  940.     IF a$=CHR$(27) THEN a$="Q"    ' ESC erlauben
  941.   LOOP UNTIL a$="E" OR a$="K" OR a$="S" OR a$="Q" OR a$="R" OR a$="D"
  942.   SELECT CASE a$                  ' Auswahl der Unterprogramme
  943.     CASE "D"
  944.       CALL ClrScr
  945.       CALL Diskinformation
  946.     CASE "R"
  947.       CALL ClrScr
  948.       CALL MemorySetting
  949.     CASE "E"
  950.       CALL ClrScr
  951.       CALL SubMen ("Environment") ' Untermenünamen anzeigen
  952.       j = 6                       ' Erste Displayzeile
  953.       FOR i = 1 TO 15             ' die ersten 15 Einträge
  954.         IF ENVIRON$(i)<>"" THEN   ' erlaubt sind 255
  955.                                   ' normal sind 5 bis  10
  956.           CALL QPrint (j, 1, "SET " + ENVIRON$(i), 7)
  957.           INCR j                  ' Anzeigezeile erhöhen
  958.         END IF
  959.         IF LEN(ENVIRON$(i))>78 THEN
  960.           INCR j                  ' Zeilensprung
  961.         END IF                    ' (nötig z.B. für PATH)
  962.       NEXT i
  963.       enlength = 0                ' Länge des Environments
  964.       FOR i = 1 TO 255            ' Für die maximale Zahl
  965.         IF LEN(ENVIRON$(i))=0 THEN EXIT FOR
  966.                                   ' Ausstieg, wenn
  967.                                   ' Environment-String leer
  968.         enlength=enlength+LEN(ENVIRON$(i))
  969.       NEXT i
  970.       IF j>21 THEN j=21           ' Tiefer als Zeile 21?
  971.                                   ' maximal Zeile 23 erlaubt
  972.       CALL QPrint (j+2,1,"Im DOS-Umgebungsspeicher sind"+_
  973.             STR$(enlength)+" Bytes belegt.",15)
  974.     CASE "S"
  975.       CALL ClrScr
  976.       CALL ClearBuffer
  977.       CALL Benchmark
  978.     CASE "K"
  979.       CALL HardwareSetting
  980.     CASE "Q"
  981.       CALL ClearBuffer
  982.       CALL Sicherheitsabfrage
  983.   END SELECT
  984.   IF a$<>"Q" THEN
  985.     CALL ClearBuffer
  986.     CALL Taste
  987.     CALL ClrScr
  988.   END IF
  989. LOOP        ' DO ... LOOP ohne Abbruchbedingung
  990.  
  991. DATA Januar, Februar, "März", April, Mai, Juni, Juli
  992. DATA August, September, Oktober, November, Dezember
  993. '* ------------------------------------------------------- *
  994. '*                Ende von SYSINFO.BAS                     *
  995.