home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / dosutil.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-29  |  31.0 KB  |  842 lines
  1. {$A+,B-,D-,E-,F+,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                            DOSUTIL.PAS                            *)
  4. (*                    (C) 1993 te-wi Verlag, München                 *)
  5. (*-------------------------------------------------------------------*)
  6. (*  Implementation von in der Unit DOS »vergessenen« DOS- und BIOS-  *)
  7. (*                 Funktionen sowie Erweiterungen                    *)
  8. (*===================================================================*)
  9.  
  10. UNIT DOSUtil;
  11.  
  12. INTERFACE
  13.  
  14. CONST
  15.   USA          = 01; Netherlands  = 31; Belgium      = 32;
  16.   France       = 33; Spain        = 34; Italy        = 39;
  17.   Switzerland  = 41; Austria      = 43; Britain      = 44;
  18.   Denmark      = 45; Sweden       = 46; Norway       = 47;
  19.   Germany      = 49;                              (* Länderkennungen *)
  20.  
  21. TYPE
  22.   tBPB       = RECORD
  23.     BytesPerSector    : WORD;      (* Bytes pro Sektor               *)
  24.     SectorsPerCluster : BYTE;      (* Anzahl der Sektoren je Cluster *)
  25.     ReservedSectors   : WORD;      (* reservierte Sektoren           *)
  26.     NumberOfFATs      : BYTE;      (* Anzahl der Fileallocat.-Tables *)
  27.     RootEntries       : WORD;      (* Anzahl der Rooteinträge        *)
  28.     TotalSectors      : WORD;      (* der Sektoren auf dem Laufwerk  *)
  29.     MediaDescriptor   : BYTE;      (* Media-Identifizierungs-Byte    *)
  30.     SectorsPerFAT     : WORD;      (* Anzahl der Sektoren pro FAT    *)
  31.     SectorsPerTrack   : WORD;      (* Anzahl der Sektoren pro Spur   *)
  32.     Heads             : WORD;      (* Anzahl der Schreib-/Lese-Köpfe *)
  33.     HiddenSectors     : LONGINT;   (* Anzahl versteckter Sektoren    *)
  34.     BigTotalSectors   : LONGINT;   (* Anzahl der Sektoren bei BIGDOS *)
  35.     reserved          : ARRAY[0..6] OF BYTE; (* reservierter Bereich *)
  36.   END;
  37.  
  38.   tBootBlock = RECORD
  39.     Jump              : ARRAY[1..3] OF BYTE;   (* JMP zur Bootrout.  *)
  40.     OEM               : ARRAY[1..8] OF CHAR;   (* OEM-Kennung        *)
  41.     Data              : tBPB;                  (* Parameter-Tabelle  *)
  42.         (* Ab hier kein Standard mehr. Kompatible und ältere Systeme *)
  43.         (* können einen hiervon abweichenden Aufbau besitzen:        *)
  44.     DiskLabel         : ARRAY[1..11] OF CHAR;  (* DOS>=4-spezifisch  *)
  45.     FATTypeText       : ARRAY[1..8] OF CHAR;   (* DOS>=4-spezifisch  *)
  46.     DosLoader         : ARRAY[0..351] OF BYTE; (* DOS-Laderoutine    *)
  47.     Messages          : ARRAY[0.. 64] OF CHAR; (* Lader-Meldungen    *)
  48.     FileLoader        : ARRAY[0.. 30] OF CHAR; (* Dateilader         *)
  49.         (* Ab hier wieder Standard:                                  *)
  50.     EndMarker         : ARRAY[0..1] OF CHAR;   (* Sektor-Ende-Marke  *)
  51.   END;
  52.  
  53. (*-------------------------------------------------------------------*)
  54. (* Die Funktion GetCountry liefert den in der CONFIG.SYS angegebenen *)
  55. (* Landescode nach der obigen Konstantentabelle                      *)
  56. FUNCTION GetCountry: BYTE;
  57.  
  58. (*-------------------------------------------------------------------*)
  59. (* Funktion zur Ermittlung der Länge eines Exe-Programms aus dem     *)
  60. (* Exe-Header                                                        *)
  61. FUNCTION ExeFileLength(fName: STRING) : LONGINT;
  62.  
  63. (*-------------------------------------------------------------------*)
  64. (* DOS-Funktionen ab DOS 4: Es wird die nicht-dokumentierte DOS-     *)
  65. (* Funktion 69h mit den Unterfunktionen 00h und 01h verwendet. Die   *)
  66. (* Funktion gibt es zwar auch unter OS/2 2.0X. Dort werden die Lese- *)
  67. (* und Schreiboperationen aber vom Betriebssystem-Kernel abgeblockt. *)
  68.  
  69. (* Lesen der Datenträger-Kennnummer der DOS-Versionen 4 bis 6        *)
  70. FUNCTION ReadDiskIDNumber(Drive: CHAR): STRING;
  71.  
  72. (* Schreiben der Datenträger-Kennnummer der DOS-Versionen 4 bis 6    *)
  73. FUNCTION WriteDiskIDNumber(Drive: CHAR; IdNumber: STRING): INTEGER;
  74.  
  75. (* Lesen des Disketten-/Plattenlabels über FindFirst. Dos-Versions-  *)
  76. (* unabhängig.                                                       *)
  77. FUNCTION GetLabel(Drive: BYTE): STRING;
  78.  
  79. (* Setzen des Disketten-/Plattenlabels über FCB-Funktionen           *)
  80. FUNCTION SetLabel(Drive: BYTE; DriveLabel: STRING): INTEGER;
  81.  
  82. (* Lesen des Disketten-/Plattenlabels im Bootsektor der DOS-Versio-  *)
  83. (* nen 4 bis 6. Nicht zu verwechseln mit dem Eintragen der Volume-   *)
  84. (* Label-Verzeichniseintrags!                                        *)
  85. FUNCTION ReadDos4Label(Drive: CHAR): STRING;
  86.  
  87. (* Schreiben des Disketten-/Plattenlabels im Bootsektor der DOS-     *)
  88. (* Versionen 4 bis 6. Nicht zu verwechseln mit dem Eintrag »Volume«  *)
  89. (* im Hauptverzeichnis einer Diskette oder Platte.                   *)
  90. FUNCTION WriteDos4Label(Drive: CHAR; VolLabel: STRING): INTEGER;
  91.  
  92. (*-------------------------------------------------------------------*)
  93. (*     DOS und BIOS-Funktionen Direct-Write und Direct-Read.         *)
  94.  
  95. FUNCTION BIOSWrite(Drive: BYTE; Head, Cyl, First, Num: WORD;
  96.                    VAR Buffer): INTEGER;
  97. FUNCTION BIOSRead(Drive: BYTE; Head, Cyl, First, Num: WORD;
  98.                   VAR Buffer): INTEGER;
  99.  
  100. FUNCTION DiskWrite(Drive: BYTE; Head, Cyl, First, Num: WORD;
  101.                    VAR Buffer): INTEGER;
  102. FUNCTION DiskRead(Drive: BYTE; Head, Cyl, First, Num: WORD;
  103.                   VAR Buffer): INTEGER;
  104.  
  105. FUNCTION ReadBootSector (Drive: BYTE; VAR Buffer): INTEGER;
  106. FUNCTION WriteBootSector(Drive: BYTE; VAR Buffer): INTEGER;
  107.  
  108. FUNCTION ReadPartition (Drive: BYTE; VAR Buffer): INTEGER;
  109. FUNCTION WritePartition(Drive: BYTE; VAR Buffer): INTEGER;
  110.  
  111. (*-------------------------------------------------------------------*)
  112. (*               Auslösen von Kaltstart und Warmstart!               *)
  113. PROCEDURE ColdBoot;
  114. PROCEDURE WarmBoot;
  115.  
  116. (* Falls DR-DOS installiert ist, Rückgabe der Versionsnummer, sonst  *)
  117. (* (also bei MS-DOS) wird der Wert $0000 zurückgegeben               *)
  118. FUNCTION DRDOSVersion: WORD;
  119.  
  120. IMPLEMENTATION
  121. {$F+}
  122.  
  123. USES Dos, Hex;
  124.  
  125. TYPE
  126.   tInfoRec     = RECORD
  127.     reserved,
  128.     labellow,
  129.     labelhigh  : WORD;
  130.     vlabel,
  131.     fattype    : ARRAY[0..10] OF CHAR;
  132.   END;
  133.  
  134. CONST
  135.   InfoRec     : tInfoRec =
  136.     (reserved : 0000;
  137.      labellow : 0000;
  138.      labelhigh: 0000;
  139.      vlabel   : #0#0#0#0#0#0#0#0#0#0#0;
  140.      fattype  : 'FAT 16'#0#0#0#0#0);
  141.  
  142.   MaxBufSize              = 511;
  143.   GetParameters : BYTE    = $60;
  144.   SetParameters : BYTE    = $40;
  145.   WriteTrack    : BYTE    = $41;
  146.   ReadTrack     : BYTE    = $61;
  147.   FormatTrack   : BYTE    = $42;
  148.   VerifyTrack   : BYTE    = $62;
  149.   SetAccessFlag : BYTE    = $47;
  150.   GetAccessFlag : BYTE    = $67;
  151.   Dos330                  = $31E;
  152.  
  153. TYPE
  154.   tSectBuffer = ARRAY[0..MaxBufSize] OF BYTE; (* Puffer für 1 Sektor *)
  155.  
  156.   pLayoutList = ^tLayoutList;
  157.   tLayoutList = RECORD
  158.     SectorNumber : WORD;
  159.     SectorSize   : WORD;
  160.     Next         : pLayoutList;
  161.   END;
  162.  
  163.   tTrackLayout = RECORD
  164.     SectorCount : WORD;
  165.     Sectors     : pLayoutList;
  166.   END;
  167.  
  168.   tDeviceParams = RECORD
  169.     SpecialFunctions : BYTE;
  170.     DeviceType       : BYTE;
  171.     DeviceAttributes : WORD;
  172.     Cylinders        : WORD;
  173.     MediaType        : BYTE;
  174.     DeviceBPB        : tBPB;
  175.     TrackLayOut      : tTrackLayout;
  176.   END;
  177.  
  178.   tR_W_Block = RECORD
  179.     SpecialFunctions : BYTE;
  180.     Head             : WORD;
  181.     Cylinder         : WORD;
  182.     FirstSector      : WORD;
  183.     NumberOfSectors  : WORD;
  184.     TransferAddress  : POINTER;
  185.   END;
  186.  
  187. FUNCTION GetExtendedError: INTEGER; ASSEMBLER;
  188. (*-------------------------------------------------------------------*)
  189. (* Liste aller möglichen DOS-Fehler:                                 *)
  190. (* Standard-Fehlercodes:                                             *)
  191. (*  0       kein Fehler                                              *)
  192. (*  1       Subfunktion nicht unterstützt                            *)
  193. (*  2       Datei nicht gefunden                                     *)
  194. (*  3       Suchweg nicht gefunden                                   *)
  195. (*  4       Keine weiteren freien Handles                            *)
  196. (*  5       Zugriff verweigert                                       *)
  197. (*  6       Handle nicht definiert                                   *)
  198. (*  7       Speicherkontrollblock zerstört                           *)
  199. (*  8       Nicht genug Speicherplatz                                *)
  200. (*  9       Keine Block-Segmentadresse (MCB)                         *)
  201. (* 10       Fehler im Environment                                    *)
  202. (* 11       Ungültiges Format                                        *)
  203. (* 12       Ungültiger Zugriffscode                                  *)
  204. (* 13       Ungültige Daten                                          *)
  205. (* 14       reserviert (unbenutzt)                                   *)
  206. (* 15       Laufwerk existiert nicht                                 *)
  207. (* 16       Aktuelles Laufwerk läßt sich nicht entfernen             *)
  208. (* 17       Rename kann nicht kopieren                               *)
  209. (* 18       Keine weiteren Einträge                                  *)
  210. (* Kritische Fehler:                                                 *)
  211. (* 19       Medium ist schreibgeschützt                              *)
  212. (* 20       Gerät nicht definiert                                    *)
  213. (* 21       Gerät nicht bereit                                       *)
  214. (* 22       Unbekannter Befehl                                       *)
  215. (* 23       Prüfsummenfehler (CRC) auf dem Medium                    *)
  216. (* 24       Falsche Sektorlänge                                      *)
  217. (* 25       Spur nicht gefunden                                      *)
  218. (* 26       Unbekanntes Media-ID                                     *)
  219. (* 27       Sektor nicht gefunden                                    *)
  220. (* 28       Kein Papier im Drucker                                   *)
  221. (* 29       genereller Schreibfehler                                 *)
  222. (* 30       Lesefehler                                               *)
  223. (* 31       Genereller Fehler                                        *)
  224. (* Kritische Fehler ab DOS 3.0:                                      *)
  225. (* 32       Datei ist gesperrt                                       *)
  226. (* 33       Datensatz ist gesperrt                                   *)
  227. (* 34       Unerlaubter Diskettenwechsel                             *)
  228. (* 35       Kein FCB verfügbar                                       *)
  229. (* 36       Alle LOCK-Records besetzt                                *)
  230. (* Standard-Fehlercodes ab DOS 3.0:                                  *)
  231. (* 50       Operation nicht unterstützt                              *)
  232. (* 65       Codeseiten-Umschaltung nicht möglich                     *)
  233. (* 68       Generische IOCTL-Aufrufe nicht unterstützt               *)
  234. (* 80       Datei existiert bereits                                  *)
  235. (* 81       FCB existiert doppelt                                    *)
  236. (* 82       Verzeichnis existiert bereits                            *)
  237. (* 83       Abbruch nach Critical Error                              *)
  238. (* 84       DOS-interne Tabellen vollständig belegt                  *)
  239. (* 85       Laufwerk bereits zugeordnet                              *)
  240. (* 86       Paßwort ungültig (LAN)                                   *)
  241. (* 87       Ungültiger Parameter                                     *)
  242. (* 88       Schreibfehler im Netzwerk                                *)
  243. (*-------------------------------------------------------------------*)
  244. ASM                              (* DOS-Funktion 59h: Extended Error *)
  245.   MOV AH, 59h                    (* Die Funktion liefert den letzten *)
  246.   XOR BX, BX                     (* bei einer DOS-Operation aufge-   *)
  247.   INT 21h                        (* tretenen Fehlercode in AX zurück *)
  248. END;
  249.  
  250. FUNCTION ReadDiskIDNumber(Drive: CHAR): STRING;
  251. VAR
  252.   drv : BYTE;
  253.   Regs: Registers;
  254.   s   : STRING;
  255. BEGIN
  256.   drv := Ord(UpCase(Drive)) - 64;
  257.   IF Lo(DosVersion) IN [4..9] THEN WITH Regs DO
  258.   BEGIN
  259.     BL := drv;
  260.     DS := Seg(InfoRec);
  261.     DX := Ofs(InfoRec);
  262.     AX := $6900;                 (* undokumentierte DOS-Funktion 69h *)
  263.     MsDos(Regs);                 (* Unterfunktion 00 ab MS-DOS 4.0   *)
  264.     IF Odd(Flags) THEN           (* (Flags AND FCarry) = FCarry      *)
  265.     BEGIN
  266.       CASE AX OF
  267.         5, 11:  s := 'XXXX:XXXX';
  268.        15, 30:  s := '    :    ';
  269.        ELSE     s := Word2Hex(InfoRec.labelhigh) + ':' +
  270.                      Word2Hex(InfoRec.labellow);
  271.       END
  272.     END
  273.     ELSE
  274.       s := Word2Hex(InfoRec.labelhigh) + ':' +
  275.            Word2Hex(InfoRec.labellow);
  276.   END
  277.   ELSE s := '0000:0000';               (* Funktion nicht unterstützt *)
  278.   ReadDiskIDNumber := s;
  279. END;
  280.  
  281. FUNCTION WriteDiskIDNumber(Drive: CHAR; IdNumber: STRING): INTEGER;
  282. VAR
  283.   Regs  : Registers;
  284.   drv   : BYTE;
  285.   test  : INTEGER;
  286.   s1, s2: STRING;
  287. BEGIN
  288.   IF Length(IdNumber) <> 9 THEN
  289.   BEGIN
  290.     WriteDiskIDNumber := 50;
  291.     Exit;
  292.   END;
  293.   WriteDiskIDNumber := 0;
  294.   drv := Ord(UpCase(Drive)) - 64;
  295.   IF Lo(DosVersion) IN [4..9] THEN WITH Regs DO
  296.   BEGIN
  297.     BL := drv;
  298.     DS := Seg(InfoRec);
  299.     DX := Ofs(InfoRec);
  300.     AX := $6900;                 (* undokumentierte DOS-Funktion 69h *)
  301.     MsDos(Regs);                 (* Unterfunktion 00 ab MS-DOS 4.0   *)
  302.     IF Odd(Flags) THEN           (* (Flags AND FCarry) = FCarry      *)
  303.     BEGIN
  304.    (* es ist ein Fehler aufgetreten, der Zeiger konnte nicht gesetzt *)
  305.    (* werden. Deshalb wird die Datenträger-Nummer nicht geschrieben. *)
  306.       WriteDiskIDNumber := INTEGER(AX);
  307.       Exit;
  308.     END
  309.     ELSE
  310.     BEGIN
  311.       s1 := Copy(IdNumber, 1, 4);
  312.       Delete(IdNumber, 1, 5);
  313.       s2 :=IdNumber;
  314.       Val(s1, InfoRec.labellow, test);
  315.       IF test <> 0 THEN BEGIN WriteDiskIDNumber := test; Exit; END;
  316.       Val(s2, InfoRec.labelhigh, test);
  317.       IF test <> 0 THEN BEGIN WriteDiskIDNumber := test; Exit; END;
  318.       BL := drv;
  319.       DS := Seg(InfoRec);
  320.       DX := Ofs(InfoRec);        (* undokumentierte DOS-Funktion 69h *)
  321.       AX := $6901;               (* Unterfunktion 01 ab MS-DOS 4.0   *)
  322.       MsDos(Regs);
  323.       IF Odd(Flags) THEN WriteDiskIDNumber := AX;
  324.     END;
  325.   END;
  326. END;
  327.  
  328. FUNCTION ReadDos4Label(Drive: CHAR): STRING;
  329. VAR
  330.   drv  : BYTE;
  331.   Regs : Registers;
  332.  
  333. BEGIN
  334.   drv := Ord(UpCase(Drive)) - 64;
  335.   IF Lo(DosVersion) IN [4..9] THEN WITH Regs DO
  336.   BEGIN
  337.     BL := drv;
  338.     DS := Seg(InfoRec);
  339.     DX := Ofs(InfoRec);
  340.     AX := $6900;                 (* undokumentierte DOS-Funktion 69h *)
  341.     MsDos(Regs);                 (* Unterfunktion 00 ab MS-DOS 4.0   *)
  342.     IF Odd(Flags) THEN
  343.     BEGIN
  344.       ReadDos4Label := #0#0#0#0#0#0#0#0#0#0#0;
  345.       Exit;
  346.     END
  347.     ELSE ReadDos4Label := InfoRec.vlabel;
  348.   END
  349.   ELSE ReadDos4Label := #0#0#0#0#0#0#0#0#0#0
  350.                                        (* Funktion nicht unterstützt *)
  351. END;
  352.  
  353. FUNCTION WriteDos4Label(Drive: CHAR; VolLabel: STRING): INTEGER;
  354. VAR
  355.   Regs: Registers;
  356.   i,
  357.   drv : BYTE;
  358. BEGIN
  359.   WriteDos4Label := 0;
  360.   drv := Ord(UpCase(Drive)) - 64;
  361.   IF Lo(DosVersion) IN [4..9] THEN WITH Regs DO
  362.   BEGIN
  363.     BL := drv;
  364.     DS := Seg(InfoRec);
  365.     DX := Ofs(InfoRec);
  366.     AX := $6900;                 (* undokumentierte DOS-Funktion 69h *)
  367.     MsDos(Regs);                 (* Unterfunktion 00 ab MS-DOS 4.0   *)
  368.     IF Odd(Flags) THEN BEGIN     (* FCarry ist gesetzt               *)
  369.    (* es ist ein Fehler aufgetreten, der Zeiger konnte nicht gesetzt *)
  370.    (* werden. Deshalb wird die Datenträger-Nummer nicht geschrieben. *)
  371.       WriteDos4Label := AX;
  372.       Exit;
  373.     END
  374.     ELSE
  375.     BEGIN
  376.       FOR i := 0 TO Pred(Length(VolLabel)) DO
  377.         InfoRec.vlabel[i] := VolLabel[Succ(i)];
  378.       IF Length(VolLabel) < 11 THEN
  379.         FOR i := Length(VolLabel) TO 11 DO
  380.          InfoRec.vlabel[Pred(i)] := #0;
  381.       BL := drv;
  382.       DS := Seg(InfoRec);
  383.       DX := Ofs(InfoRec);        (* undokumentierte DOS-Funktion 69h *)
  384.       AX := $6901;               (* Unterfunktion 01 ab MS-DOS 4.0   *)
  385.       MsDos(Regs);
  386.       IF Odd(Flags) THEN WriteDos4Label := AX;
  387.     END;
  388.   END;
  389. END;
  390.  
  391. FUNCTION ExeFileLength(fName: STRING): LONGINT;
  392. VAR
  393.   ExeFile: FILE OF BYTE;
  394.   ExeID1,
  395.   ExeID2,
  396.   b1, b2,
  397.   b3, b4 : BYTE;
  398.   sr     : SearchRec;
  399. BEGIN
  400.   FindFirst(fName, Anyfile - Directory - VolumeID, sr);
  401.   IF Length(fName) < Length(sr.Name) THEN BEGIN
  402.     IF Pos(fName, sr.Name) = 0 THEN
  403.     BEGIN
  404.       ExeFileLength := -1;
  405.       Exit;
  406.     END
  407.   END ELSE BEGIN
  408.     IF Pos(sr.Name, fName) = 0 THEN
  409.     BEGIN
  410.       ExeFileLength := -1;
  411.       Exit;
  412.     END;
  413.   END;
  414.   Assign(ExeFile, fName);
  415.   Reset(ExeFile);
  416.   Read(ExeFile, ExeID1);
  417.   Read(ExeFile, ExeID2);
  418.   IF (Chr(ExeID1) <> 'M') OR (Chr(ExeID2) <> 'Z') THEN
  419.   BEGIN
  420.     ExeFileLength := -1;                (* Keine Exe-Programm-Datei! *)
  421.     Exit;
  422.   END;
  423.   Read(ExeFile, b1);
  424.   Read(ExeFile, b2);
  425.   Read(ExeFile, b3);
  426.   Read(ExeFile, b4);
  427.   Close(ExeFile);
  428.   IF (b2 = 0) AND (b1 = 0) THEN
  429.     ExeFileLength:= b4 * $100 + b3
  430.   ELSE
  431.     ExeFileLength := ((b4 * $100 + b3) - 1) * $200
  432.                     + (b2 * $100 + b1)
  433. END;
  434.  
  435. FUNCTION GetCountry: BYTE; 
  436. (* Die Daten aus dem LandesPuffer werden nicht ausgewertet, wer Lust *)
  437. (* hat, kann sich das selbst implementieren.                         *)
  438. TYPE
  439.   tCountryBuffer = RECORD       (* DOS-Puffer mit Landes-Information *)
  440.     DateFormat: WORD;           (* Aufbau nur gültig ab DOS 3.0!     *)
  441.     Currency  : ARRAY[0..4] OF CHAR;           (* Währungsformat     *)
  442.     thousand  : CHAR;                          (* Tausender-Trennung *)
  443.     dummy1    : BYTE;                          (* ein Null-Byte      *)
  444.     dezimal   : CHAR;                          (* Dezimal-Zeichen    *)
  445.     dummy2    : BYTE;                          (* ein Null-Byte      *)
  446.     date      : CHAR;                          (* Datum-Trennzeichen *)
  447.     dummy3    : BYTE;                          (* ein Null-Byte      *)
  448.     Time      : CHAR;                          (* Zeit-Trennzeichen  *)
  449.     dummy4    : BYTE;                          (* ein Null-Byte      *)
  450.     Curr_Form : BYTE; (* BITSET *)             (* Währungsformat     *)
  451.     exact     : BYTE;            (* Stellen hinter dem Währungskomma *)
  452.     Time_Form : BYTE; (* BITSET *)             (* Zeitformat         *)
  453.     Rout_Offs : WORD;            (* Offset DOS-Zeichensatztabelle    *)
  454.     Rout_Seg  : WORD;            (* Segment DOS-Zeichensatztabelle   *)
  455.     reserved  : ARRAY[0..11] OF BYTE;            (* reserv. Bereich  *)
  456.   END;
  457. VAR
  458.   vCountry: tCountryBuffer;
  459.   s, o    : WORD;
  460.   return  : BYTE;
  461. BEGIN
  462.   s := Seg(vCountry);
  463.   o := Ofs(GetCountry);
  464.   ASM
  465.      MOV AH, 38h
  466.      MOV BX, s
  467.      MOV DS, BX
  468.      MOV DX, o
  469.      XOR AL, AL
  470.      INT 21h
  471.      MOV return, BL
  472.   END;
  473.   GetCountry := return;
  474. END;
  475. FUNCTION IO_Generic(Drive: BYTE; What: BYTE; VAR Struct): INTEGER;
  476. VAR
  477.   Regs : Registers;
  478. BEGIN
  479.   WITH Regs DO BEGIN
  480.     AH := $44;
  481.     AL := $0D;
  482.     BL := Drive;
  483.     CH := $08;                              (* Kategorie (immer $08) *)
  484.     CL := What;
  485.     DS := Seg(Struct);
  486.     DX := Ofs(Struct);
  487.     Intr($21, Regs);
  488.     IF Odd(Flags) THEN IO_Generic := AX ELSE IO_Generic := 0;
  489.   END;
  490. END;
  491.  
  492. FUNCTION DiskRead(Drive: BYTE; Head, Cyl, First, Num: WORD;
  493.                   VAR Buffer): INTEGER;
  494. VAR
  495.   RW : tR_W_Block;
  496. BEGIN
  497.   RW.SpecialFunctions := 0;
  498.   RW.Head             := Head;
  499.   RW.Cylinder         := Cyl;
  500.   RW.FirstSector      := First - 1;
  501.   RW.NumberOfSectors  := Num;
  502.   RW.TransferAddress  := @Buffer;
  503.   DiskRead := IO_Generic(Drive, ReadTrack, RW);
  504. END;
  505.  
  506. FUNCTION DiskWrite(Drive: BYTE; Head, Cyl, First, Num : WORD;
  507.                    VAR Buffer): INTEGER;
  508. VAR
  509.   RW : tR_W_Block;
  510. BEGIN
  511.   RW.SpecialFunctions := 0;
  512.   RW.Head             := Head;
  513.   RW.Cylinder         := Cyl;
  514.   RW.FirstSector      := First - 1;
  515.   RW.NumberOfSectors  := Num;
  516.   RW.TransferAddress  := @Buffer;
  517.   DiskWrite := IO_Generic(Drive, WriteTrack, RW);
  518. END;
  519.  
  520. FUNCTION BIOSRead(Drive: BYTE; Head, Cyl, First, Num : WORD;
  521.                   VAR Buffer): INTEGER;
  522. VAR
  523.   Regs: Registers;
  524. BEGIN
  525.   WITH Regs DO
  526.   BEGIN
  527.     AH := 2;
  528.     AL := Num;
  529.     CH := Cyl;
  530.     CL := First;
  531.     DH := Head;
  532.     IF Drive < 3 THEN
  533.       DL := Drive
  534.     ELSE
  535.       DL := Drive + $80 - 3;
  536.     ES := Seg(Buffer);
  537.     BX := Ofs(Buffer);
  538.     Intr($13, Regs);
  539.     IF AH = $FF THEN BIOSRead := GetExtendedError
  540.                 ELSE BIOSRead := 0;
  541.   END;
  542. END;
  543.  
  544. FUNCTION BIOSWrite(Drive: BYTE; Head, Cyl, First, Num: WORD;
  545.                    VAR Buffer): INTEGER;
  546. VAR
  547.   Regs: Registers;
  548. BEGIN
  549.   WITH Regs DO
  550.   BEGIN
  551.     AH := 3;
  552.     AL := Num;
  553.     CH := Cyl;
  554.     CL := First;
  555.     DH := Head;
  556.     IF Drive < 3 THEN
  557.       DL := Drive
  558.     ELSE
  559.       DL := Drive + $80 - 3;
  560.     ES := Seg(Buffer);
  561.     BX := Ofs(Buffer);
  562.     Intr($13, Regs);
  563.     IF AH = $FF THEN BIOSWrite := GetExtendedError
  564.                 ELSE BIOSWrite := 0;
  565.  
  566.   END;
  567. END;
  568.  
  569. FUNCTION ReadBootSector(Drive: BYTE; VAR Buffer): INTEGER;
  570. VAR
  571.   r: INTEGER;
  572. BEGIN
  573.   IF Drive < 3 THEN
  574.   BEGIN
  575.     IF Swap(Dos.DosVersion) < Dos330 THEN
  576.       r := BIOSRead(Drive, 0, 0, 1, 1, Buffer)
  577.     ELSE
  578.       r := DiskRead(Drive, 0, 0, 1, 1, Buffer);
  579.   END
  580.   ELSE
  581.   BEGIN
  582.     IF Swap(Dos.DosVersion) < Dos330 THEN
  583.       r := BIOSRead(Drive, 1, 0, 1, 1, Buffer)
  584.     ELSE
  585.       r := DiskRead(Drive, 1, 0, 1, 1, Buffer)
  586.   END;
  587.   ReadBootSector := r;
  588. END;
  589.  
  590. FUNCTION WriteBootSector(Drive: BYTE; VAR Buffer): INTEGER;
  591. VAR
  592.   r: INTEGER;
  593. BEGIN
  594.   IF Drive < 3 THEN
  595.   BEGIN
  596.     IF Swap(Dos.DosVersion) < Dos330 THEN
  597.       r := BIOSWrite(Drive, 0, 0, 1, 1, Buffer)
  598.     ELSE
  599.       r := DiskWrite(Drive, 0, 0, 1, 1, Buffer);
  600.   END
  601.   ELSE
  602.   BEGIN
  603.     IF Swap(Dos.DosVersion) < Dos330 THEN
  604.       r := BIOSWrite(Drive, 1, 0, 1, 1, Buffer)
  605.     ELSE
  606.       r := DiskWrite(Drive, 1, 0, 1, 1, Buffer);
  607.   END;
  608.   WriteBootSector := r;
  609. END;
  610.  
  611. FUNCTION ReadPartition(Drive: BYTE; VAR Buffer): INTEGER;
  612. VAR
  613.   r: INTEGER;
  614. BEGIN
  615.   IF Swap(Dos.DosVersion) < Dos330 THEN
  616.     r := BIOSRead(Drive, 0, 0, 1, 1, Buffer)
  617.   ELSE
  618.     r := DiskRead(Drive, 0, 0, 1, 1, Buffer);
  619.   ReadPartition := r;
  620. END;
  621.  
  622. FUNCTION WritePartition(Drive: BYTE; VAR Buffer): INTEGER;
  623. VAR
  624.   r: INTEGER;
  625. BEGIN
  626.   IF Swap(Dos.DosVersion) < Dos330 THEN
  627.     r := BIOSWrite(Drive, 0, 0, 1, 1, Buffer)
  628.   ELSE
  629.     r := DiskWrite(Drive, 0, 0, 1, 1, Buffer);
  630.   WritePartition := r;
  631. END;
  632.  
  633. PROCEDURE RebootSystem; ASSEMBLER;
  634. (* Löst einen Warmstart aus, das WarmstartIDWort wird nicht geändert *)
  635. ASM
  636.   PUSH AX                      (* vorsichtshalber alle verwendeten   *)
  637.   PUSH BX                      (* Register sichern (kann nie schaden *)
  638.   PUSH DX
  639.   PUSH DS
  640.   PUSH ES
  641.   MOV  BX, 0F000H              (* Segment: $F000; Offset:  $FFFE     *)
  642.   MOV  DS, BX                  (* = vorletztes adressierbares Byte   *)
  643.   MOV  BX, 0FFFEH              (* vor 1 Mbyte (absolute Adr. $FFFFE) *)
  644.   MOV  AL, DS:[BX]
  645.   CMP  AL, 0FCH                (* Maschinen-ID: $FC = AT             *)
  646.   JNE  @NoAT
  647.   MOV  AL, 0FEH                (* Identisch mit: Inline($B0/$FE      *)
  648.   MOV  DX, 0064H               (*                      /$BA/$64/$00  *)
  649.   OUT  DX, AL                  (*                      /$EE);        *)
  650.                                (* --> Simulation von Alt+Ctrl+Del    *)
  651. @NoAT:                         (* Nicht geklappt: Brachialmethode    *)
  652.   MOV  BX, 0FFFFH              (* äquivalent zu JMP FAR $FFFF:0000   *)
  653.   MOV  BX, ES                  (* --> Inline($EA/$00/$00/$FF/$FF);   *)
  654.   XOR  BX, BX                  (* IBM, Phoenix, XTs, ... . Reset     *)
  655.   CALL WORD Ptr ES:[BX]        (* Im TASM/BASM nur als CALL über Reg *)
  656.   POP  ES                      (* Sprung auf die BIOS-Reset-Routine  *)
  657.   POP  DS                      (* Falls es wider Erwarten nicht ge-  *)
  658.   POP  DX                      (* klappt hat, alle Register wieder   *)
  659.   POP  BX                      (* restaurieren                       *)
  660.   POP  AX
  661. END;
  662.  
  663. PROCEDURE ColdBoot; ASSEMBLER;
  664. (* Die Prozedur löst einen Reset des Rechners mit Systemcheck aus.   *)
  665. ASM
  666.   PUSH AX                      (* Register auf den Stack (das        *)
  667.   PUSH BX                      (* schadet bekanntlich nie)           *)
  668.   PUSH DS
  669.   MOV  BX, 0040H               (* Segmentadresse auf 0040h über      *)
  670.   MOV  DS, BX                  (* DS := BX setzen und Offset auf 72h *)
  671.   MOV  BX, 0072H               (* so daß DS:[BX] = 40h:72h ist.      *)
  672.   XOR  AX, AX                  (* AX := 0;                           *)
  673.   MOV  DS:[BX], AX             (* und nach 40h:72h := 0000 schreiben *)
  674.   CALL RebootSystem            (* ... und Neustart!                  *)
  675.   POP  DS                      (* Register wieder vom Stack holen    *)
  676.   POP  BX
  677.   POP  AX
  678. END;
  679.  
  680. PROCEDURE WarmBoot; ASSEMBLER;
  681. ASM
  682.   PUSH AX                      (* Register auf den Stack (das        *)
  683.   PUSH BX                      (* schadet bekanntlich nie)           *)
  684.   PUSH DS
  685.   MOV  BX, 0040H               (* Segmentadresse auf 0040h über      *)
  686.   MOV  DS, BX                  (* DS := BX setzen und Offset auf 72h *)
  687.   MOV  BX, 0072H               (* so daß DS:[BX] = 40h:72h ist.      *)
  688.   MOV  AX, 1234H               (* AX := 1234 = Warmstartkennung      *)
  689.   MOV  DS:[BX], AX             (* und nach 40h:72h := 0000 schreiben *)
  690.   CALL RebootSystem            (* ... und Neustart                   *)
  691.   POP  DS                      (* Register wieder vom Stack holen    *)
  692.   POP  BX
  693.   POP  AX
  694. END;
  695.  
  696. FUNCTION DRDOSVersion: WORD;
  697. (* Die Funktion ermittelt auf einfache Weise die DR-DOS-Version. Da- *)
  698. (* bei wird davon ausgegangen, daß DR-DOS im Environment die Variab- *)
  699. (* len OS=DRDOS und VERSION=Nummer implementiert. Diese können al-   *)
  700. (* lerdings durch den Benutzer gelöscht werden. Es gibt eine weitere *)
  701. (* Möglichkeit, die DR-DOS Version über Bugs in diesen Betriebssy-   *)
  702. (* stemen zu ermitteln (SCHÄPERS 1991, S. 359 ff, dies ist aber im   *)
  703. (* Normalfall nicht notwendig. Außerdem kann DR-DOS auch damit er-   *)
  704. (* mittelt werden, daß das Betriebssystem einige spezifische Erwei-  *)
  705. (* terungen, wie die Paßwortabfrage, enthält.                        *)
  706. VAR
  707.   os     : STRING;
  708.   version: STRING;
  709. BEGIN
  710.   IF Swap(Dos.DosVersion) <> $31F THEN DRDOSVersion := $0000 ELSE
  711.   BEGIN
  712.     os := GetEnv('OS');
  713.     IF os <> 'DRDOS' THEN
  714.     BEGIN
  715.       DRDOSVersion := $0000;
  716.       Exit;
  717.     END;
  718.     version := GetEnv('VERSION');
  719.     CASE version[1] OF
  720.       '3': DRDOSVersion := 341;
  721.       '5': DRDOSVersion := 500;
  722.       '6': DRDOSVersion := 600;
  723.       ELSE DRDOSVersion :=   0;
  724.     END;
  725.   END;
  726. END;
  727.  
  728. FUNCTION GetLabel(Drive: BYTE): STRING; (* Label des Laufwerks lesen *)
  729. VAR
  730.   sr         : SearchRec;
  731.   SearchDrive: PathStr;
  732.   DriveLabel : STRING[12];
  733. BEGIN
  734.   IF Drive = 0 THEN GetDir(0, SearchDrive)
  735.                ELSE SearchDrive := Chr(Drive + 64);
  736.   SearchDrive := SearchDrive[1];
  737.   FindFirst(SearchDrive + ':\*.*', VolumeID, sr);
  738.   IF DosError = 0 THEN          (* bei DosError 18 --> nicht gesetzt *)
  739.   BEGIN
  740.     DriveLabel := sr.Name;                    (* aus SearchRec holen *)
  741.     IF Pos('.', DriveLabel) > 0 THEN
  742.       Delete(DriveLabel, Pos('.', DriveLabel), 1);  (* Punkt löschen *)
  743.   END
  744.   ELSE
  745.     DriveLabel := '';                               (* nicht gesetzt *)
  746.   GetLabel := DriveLabel;
  747. END;
  748.  
  749. FUNCTION SetLabel(Drive: BYTE; DriveLabel: STRING): INTEGER;
  750. (* Setzen des Volume-Labels über die DOS FCB-Funktionen. Es werden   *)
  751. (* die DOS-Konventionen berücksichtigt, also nur erlaubte Zeichen    *)
  752. (* geschrieben. Für Drive: 0 = aktuell, 1 = A:, 2 = B:, 3 = C ...    *)
  753. VAR
  754.   FCB     : ARRAY[0..45] OF BYTE;  (* File-Control-Block vereinfacht *)
  755.   Regs    : Registers;
  756.   OldLabel: STRING[11];             (* ursprüngliches Diskettenlabel *)
  757.   i       : INTEGER;
  758. BEGIN
  759.   IF Length(DriveLabel) > 11 THEN DriveLabel[0] := Chr(11);
  760.   FCB[0] := $FF;                     (* Kennung erw. FCB setzen      *)
  761.   FOR i := 1 TO 45 DO FCB[i] := $00; (* ... des Rest ausnullen       *)
  762.   FCB[6] := VolumeID;                (* was bearbeitet werden soll   *)
  763.   FCB[7] := Drive;                   (* Laufwerk an Position 7       *)
  764.   OldLabel := GetLabel(drive);       (* das bleibt uns nicht erspart *)
  765.   IF DosError = 18 THEN DosError := 0;(* »No more files« kein Fehler *)
  766.   IF DosError <> 0 THEN              (* DOS-Fehler aufgetaucht       *)
  767.   BEGIN
  768.     SetLabel := DosError;            (* Funktionsergebnis = Fehler   *)
  769.     Exit;                            (* ... und raus                 *)
  770.   END;
  771.  
  772.   IF DriveLabel = '' THEN            (* --> Funktion Label löschen   *)
  773.   BEGIN
  774.     IF OldLabel <> '' THEN           (* war eines da                 *)
  775.     BEGIN
  776.       FOR i := Length(OldLabel) TO 11 DO
  777.         OldLabel := OldLabel +  ' '; (* Ausnullen mit Leerzeichen    *)
  778.       FOR i := 1 TO 11 DO FCB[i + 7] := Ord(OldLabel[i]);
  779.       WITH Regs DO                   (* in FCB übertragen            *)
  780.       BEGIN
  781.         AH := $13;                   (* Funktion 13h: Label löschen  *)
  782.         DS := Seg(FCB);
  783.         DX := Ofs(FCB);
  784.         MsDos(Regs);
  785.         IF Regs.AH = $FF THEN SetLabel := GetExtendedError
  786.                          ELSE SetLabel := 0;  (* Fehlerprüfung       *)
  787.         Exit;                                 (* ... und raus        *)
  788.       END
  789.     END
  790.     ELSE
  791.     BEGIN             (* wo nichts ist, kannn nichts gelöscht werden *)
  792.       SetLabel := 0;  (* Löschen was nicht war ist kein Fehler       *)
  793.       Exit;           (* und raus aus der Funktion                   *)
  794.     END;
  795.   END;
  796.  
  797.   FOR i := Length(DriveLabel) TO 11 DO (* ... und jetzt Label setzen *)
  798.     DriveLabel := DriveLabel +  ' ';
  799.   FOR i := 1 TO 11 DO
  800.   BEGIN                                  (* unerlaubtes Zeichen ???? *)
  801.     IF DriveLabel[i] IN [Chr(0)..Chr(31), '.', '&', '?', '"', '*' ,
  802.                          '+', '<', '>', Chr(166)..Chr(255)] THEN
  803.       DriveLabel[i] := '_';            (* durch Unterstrich ersetzen *)
  804.     IF DriveLabel[i] IN ['/', '|', '/'] THEN DriveLabel[i] := '!'
  805.   END;                              (* oder durch ein Ausrufezeichen *)
  806.  
  807.   IF Length(OldLabel) > 0 THEN
  808.   BEGIN
  809.     FOR i := Length(OldLabel) TO 11 DO OldLabel := OldLabel +  ' ';
  810.     FOR i := 1 TO 11 DO           (* ausnullen und übertragen in FCB *)
  811.     BEGIN
  812.       FCB[i +  7] := Ord(OldLabel[i]); (* Laufwerksnummer nach Pos 7 *)
  813.       FCB[i + 23] := Ord(DriveLabel[i]);
  814.     END;
  815.     WITH Regs DO
  816.     BEGIN
  817.       AH := $17;                   (* Funktion 17h: Label umbenennen *)
  818.       DS := Seg(FCB);
  819.       DX := Ofs(FCB);
  820.       MsDos(Regs);
  821.       IF Regs.AH = $FF THEN SetLabel := GetExtendedError
  822.                        ELSE SetLabel := 0           (* Fehlerabfrage *)
  823.     END;
  824.   END
  825.   ELSE
  826.   BEGIN
  827.     FOR i := 1 TO 11 DO FCB[i + 7] := Ord(DriveLabel[i]);
  828.     WITH Regs DO
  829.     BEGIN
  830.       AH := $16;                        (* Funktion 16h: Neu anlegen *)
  831.       DS := Seg(FCB);                   (* des Labels                *)
  832.       DX := Ofs(FCB);
  833.       MsDos(Regs);
  834.       IF Regs.AH = $FF THEN SetLabel := GetExtendedError
  835.                        ELSE SetLabel := 0
  836.     END;
  837.   END;
  838. END;
  839.  
  840. END.
  841. (*===================================================================*)
  842.