home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9203 / driver / dosutils.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-04-05  |  93.7 KB  |  2,815 lines
  1. Unit DosUtils;   { Utility-Routinen zur DOS-Programmierung }
  2. Interface
  3. uses Dos;
  4.  
  5. Type  { Struktur eines File Control Blocks }
  6. FCBRec = Record
  7.   Drive: Byte;                 { Laufwerksnummer: 1 = A:, 2 = B: usw. }
  8.   Name: Array[1..8] of Char;   { Dateiname, aufgefüllt mit Leerz. }
  9.   Suffix: Array[1..3] of Char; { Suffix, aufgefüllt mit Leerzeichen }
  10.   CurrBlock: Word;             { momentane Blocknummer (Datensatz/128) }
  11.   RecSize: Word;               { Datensatzgröße in Bytes }
  12.   FileSize: LongInt;           { Dateigröße in Bytes }
  13.   ModDate: Word;               { Datum der letzten Modifikation }
  14.   ModTime: Word;               { Uhrzeit der letzten Modifikation }
  15.   Reserved: Array[1..8] of Byte; { Betriebssystem-intern verwendet }
  16.   CurrRec: Byte;               { momentane Datensatznummer (0..127) }
  17.   RandRec: LongInt;            { Recordnummer für R/W Random }
  18. end;
  19.   FCBPointer = ^FCBRec;   { Zeiger darauf }
  20.  
  21.   { Kopfinformation von Gerätetreibern }
  22.   DriverPointer = ^DriverHead;
  23.   DriverHead = Record      { Gerätetreiber-Kopf }
  24.     DNext: DriverPointer;  { Zeiger auf den nächsten Treiber }
  25.     DAttr: Word;       { Geräteattribut, <> Func $4400! }
  26.     DStrat: Word;      { Offset-Adresse der "Strategy"-Routine }
  27.     DIntr: Word;       { Offset-Adresse der "Interrupt"-Routine }
  28.     case Integer of
  29.       0: (Name: Array[1..8] of Char);
  30.       1: (Drives: Byte);
  31.   end;
  32.  
  33. Type
  34.  PSPSegment = Record
  35.    INT20 : Array[1..2] of Byte;  { INT $20-Befehl }
  36.    MemEnd: Word;  { Höchste Speicheradresse in Paragraphs }
  37.    Fill1: Byte;  { unbenutzt }
  38.    DOSJmp: Array[1..5] of Byte;  { JMP FAR zu DOS, mit 1. Prog-Seg }
  39.    OrgInt22: Pointer;  { Originalwert INT $22, d.h. Rücksprungadresse }
  40.    OrgInt23: Pointer;  { Originalwert INT $23 }
  41.    OrgInt24: Pointer;  { Originalwert INT $24 }
  42.    ParentPSP: Word;    { PSP-Segment des aufrufenden Programms }
  43.    JFT: Array[0..19] of Byte;  { Offene Dateien }
  44.    EnvSeg: Word;  { Environment-Segment }
  45.    SPSave: Word;  { SP beim letzten DOS-Aufruf }
  46.    SSSave: Word;  { SS beim letzten DOS-Aufruf }
  47.    FILES: Word;   { DOS 3.x: Maximalzahl offener Dateien }
  48.    JFTAddr: Pointer; { DOS 3.x: Datei-Tabelle, normalerweise @FTable }
  49.    PrevPSP: Pointer;  { DOS 3.x: vorangehendes PSP ($FFFFF) }
  50.    Fill2: Array[1..20] of Byte;  { unbenutzt }
  51.    DOSCall: Array[1..3] of Byte; { INT $21 / RETF }
  52.    Fill3: Array[1..9] of Byte; { unbenutzt }
  53.    { FCB }
  54.    Drive: Byte;                 { Laufwerksnummer: 1 = A:, 2 = B: usw. }
  55.    Name: Array[1..8] of Char;   { Dateiname, aufgefüllt mit Leerz. }
  56.    Suffix: Array[1..3] of Char; { Suffix, aufgefüllt mit Leerzeichen }
  57.    CurrBlock: Word;             { momentane Blocknummer }
  58.    RecSize: Word;               { Datensatzgröße in Bytes }
  59.    NewDrive: Byte;                { für den FCB: FileSize, ModDate... }
  60.    NewName: Array[1..8] of Char;
  61.    NewSuffix: Array[1..3] of Char;
  62.    Fill4: Array[1..8] of Byte;
  63.    DTA: Array[0..$7F] of Char;
  64.  end;
  65.  PSPSegPointer = ^PSPSegment;
  66.  
  67. var
  68.   ExtErrInfo : Record  { wird von GetExtError gesetzt und }
  69.     Code: Word;        { von GetExtError als Parameter benutzt }
  70.     Class, Action, Locus: Byte;
  71.     ExtPointer: Pointer;
  72.   end;
  73.  
  74. Procedure ShowExtError;  { Ausgabe des Fehlerstatus (Funktion $59) }
  75.  
  76. Procedure CallCommand(Cmd: String);   { Aufruf von COMMAND.COM }
  77.  
  78. Type            { Struktur eines Speicherkontrollblocks ab V 4.0 }
  79.   MCBRec = Record  { bzw. DR-DOS 5.0 }
  80.     Flag: Char;  { 'M' oder 'Z' }
  81.     OwnerPSP: Word;  { PSP-Segment des "Besitzers" }
  82.     Size: Word;  { Größe in Paragraphs }
  83.     Resvd: Array[1..3] of Byte;  { "reserviert" }
  84.     OwnerID: Array[1..8] of Char;
  85.   end;
  86.   MCBPtr = ^MCBRec;
  87.  
  88. Type                         { für die Funktionen $5Dxx }
  89.   ServerCallBlock = Record
  90.     AX,BX,CX,DX,SI,DI,DS,ES: Word;  { Register }
  91.     Resvd: Word;   { sollte immer 0 sein }
  92.     SysID: Word;   { Stations-ID: 0 für die eigene Maschine }
  93.     ProcID: Word;  { = PSP-Segment des aufrufenden Prozesses }
  94.   end;
  95.  
  96. Type                         { für die Funktion $6501 }
  97.   Func6501Country = Record
  98.     SubFuncNo: Byte;   { immer $01 }
  99.     DataSize: Word;    { Umfang der folgenden Daten }
  100.     CountryCode: Word; { Nummer des aktuellen/angegebenen Landes }
  101.     CodePage: Word;    { Nummer aktuelle/angegebene Codeseite (CON) }
  102.  
  103.     { ab hier: wie bei Funktion $38 }
  104.     DateFmt: Word;   { 0=USA,1=Europa,2=Japan }
  105.     Currency: Array[0..4]  of Char;  { ASCIIz-String }
  106.     TSep: Char;      { Trennzeichen für Tausender }
  107.     Dummy1: Byte;
  108.     DSep: Char;      { Trennzeichen für Nachkommastellen }
  109.     Dummy2: Byte;    { unbenutzt }
  110.     DateSep: Char;   { Trennzeichen für Datum }
  111.     Dummy3: Char;
  112.     TimeSep: Char;   { Trennzeichen für Zeit }
  113.     Dummy4: Byte;
  114.     CurrFmt: Byte;   { Bit 0 = 0 -> DM xxxx, 1-> xxxx DM }
  115.                      { Bit 1 = 0 -> DMxxxx, 1-> DM xxxx }
  116.     Precision: Byte; { Anzahl Nachkommastellen }
  117.     TimeFmt: Byte;   { 0 = 12 Stunden, 1 = 24 Stunden }
  118.     UpcasePtr: Pointer; { Zeiger auf Upcase-Routine }
  119.     Dummy5: Array[22..33] of Byte;  { unbenutzt }
  120.   end;
  121.  
  122. Type
  123.   DiskSerialInfo = Record   { Funktionen $69xx und $440D/$46 bzw. $66 }
  124.     InfoLevel: Word;     { immer 0 }
  125.     SerialNo: LongInt;   { Seriennummer des Volumes }
  126.     VLabel: Array[1..11] of Char;  { Volume-Label }
  127.     FileSystem: Array[1..8] of Char;  { Dateisystem ('FATxx') }
  128.   end;
  129.  
  130.  
  131. { Ausgabe im Hexadezimalformat mit führenden Nullen }
  132. Function HexB(b: Byte): String;
  133. Function HexW(w: Word): String;
  134. Function HexP(p: Pointer): String;
  135. Function HexL(l: LongInt): String;
  136.  
  137. { Umwandlung zwischen ASCIIZ und Pascal-Strings }
  138. Function StrtoZ(PascalStr: String): String;
  139. Function ZtoStr(ZStr: Pointer): String;
  140.  
  141. Procedure AbsRead(Drive: Byte; DTA: Pointer;   { Abs. Sektor lesen }
  142.                   StartSec: LongInt; NumSecs: Word);
  143. Procedure AbsWrite(Drive: Byte; DTA: Pointer;  { Abs. Sektor schreiben }
  144.                   StartSec: LongInt; NumSecs: Word);
  145.  
  146. { Lokalisieren und Bearbeiten von Gerätetreibern }
  147. Function LocateDriver(DriverName: String): DriverPointer;
  148. Procedure GetDriver (DriverName: String; var Attributes: Word;
  149.                      var Strategy: Pointer; var Intrupt: Pointer);
  150.  
  151. { Speichert bei jedem Aufruf den als NewVal übergebenen Wert in seinem
  152.   Codesegment und liefert den dort zuletzt gespeicherten Wert zurück,
  153.   wird für EXEC und andere Routinen gebraucht, die das DS-Register
  154.   und den Stack verändern.
  155. }
  156. Function SwapValInCS(NewVal: Word): Word;
  157.  
  158.  
  159. { ------- CP/M-kompatible DOS-Funktionen -------- }
  160. { $01 } Function GetChar01: Char;        { Zeicheneingabe }
  161. { $02 } Procedure PutChar02(Ch: Char);  { Zeichenausgabe }
  162. { $03 } Function GetChar03: Char;       { Zeicheneingabe AUX }
  163. { $04 } Procedure PutChar04(Ch: Char);  { Zeichenausgabe AUX }
  164. { $05 } Procedure PutChar05(Ch: Char);  { Zeichenausgabe PRN }
  165. { $06 } Function GetChar06: Char;       { Zeicheneingabe }
  166.         Procedure PutChar06(Ch: Char);  { Zeichenausgabe }
  167. { $07 } Function GetChar07: Char;       { Zeicheneingabe }
  168. { $08 } Function GetChar08: Char;       { Zeichenausgabe }
  169. { $09 } Procedure WriteString09(s: String); { Ausgabe CP/M-String }
  170. { $0A } Function ReadString0A(MaxLen: Integer): String; { Stringeingabe }
  171. { $0B } Function CharAvailable: Boolean; { Test auf "Zeichen bereit" }
  172. { $0C } Function FlushRead(FuncNo: Byte): Char;
  173. { $0D } Procedure DriverFlush0D;   { vor Diskettenwechsel }
  174. { $0E } Procedure SetDefaultDrive(NewDrive: Byte); { Standardlaufwerk setzen }
  175. { $0F } Procedure OpenFileFCB(FCB: Pointer);  { CP/M-kompatibles OPEN }
  176. { $10 } Procedure CloseFileFCB(FCB: Pointer); { CP/M-kompatibles CLOSE }
  177. { $11 } Procedure FindFirstCPM(StartFCB: Pointer);  { Datei via FCB suchen }
  178. { $12 } Procedure FindNextCPM (NextFCB: Pointer);  { weitere Dateien suchen }
  179. { $13 } Procedure DeleteFileFCB(FCB: Pointer); { CP/M-kompatibles Löschen }
  180. { $14 } Function ReadSequential(FCB: Pointer): Integer;  { sequ. Lesen }
  181. { $15 } Function WriteSequential(FCB: Pointer): Integer; { sequ. Schreiben }
  182. { $16 } Procedure CreateFileFCB(FCB: Pointer);  { CP/M-kompatibles CREATE }
  183. { $17 } Procedure RenameFCB(FCB: Pointer);     { CP/M-kompatibles RENAME }
  184. { $18 } { nicht definiert }
  185. { $19 } Function GetCurrentDrive: Byte; { aktuelles Laufwerk }
  186. { $1A } Procedure SetDTA(DTA: Pointer); { setzt die DTA }
  187.  
  188. Type  { Von den Funktionen $1B und $1C zurückgelieferte Daten als Record }
  189.   FATInfoType = Record
  190.     SecsCluster: Word;   { Sektoren pro Cluster }
  191.     BytesSec:    Word;   { Bytes pro Sektor }
  192.     NumCluster:  Word;   { Gesamtzahl Cluster }
  193.     MediaID:     Byte;   { eigentlich: Zeiger auf Media-ID }
  194.   end;
  195. { $1B } Procedure GetCurrFATInfo(var Info: FATInfoType);
  196. { $1C } Procedure GetAnyFATInfo(var Info: FATInfoType; DiskNum: Byte);
  197. { $1D } { undefiniert }
  198. { $1E } { undefiniert }
  199. { $1F } Function GetCurrentDPB: Pointer;  { aktuellen DPB ermitteln }
  200. { $20 } { undefiniert }
  201. { $21 } Function ReadFCBRand(FCB: FCBPointer; RecNo: LongInt): Integer;
  202. { $22 } Function WriteFCBRand(FCB: FCBPointer; RecNo: LongInt): Integer;
  203. { $23 } Function GetFileSizeFCB(FCBPtr: FCBPointer): LongInt;
  204. { $24 } Procedure SetRandRecNo(FCB: FCBPointer);
  205.  
  206. { ------- DOS-Funktionen --------- }
  207. { $25 - DOS - Procedure SetIntVec(IntNo: Byte; Vector: Pointer);  }
  208. { $26 } Procedure MakeNewPSP(PSPAddr: Word);
  209. { $27 } Function ReadRandRecs(FCB: FCBPointer; FirstRec: LongInt;
  210.                  NumBlocks: Word): Integer;
  211. { $28 } Function WriteRandRecs(FCB: FCBPointer; FirstRec: LongInt;
  212.                  NumBlocks: Word): Integer;
  213. { $29 } Function ParseFName(CmdLine: Pointer; FCBAddr: Pointer): Pointer;
  214. { $2A - DOS - Procedure GetDate(var Year,Month,Day,DayofWeek: Word); }
  215. { $2B } Procedure SetDate(Year,Month,Day: Word);  { setzt DosError }
  216. { $2C - DOS - Procedure GetTime(var Hour, Minute, Second, Sec100: Word); }
  217. { $2D } Procedure SetTime(Hour,Minute,Second,Sec100: Word);
  218. { $2E - DOS - Procedure SetVerify(Verify: Boolean);  }
  219. { $2F } Function GetDTA: Pointer;  { Ermittelt die momentane DTA }
  220. { $30 } Function DosVersion: Word;  { echte Versionsnummer }
  221. { $31 - DOS - Procedure Keep(ExitCode: Word); }
  222. { $32 } Function GetAnyDPB(DriveNo: Byte): Pointer;
  223. { $3300 - DOS - Procedure GetCBreak(var Break: Boolean); }
  224. { $3301 - DOS - Procedure SetCBreak(Break: Boolean); }
  225. { $3302 } Function SwapCBreak(NewBreak: Boolean): Boolean;
  226. { $3305 } Function GetBootDrive: Byte;
  227. { $3306 } Function GetDosHIGH: Boolean;  { (zusätzlich: Versionsnummer) }
  228. { $34 } Procedure GetDOSFlags(var InDosPtr, CritErrPtr);
  229. { $35 - DOS - Procedure GetIntVec(IntNo: Byte; var Vector: Pointer); }
  230. { $36 - DOS - Function DiskFree(Drive: Byte): LongInt; }
  231. { $3700 } Function GetSwitChar: Char;  { Trennzeichen ermitteln }
  232. { $3701 } Function SetSwitChar(NewSwitch: Char): Boolean;
  233. { $3702 } Function GetDevAvail: Boolean;
  234. { $3703 } Procedure SetDevAvail(NewState: Boolean);
  235. { $38 } Function GetCountry(Mode: Byte; CountryNo: Word; var CInfo): Integer;
  236.         Function SetCountry(CountryNo: Word): Boolean;
  237. { $39 - DOS - Procedure MkDir(s: String); }
  238. { $3A - DOS - Procedure RmDir(s: String); }
  239. { $3B - DOS - Procedure ChDir(s: String); }
  240. { $3C } Function CreateFile(s: String; Attrib: Byte): Word;
  241. { $3D } Function OpenFile(s: String): Word;  { SHARE-Flags via FileMode }
  242. { $3E } Procedure CloseFile(Handle: Word);  { schließt eine Datei }
  243. { $3F } Function ReadFile(FHandle: Word; Count: Word;
  244.                  BufPtr: Pointer): Word;
  245. { $40 } Procedure WriteFile(Handle,Count: Word; BufPtr: Pointer);
  246. { $41 - DOS - Procedure Erase(FileName: String); }
  247. { $42 } Function FileSeek(Handle: Word; Offset: LongInt;
  248.                  Action: Integer): LongInt;
  249. { $4300 - DOS - Function GetFAttr(FName: String): Word; }
  250. { $4301 - DOS - Procedure SetFAttr(FName: String; NewAttrs: Word); }
  251. { $4302 } Function GetFPass(FName: String): Byte;  { nur DR-DOS }
  252. { $4303 } Procedure SetFPass(FName, Pass: String; Mode: Byte); { nur DR }
  253.  
  254. { $4400 } Function GetDevAttributes(Handle: Word): Word;
  255. { $4401 } Procedure SetDevAttributes(Handle: Word; Attr: Word);
  256. { $4402 } Function IOCTLReadHandle(Handle, Count: Word;
  257.                    Buf: Pointer): Word;
  258. { $4403 } Function IOCTLWriteHandle(Handle, Count: Word;
  259.                    Buf: Pointer): Word;
  260. { $4404 } Function IOCTLReadBlock(Drive, Count: Word;
  261.                    Buf: Pointer): Word;
  262. { $4405 } Function IOCTLWriteBlock(Drive, Count: Word;
  263.                    Buf: Pointer): Word;
  264. { $4406 } Function IOCTLInReady(Handle: Byte): Boolean;
  265. { $4407 } Function IOCTLOutReady(Handle: Byte): Boolean;
  266. { $4408 } Function IOCTLChangeable(Drive: Byte): Boolean;
  267. { $4409 } Function IOCTLDevLocal(Drive: Byte): Word;
  268. { $440A } Function IOCTLHandleLocal(Handle: Word): Word;
  269. { $440B } Procedure IOCTLSetRetry(Repeats, Counter: Word);
  270. { $440C } Procedure IOCTLGenericHandle(Handle,Category,Subcode: Byte;
  271.                     var ParmBlock);
  272. { $440D } Procedure IOCTLGenericBlock(Drive,Subcode: Byte; var ParmBlock);
  273. { $440E } Function IOCTLGetLogMap(Drive: Byte): Byte;
  274. { $440F } Procedure IOCTLSetLogMap(NewDrive: Byte);
  275. { $4410 } Function IOCTLSupportH(Handle: Word; Categorie, Subcode: Byte): Boolean;
  276. { $4411 } Function IOCTLSupportB(Drive: Word; Subcode: Byte): Boolean;
  277.  
  278. { $45 } Function DupHandle(Handle: Word): Word;
  279. { $46 } Procedure SetHandle2(Handle1, Handle2: Word);
  280. { $47 - DOS -  Procedure GetDir(Drive: Byte; var s: String); }
  281. { $48 } Function GetMemBlock(Size: LongInt): Word;
  282.         Function GetFreeMainMem: LongInt;
  283. { $49 } Procedure FreeMemBlock(BlockSeg: Word);
  284. { $4A } Procedure SetMemBlock(BlockSeg,BlockSize: Word);
  285. { $4B00 - DOS - Procedure Exec(Path, CmdLine: String); }
  286. { $4B01 } Procedure ExecLoad(Path, CmdLine: String; var ProgRegs);
  287. { $4B02 }  { undefiniert }
  288. { $4B03 } Procedure LoadOverlay(Name: String);
  289. { $4B04 }  { undefiniert }
  290. { $4B05 }  { funktioniert leider noch nicht! }
  291. { $4C - DOS - Procedure TerminateProcess(ExitCode: Byte); }
  292. { $4D - DOS - Function DosExitCode: Word; }
  293. { $4E - DOS - Procedure FindFirst(Path: String;
  294.               Attr: Word; var S: SearchRec); }
  295. { $4F - DOS - Procedure FindNext(var S: SearchRec); }
  296. { $50 } Procedure SetActivePSP(PSPSeg: Word);  { Aktives PSP setzen }
  297. { $51 } Function GetPSPAddr51 : Word;
  298. { $52 } Function GetDosDataArea: Pointer;
  299. { $53 } Procedure MakeDPB(DriveNo: Byte; DPB: Pointer);
  300. { $54 - DOS - Procedure GetVerify(var Verify: Boolean); }
  301. { $55 } Procedure CreateNewPSP(NewSeg, MemTop: Word);
  302. { $56 - DOS - Procedure Rename(var F; NewName: String); }
  303. { $5700 - DOS - Procedure GetFTime(var F; Time: LongInt; }
  304. { $5701 - DOS - Procedure SetFTime(var F; Time: LongInt; }
  305. { $5800 } Function GetAllocStrat: Byte;
  306. { $5801 } Procedure SetAllocStrat(Strat: Byte);
  307. { $5802 } Function GetUMBLink: Boolean;
  308. { $5803 } Procedure SetUMBLink(LinkState: Boolean);
  309.  
  310. { $59 } Procedure GetExtError;  { setzt die Variable ExtErrInfo }
  311. { $5A } Function TmpFile(Path: PathStr): String;
  312. { $5B } Function CreateNewFile(Name: String): Word;
  313.  
  314. { $5C00 } Procedure Lock(var F; Offset, Len: LongInt);
  315. { $5C01 } Procedure Unlock(var F; Offset, Len: LongInt);
  316.  
  317. { $5D00 } Procedure ServerCall(Params: ServerCallBlock);
  318. { $5D01 } Procedure UpdateAllFiles;
  319. { $5D02 } Procedure CloseFileName(FName: String);
  320. { $5D03 } Procedure CloseMachineFiles(StatID: Word);
  321. { $5D04 } Procedure CloseProcessFiles(ProcPSP: Word);
  322. { $5D05 } Procedure GetSHAREEntry(SHIndex, SFTIndex: Word;
  323.                     var Regs: Registers);
  324. { $5D06 } Procedure GetDosVars(var p: Pointer; var Header,MaxSize: Word);
  325. { $5D07 } Function RedirPrinterGetJob: Boolean;
  326. { $5D08 } Procedure RedirPrinterSetJob(Join: Boolean);
  327. { $5D09 } Procedure RedirPrinterNewJob;
  328. { $5D0A } Procedure SetExtError(ErrCode,Class,
  329.                     Locus,Action: Word; p: Pointer);
  330. { $5E00 } Function GetStationName(var Number: Byte;
  331.                    var Name: String): Boolean;
  332. { $5E01 } Procedure SetStationName(Number: Byte; Name: String);
  333. { $5E02 } Procedure ReDirPrinterSetInit(DevName: String; InitStr: String);
  334. { $5E03 } Function ReDirPrinterGetInit(DevName: String): String;
  335. { $5E04 } Procedure ReDirPrinterSetTabs(DevName: String; Tabs: Boolean);
  336. { $5E05 } Function ReDirPrinterGetTabs(DevName: String): Boolean;
  337. { $5F00 } Function ReDirPrinterGetMode: Boolean;
  338.           Function ReDirDriveGetMode : Boolean;
  339. { $5F01 } Procedure ReDirPrinterSetMode(Mode: Boolean);
  340.           Procedure ReDirDriveSetMode(Mode: Boolean);
  341. { $5F02 } Function ReDirGetEntry(LocalName: string;
  342.                    var NetName: String): Integer;
  343. { $5F03 } Procedure ReDirSetEntry(DevCode: Byte; UserVal: Word;
  344.                    LocalName, NetName: String);
  345. { $5F04 } Procedure ReDirDeleteEntry(LocalName: String);
  346. { $5F05 } Function GetDirGetExtEntry(LocalName: string;
  347.               var NetName: String; var NetBIOSNo: Word): Integer;
  348. { $5F06 - *** existiert - Arbeitsweise bis dato unbekannt *** }
  349. { $5F07 } Function ActivateLocalDrive(Drive: Byte): Boolean;
  350. { $5F08 } Function DeactivateLocalDrive(Drive: Byte): Boolean;
  351.  
  352. { $60 } Function RealFName(FName: String): String; { echter Dateiname }
  353. { $61 }  { undefiniert }
  354. { $62 } Function GetActivePSP : Word; { Liefert aktives PSP }
  355. { $63 }  { Ih Minh Hoho Tschi! }
  356. { $64 } Procedure SetPRINTFlag(NewVal: Byte);
  357. { $6500 } { undefiniert }
  358. { $6501 } Procedure GetExtCountryInfo(CCode,CodeP: Integer;
  359.                     var CountryRec: Func6501Country);
  360. { $6502 } Procedure GetASCIIHiXLate(var Size: Word; var TablePtr);
  361. { $6503 } { undefiniert }
  362. { $6504 } Procedure GetFNamecase(var Size: Word; var TablePtr);
  363. { $6505 } Procedure GetFNameTerminators(var Size: Word; var TablePtr);
  364. { $6506 } Procedure GetSortTable(var Size: Word; var TablePtr);
  365. { $6507 } Procedure GetDBCSTable(var Size: Word; var TablePtr);
  366. { $6520 } Function Upcase6520(Ch: Char): Char;
  367. { $6521 } Function Upcase6521(s: String): String;
  368. { $6522 } Procedure Upcase6522(s: Pointer);  { Umsetzung ASCIIZ-String }
  369. { $6523 } Function Query6523(Ch: Char): Integer;
  370.  
  371. { $6600 } { undefiniert }
  372. { $6601 } Procedure GetCodePage(var CurrPage, SysPage: Word);
  373. { $6602 } Procedure SetCodePage(NewPage: Word);
  374.  
  375. { $67 } Procedure SetHandleCount(Handles: Word);
  376. { $68 } Procedure UpdateFile(Handle: Word);
  377. { $6900 } Procedure GetDiskSerialNo(Drive: Byte; var Buf: DiskSerialInfo);
  378. { $6901 } Procedure SetDiskSerialNo(Drive: Byte; var Buf: DiskSerialInfo);
  379.  
  380. { $6A }  { *** existiert, Arbeitsweise vorläufig unbekannt *** }
  381. { $6B } { undefiniert }
  382. { $6C } Function CreateExtended(FName: String; Attr: Word;
  383.                  Action: Byte): Word;  { = Handle }
  384.  
  385.  
  386. { *********************************************** }
  387. Implementation
  388. { *********************************************** }
  389. var DRDos341, DRDos500: Boolean;  { durch Initialisierungsteil gesetzt }
  390.     CurrDosVersion: Word;         { echte DOS-Version, dito }
  391.  
  392. { Speichert bei jedem Aufruf den als NewVal übergebenen Wert in seinem
  393.   Codesegment und liefert den dort zuletzt gespeicherten Wert zurück.
  394.   ACHTUNG: Diese Funktion darf *nicht* rein als INLINE codiert werden,
  395.   weil sonst jeder Aufruf eine separate Kopie des Codes erzeugen würde!
  396. }
  397. Function SwapValInCS(NewVal: Word): Word;
  398. begin
  399.   inline($8B/$46/<NewVal/   {     mov ax,NewVal[bp]                 }
  400.          $E8/$02/$00/       {     call L1     ; @(nop/nop) -> Stack }
  401.          $90/$90/           {     nop / nop   ; Speicherplatz(!)    }
  402.          $5B/               { L1: pop bx      ; RET-Adresse als Zeiger }
  403.          $2E/$87/$07/       {     xchg ax,cs:[bx] ; Austausch       }
  404.          $89/$46/$FE        {     mov [bp-2],ax   ; Fkt-Ergebnis    }
  405.         );
  406. end;
  407.  
  408. { Aufruf des residenten Teils von COMMAND über INT $2E }
  409. Procedure CallCommand(Cmd: String);
  410. Const
  411.   TurboSS : Word = 0;  { zum Sichern von SS,SP und BP }
  412.   TurboSP : Word = 0;
  413.   TurboBP : Word = 0;
  414. var Regs: Registers;
  415.     OrgProgSize: Word;  { Originalgröße des Programms }
  416. begin
  417.   OrgProgSize := Word(Ptr(PrefixSeg,$02)^) - PrefixSeg;
  418.   { Reduktion des Programms auf die tatsächliche Größe }
  419.   SetMemBlock(PrefixSeg,Seg(HeapPtr^)-PrefixSeg);
  420.   Cmd[Length(Cmd)+1] := #13; { RET-Zeichen anhängen }
  421.   TurboSS := SSeg;
  422.   inline($89/$2E/TurboBP); { mov [TurboBP],BP  - BP festhalten }
  423.   if SwapValInCS(DSeg) <> 0 then ;  { DS sichern }
  424.   inline
  425.    ($16/$1F/      { push ss; pop ds  ; DS:SI = @Cmd }
  426.     $8D/$36/Cmd/  { lea  si,[Cmd]                   }
  427.     $CD/$2E       { int  $2E         ; Ausführung   }
  428.    );
  429.   if SwapValInCS(0) <> 0 then ;  { liefert DS in AX zurück }
  430.   inline
  431.    ($8E/$D8/          { mov  ds,ax       ; Turbo-DS     }
  432.     $8E/$16/TurboSS/  { mov  ss,TurboSS  ; Turbo-SS     }
  433.     $8B/$26/TurboSP/  { mov  sp,TurboSP  ; Turbo-SP     }
  434.     $8B/$2E/TurboBP   { mov  bp,TurboBP  ; Turbo-BP     }
  435.    );
  436.   SetMemblock(PrefixSeg,OrgProgSize); { zurück auf Originalgröße }
  437. end;
  438.  
  439. { Sucht die Treiber-Kette von DOS ab und ermittelt das Attribut
  440.   sowie die Aufrufadressen der Strategie- und Interrupt-Routinen.
  441.   Bei Aufruf mit einem Nullstring wird der zuletzt eingebaute
  442.   Blocktreiber lokalisiert, ansonsten gehts um Zeichentreiber.
  443. }
  444. Function LocateDriver(DriverName: String): DriverPointer;
  445. var Regs: Registers;
  446.     DHead: DriverPointer;  { Zeiger auf den aktuellen Treiberkopf }
  447.     DosV: Word;   { Dos-Versionsnummer, umgedreht }
  448.     SearchBlock: Boolean;
  449. begin
  450.   if Length(DriverName) = 0 then SearchBlock := True
  451.   else
  452.   begin    { Treibernamen auf volle Länge bringen, soweit notwendig }
  453.     while Length(DriverName) < 8 do DriverName := DriverName + ' ';
  454.     SearchBlock := False;
  455.   end;
  456.  
  457.   { DOS-Datenbereich ermitteln. Je nach Version steht der Kopf der
  458.     Treiberkette (Gerät NUL) hier ab dem Offset $17, $28 oder $22:
  459.   }
  460.   Regs.AH := $52; Intr($21,Regs);   { DOS-Datenbereich }
  461.   DosV := Swap(DosVersion);  { $1403 (20.3) -> $0314 (3.20) }
  462.   if DosV < $0300 then DHead := Ptr(Regs.ES,Regs.BX+$17)
  463.      else if DosV < $030A then DHead := Ptr(Regs.ES,Regs.BX+$28)
  464.      else DHead := Ptr(Regs.ES,Regs.BX+$22);   { Version 4.x, 5.0 }
  465.  
  466.   { Hat die Sache geklappt? }
  467.   if DHead^.Name <> 'NUL     ' then  { 'NUL'+ 5 Leerzeichen }
  468.   begin
  469.     Writeln('Kopf der Treiberkette (NUL) nicht gefunden!');
  470.     Writeln('Welches Betriebssystem ist das?');
  471.     Halt;
  472.   end;
  473.  
  474.   { Absuchen der Kette nach dem entsprechenden Gerät oder dem
  475.     zuletzt eingebauten Blocktreiber }
  476.   while (not SearchBlock and (DHead^.Name <> DriverName)) or
  477.          (SearchBlock and ((DHead^.DAttr and $8000) <> 0)) do
  478.   begin
  479.     DHead := DHead^.DNext;     { nächster Treiberkopf }
  480.     if Ofs(DHead^) = $FFFF then  { Kettenende? }
  481.       begin
  482.         LocateDriver := NIL; Exit;
  483.       end;
  484.   end;
  485.   LocateDriver := DHead;
  486. end;
  487.  
  488. { Ruft LocateDriver auf und stellt die Ergebnisse dar }
  489. Procedure GetDriver (DriverName: String; var Attributes: Word;
  490.                      var Strategy: Pointer; var Intrupt: Pointer);
  491. var DHead : DriverPointer;
  492. begin
  493.   DHead := LocateDriver(DriverName);
  494.   if DHead = NIL then
  495.   begin
  496.     Writeln('Treiber ', DriverName,' nicht gefunden!');
  497.     Halt;
  498.   end;
  499.   if DriverName = ''
  500.     then Writeln('Blocktreiber für ',Ord(DHead^.Drives),
  501.       ' Laufwerke gefunden.')
  502.     else Writeln('Zeichentreiber "',DriverName,'" gefunden.');
  503.   Attributes := DHead^.DAttr;
  504.   Strategy := Ptr(Seg(DHead^),DHead^.DStrat);
  505.   Intrupt := Ptr(Seg(DHead^),DHead^.DIntr);
  506.   Writeln('Attribute: $',HexW(Attributes),
  507.           ', Strategie: $',HexP(Strategy),
  508.           ', Interrupt: $',HexP(Intrupt));
  509. end;
  510. Procedure ShowExtError;
  511. begin
  512.   GetExtError;  { setzt die Variable ExtErrInfo }
  513.   with ExtErrInfo do
  514.     Writeln('Extended Error - Code: ',Code,', Klasse: ',Class,
  515.             ', Ort: ',Locus,', Aktion: ',Action,
  516.             ', Ptr: $',HexP(ExtPointer));
  517. end;
  518.  
  519.  
  520. Function HexB(b: Byte): String;
  521. var x: Integer;
  522. begin
  523.   HexB[0] := #2;  { Längenbyte direkt setzen }
  524.   for x := 2 downto 1 do
  525.   begin
  526.     if b and $0F > 9 then HexB[x] := Chr((b and $0F)-10+Ord('A'))
  527.      else HexB[x] := Chr((b and $0F)+Ord('0'));
  528.     b := b shr 4;
  529.   end;
  530. end;
  531.  
  532. Function HexW(w: Word): String;
  533. begin HexW := HexB(Hi(w)) + HexB(Lo(w)); end;
  534.  
  535. Function HexP(p: Pointer): String;
  536. begin HexP := HexW(LongInt(p) shr 16) + ':' + HexW(LongInt(p)); end;
  537.  
  538. Function HexL(l: LongInt): String;
  539. begin HexL := HexW(l shr 16) + HexW(l); end;
  540.  
  541. Function StrtoZ(PascalStr: String): String;  { Pascal -> ASCIIZ }
  542. begin
  543.   StrtoZ := PascalStr + #0;
  544. end;
  545.  
  546. Function ZtoStr(ZStr: Pointer): String;
  547. Type
  548.   CharArray = Array[1..254] of Char;
  549.   CharPtr = ^CharArray;
  550. var x, Len: Byte;
  551. begin
  552.   Len := Pos(#0,CharPtr(ZStr)^)-1;
  553.   ZtoStr[0] := Chr(Len);
  554.   for x:= 1 to Len do ZtoStr[x] := CharPtr(ZStr)^[x];
  555. end;
  556.  
  557. Procedure AbsRead(Drive: Byte; DTA: Pointer;
  558.                   StartSec: LongInt; NumSecs: Word);
  559. var Regs: Registers;
  560.     ParmBlock: Record  { für DR-DOS 3.41, 5.0 sowie MS-DOS ab 4.0 }
  561.       SSec: LongInt;   { Start-Sektor (long) }
  562.       NSecs: Word;     { Anzahl Sektoren }
  563.       Target: Pointer; { Zielpuffer }
  564.     end;
  565. begin
  566.   if (Swap(CurrDosVersion) < $0329)  { MS-DOS 2.x, 3.x }
  567.   then inline
  568.    ($1E/               { asm push ds                                   }
  569.     $8A/$46/<Drive/    {     mov  al,[Drive]      ; 0=A:,1=B: usw.     }
  570.     $8B/$4E/<NumSecs/  {     mov  cx,[NumSecs]    ; Anzahl Sektoren    }
  571.     $8B/$56/<StartSec/ {     mov  dx,[StartSec]   ; erster Sektor      }
  572.     $C5/$5E/<DTA/      {     lds  bx,[DTA]        ; DS:BX = Zielpuffer }
  573.     $55/               {     PUSH BP              ; wird von 3.x zerstört! }
  574.     $CD/$25/           {     int  $25             ; Aufruf             }
  575.     $59/               {     pop  cx              ; STACK-KORREKTUR    }
  576.     $5D/               {     POP  BP              ; BP wieder zurück   }
  577.     $72/$02/           {     jb   @L1             ; -> Fehler          }
  578.     $30/$C0/           {     xor  al,al           ; sonst Status = 0   }
  579.     $30/$E4/           { @L1:xor  ah,ah           ; AH = undefiniert   }
  580.     $1F/               {     pop  ds                                   }
  581.     $A3/DosError       {     mov  [DosError],ax   ; Status setzen      }
  582.    )
  583.   else
  584.   with ParmBlock do
  585.   begin
  586.     SSec := StartSec; NSecs := NumSecs; Target := DTA;
  587.   inline
  588.    ($1E/               { asm push ds                                   }
  589.     $8A/$46/<Drive/    {     mov  al,[Drive]      ; 0=A:,1=B: usw.     }
  590.     $16/               {     push ss              ; DS:BX = @ParmBlock }
  591.     $1F/               {     pop  ds              ; (auf dem Stack)    }
  592.     $8D/$5E/<ParmBlock/{     lea  bx,[ParmBlock]  ; (Offset-Anteil)    }
  593.     $B9/$FFFF/         {     mov  cx,$FFFF        ; Flag für ParmBlock }
  594.     $CD/$25/           {     int  $25             ; Aufruf             }
  595.     $59/               {     pop  cx              ; STACK-KORREKTUR    }
  596.     $72/$02/           {     jb   @L1             ; -> Fehler          }
  597.     $30/$C0/           {     xor  al,al           ; sonst Status = 0   }
  598.     $30/$E4/           { @L1:xor  ah,ah           ; AH = undefiniert   }
  599.     $1F/               {     pop  ds                                   }
  600.     $A3/DosError       {     mov  [DosError],ax   ; Status setzen      }
  601.    )
  602.   end;  { with ParmBlock }
  603. end;
  604.  
  605. Procedure AbsWrite(Drive: Byte; DTA: Pointer;
  606.                   StartSec: LongInt; NumSecs: Word);
  607. var Regs: Registers;
  608.     ParmBlock: Record  { für DR-DOS 3.41, 5.0 sowie MS-DOS ab 4.0 }
  609.       SSec: LongInt;   { Start-Sektor (long) }
  610.       NSecs: Word;     { Anzahl Sektoren }
  611.       Target: Pointer; { Quellpuffer }
  612.     end;
  613. begin
  614.   if (Swap(CurrDosVersion) < $0329)  { MS-DOS 2.x, 3.x }
  615.   then inline
  616.    ($1E/               { asm push ds                                   }
  617.     $8A/$46/<Drive/    {     mov  al,[Drive]      ; 0=A:,1=B: usw.     }
  618.     $8B/$4E/<NumSecs/  {     mov  cx,[NumSecs]    ; Anzahl Sektoren    }
  619.     $8B/$56/<StartSec/ {     mov  dx,[StartSec]   ; erster Sektor      }
  620.     $C5/$5E/<DTA/      {     lds  bx,[DTA]        ; DS:BX = Zielpuffer }
  621.     $55/               {     PUSH BP              ; wird von 3.x zerstört! }
  622.     $CD/$26/           {     int  $26             ; Aufruf             }
  623.     $59/               {     pop  cx              ; STACK-KORREKTUR    }
  624.     $5D/               {     POP  BP              ; BP wieder zurück   }
  625.     $72/$02/           {     jb   @L1             ; -> Fehler          }
  626.     $30/$C0/           {     xor  al,al           ; sonst Status = 0   }
  627.     $30/$E4/           { @L1:xor  ah,ah           ; AH = undefiniert   }
  628.     $1F/               {     pop  ds                                   }
  629.     $A3/DosError       {     mov  [DosError],ax   ; Status setzen      }
  630.    )
  631.   else
  632.   with ParmBlock do
  633.   begin
  634.     SSec := StartSec; NSecs := NumSecs; Target := DTA;
  635.   inline
  636.    ($1E/               { asm push ds                                   }
  637.     $8A/$46/<Drive/    {     mov  al,[Drive]      ; 0=A:,1=B: usw.     }
  638.     $16/               {     push ss              ; DS:BX = @ParmBlock }
  639.     $1F/               {     pop  ds              ; (auf dem Stack)    }
  640.     $8D/$5E/<ParmBlock/{     lea  bx,[ParmBlock]  ; (Offset-Anteil)    }
  641.     $B9/$FFFF/         {     mov  cx,$FFFF        ; Flag für ParmBlock }
  642.     $CD/$26/           {     int  $26             ; Aufruf             }
  643.     $59/               {     pop  cx              ; STACK-KORREKTUR    }
  644.     $72/$02/           {     jb   @L1             ; -> Fehler          }
  645.     $30/$C0/           {     xor  al,al           ; sonst Status = 0   }
  646.     $30/$E4/           { @L1:xor  ah,ah           ; AH = undefiniert   }
  647.     $1F/               {     pop  ds                                   }
  648.     $A3/DosError       {     mov  [DosError],ax   ; Status setzen      }
  649.    )
  650.   end;  { with ParmBlock }
  651. end;
  652.  
  653. { --------------- CP/M-kompatible DOS-Funktionen ---------- }
  654. { Eingabe eines Zeichens über die DOS-Funktion $01 }
  655. Function GetChar01: Char;
  656. var Regs: Registers;
  657. begin
  658.   Regs.AH := $01;     { Funktionsnummer }
  659.   Intr($21,Regs);     { DOS-Aufruf }
  660.   GetChar01 := Chr(Regs.AL);  { ASCII-Code }
  661. end;
  662.  
  663. { Ausgabe eines Zeichens über die DOS-Funktion $02 }
  664. Procedure PutChar02(Ch: Char);
  665. var Regs: Registers;
  666. begin
  667.   Regs.AH := $02;     { Funktionsnummer }
  668.   Regs.DL := Ord(Ch); { ASCII-Code des Zeichens }
  669.   Intr($21,Regs);     { DOS-Aufruf }
  670. end;
  671.  
  672. { Eingabe eines Zeichens über die serielle Schnittstelle via DOS }
  673. Function GetChar03: Char;
  674. var Regs: Registers;
  675. begin
  676.   Regs.AH := $03;     { Funktionsnummer }
  677.   Intr($21,Regs);
  678.   GetChar03 := Chr(Regs.AL);  { ASCII-Code des Zeichens }
  679. end;
  680.  
  681. { Ausgabe eines Zeichens über die serielle Schnittstelle via DOS }
  682. Procedure PutChar04(Ch: Char);
  683. var Regs: Registers;
  684. begin
  685.   Regs.AH := $04;     { Funktionsnummer }
  686.   Regs.DL := Ord(Ch); { auszugebendes Zeichen }
  687.   Intr($21,Regs);
  688. end;
  689.  
  690. { Ausgabe eines Zeichens zum Drucker via DOS }
  691. Procedure PutChar05(Ch: Char);
  692. var Regs: Registers;
  693. begin
  694.   Regs.AH := $05;     { Funktionsnummer }
  695.   Regs.DL := Ord(Ch); { auszugebendes Zeichen }
  696.   Intr($21,Regs);
  697. end;
  698.  
  699. { Eingabe eines Zeichens über die DOS-Funktion $06 }
  700. Function GetChar06: Char;
  701. var Regs: Registers;
  702. begin
  703.   Regs.AH := $06;          { Funktionsnummer }
  704.   Regs.DL := $FF;          { Flag für Eingabe }
  705.   Intr($21,Regs);          { DOS-Aufruf }
  706.   if Regs.Flags and FZero = 0
  707.     then GetChar06 := Chr(Regs.AL) { ASCII-Code des Zeichens }
  708.     else GetChar06 := Chr(255);
  709. end;
  710.  
  711. { Ausgabe eines Zeichens über die DOS-Funktion $06 }
  712. Procedure PutChar06(Ch: Char);
  713. var Regs: Registers;
  714. begin
  715.   Regs.AH := $06;          { Funktionsnummer }
  716.   Regs.DL := Ord(Ch);      { auszugebendes Zeichen }
  717.   Intr($21,Regs);          { DOS-Aufruf }
  718. end;
  719.  
  720. { Eingabe eines Zeichens über die DOS-Funktion $07 }
  721. Function GetChar07: Char;
  722. var Regs: Registers;
  723. begin
  724.   Regs.AH := $07;          { Funktionsnummer }
  725.   Intr($21,Regs);          { DOS-Aufruf }
  726.   GetChar07 := Chr(Regs.AL); { ASCII-Code des Zeichens }
  727. end;
  728.  
  729. { Eingabe eines Zeichens über die DOS-Funktion $08 }
  730. Function GetChar08: Char;
  731. var Regs: Registers;
  732. begin
  733.   Regs.AH := $08;          { Funktionsnummer }
  734.   Intr($21,Regs);          { DOS-Aufruf }
  735.   GetChar08 := Chr(Regs.AL); { ASCII-Code des Zeichens }
  736. end;
  737.  
  738. Procedure WriteString09(s: String);
  739. var Regs: Registers;
  740. begin
  741.   s := s + '$';        { Abschlußzeichen anhängen }
  742.   Regs.AH := $09;      { Funktionsnummer }
  743.   Regs.AL := 0;        { unnötig - nur zur Demonstration }
  744.   Regs.DS := Seg(s);   { Segmentadresse des Strings (Stack) }
  745.   Regs.DX := Ofs(s)+1; { Offsetadresse des Strings (Stack), ohne Längenbyte! }
  746.   Intr($21,Regs);
  747. end;
  748.  
  749. Function ReadString0A(MaxLen: Integer): String;
  750. Type CharArray = Array[1..257] of Char;
  751. var p: ^CharArray;
  752.     Regs: Registers;
  753. begin
  754.   if MaxLen > 255 then MaxLen := 255;  { Begrenzung }
  755.   GetMem(p,MaxLen+2);   { Puffer erzeugen }
  756.   p^[1] := Chr(MaxLen); { Eintrag der Maximallänge }
  757.   Regs.Ah := $0A;       { Funktionsnummer }
  758.   Regs.DX := Ofs(p^);   { Startadresse des Puffers }
  759.   Regs.DS := Seg(p^);
  760.   Intr($21, Regs);      { DOS-Aufruf }
  761.  
  762.   ReadString0A := String(Ptr(Regs.DS,Regs.DX+1)^); { ab 2. Byte }
  763.   FreeMem(p,MaxLen+2);
  764. end;
  765.  
  766. { Test auf "Zeichen bereit" - funktioniert auch bei Umleitungen }
  767. Function CharAvailable: Boolean;
  768. var Regs: Registers;
  769. begin
  770.   Regs.AH := $0B;
  771.   Intr($21,Regs);
  772.   CharAvailable := (Regs.AL = 255);
  773. end;
  774.  
  775. { Clear Keyboard and Input - DOS-Funktion $0C }
  776. Function FlushRead(FuncNo: Byte): Char;
  777. var Regs: Registers;
  778. begin
  779.   Regs.AH := $0C; Regs.AL := FuncNo;
  780.   Regs.DL := $FF;  { nur für Funktion $06 }
  781.   Intr($21,Regs);
  782.   if (FuncNo = $06) and ((Regs.Flags and FZero <> 0))
  783.    then FlushRead := Chr($FF)
  784.    else FlushRead := Chr(Regs.AL);
  785. end;
  786.  
  787. { Erzwingt das physikalische Schreiben der Treiber-Puffer }
  788. Procedure DriverFlush0D;
  789. var Regs: Registers;
  790. begin
  791.   Regs.AH := $0D;
  792.   Intr($21,Regs);
  793. end;
  794.  
  795. Procedure SetDefaultDrive(NewDrive: Byte);
  796. var Regs: Registers;
  797. begin
  798.   Regs.AH := $0E;
  799.   Regs.DL := NewDrive;
  800.   Intr($21,Regs);
  801. end;
  802.  
  803. Procedure OpenFileFCB(FCB: Pointer);  { CP/M-kompatibles OPEN }
  804. var Regs: Registers;
  805. begin
  806.   with Regs do
  807.   begin
  808.     AH := $0F;  { Funktion: "Open File via FCB" }
  809.     DS := Seg(FCB^); DX := Ofs(FCB^);
  810.     Intr($21,Regs);
  811.     if AL <> 0 then InOutRes := 2; { "Datei nicht gefunden" }
  812.   end;
  813. end;
  814.  
  815. Procedure CloseFileFCB(FCB: Pointer);  { CP/M-kompatibles CLOSE }
  816. var Regs: Registers;
  817. begin
  818.   Regs.AH := $10;  { Funktion: Close File (FCB) }
  819.   Regs.DS := Seg(FCB^);
  820.   Regs.DX := Ofs(FCB^);  { DS:DX = FCB-Adresse }
  821.   Intr($21,Regs);
  822.   if Regs.AL <> 0 then InOutRes := 6;  { "Handle" existiert nicht }
  823. end;
  824.  
  825. Procedure FindFirstCPM(StartFCB: Pointer);  { Datei via FCB suchen }
  826. var Regs : Registers;
  827. begin
  828.   Regs.AH := $11;  { Funktion: "Find First [Entry]" }
  829.   Regs.DS := Seg(StartFCB^);
  830.   Regs.DX := Ofs(StartFCB^); { DS:DX = FCB-Adresse }
  831.   Intr($21,Regs);
  832.   if Regs.AL = 0 then DosError := 0
  833.    else DosError := 18;   { "keine weiteren Einträge" }
  834. end;
  835.  
  836. Procedure FindNextCPM (NextFCB: Pointer);  { weitere Dateien suchen }
  837. var Regs : Registers;
  838. begin
  839.   Regs.AH := $12;  { Funktion: "Find Next [Entry]" }
  840.   Regs.DS := Seg(NextFCB^);
  841.   Regs.DX := Ofs(NextFCB^);
  842.   Intr($21,Regs);
  843.   if Regs.AL = 0 then DosError := 0
  844.    else DosError := 18;
  845. end;
  846.  
  847. Procedure DeleteFileFCB(FCB: Pointer); { CP/M-kompatibles Löschen }
  848. var Regs: Registers;
  849. begin
  850.   Regs.AH := $13;  { Funktionsnummer }
  851.   Regs.DS := Seg(FCB^);  { DS:DX = FCB-Adresse }
  852.   Regs.DX := Ofs(FCB^);
  853.   Intr($21, Regs);
  854.   if Regs.AL <> 0
  855.     then InOutRes := 2;  { "Datei nicht gefunden" }
  856. end;
  857.  
  858. Function ReadSequential(FCB: Pointer): Integer;  { sequ. Lesen }
  859. var Regs: Registers;
  860. begin
  861.   Regs.AH := $14;  { DOS-Funktion: Read Sequential via FCB }
  862.   Regs.DS := Seg(FCB^); { DS:DX = FCB }
  863.   Regs.DX := Ofs(FCB^);
  864.   Intr($21,Regs);  { liest $80 Bytes in die Standard-DTA }
  865.   ReadSequential := Regs.AL;
  866. end;
  867.  
  868. Function WriteSequential(FCB: Pointer): Integer; { sequ. Schreiben }
  869. var Regs: Registers;
  870. begin
  871.   Regs.AH := $15;  { DOS-Funktion: Write Sequential via FCB }
  872.   Regs.DS := Seg(FCB^); { DS:DX = FCB }
  873.   Regs.DX := Ofs(FCB^);
  874.   Intr($21,Regs);  { schreibt RecSize Bytes aus der Standard-DTA }
  875.   WriteSequential := Regs.AL;
  876. end;
  877.  
  878. Procedure CreateFileFCB(FCB: Pointer); { CP/M-kompatibles CREATE }
  879. var Regs: Registers;
  880. begin
  881.   Regs.AH := $16;  { Funktionsnummer }
  882.   Regs.DS := Seg(FCB^);  { DS:DX = FCB }
  883.   Regs.DX := Ofs(FCB^);
  884.   Intr($21,Regs);
  885.   if Regs.AL <> 0
  886.     then InOutRes := 5;  { "Zugriff verweigert" }
  887. end;
  888.  
  889. Procedure RenameFCB(FCB: Pointer);  { Funktion $17 }
  890. var Regs: Registers;
  891. begin
  892.   with Regs do
  893.   begin
  894.     AH := $17;  { Funtion: "Rename via FCB" }
  895.     DS := Seg(FCB^); DX := Ofs(FCB^);  { DS:DX = FCB }
  896.     Intr($21,Regs);
  897.     if AL <> 0 then InOutRes := 2; { "Datei nicht gefunden" }
  898.   end;
  899. end;
  900.  
  901. { Liefert die Kennziffer des aktuellen Laufwerks zurück. }
  902. Function GetCurrentDrive: Byte;
  903. var Regs: Registers;
  904. begin
  905.   Regs.AH := $19;  { Funktionsnummer }
  906.   Intr($21,Regs);
  907.   GetCurrentDrive := Regs.AL;
  908. end;
  909.  
  910. Procedure SetDTA(DTA: Pointer); { setzt die DTA }
  911. var Regs: Registers;
  912. begin
  913.   Regs.AH := $1A;  { Funktion: "Set DTA Address" }
  914.   Regs.DS := Seg(DTA^); Regs.DX := Ofs(DTA^);
  915.   Intr($21,Regs);
  916. end;
  917.  
  918. Procedure GetCurrFATInfo(var Info: FATInfoType);  { Funktion $1B }
  919. var Regs: Registers;
  920. begin
  921.   Regs.AH := $1B;  { Funktionsnummer }
  922.   Intr($21,Regs);  { Aufruf }
  923.   with Info do
  924.   begin
  925.     SecsCluster := Regs.AL;  { Sektoren pro Cluster }
  926.     BytesSec := Regs.CX;     { Bytes pro Sektor }
  927.     NumCluster := Regs.DX;   { Gesamtzahl Cluster }
  928.     MediaID := Byte(Ptr(Regs.DS,Regs.BX)^);
  929.   end;
  930. end;
  931.  
  932. Procedure GetAnyFATInfo(var Info: FATInfoType; DiskNum: Byte); { Funktion $1C }
  933. var Regs: Registers;
  934. begin
  935.   Regs.AH := $1C;  { Funktion: "Get FAT Info, Any Drive" }
  936.   Regs.DL := DiskNum; { Laufwerks-Kennziffer }
  937.   Intr($21,Regs);  { Aufruf }
  938.   with Info do
  939.   begin
  940.     SecsCluster := Regs.AL;  { Sektoren pro Cluster }
  941.     BytesSec := Regs.CX;     { Bytes pro Sektor }
  942.     NumCluster := Regs.DX;   { Gesamtzahl Cluster }
  943.     MediaID := Byte(Ptr(Regs.DS,Regs.BX)^);
  944.   end;
  945. end;
  946.  
  947. Function GetCurrentDPB: Pointer;  { Funktion $1F }
  948. var Regs: Registers;
  949. begin
  950.   Regs.AH := $1F;  { inoffizielle Funktion: "Get DPB" }
  951.   Intr($21,Regs);
  952.   GetCurrentDPB := Ptr(Regs.DS,Regs.BX);
  953. end;
  954.  
  955. Function ReadFCBRand(FCB: FCBPointer; RecNo: LongInt): Integer;
  956. var Regs: Registers;
  957. begin
  958.   FCB^.RandRec := RecNo;  { Eintrag der Recordnummer }
  959.   Regs.AH := $21;   { Funktion "Read Random" }
  960.   Regs.DS := Seg(FCB^); { DS:DX = FCB }
  961.   Regs.DX := Ofs(FCB^);
  962.   Intr($21,Regs);
  963.   ReadFCBRand := Regs.AL;
  964. end;
  965.  
  966. Function WriteFCBRand(FCB: FCBPointer; RecNo: LongInt): Integer;
  967. var Regs: Registers;
  968. begin
  969.   FCB^.RandRec := RecNo;  { Eintrag der Recordnummer }
  970.   Regs.AH := $22;         { Write Random }
  971.   Regs.DS := Seg(FCB^);   { DS:DX = FCB }
  972.   Regs.DX := Ofs(FCB^);
  973.   Intr($21,Regs);
  974.   WriteFCBRand := Regs.AL;
  975. end;
  976.  
  977. Function GetFileSizeFCB(FCBPtr: FCBPointer): LongInt;
  978. var Regs: Registers;
  979. begin
  980.   Regs.AH := $23;  { Funktion: "Get File Size" }
  981.   Regs.DS := Seg(FCBPtr^);
  982.   Regs.DX := Ofs(FCBPtr^);  { DS:DX auf die Adresse des FCB }
  983.   FCBPtr^.Recsize := 1;     { "Recordgröße" = 1 }
  984.   FCBPtr^.RandRec := 0;
  985.   Intr($21,Regs);
  986.   if Regs.AL = 0 then GetFileSizeFCB := FCBPtr^.RandRec
  987.    else GetFileSizeFCB := -1;
  988. end;
  989.  
  990. Procedure SetRandRecNo(FCB: FCBPointer);
  991. var Regs: Registers;
  992. begin
  993.   Regs.AH := $24;  { Set Random Record }
  994.   Regs.DS := Seg(FCB^);  { DS:DX = FCB }
  995.   Regs.DX := Ofs(FCB^);
  996.   Intr($21,Regs);
  997. end;
  998.  
  999. { Procedure SetIntVec - ist im Unit DOS - }
  1000.  
  1001. Procedure MakeNewPSP(PSPAddr: Word);  { Funktion $26 }
  1002. var Regs: Registers;
  1003. begin
  1004.   Regs.AH := $26;  { Funktion: Create New PSP }
  1005.   Regs.DX := PSPAddr;  { Segment des PSP }
  1006.   Intr($21,Regs);
  1007. end;
  1008.  
  1009. Function ReadRandRecs(FCB: FCBPointer; FirstRec: LongInt;
  1010.                       NumBlocks: Word): Integer;
  1011. var Regs: Registers;
  1012. begin
  1013.   Regs.AH := $27;  { Read Random Records }
  1014.   Regs.CX := NumBlocks;  { Anzahl zu lesender Datensätze }
  1015.   FCB^.RandRec := FirstRec;  { Nummer des ersten Datensatzes }
  1016.   Regs.DS := Seg(FCB^);  { DS:DX = FCB }
  1017.   Regs.DX := Ofs(FCB^);
  1018.   Intr($21,Regs);
  1019.   ReadRandRecs := Regs.AL;
  1020. end;
  1021.  
  1022. Function WriteRandRecs(FCB: FCBPointer; FirstRec: LongInt;
  1023.                        NumBlocks: Word): Integer;
  1024. var Regs: Registers;
  1025. begin
  1026.   Regs.AH := $28;         { Write Random }
  1027.   Regs.CX := NumBlocks;   { Anzahl zu schreibender Datensätze }
  1028.   Regs.DS := Seg(FCB^);   { DS:DX = FCB }
  1029.   Regs.DX := Ofs(FCB^);
  1030.   FCB^.RandRec := FirstRec; { Nummer des ersten Records }
  1031.   Intr($21,Regs);
  1032.   WriteRandRecs := Regs.AL;
  1033. end;
  1034.  
  1035. Function ParseFName(CmdLine: Pointer; FCBAddr: Pointer): Pointer;
  1036. var x: Integer;                              { Funktion $29 }
  1037.     Regs:Registers;
  1038. begin
  1039.   with Regs do
  1040.   begin
  1041.     DS := Seg(CmdLine^); SI := Ofs(CmdLine^);
  1042.     ES := Seg(FCBAddr^); DI := Ofs(FCBAddr^);
  1043.     AH := $29;  { Funktion: "Parse Filename" }
  1044.     AL := 1;    { führende Trennz. ignorieren, alle Felder setzen }
  1045.     Intr($21,Regs);
  1046.     ParseFName := Ptr(DS,SI);  { Zeiger auf 1. Zeichen nach Dateiname }
  1047.   end;
  1048. end;
  1049.  
  1050. { Procedure GetDate - ist im Unit DOS - }
  1051.  
  1052. { Nachkonstruktion, setzt zusätzlich DosError }
  1053. Procedure SetDate(Year,Month,Day: Word);
  1054. var Regs: Registers;
  1055. begin
  1056.   with Regs do
  1057.   begin
  1058.     AH := $2B; CX := Year;
  1059.     DH := Month; DL := Day;
  1060.     Intr($21,Regs);
  1061.     if AL = 0 then DosError := 0
  1062.       else DosError := 13;  { Ungültige Daten }
  1063.   end
  1064. end;
  1065.  
  1066. { Procedure GetTime - ist im Unit DOS - }
  1067.  
  1068. { Nachkonstruktion, setzt zusätzlich DosError }
  1069. Procedure SetTime(Hour,Minute,Second,Sec100: Word);
  1070. var Regs: Registers;
  1071. begin
  1072.   with Regs do
  1073.   begin
  1074.     AH := $2D;
  1075.     CH := Hour; CL := Minute;
  1076.     DH := Second; DL := Sec100;
  1077.     Intr($21,Regs);
  1078.     if AL = 0 then DosError := 0
  1079.       else DosError := 13;  { Ungültige Daten }
  1080.   end
  1081. end;
  1082.  
  1083. { Procedure SetVerify - ist im Unit DOS - }
  1084.  
  1085. Function GetDTA: Pointer;  { Ermittelt die momentane DTA }
  1086. var Regs: Registers;
  1087. begin
  1088.   Regs.AH := $2F;  { Funktion "Get DTA Address" }
  1089.   Intr($21,Regs);
  1090.   GetDTA := Ptr(Regs.ES,Regs.BX);
  1091. end;
  1092.  
  1093. Function DosVersion: Word;  { Liefert die echte DOS-Versionsnummer }
  1094. var Regs: Registers;
  1095. begin
  1096.   if DRDos341 then DosVersion := $2903  { "3.41" }
  1097.    else if DrDos500 then DosVersion := $3203  { "3.50" }
  1098.    else
  1099.    begin
  1100.      Regs.AX := $3306;  Intr($21,Regs); { "Get DosVersion/Location" }
  1101.      if Regs.AX = $3306 then DosVersion := Regs.BX
  1102.      else
  1103.      begin
  1104.        Regs.AH := $30; Intr($21,Regs); DosVersion := Regs.AX;
  1105.      end;
  1106.    end;
  1107. end;
  1108.  
  1109. { Procedure Keep - ist im Unit DOS - }
  1110.  
  1111. Function GetAnyDPB(DriveNo: Byte): Pointer;    { Funktion $32 }
  1112. var Regs: Registers;
  1113. begin
  1114.   Regs.AH := $32;  { inoffizielle Funktion: "Get DPB, Any Drive" }
  1115.   Regs.DL := DriveNo;  { 0 = aktuelles Laufwerk, 1 = A: usw. }
  1116.   Intr($21,Regs);
  1117.   if Regs.AL <> $FF then GetAnyDPB := Ptr(Regs.DS,Regs.BX)
  1118.    else GetAnyDPB := nil;
  1119. end;
  1120.  
  1121. { Procedure GetCBreak - ist im Unit DOS - }
  1122.  
  1123. { Procedure SetCBreak - ist im Unit DOS - }
  1124.  
  1125. Function SwapCBreak(NewBreak: Boolean): Boolean;  { Fkt. $3302 }
  1126. var Regs: Registers;
  1127.     Temp: Boolean;
  1128. begin
  1129.   Regs.AX := $3302;  { Funktion: "Exchange Control Break" }
  1130.   Regs.DL := Ord(NewBreak);
  1131.   Intr($21,Regs);
  1132.   if Regs.AL <> $FF then SwapCBreak := Boolean(Regs.DL)
  1133.   else
  1134.   begin
  1135.     GetCBreak(Temp); SwapCBreak := Temp;
  1136.     SetCBreak(NewBreak);
  1137.   end;
  1138. end;
  1139.  
  1140. Function GetBootDrive: Byte;                { Funktion $3305 }
  1141. var Regs: Registers;
  1142. begin
  1143.   Regs.AX := $3305;  { Funktion: "Get Boot Drive" }
  1144.   Intr($21,Regs);
  1145.   GetBootDrive := Regs.DL;
  1146. end;
  1147.  
  1148. Function GetDosHIGH: Boolean;               { Funktion $3306 }
  1149. var Regs: Registers;
  1150. begin
  1151.   Regs.AX := $3306;  { Funktion: "Get DOS Location" }
  1152.   Intr($21,Regs);
  1153.   GetDosHIGH := (Regs.DX = $1000);
  1154. end;
  1155.  
  1156. Procedure GetDOSFlags(var InDosPtr, CritErrPtr);  { Funktion $34 }
  1157. var Regs: Registers;
  1158.     InDos, CritErr: ^Byte;
  1159. begin
  1160.   with Regs do
  1161.   begin
  1162.     AH := $34; { inoffizielle Funktion: "Get InDos Flag Address" }
  1163.     Intr($21,Regs);
  1164.     InDos := Ptr(ES,BX);
  1165.     if Lo(DosVersion) = 2    { ein Byte davor }
  1166.       then CritErr := Ptr(Seg(InDos^)-1,Ofs(InDos^)+15)
  1167.       else if DosVersion = $0003
  1168.       then CritErr := Ptr(Seg(InDos^),Ofs(InDos^)+1)
  1169.       else { DOS-Version > 3.0 -> direkte Abfrage }
  1170.       begin
  1171.         AX := $5D06; Intr($21,Regs);
  1172.         CritErr := Ptr(DS,SI);
  1173.       end;
  1174.   end;
  1175.   Pointer(InDosPtr) := InDos; Pointer(CritErrPtr) := CritErr;
  1176. end;
  1177.  
  1178. { Procedure GetIntVec - ist im Unit DOS - }
  1179.  
  1180. { Function DiskFree - ist im Unit DOS - }
  1181.  
  1182. Function GetSwitChar: Char;  { Funktion $3700 - Trennzeichen ermitteln }
  1183. var Regs: Registers;
  1184. begin
  1185.   Regs.AX := $3700;  { undokumentierte Funktion: "Get Switchar" }
  1186.   Intr($21,Regs);
  1187.   if Regs.Flags and FCarry <> 0
  1188.     then GetSwitChar := #0
  1189.     else GetSwitChar := Chr(Regs.DL);
  1190. end;
  1191.  
  1192. Function SetSwitChar(NewSwitch: Char): Boolean;  { Funktion $3701 }
  1193. var Regs: Registers;
  1194. begin
  1195.   FillChar(Regs,SizeOf(Regs),0);
  1196.   Regs.AX := $3701;  { undokumentierte Funktion: "Set Switchar" }
  1197.   Regs.DL := Ord(NewSwitch);
  1198.   Intr($21,Regs);
  1199.   SetSwitchar := (Regs.Flags and FCarry = 0); { TRUE für OK }
  1200.   if Regs.DL <> Ord(NewSwitch)
  1201.    then Regs.DL := 0;
  1202. end;
  1203.  
  1204. { Liefert TRUE, wenn Geräte auch ohne
  1205.   vorangestelltes \DEV verfügbar sind
  1206. }
  1207. Function GetDevAvail: Boolean;   { Funktion $3702 }
  1208. var Regs: Registers;
  1209. begin
  1210.   Regs.AX := $3702;  { undokumentierte Funktion: "Get DevAvail" }
  1211.   Intr($21,Regs);
  1212.   if Regs.AL = $FF   { Funktion nicht unterstützt }
  1213.     then GetDevAvail := True
  1214.     else GetDevAvail := Regs.DL = $FF;
  1215. end;
  1216.  
  1217. { Versucht beim Aufruf mit FALSE, das Voranstellen von \DEV\
  1218.   vor Gerätenamen zwingend zu machen (und hat nur unter DOS 2.x
  1219.   ein sichtbares Resultat).
  1220. }
  1221. Procedure SetDevAvail(NewState: Boolean);   { Funktion $3703 }
  1222. var Regs: Registers;
  1223. begin
  1224.   Regs.AX := $3703;  { undokumentierte Funktion: "Set DevAvail" }
  1225.   if NewState then Regs.DL := $FF  { Geräte direkt erreichbar }
  1226.     else Regs.DL := 0;  { Geräte nur via \DEV\ erreichbar }
  1227.   Intr($21,Regs);
  1228. end;
  1229.  
  1230. Function GetCountry(Mode: Byte; CountryNo: Word; var CInfo): Integer;
  1231. var Regs: Registers;
  1232. begin
  1233.   Regs.AH := $38;  { Funktion: "Get/Set Country Information" }
  1234.   Regs.AL := Mode; { 0 = aktuelles Land lesen, 1..254 Landescode }
  1235.   if Mode = 255 then Regs.BX := CountryNo; { 255: Landescode in BX }
  1236.   Regs.DS := Seg(CInfo);
  1237.   Regs.DX := Ofs(CInfo);
  1238.   Intr($21,Regs);
  1239.   if (Regs.Flags and FCarry) = 0 then GetCountry := Regs.BX
  1240.     else GetCountry := -1;
  1241. end;
  1242.  
  1243. Function SetCountry(CountryNo: Word): Boolean;
  1244. var Regs: Registers;
  1245. begin
  1246.   Regs.AH := $38;  { Funktion: "Get/Set Country Info" }
  1247.   if CountryNo > 254 then
  1248.   begin
  1249.     Regs.AL := 255; Regs.BX := CountryNo;
  1250.   end
  1251.   else Regs.AL := CountryNo;
  1252.   Regs.DX := $FFFF;  { *** Dieser Wert unterscheidet }
  1253.   Intr($21,Regs);    { "Get" und "Set"!              }
  1254.   SetCountry := (Regs.Flags and FCarry = 0); { TRUE f. OK }
  1255. end;
  1256.  
  1257. { Procedure MkDir - ist im Unit DOS - }
  1258.  
  1259. { Procedure RmDir - ist im Unit DOS - }
  1260.  
  1261. { Procedure ChDir - ist im Unit DOS - }
  1262.  
  1263. { Ergebnis: Handle der Datei }
  1264. Function CreateFile(s: String; Attrib: Byte): Word;
  1265. var Regs: Registers;                   { Funktion $3C }
  1266. begin
  1267.   s := StrtoZ(s);  { wandelt die Lokalkopie von s in ASCIIZ um }
  1268.   Regs.AH := $3C;  { Funktion: "Create File" }
  1269.   Regs.CX := Attrib;  { Attribute }
  1270.   Regs.DS := Seg(s); Regs.DX := Ofs(s) + 1;
  1271.   Intr($21,Regs);
  1272.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX;
  1273.   CreateFile := Regs.AX;  { Handle der geöffneten Datei }
  1274. end;
  1275.  
  1276. { SHARE-Flags via FileMode; Ergebnis: Handle der Datei }
  1277. Function OpenFile(s: String): Word;       { Funktion $3D }
  1278. var Regs: Registers;
  1279. begin
  1280.   s := StrtoZ(s);  { wandelt die Lokalkopie von s in ASCIIZ um }
  1281.   Regs.AH := $3D;      { Funktion: "Open File" }
  1282.   Regs.AL := FileMode; { R/W und SHARE-Modus }
  1283.   Regs.DS := Seg(s); Regs.DX := Ofs(s)+1; { hinter Längenbyte }
  1284.   Intr($21,Regs);
  1285.   if Regs.Flags and FCarry <> 0
  1286.     then InOutRes := Regs.AX;
  1287.   OpenFile := Regs.AX;  { Handle der geöffneten Datei }
  1288. end;
  1289.  
  1290. Procedure CloseFile(Handle: Word);    { Funktion $3E }
  1291. var Regs: Registers;
  1292. begin
  1293.   Regs.AH := $3E;  { Funktion: "Close File" }
  1294.   Regs.BX := Handle;
  1295.   Intr($21,Regs);
  1296.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX;
  1297. end;
  1298.  
  1299. Function ReadFile(FHandle: Word; Count: Word; BufPtr: Pointer): Word;
  1300. var Regs: Registers;
  1301.     DevAttr: Word;
  1302. begin
  1303.   Regs.AH := $3F;  { Funktion: "Read File/Device" }
  1304.   Regs.BX := FHandle;
  1305.   Regs.CX := Count;
  1306.   Regs.DS := Seg(BufPtr^); Regs.DX := Ofs(BufPtr^);
  1307.   Intr($21,Regs);
  1308.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1309.   else if Regs.AX < Regs.CX then  { weniger gelesen als gewünscht }
  1310.   begin
  1311.     DevAttr := GetDevAttributes(FHandle);
  1312.     if (DevAttr and $0120 <> 0)   { Datei oder "Raw-Gerät" }
  1313.       then InOutRes := 100  { ja - Eof überschritten }
  1314.   end;
  1315.   ReadFile := Regs.AX;
  1316. end;
  1317.  
  1318. Procedure WriteFile(Handle,Count: Word; BufPtr: Pointer);
  1319. var Regs: Registers;            { Funktion $40 }
  1320. begin
  1321.   Regs.AH := $40;  { Funktion: "Write File/Device" }
  1322.   Regs.BX := Handle;
  1323.   Regs.CX := Count;
  1324.   Regs.DS := Seg(BufPtr^); Regs.DX := Ofs(BufPtr^);
  1325.   Intr($21,Regs);
  1326.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1327.   else if Regs.AX <> Regs.CX   { Anzahl geschriebener Bytes }
  1328.     then InOutRes := 101;
  1329. end;
  1330.  
  1331. { Procedure Erase - im Unit DOS - }        { Funktion $41 }
  1332.  
  1333. Function FileSeek(Handle: Word; Offset: LongInt; Action: Integer): LongInt;
  1334. var Regs: Registers;               { Funktion $42 }
  1335. begin
  1336.   Regs.AH := $42;  { Funktion: "Move File Pointer" }
  1337.   Regs.AL := Action;  { 0: Start, 1: Relativ, 2:Ende }
  1338.   Regs.BX := Handle; { Kennziffer der offenen Datei }
  1339.   Regs.CX := Offset shr 16;
  1340.   Regs.DX := Offset; { CX:DX = Offset bzw. neue Position }
  1341.   Intr($21,Regs);
  1342.   FileSeek := -1;
  1343.   if Regs.Flags and FCarry <> 0 then
  1344.   begin
  1345.     InOutRes := Regs.AX; FileSeek := -1;
  1346.   end
  1347.    else FileSeek := Regs.AX + LongInt(Regs.DX) shl 16;
  1348. end;
  1349.  
  1350. { Arbeitet mit einem Dateinamen anstelle einer Dateivariablen
  1351.   und ist deshalb nur ein funktionelles Äquivalent der
  1352.   gleichnamigen Prozedur
  1353. }
  1354. Function GetFAttr(FName: String): Word;    { Funktion $4300 }
  1355. var Regs: Registers;
  1356. begin
  1357.   FName := StrtoZ(FName); { Umwandlung des Namens in ASCIIZ }
  1358.   Regs.AH := $43;  { Funktion: "Get/Set File Attribute" }
  1359.   Regs.AL := 0;    { Subfunktion: "Get" }
  1360.   Regs.DS := Seg(FName); Regs.DX := Ofs(FName)+1;
  1361.   Intr($21,Regs);
  1362.   if Regs.Flags and FCarry <> 0
  1363.    then InOutRes := Regs.AX
  1364.    else GetFAttr := Regs.CX;
  1365. end;
  1366.  
  1367. { Arbeitet ebenfalls mit einem Dateinamen anstelle einer
  1368.   Dateivariablen und ist deshalb lediglich ein funktionelles
  1369.   Äquivalent der gleichnamigen Routine.
  1370. }
  1371. Procedure SetFAttr(FName: String; NewAttrs: Word);   { Funktion $4301 }
  1372. var Regs: Registers;
  1373. begin
  1374.   FName := StrtoZ(FName); { Umwandlung des Namens in ASCIIZ }
  1375.   Regs.AH := $43;  { Funktion: "Get/Set File Attribute" }
  1376.   Regs.AL := 1;    { Subfunktion: "Set" }
  1377.   Regs.CX := NewAttrs;
  1378.   Regs.DS := Seg(FName); Regs.DX := Ofs(FName)+1;
  1379.   Intr($21,Regs);
  1380.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX;
  1381. end;
  1382.  
  1383. { Ermittelt die Paßwort-Bits einer Datei und ist
  1384.   eine Spezialität von DR-DOS
  1385. }
  1386. Function GetFPass(FName: String): Byte;    { Funktion $4302 }
  1387. var Regs: Registers;
  1388. begin
  1389.   FName := StrtoZ(FName);  { Pascal -> ASCIIZ }
  1390.   Regs.AX := $4302;        { Funktion: "Get Password Mode" }
  1391.   Regs.DS := Seg(FName);   { DS:DX = Dateiname }
  1392.   Regs.DX := Ofs(FName)+1;
  1393.   Intr($21,Regs);
  1394.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1395.    else GetFPass := Regs.CX and $0F;
  1396.         { Bits 0..3: "Delete/Rename", n/a, "Write", "Read" }
  1397. end;
  1398.  
  1399. { Setzt das Paßwort einer Datei sowie den Modus
  1400.   und ist eine Spezialität von DR-DOS
  1401. }
  1402. Procedure SetFPass(FName, Pass: String; Mode: Byte);  { Funktion $4303 }
  1403. var Regs: Registers;
  1404. begin
  1405.   FName := StrtoZ(FName); { Umwandlung des Namens in ASCIIZ }
  1406.   { Paßwort auf 8 Zeichen Länge bringen }
  1407.   while Length(Pass) < 8 do Pass := Pass + ' ';
  1408.   SetDTA(@Pass[1]);   { und DTA darauf setzen }
  1409.   Regs.AX := $4303;  { Funktion: "Set Password/Mode" }
  1410.   Mode := Mode and $0F;   { für "World", "Group" und "Owner" }
  1411.   Regs.CX := Mode or (Mode shl 4) or (Mode shl 8) or $8000;
  1412.   Regs.DS := Seg(FName);  { DS:DX = Dateiname }
  1413.   Regs.DX := Ofs(FName)+1;
  1414.   Intr($21,Regs);
  1415.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1416. end;
  1417.  
  1418. Function GetDevAttributes(Handle: Word): Word;  { Funktion $4400 }
  1419. var Regs: Registers;
  1420. begin
  1421.   Regs.AH := $44;   { Funktion "IOCTL" }
  1422.   Regs.AL := $00;   { Unterfunktion "Get Device Attribute" }
  1423.   Regs.BX := Handle;
  1424.   Intr($21,Regs);
  1425.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1426.     else GetDevAttributes := Regs.DX;
  1427. end;
  1428.  
  1429. Procedure SetDevAttributes(Handle: Word; Attr: Word);  { Funktion $4401 }
  1430. var Regs: Registers;
  1431. begin
  1432.   Regs.AH := $44;  { Funktion: "IOCTL" }
  1433.   Regs.AL := $01;  { Unterfunktion "Set Device Attribute" }
  1434.   Regs.BX := Handle;
  1435.   Regs.DX := Attr and $00FF; { B8..15 *müssen* gelöscht werden! }
  1436.   Intr($21,Regs);
  1437.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX;
  1438. end;
  1439.  
  1440. Function IOCTLReadHandle(Handle,Count: Word;
  1441.                          Buf: Pointer): Word; { Funktion $4402 }
  1442. var Regs: Registers;
  1443. begin
  1444.   with Regs do
  1445.   begin
  1446.     AX := $4402;   { Funktion: Read Control Char }
  1447.     BX := Handle;  { Handle des Geräts }
  1448.     CX := Count;
  1449.     DS := Seg(Buf^); DX := Ofs(Buf^);
  1450.     Intr($21,Regs);
  1451.     if (Flags and FCarry) <> 0 then
  1452.     begin
  1453.       DosError := AX; IOCTLReadHandle := 0;
  1454.     end else
  1455.     begin             { Anzahl gelesener Bytes }
  1456.       DosError := 0; IOCTLReadHandle := AX;
  1457.     end;
  1458.   end;
  1459. end;
  1460.  
  1461.  
  1462. Function IOCTLWriteHandle(Handle, Count: Word;  { Funktion $4403 }
  1463.          Buf: Pointer): Word;
  1464. var Regs: Registers;
  1465. begin
  1466.   with Regs do
  1467.   begin
  1468.     AX := $4403;   { Funktion: Write Control Char }
  1469.     BX := Handle;  { Handle des Geräts }
  1470.     CX := Count;
  1471.     DS := Seg(Buf^); DX := Ofs(Buf^);
  1472.     Intr($21,Regs);
  1473.     if (Flags and FCarry) <> 0 then
  1474.     begin
  1475.       DosError := AX; IOCTLWriteHandle := 0;
  1476.     end else
  1477.     begin              { Anzahl geschriebener Bytes }
  1478.       DosError := 0; IOCTLWriteHandle := AX;
  1479.     end;
  1480.   end;
  1481. end;
  1482.  
  1483. Function IOCTLReadBlock(Drive,Count: Word;
  1484.          Buf: Pointer): Word; { Funktion $4404 }
  1485. var Regs: Registers;
  1486. begin
  1487.   with Regs do
  1488.   begin
  1489.     AX := $4404;   { Funktion: Read Control Char (Block) }
  1490.     BX := Drive;   { Laufwerksnummer }
  1491.     CX := Count;
  1492.     DS := Seg(Buf^); DX := Ofs(Buf^);
  1493.     Intr($21,Regs);
  1494.     if (Flags and FCarry) <> 0 then
  1495.     begin
  1496.       DosError := AX; IOCTLReadBlock := 0;
  1497.     end else
  1498.     begin            { Anzahl gelesener Bytes }
  1499.       DosError := 0; IOCTLReadBlock := AX;
  1500.     end;
  1501.   end;
  1502. end;
  1503.  
  1504. Function IOCTLWriteBlock(Drive,Count: Word;
  1505.          Buf: Pointer): Word; { Funktion $4405 }
  1506. var Regs: Registers;
  1507. begin
  1508.   with Regs do
  1509.   begin
  1510.     AX := $4402;   { Funktion: Write Control Char (Block) }
  1511.     BX := Drive;   { Laufwerksnummer }
  1512.     CX := Count;
  1513.     DS := Seg(Buf^); DX := Ofs(Buf^);
  1514.     Intr($21,Regs);
  1515.     if (Flags and FCarry) <> 0 then
  1516.     begin
  1517.       DosError := AX; IOCTLWriteBlock := 0;
  1518.     end else
  1519.     begin            { Anzahl geschriebener Bytes }
  1520.       DosError := 0; IOCTLWriteBlock := AX;
  1521.     end;
  1522.   end;
  1523. end;
  1524.  
  1525. Function IOCTLInReady(Handle: Byte): Boolean;  { Funktion $4406 }
  1526. var Regs: Registers;
  1527. begin
  1528.   Regs.AX := $4406;  { IOCTL: "Get Input Status" }
  1529.   Regs.BX := Handle;
  1530.   Intr($21,Regs);
  1531.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1532.     else IOCTLInReady := (Regs.AL = $FF); { TRUE für "ready" }
  1533. end;
  1534.  
  1535. Function IOCTLOutReady(Handle: Byte): Boolean;  { Funktion $4407 }
  1536. var Regs: Registers;
  1537. begin
  1538.   Regs.AX := $4407;  { IOCTL: "Get Output Status" }
  1539.   Regs.BX := Handle;
  1540.   Intr($21,Regs);
  1541.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1542.     else IOCTLOutReady := (Regs.AL = $FF); { TRUE für "ready" }
  1543. end;
  1544.  
  1545. Function IOCTLChangeable(Drive: Byte): Boolean;  { Funktion $4408 }
  1546. var Regs: Registers;
  1547. begin
  1548.   Regs.AX := $4408;   { IOCTL: "Changeable Media" }
  1549.   Regs.BL := Drive;
  1550.   Intr($21,Regs);
  1551.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1552.    else DosError := 0;
  1553.   IOCTLChangeable := (Regs.AX = 0);  { TRUE für "wechselbar" }
  1554. end;
  1555.  
  1556. Function IOCTLDevLocal(Drive: Byte): Word;    { Funktion $4409 }
  1557. var Regs: Registers;
  1558. begin
  1559.   Regs.AX := $4409;   { IOCTL: "Device Local/Remote" }
  1560.   Regs.BL := Drive;
  1561.   Intr($21,Regs);
  1562.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1563.    else DosError := 0;
  1564.   IOCTLDevLocal := Regs.DX;  { Laufwerks-Attribute }
  1565. end;
  1566.  
  1567. Function IOCTLHandleLocal(Handle: Word): Word;  { Funktion $440A }
  1568. var Regs: Registers;
  1569. begin
  1570.   Regs.AH := $44;   { Funktion "IOCTL" }
  1571.   Regs.AL := $0A;   { Unterfunktion "Handle Local/Remote" }
  1572.   Regs.BX := Handle;
  1573.   Intr($21,Regs);
  1574.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX
  1575.     else IOCTLHandleLocal := Regs.DX;
  1576. end;
  1577.  
  1578. Procedure IOCTLSetRetry(Repeats, Counter: Word);  { Funktion $440B }
  1579. var Regs: Registers;
  1580. begin
  1581.   Regs.AX := $440B;   { IOCTL: "Set SHARE Retry Count" }
  1582.   Regs.CX := Counter; { Verzögerungszähler }
  1583.   Regs.DX := Repeats; { Anzahl der Wiederholungen }
  1584.   Intr($21,Regs);
  1585.   if (Regs.Flags and FCarry) <> 0 then DosError := Regs.AX
  1586.     else DosError := 0;
  1587. end;
  1588.  
  1589. Procedure IOCTLGenericHandle(Handle, Category,Subcode: Byte;
  1590.           var ParmBlock);   { Funktion $440C }
  1591. var Regs: Registers;
  1592. begin
  1593.   with Regs do
  1594.   begin
  1595.     AX := $440C;  { Funktion: "Generic IOCTL (Handle)" }
  1596.     BX := Handle;
  1597.     CH := Category;  { 1=PRN,3=CON,5=COM }
  1598.     CL := Subcode;
  1599.     DS := Seg(ParmBlock); DX := Ofs(ParmBlock);
  1600.     Intr($21,Regs);
  1601.     if (Flags and FCarry) <> 0 then DosError := AX
  1602.      else DosError := 0;
  1603.   end;
  1604. end;
  1605.  
  1606. Procedure IOCTLGenericBlock(Drive,Subcode: Byte; var ParmBlock);
  1607. var Regs: Registers;                               { Funktion $440D }
  1608. begin
  1609.   with Regs do
  1610.   begin
  1611.     AX := $440D;  { Funktion: "Generic IOCTL (Block)" }
  1612.     BX := Drive;  { Laufwerksnummer }
  1613.     CH := $08;    { "Gerätekategorie", immer $08 (= Laufwerk) }
  1614.     CL := Subcode;
  1615.     DS := Seg(ParmBlock); DX := Ofs(ParmBlock);
  1616.     Intr($21,Regs);
  1617.     if (Flags and FCarry) <> 0 then DosError := AX
  1618.      else DosError := 0;
  1619.   end;
  1620. end;
  1621.  
  1622. Function IOCTLGetLogMap(Drive: Byte): Byte;  { Funktion $440E }
  1623. var Regs: Registers;
  1624. begin
  1625.   Regs.AX := $440E;  { IOCTL: "Get Logical Drive Map" }
  1626.   Regs.BL := Drive;   { Laufwerksnummer }
  1627.   Intr($21,Regs);
  1628.   if (Regs.Flags and FCarry) <> 0 then DosError := Regs.AX
  1629.    else DosError := 0;
  1630.   IOCTLGetLogMap := Regs.AL; { logische Laufwerksnummer }
  1631. end;
  1632.  
  1633. Procedure IOCTLSetLogMap(NewDrive: Byte);  { Funktion $440F }
  1634. var Regs: Registers;
  1635. begin
  1636.   Regs.AX := $440F;  { IOCTL: "Set Logical Drive Map" }
  1637.   Regs.BL := NewDrive-1;   { neue interne Laufwerksnummer }
  1638.   Intr($21,Regs);
  1639.   if (Regs.Flags and FCarry) <> 0 then DosError := Regs.AX
  1640.    else DosError := 0;
  1641. end;
  1642.  
  1643. Function IOCTLSupportH(Handle: Word; Categorie, Subcode: Byte): Boolean;
  1644. var Regs: Registers;                    { Funktion $4410 }
  1645. begin
  1646.   with Regs do
  1647.   begin
  1648.     AX := $4410;  { Funktion: "Query IOCTL Supported (Handle)" }
  1649.     BX := Handle;
  1650.     CH := Categorie; CL := Subcode;
  1651.     Intr($21,Regs);
  1652.     IOCTLSupportH := Flags and FCarry = 0;
  1653.   end;
  1654. end;
  1655.  
  1656. Function IOCTLSupportB(Drive: Word; Subcode: Byte): Boolean;
  1657. var Regs: Registers;                        { Funktion $4411 }
  1658. begin
  1659.   with Regs do
  1660.   begin
  1661.     AX := $4411;  { Funktion: "Query IOCTL Supported (Block)" }
  1662.     BX := Drive;
  1663.     CH := $08;
  1664.     CL := Subcode;
  1665.     Intr($21,Regs);
  1666.     IOCTLSupportB := Flags and FCarry = 0;
  1667.   end;
  1668. end;
  1669.  
  1670. Function DupHandle(Handle: Word): Word;  { Funktion $45 }
  1671. var Regs: Registers;
  1672. begin
  1673.   Regs.AH := $45;  { Funktion: Duplicate Handle }
  1674.   Regs.BX := Handle; { Handle der offenen Datei }
  1675.   Intr($21,Regs);
  1676.   if (Regs.Flags and FCarry) <> 0
  1677.     then InOutRes := Regs.AX
  1678.     else DupHandle := Regs.AX;
  1679. end;
  1680.  
  1681. Procedure SetHandle2(Handle1, Handle2: Word);  { Funktion $46 }
  1682. var Regs: Registers;
  1683. begin
  1684.   Regs.AH := $46;  { Funktion: "Set 2nd Handle" }
  1685.   Regs.BX := Handle1;
  1686.   Regs.CX := Handle2;
  1687.   Intr($21,Regs);
  1688.   if (Regs.Flags and FCarry) <> 0
  1689.     then InOutRes := Regs.AX;
  1690. end;
  1691.  
  1692. { Procedure GetDir - ist im Unit DOS - }
  1693.  
  1694. Function GetMemBlock(Size: LongInt): Word;  { Funktion $48 }
  1695. var Regs: Registers;
  1696. begin
  1697.   Regs.AH := $48;  { Funktion: "Allocate Memory Block" }
  1698.   Regs.BX := (Size + $F) div 16;  { Aufrundung auf Paragraphs }
  1699.   Intr($21,Regs);
  1700.   if Regs.Flags and FCarry <> 0 then
  1701.   begin
  1702.     GetMemBlock := 0; DosError := Regs.AX;
  1703.   end else
  1704.   begin
  1705.    GetMemBlock := Regs.AX; DosError := 0;
  1706.   end;
  1707. end;
  1708.  
  1709. Function GetFreeMainMem: LongInt;   { Funktion $48, andere Anwendung }
  1710. var Regs: Registers;
  1711. begin
  1712.   Regs.AH := $48;  { Funktion: "Allocate Memory Block" }
  1713.   Regs.BX := $FFFF; { eine "unmögliche" Größe }
  1714.   Intr($21,Regs);
  1715.   GetFreeMainMem := LongInt(Regs.BX) * 16;
  1716. end;
  1717.  
  1718. Procedure FreeMemBlock(BlockSeg: Word);  { Funktion $49 }
  1719. var Regs: Registers;
  1720. begin
  1721.   Regs.AH := $49; { Funktion: "Free Memory Block" }
  1722.   Regs.ES := BlockSeg;  { Segment des freizugebenden Blocks }
  1723.   Intr($21,Regs);
  1724.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1725.     else DosError := 0;
  1726. end;
  1727.  
  1728. Procedure SetMemBlock(BlockSeg,BlockSize: Word);  { Funktion $4A }
  1729. var Regs: Registers;
  1730. begin
  1731.   Regs.AH := $4A;    { Funktion: "Modify Allocated Memory" }
  1732.   Regs.BX := BlockSize; { neue Größe in Paragraphs }
  1733.   Regs.ES := BlockSeg;  { Block-Segment }
  1734.   Intr($21,Regs);
  1735.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1736.    else DosError := 0;
  1737. end;
  1738.  
  1739. { Procedure Exec - ist im Unit DOS - }
  1740.  
  1741. Procedure ExecLoad(Path, CmdLine: String; var ProgRegs);
  1742. Type                        { Funktion $4B01 }
  1743.   SSIPBlock = Record
  1744.     rSP,rSS: Word;   { SS:SP des geladenen Programms }
  1745.     rCS,rIP: Word;   { CS:IP des geladenen Programms }
  1746.   end;
  1747. Const
  1748.   TurboSS: Word = 0;  { zum Zwischenspeichern }
  1749.   TurboBP: Word = 0;  { von SS und BP      }
  1750. var
  1751.   FCBPart1, FCBPart2 : Array[1..16] of Char; { Laufwerk/Name/Suffix }
  1752.   ExecParams : Record
  1753.       EnvSeg : Word;  { Environment d. aufrufenden Programms }
  1754.       CmdAddr: Pointer;  { Kommandozeile }
  1755.       FCBP1 : Pointer;  { erster Teil-FCB }
  1756.       FCBP2 : Pointer;  { zweiter Teil-FCB }
  1757.       { Erweiterungen des Parameterblocks für die Funktion $4B01 }
  1758.       SP, SS: Word;     { SS:SP des geladenen Programms }
  1759.       IP, CS: Word;     { CS:IP des geladenen Programms }
  1760.   end;
  1761. begin
  1762.   { Die ersten drei Schritte sind eine exakte Kopie der
  1763.     Funktion $4B00 }
  1764.   { 1. Register sichern }
  1765.   TurboSS := SSeg;                  { SS festhalten }
  1766.   if SwapValInCS(DSeg) <> 0 then ;  { DS festhalten }
  1767.   inline($89/$2E/TurboBP);    { mov [TurboBP],BP  - BP festhalten }
  1768.  
  1769.   { 2. Einsetzen der Kommandozeile in die beiden Teil-FCBs }
  1770.   CmdLine := CmdLine + Chr($0D); { RETURN-Zeichen anhängen }
  1771.   if ParseFName(ParseFName(@CmdLine[1],@FCBPart1),@FCBPart2)
  1772.      <> NIL then ;   { 2. Ergebnis nicht verwertet }
  1773.  
  1774.   { 3. Besetzen des Parameterblocks }
  1775.   with ExecParams do
  1776.   begin  { Endadresse dieses Programms als Env-Seg des neuen Prog. }
  1777.     EnvSeg := Word(Ptr(PrefixSeg,$02)^);
  1778.     CmdAddr := @CmdLine;  { Kommandozeile, incl. Längenbyte }
  1779.     FCBP1 := @FCBPart1;
  1780.     FCBP2 := @FCBPart2;
  1781.   end;
  1782.   Path := StrtoZ(Path);  { NUL-Zeichen als Ende des Programmnamens }
  1783.  
  1784.   { 4. DOS-Aufruf. Verändert ist nur die Funktionsnummer }
  1785.   inline
  1786.    ($B8/$4B01/          {    mov  ax,$4B01        ; Dos-Funktion EXEC/Load }
  1787.     $8D/$96/>Path/      {    lea  dx,Path                             }
  1788.     $42/                {    inc  dx              ; hinter dem Längenbyte }
  1789.     $16/$1F/            {    push ss / pop ds     ; DS:DX = Prog.-Name }
  1790.     $8D/$9E/>ExecParams/{    lea  bx,ExecParams                       }
  1791.     $16/$07/            {    push ss / pop es     ; ES:BX = Parameter }
  1792.     $CD/$21/            {    int  $21             ; DOS-Aufruf        }
  1793.     $72/$02/            {    jc   L1              ; Fehler?           }
  1794.     $31/$C0/            {    xor  ax,ax           ; nein: AX = 0      }
  1795.     $50                 { L1:push ax              ; DOS-Ergebniscode  }
  1796.     );
  1797.   if SwapValInCS(0) <> 0 then ;  { Liefert altes DS in AX }
  1798.   inline
  1799.    ($8E/$D8/            {    mov  ds,ax           ; DS zurück auf TURBO }
  1800.     $58/                {    pop  ax              ; DOS-Ergebniscode    }
  1801.     $A3/DosError/       {    mov  [DosError],ax   ; setzen              }
  1802.     $8B/$2E/TurboBP/    {    mov  bp,[TurboBP]    ; BP zurück auf TURBO }
  1803.     $8E/$16/TurboSS     {    mov  ss,[TurboSS]    ; SS zurück auf TURBO }
  1804.    );
  1805.  
  1806.    { 5. Speichern der zurückgelieferten Werte. Läuft rein über BP! }
  1807.    with SSIPBlock(ProgRegs),ExecParams do
  1808.    begin
  1809.      rSS := SS; rSP := SP; rCS := CS; rIP := IP;
  1810.    end;
  1811. end;    { <- führt als erstes den Befehl MOV SP,BP aus, d.h. setzt SP }
  1812.  
  1813. Procedure LoadOverlay(Name: String);   { Funktion $4B03 }
  1814. var Regs: Registers;
  1815.     OvlyParams : Record
  1816.       LoadAddr: Word;  { Ladesegment }
  1817.       Reloc: Word;  { Relozierungskonstante }
  1818.     end;
  1819. begin
  1820.   Name := StrtoZ(Name);  { Pascal-String -> ASCIIZ }
  1821.   with OvlyParams do
  1822.   begin
  1823.     LoadAddr := Seg(HeapPtr^)+1;
  1824.     Reloc := 0;
  1825.   end;
  1826.   with Regs do
  1827.   begin
  1828.     AX := $4B03;  { Funktion: "Load Overlay" }
  1829.     DS := Seg(Name); DX := Ofs(Name)+1; { hinter Längenbyte }
  1830.     ES := Seg(OvlyParams); BX := Ofs(OvlyParams);
  1831.     Intr($21,Regs);
  1832.     if Flags and FCarry <> 0 then InOutRes := AX;
  1833.   end;
  1834. end;
  1835.  
  1836. { Procedure TerminateProcess - ist im Unit DOS - (Halt) }
  1837.  
  1838. { Function DosExitCode - ist im Unit DOS - }
  1839.  
  1840. { Procedure FindFirst - ist im Unit DOS - }
  1841.  
  1842. { Procedure FindNext - ist im Unit DOS - }
  1843.  
  1844. Procedure SetActivePSP(PSPSeg: Word);  { Aktives PSP setzen }
  1845. var Regs: Registers;               { Funktion $50 }
  1846. begin
  1847.   Regs.AH := $50; Regs.BX := PSPSeg;
  1848.   Intr($21,Regs);
  1849. end;
  1850.  
  1851. { Liefert die Segmentadresse des PSP zurück }
  1852. Function GetPSPAddr51 : Word;    { Funktion $51 }
  1853. var Regs: Registers;
  1854. begin
  1855.   Regs.AH := $51;  { Funktion: "Get PSP Address" }
  1856.   Intr($21,Regs);  { (äquivalent zur Funktion $62) }
  1857.   GetPSPAddr51 := Regs.BX;
  1858. end;
  1859.  
  1860. Function GetDosDataArea: Pointer;  { Funktion $52 }
  1861. var Regs: Registers;
  1862. begin
  1863.   Regs.AH := $52; Intr($21,Regs);
  1864.   GetDosDataArea := Ptr(Regs.ES,Regs.BX);
  1865. end;
  1866.  
  1867. Procedure MakeDPB(DriveNo: Byte; DPB: Pointer);  { Funktion $53 }
  1868. var Regs: Registers;
  1869.     SecBuf: Array[0..511] of Byte;
  1870. begin
  1871.   AbsRead(DriveNo,@SecBuf,0,1);  { Lesen des "Boot"-Sektors }
  1872.   with Regs do
  1873.   begin
  1874.     AH := $53; { inoffizielle Funktion: "Translate BPB" }
  1875.     ES := Seg(DPB^); BP := Ofs(DPB^);  { soll hier gespeichert werden }
  1876.     DS := Seg(SecBuf); SI := Ofs(SecBuf)+11;
  1877.     Intr($21,Regs);
  1878.   end;
  1879. end;
  1880.  
  1881. { Procedure GetVerify(var Verify: Boolean); - ist im Unit DOS - }
  1882.  
  1883. Procedure CreateNewPSP(NewSeg, MemTop: Word);  { Funktion $55 }
  1884. var Regs: Registers;
  1885. begin
  1886.   with Regs do
  1887.   begin
  1888.     AH := $55;  { inoffizielle Funktion: "Create New PSP" }
  1889.     SI := MemTop;  { ab DOS 3.0: Speicher-Endadresse }
  1890.     DX := NewSeg;
  1891.     Intr($21,Regs);
  1892.     if Flags and FCarry <> 0 then DosError := AX
  1893.       else DosError := 0;
  1894.   end;
  1895. end;
  1896.  
  1897. { Procedure Rename - im Unit DOS - }
  1898.  
  1899. { Procedure GetFTime - im Unit DOS - }   { Funktion $5700 }
  1900.  
  1901. { Procedure SetFTime - im Unit DOS - }   { Funktion $5701 }
  1902.  
  1903. Function GetAllocStrat: Byte;    { Funktion $5800 }
  1904. var Regs: Registers;
  1905. begin
  1906.   Regs.AX := $5800;  { Funktion: "Get Allocation Strategy" }
  1907.   Intr($21,Regs);
  1908.   GetAllocStrat := Regs.AX;
  1909. end;
  1910.  
  1911. Procedure SetAllocStrat(Strat: Byte);  { Funktion $5801 }
  1912. var Regs: Registers;
  1913. begin
  1914.   Regs.AX := $5801; { Funktion: "Set Allocation Strategy" }
  1915.   Regs.BX := Strat;
  1916.   Intr($21,Regs);
  1917. end;
  1918.  
  1919. Function GetUMBLink: Boolean;   { Funktion $5802 }
  1920. var Regs: Registers;
  1921.     MCB: MCBPtr; p: ^Word;
  1922. begin
  1923.   if DosVersion = $3203 then { DR-DOS 5.0 }
  1924.   begin
  1925.     p := GetDosDataArea; Dec(LongInt(p),2);
  1926.     MCB := Ptr(p^,0);  { DOS-Datenbereich, Offset - 2 }
  1927.     while MCB^.Flag <> 'Z' do  { MCB-Kette verfolgen }
  1928.       MCB := Ptr(Seg(MCB^)+1+MCB^.Size,0);
  1929.     GetUMBLink := Seg(MCB^)+MCB^.Size > $A000;
  1930.   end else
  1931.   begin
  1932.     Regs.AX := $5802;  { Funktion: "Get UMB Link State" }
  1933.     Intr($21,Regs);
  1934.     if Regs.Flags and FCarry <> 0 then GetUMBLink := False
  1935.       else GetUMBLink := (Regs.AL <> 0);  { TRUE für "UMB eingebunden" }
  1936.   end;
  1937. end;
  1938.  
  1939. Procedure SetUMBLink(LinkState: Boolean);  { Funktion $5803 }
  1940. var Regs: Registers;
  1941.     MCB: MCBPtr; p: ^Word;
  1942.     NextMCB: Word; Done: Boolean;
  1943. begin
  1944.   if DosVersion = $3203 then { DR-DOS 5.0 }
  1945.   begin
  1946.     p := GetDosDataArea; Dec(LongInt(p),2);
  1947.     MCB := Ptr(p^,0);  { DOS-Datenbereich, Offset - 2 }
  1948.     Done := False;
  1949.     { MCB-Kette bis < $9FFF verfolgen }
  1950.     while (MCB^.Flag <> 'Z') and not Done do
  1951.     begin
  1952.       NextMCB := Seg(MCB^)+1+MCB^.Size;
  1953.       if NextMCB >= $9FFF then Done := True
  1954.        else MCB := Ptr(NextMCB,0);
  1955.     end;
  1956.     if NextMCB < $9FFF then NextMCB := Seg(MCB^)+1+MCB^.Size;
  1957.     if ((NextMCB and $FF00) = $9F00) and  { MCB mit ID von MEMMAX auf $9Fxx? }
  1958.       (MCBPtr(Ptr(NextMCB,0))^.OwnerPSP = $0007) then
  1959.     begin
  1960.       if LinkState then MCB^.Flag := 'M'
  1961.        else MCB^.Flag := 'Z';
  1962.     end
  1963.      else DosError := 1;  { Funktion nicht unterstützt }
  1964.   end else
  1965.   begin      { MS-DOS }
  1966.     Regs.AX := $5803;  { Funktion: "Set UMB Link" }
  1967.     Regs.BX := Ord(LinkState);
  1968.     Intr($21,Regs);
  1969.     if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  1970.       else DosError := 0;
  1971.   end;
  1972. end;
  1973.  
  1974. Procedure GetExtError;  { setzt die globale Variable ExtErrInfo }
  1975. var Regs: Registers;    { Funktion $59 }
  1976. begin
  1977.   with Regs, ExtErrInfo do
  1978.   begin
  1979.     AH := $59; Intr($21,Regs); { Funktion: "Get Extended Error" }
  1980.     Code := AX;
  1981.     Class := BH; Action := BL;  { Fehlerklasse, vorgeschlagene Aktion }
  1982.     Locus := CH;  { "Ort" des Fehlers }
  1983.     ExtPointer := Ptr(ES,DI);  { nur von SetExtError aktiv gesetzt }
  1984.   end;
  1985. end;
  1986.  
  1987. { Legt eine Datei mit einem "einzigartigen" Namen an
  1988.   und liefert diesen Namen zurück }
  1989. Function TmpFile(Path: PathStr): String;   { Funktion $5A }
  1990. var Regs: Registers;
  1991. begin
  1992.   Path := StrtoZ(Path);
  1993.   with Regs do
  1994.   begin
  1995.     AH := $5A;  { Funktion: "Create Temporary File" }
  1996.     CX := 0;    { keine Attribute }
  1997.     DS := Seg(Path); DX := Ofs(Path)+1;
  1998.     Intr($21,Regs);
  1999.     if Flags and FCarry <> 0 then InOutRes := AX;
  2000.   end;
  2001.   TmpFile := ZtoStr(@Path[1]);
  2002. end;
  2003.  
  2004. Function CreateNewFile(Name: String): Word;  { Funktion $5B }
  2005. var Regs: Registers;
  2006. begin
  2007.   Name := StrtoZ(Name);
  2008.   with Regs do
  2009.   begin
  2010.     AH := $5B;  { Funktion: "Create New File" }
  2011.     CX := $00;  { keine Attribute }
  2012.     DS := Seg(Name); DX := Ofs(Name) + 1;
  2013.     Intr($21,Regs);
  2014.     if Flags and FCarry <> 0 then InOutRes := 5  { "Zugriff verweigert" }
  2015.       else CreateNewFile := AX;  { Handle }
  2016.   end;
  2017. end;
  2018.  
  2019. { SHARE: Sperrt einen Dateibereich }
  2020. Procedure Lock(var F; Offset, Len: LongInt);
  2021. var Regs: Registers;
  2022. begin
  2023.   with Regs do
  2024.   begin
  2025.     AX := $5C00;  { Funktion: "Lock File Access" }
  2026.     BX := FileRec(F).Handle;  { Handle der Datei }
  2027.     DX := Offset; CX := Offset shr 16;
  2028.     DI := Len; SI := Len shr 16;
  2029.     Intr($21,Regs);
  2030.     if Regs.Flags and FCarry <> 0 then InOutRes := AX
  2031.   end;
  2032. end;
  2033.  
  2034. Procedure Unlock(var F; Offset, Len: LongInt);
  2035. var Regs: Registers;
  2036. begin
  2037.   with Regs do
  2038.   begin
  2039.     AX := $5C01;  { Funktion: "Unlock File Access" }
  2040.     BX := FileRec(F).Handle;  { Handle der Datei }
  2041.     DX := Offset; CX := Offset shr 16;
  2042.     DI := Len; SI := Len shr 16;
  2043.     Intr($21,Regs);
  2044.     if Regs.Flags and FCarry <> 0 then InOutRes := AX
  2045.   end;
  2046. end;
  2047.  
  2048. Procedure ServerCall(Params: ServerCallBlock);  { Funktion $5D00 }
  2049. var Regs: Registers;
  2050. begin
  2051.   with Params do
  2052.   begin
  2053.     Resvd := 0; SysID := 0; ProcID := PrefixSeg;
  2054.   end;
  2055.   with Regs do
  2056.   begin
  2057.     AX := $5D00;  { undokumentierte Funktion: "Server Call" }
  2058.     DS := Seg(Params); DX := Ofs(Params);
  2059.     Intr($21,Regs);
  2060.   end;
  2061. end;
  2062.  
  2063. Procedure UpdateAllFiles;   { Funktion $5D01 }
  2064. var Regs: Registers;
  2065.     PBlock : ServerCallBlock;
  2066. begin
  2067.   with Regs, PBlock do
  2068.   begin
  2069.     Resvd := 0; SysID := 0; ProcID := PrefixSeg;
  2070.     AX := $5D01;  { undokumentierte Funktion: "Update all Files" }
  2071.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2072.     Intr($21,Regs);
  2073.     if Flags and FCarry <> 0 then InOutRes := AX;
  2074.   end;
  2075. end;
  2076.  
  2077. Procedure CloseFileName(FName: String);  { Funktion $5D02 }
  2078. var PBlock: ServerCallBlock;
  2079.     Regs: Registers;
  2080. begin
  2081.   FName := RealFName(FName);  { "absoluter" Dateiname (Funktion $60) }
  2082.   FName := StrtoZ(FName);    { Umwandlung in ASCIIZ }
  2083.   with PBlock do
  2084.   begin
  2085.     Resvd := 0; SysID := 0; ProcID := PrefixSeg;
  2086.     DS := Seg(FName); DX := Ofs(FName)+1;
  2087.   end;
  2088.   with Regs do
  2089.   begin
  2090.     AX := $5D02;  { undokumentierte Funktion: "Close File by Name" }
  2091.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2092.     Intr($21,Regs);
  2093.     if Flags and FCarry <> 0 then InOutRes := AX;
  2094.   end;
  2095. end;
  2096.  
  2097. Procedure CloseMachineFiles(StatID: Word);  { Funktion $5D03 }
  2098. var Regs: Registers;
  2099.     PBlock : ServerCallBlock;
  2100. begin
  2101.   with PBlock do
  2102.   begin
  2103.     Resvd := 0; SysID := StatID;
  2104.   end;
  2105.   with Regs do
  2106.   begin
  2107.     AX := $5D03;  { undokumentierte Funktion: "Close Machine's Files" }
  2108.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2109.     Intr($21,Regs);
  2110.     if Flags and FCarry <> 0 then InOutRes := AX;
  2111.   end;
  2112. end;
  2113.  
  2114. Procedure CloseProcessFiles(ProcPSP: Word);  { Funktion $5D04 }
  2115. var Regs: Registers;
  2116.     PBlock : ServerCallBlock;
  2117. begin
  2118.   with PBlock do
  2119.   begin
  2120.     Resvd := 0; SysID := 0; ProcID := ProcPSP;
  2121.   end;
  2122.   with Regs do
  2123.   begin
  2124.     AX := $5D04;  { undokumentierte Funktion: "Close Process Files" }
  2125.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2126.     Intr($21,Regs);
  2127.     if Flags and FCarry <> 0 then InOutRes := AX;
  2128.   end;
  2129. end;
  2130.  
  2131. Procedure GetSHAREEntry(SHIndex, SFTIndex: Word;
  2132.           var Regs: Registers);  { Funktion $5D05 }
  2133. var PBlock : ServerCallBlock;
  2134. begin
  2135.   with PBlock do
  2136.   begin
  2137.     Resvd := 0; SysID := 0; ProcID := PrefixSeg;
  2138.     BX := SHIndex; CX := SFTIndex;
  2139.   end;
  2140.   with Regs do
  2141.   begin
  2142.     AX := $5D05;  { undokumentierte Funktion: "Get Open List File Entry" }
  2143.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2144.     Intr($21,Regs);
  2145.   end;
  2146. end;
  2147.  
  2148. Procedure GetDosVars(var p: Pointer; var Header,MaxSize: Word);
  2149. var Regs: Registers;           { Funktion $5D06 }
  2150. begin
  2151.   Regs.AX := $5D06;  { undokumentierte Funktion: "Get DOS Variable Area" }
  2152.   Intr($21,Regs);
  2153.   if Regs.AX <> $5D06 then DosError := 1 { nicht unterstützt }
  2154.    else
  2155.    begin
  2156.      p := Ptr(Regs.DS,Regs.SI);
  2157.      Header := Regs.DX; MaxSize := Regs.CX;
  2158.      DosError := 0;
  2159.    end;
  2160. end;
  2161.  
  2162. Function RedirPrinterGetJob: Boolean;   { Funktion $5D07 }
  2163. var Regs: Registers;
  2164. begin
  2165.   Regs.AX := $5D07;  { Undokumentierte Funktion: "Get Redir Printer Mode" }
  2166.   Intr($21,Regs);
  2167.   if Regs.Flags and FCarry <> 0
  2168.    then RedirPrinterGetJob := False
  2169.    else RedirPrinterGetJob := (Regs.DL = 1);
  2170. end;
  2171.  
  2172. Procedure RedirPrinterSetJob(Join: Boolean);  { Funktion $5D08 }
  2173. var Regs: Registers;
  2174. begin
  2175.   Regs.AX := $5D08;  { Undokumentierte Funktion: "Set Redir Printer Mode" }
  2176.   Regs.DL := Ord(Join);
  2177.   Intr($21,Regs);
  2178. end;
  2179.  
  2180. Procedure RedirPrinterNewJob;   { Funktion $5D09 }
  2181. var Regs: Registers;
  2182. begin
  2183.   Regs.AX := $5D09;  { Undokumentierte Funktion: "Flush Redir Printer" }
  2184.   Intr($21,Regs);
  2185. end;
  2186.  
  2187. Procedure SetExtError(ErrCode,Class,Locus,Action: Word; p: Pointer);
  2188. var Regs: Registers;
  2189.     PBlock : ServerCallBlock;    { Funktion $5D0A }
  2190. begin
  2191.   with PBlock do
  2192.   begin
  2193.     AX := ErrCode;
  2194.     BX := (Class shl 8) + Action;
  2195.     CX := Locus;
  2196.     ES := Seg(p^); DI := Ofs(p^);
  2197.     SysID := 0; Resvd := 0; ProcID := PrefixSeg;
  2198.   end;
  2199.   with Regs do
  2200.   begin
  2201.     AX := $5D0A;   { Undokumentierte Funktion: "Set Extended Error" }
  2202.     DS := Seg(PBlock); DX := Ofs(PBlock);
  2203.     Intr($21,Regs);
  2204.     if Flags and FCarry <> 0 then DosError := AX
  2205.       else DosError := 0;
  2206.   end;
  2207. end;
  2208.  
  2209. Function GetStationName(var Number: Byte; var Name: String): Boolean;
  2210. var Regs: Registers;
  2211. begin                       { Funktion $5E00 }
  2212.   with Regs do
  2213.   begin
  2214.     AX := $5E00;   { Funktion: "Get Machine Name" }
  2215.     DS := Seg(Name); DX := Ofs(Name);
  2216.     Intr($21,Regs);
  2217.     if (Flags and FCarry <> 0) then
  2218.      begin
  2219.        DosError := AX; Name := ''; GetStationName := False;
  2220.      end else
  2221.      begin
  2222.        DosError := 0;
  2223.        GetStationName := CH <> 0; { Name definiert / nicht def. }
  2224.        Name := ZtoStr(@Name);
  2225.        Number := CL;            { Knotennummer }
  2226.      end;
  2227.   end;
  2228. end;
  2229.  
  2230. Procedure SetStationName(Number: Byte; Name: String);
  2231. var Regs: Registers;       { Funktion $5E01 }
  2232. begin
  2233.   Name := StrtoZ(Name);   { Pascal-String -> ASCIIZ }
  2234.   with Regs do
  2235.   begin
  2236.     AX := $5E01;  { Undokumentierte Funktion: "Set Machine Name" }
  2237.     CH := 1;      { Namen definieren, nicht löschen }
  2238.     CL := Number; { Knotennummer, nur für NETBIOS }
  2239.     DS := Seg(Name); DX := Ofs(Name) + 1;
  2240.     Intr($21,Regs);
  2241.     if Flags and FCarry <> 0 then DosError := AX
  2242.       else DosError := 0;
  2243.   end;
  2244. end;
  2245.  
  2246. { Setzt den Initialisierungsstring eines Netz-Druckers }
  2247. Procedure ReDirPrinterSetInit(DevName: String; InitStr: String);
  2248. var Regs: Registers;                { Funktion $5E02 }
  2249.     NetName: String;   { Dummy }
  2250.     Index: Integer;
  2251. begin
  2252.   Index := ReDirGetEntry(DevName, NetName);
  2253.   if Index = -1 then DosError := 18
  2254.   else
  2255.     with Regs do
  2256.     begin
  2257.       AX := $5E02;  { Funktion: "Set Printer Setup" }
  2258.       BX := Index;
  2259.       CX := Length(InitStr); if CX > 64 then CX := 64;
  2260.       DS := Seg(InitStr); SI := Ofs(InitStr)+1;
  2261.       Intr($21,Regs);
  2262.       if Flags and FCarry <> 0 then DosError := AX
  2263.         else DosError := 0;
  2264.     end;
  2265. end;
  2266.  
  2267. { Ermittelt den Initialisierungsstring eines Netz-Druckers }
  2268. Function ReDirPrinterGetInit(DevName: String): String;
  2269. var Regs: Registers;
  2270.     Res: String;             { Funktion $5E03 }
  2271.     Index: Integer;
  2272. begin
  2273.   Index := ReDirGetEntry(DevName,Res); { Res: Dummy }
  2274.   if Index = -1 then DosError := 18
  2275.    else
  2276.    with Regs do
  2277.    begin
  2278.       AX := $5E03;  { Funktion: "Get Printer Setup" }
  2279.       BX := Index;
  2280.       ES := Seg(Res); DI := Ofs(Res)+1;
  2281.       Intr($21,Regs);
  2282.       if Flags and FCarry <> 0 then DosError := AX
  2283.        else DosError := 0;
  2284.       Res[0] := Chr(CX);
  2285.   end;
  2286.   RedirPrinterGetInit := Res;
  2287. end;
  2288.  
  2289. Procedure ReDirPrinterSetTabs(DevName: String; Tabs: Boolean);
  2290. var Regs: Registers;
  2291.     NetName: String;   { Dummy }
  2292.     Index: Integer;               { Funktion $5F04 }
  2293. begin
  2294.   Index := ReDirGetEntry(DevName, NetName);
  2295.   if Index = -1 then DosError := 18
  2296.   else
  2297.     with Regs do
  2298.     begin
  2299.       AX := $5E04;  { Funktion: "Set Printer Tabs" }
  2300.       BX := Index;
  2301.       DX := Ord(Tabs);  { 0 -> keine Interpretation, 1 -> Interpretation }
  2302.       Intr($21,Regs);
  2303.       if Flags and FCarry <> 0 then DosError := AX
  2304.         else DosError := 0;
  2305.     end;
  2306. end;
  2307.  
  2308. Function ReDirPrinterGetTabs(DevName: String): Boolean;
  2309. var Regs: Registers;
  2310.     Dummy: String;            { Funktion $5F05 }
  2311.     Index: Integer;
  2312. begin
  2313.   Index := ReDirGetEntry(DevName,Dummy); { (Netz-Name) }
  2314.   if Index = -1 then DosError := 18
  2315.    else
  2316.    with Regs do
  2317.    begin
  2318.       AX := $5E05;  { Funktion: "Get Printer Tabs" }
  2319.       BX := Index;
  2320.       Intr($21,Regs);
  2321.       if Flags and FCarry <> 0 then DosError := AX
  2322.        else DosError := 0;
  2323.       ReDirPrinterGetTabs := DX = 1;  { TRUE für "Interpretation" }
  2324.   end;
  2325. end;
  2326.  
  2327. Function ReDirPrinterGetMode: Boolean;   { Funktion $5F00 }
  2328. var Regs: Registers;
  2329. begin
  2330.   Regs.AX := $5F00; { Funktion: "Get Redirection Mode" }
  2331.   Regs.BX := $03;   { Abfrage Drucker }
  2332.   Intr($21,Regs);
  2333.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2334.    else DosError := 0;
  2335.   ReDirPrinterGetMode := (Regs.BH = 1);
  2336. end;
  2337.  
  2338. Function ReDirDriveGetMode : Boolean;     { Funktion $5F00 }
  2339. var Regs: Registers;
  2340. begin
  2341.   Regs.AX := $5F00; { Funktion: "Get Redirection Mode" }
  2342.   Regs.BX := $04;   { Abfrage Disk-Laufwerk. Laufwerksnummer? }
  2343.   Intr($21,Regs);
  2344.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2345.    else DosError := 0;
  2346.   ReDirDriveGetMode := (Regs.BH = 1);
  2347. end;
  2348.  
  2349. Procedure ReDirPrinterSetMode(Mode: Boolean);
  2350. var Regs: Registers;
  2351. begin                                       { Funktion $5F01 }
  2352.   Regs.AX := $5F01;
  2353.   Regs.BL := $03;   { Drucker }
  2354.   Regs.BX := Ord(Mode);
  2355.   Intr($21,Regs);
  2356.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2357.    else DosError := 0;
  2358. end;
  2359.  
  2360. Procedure ReDirDriveSetMode(Mode: Boolean);
  2361. var Regs: Registers;                        { Funktion $5F01 }
  2362. begin
  2363.   Regs.AX := $5F01;
  2364.   Regs.BL := $04;   { Disk }
  2365.   Regs.BX := Ord(Mode);
  2366.   Intr($21,Regs);
  2367.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2368.    else DosError := 0;
  2369. end;
  2370.  
  2371. { Sucht die Redirektionsliste nach einem Eintrag ab.
  2372.    Aufruf mit dem lokalen Namen des Gerätes, zurückgeliefert
  2373.    wird der Netz-Name und die Indexnummer.
  2374. }
  2375. Function ReDirGetEntry(LocalName: string; var NetName: String): Integer;
  2376. var Regs: Registers;
  2377.     LocalTemp: String[16];          { Funktion $5F02 }
  2378.     x,y: Integer;
  2379.     Found: Boolean;
  2380. begin
  2381.   for x := 1 to Length(LocalName) do
  2382.     LocalName[x] := Upcase(LocalName[x]);
  2383.  
  2384.   x := 0; Found := False; DosError := 0;
  2385.   while (DosError = 0) and not Found do
  2386.     with Regs do
  2387.     begin
  2388.       AX := $5F02;  { Funktion: "Get ReDir List Entry" }
  2389.       BX := x;      { Indexnummer }
  2390.       SI := Ofs(LocalTemp); DS := Seg(LocalTemp);
  2391.       DI := Ofs(NetName); ES := Seg(NetName);
  2392.       Intr($21,Regs);   { Aufruf }
  2393.       if (Flags and FCarry) <> 0 then DosError := AX
  2394.        else if BH = 0 then   { besetzter, d.h. gültiger Eintrag }
  2395.         begin
  2396.           LocalTemp := ZToStr(@LocalTemp[0]);
  2397.           if BL = 4 then { Laufwerk: Suche nach Unterverzeichnis }
  2398.           begin
  2399.             y := 0; while NetName[y] <> #0 do Inc(y);
  2400.             NetName[y] := ':';
  2401.           end;
  2402.           NetName := ZToStr(@NetName[0]);  { ASCIIZ-> Pascal }
  2403.           Found := LocalTemp = LocalName;
  2404.           if Found then ReDirGetEntry := x;
  2405.         end;
  2406.       Inc(x);    { Nächster Eintrag }
  2407.     end;
  2408. end;
  2409.  
  2410. { Funktion $5F03 - Legt einen Eintrag in der Redirektionsliste an }
  2411. Procedure ReDirSetEntry(DevCode: Byte; UserVal: Word;
  2412.                    LocalName, NetName: String);
  2413. var Regs: Registers;
  2414. begin
  2415.   LocalName := StrToZ(LocalName); NetName := StrToZ(NetName);
  2416.   with Regs do
  2417.   begin
  2418.     AX := $5F03;   { Funktion: "Set Redirection List" }
  2419.     BX := DevCode; { 3 = Drucker, 4 = Disk }
  2420.     CX := UserVal; { benutzerdefinierbarer Wert }
  2421.     SI := Ofs(LocalName)+1;  { DS:SI = lokaler Name }
  2422.     DS := Seg(LocalName);
  2423.     DI := Ofs(NetName)+1;    { ES:DI = Netz-Name }
  2424.     ES := Seg(NetName);
  2425.     Intr($21,Regs);  { Aufruf }
  2426.     if (Flags and FCarry) <> 0 then DosError := AX
  2427.      else DosError := 0;
  2428.   end;
  2429. end;
  2430.  
  2431. { Funktion $5F04 - löscht einen Eintrag der Redirektionsliste }
  2432. Procedure ReDirDeleteEntry(LocalName: String);
  2433. var Regs: Registers;
  2434. begin
  2435.   LocalName := StrToZ(LocalName);
  2436.   with Regs do
  2437.   begin
  2438.     AX := $5F04;  { Funktion: "Cancel Redirection" }
  2439.     SI := Ofs(LocalName)+1; { DS:SI = Gerätename }
  2440.     DS := Seg(LocalName);
  2441.     Intr($21,Regs);       { Aufruf }
  2442.     if (Flags and FCarry) <> 0 then DosError := AX
  2443.       else DosError := 0;
  2444.   end;
  2445. end;
  2446.  
  2447. { Sucht die Redirektionsliste nach einem Eintrag ab.
  2448.    Aufruf mit dem lokalen Namen des Gerätes, zurückgeliefert
  2449.    wird der Netz-Name und die Indexnummer.
  2450. }
  2451. Function GetDirGetExtEntry(LocalName: string; var NetName: String;
  2452.          var NetBIOSNo: Word): Integer;
  2453. var Regs: Registers;
  2454.     LocalTemp: String[16];      { Funktion $5F05 }
  2455.     x,y: Integer;
  2456.     Found: Boolean;
  2457. begin
  2458.   for x := 1 to Length(LocalName) do
  2459.     LocalName[x] := Upcase(LocalName[x]);
  2460.  
  2461.   x := 0; Found := False; DosError := 0;
  2462.   while (DosError = 0) and not Found do
  2463.     with Regs do
  2464.     begin
  2465.       AX := $5F05;  { Funktion: "Get Ext ReDir List Entry" }
  2466.       BX := x;      { Indexnummer }
  2467.       SI := Ofs(LocalTemp); DS := Seg(LocalTemp);
  2468.       DI := Ofs(NetName); ES := Seg(NetName);
  2469.       Intr($21,Regs);   { Aufruf }
  2470.       if (Flags and FCarry) <> 0 then DosError := AX
  2471.        else if BH = 0 then   { besetzter, d.h. gültiger Eintrag }
  2472.         begin
  2473.           LocalTemp := ZToStr(@LocalTemp[0]);
  2474.           if BL = 4 then { Laufwerk: Suche nach Unterverzeichnis }
  2475.           begin
  2476.             y := 0; while NetName[y] <> #0 do Inc(y);
  2477.             NetName[y] := ':';
  2478.           end;
  2479.           NetName := ZToStr(@NetName[0]);  { ASCIIZ-> Pascal }
  2480.           Found := LocalTemp = LocalName;
  2481.           if Found then
  2482.           begin
  2483.             GetDirGetExtEntry := x;
  2484.             NetBIOSNo := BP;
  2485.           end;
  2486.         end;
  2487.       Inc(x);    { Nächster Eintrag }
  2488.     end;
  2489. end;
  2490.  
  2491. { Stellt ein (zuvor via $5F08 unterdrücktes) lokales Laufwerk
  2492.    wieder zur Verfügung
  2493. }
  2494. Function ActivateLocalDrive(Drive: Byte): Boolean;
  2495. var Regs: Registers;
  2496. begin
  2497.   with Regs do
  2498.   begin
  2499.     AX := $5F07;       { Funktion: "Activate Drive" }
  2500.     DX := Drive;   { 0 = A:, 1 = B: usw. }
  2501.     Intr($21,Regs);
  2502.     if (Flags and FCarry) <> 0 then
  2503.     begin
  2504.       DosError := AX; ActivateLocalDrive := FALSE;
  2505.     end else
  2506.     begin
  2507.       DosError := 0; ActivateLocalDrive := TRUE;
  2508.     end;
  2509.   end;
  2510. end;
  2511.  
  2512. { Unterdrückt ein lokales Laufwerk (DOS 4.x: unterdrückt sämtliche
  2513.    Laufwerke ab der angegebenen Kennziffer)
  2514. }
  2515. Function DeactivateLocalDrive(Drive: Byte): Boolean;
  2516. var Regs: Registers;
  2517. begin
  2518.   with Regs do
  2519.   begin
  2520.     AX := $5F08;       { Funktion: "Deactivate Drive" }
  2521.     DX := Drive;   { 0 = A:, 1 = B: usw. }
  2522.     Intr($21,Regs);
  2523.     if (Flags and FCarry) <> 0 then
  2524.     begin
  2525.       DosError := AX; DeactivateLocalDrive := FALSE;
  2526.     end else
  2527.     begin
  2528.       DosError := 0; DeactivateLocalDrive := TRUE;
  2529.     end;
  2530.   end;
  2531. end;
  2532.  
  2533. { Ergänzt einen Dateinamen um Laufwerk/Suchweg, bleibt von
  2534.   JOIN, SUBST und ASSIGN unbeeindruckt }
  2535. Function RealFName(FName: String): String;   { Funktion $60 }
  2536. var Regs: Registers;
  2537.     RFName: String;
  2538.     x: Integer;
  2539. begin
  2540.   if Lo(DosVersion) < 3 then
  2541.   begin
  2542.     RealFName := FExpand(FName);
  2543.     Exit;
  2544.   end;
  2545.   FName := StrtoZ(FName);
  2546.   with Regs do
  2547.   begin
  2548.     AH := $60;  { undokumentierte Funktion: "Expand Filename" }
  2549.     DS := Seg(FName); SI := Ofs(FName)+1;  { hinter Längenbyte }
  2550.     ES := Seg(RFName); DI := Ofs(RFName); { Ergebnis }
  2551.     Intr($21,Regs);
  2552.     if Flags and FCarry <> 0 then DosError := AX
  2553.     else
  2554.     begin
  2555.       DosError := 0;
  2556.       RFName := ZtoStr(@RFName);
  2557.     end;
  2558.   end;
  2559.   RealFName := RFName;
  2560. end;
  2561.  
  2562. { Liefert die Segmentadresse des PSP zurück }
  2563. Function GetActivePSP : Word;             { Funktion $62 }
  2564. var Regs: Registers;
  2565. begin
  2566.   Regs.AH := $62;  { Funktion: "Get PSP Address" }
  2567.   Intr($21,Regs);
  2568.   GetActivePSP := Regs.BX;
  2569. end;
  2570.  
  2571. Procedure SetPRINTFlag(NewVal: Byte);   { Funktion $64 }
  2572. var Regs: Registers;
  2573. begin
  2574.   Regs.AH := $64;
  2575.   Regs.AL := NewVal;
  2576.   Intr($21,Regs);
  2577. end;
  2578.  
  2579. Procedure GetExtCountryInfo(CCode,CodeP: Integer;
  2580.           var CountryRec: Func6501Country);
  2581. var Regs: Registers;                { Funktion $6501 }
  2582. begin
  2583.   with Regs do
  2584.   begin
  2585.     { Abfrage über die Funktion $6501: aktuelle Codeseite/aktuelles Land }
  2586.     AX := $6501;
  2587.     Integer(BX) := CodeP;   { Codeseite: $FFFF = aktuelle Seite von CON }
  2588.     CX := SizeOf(Func6501Country);  { Größe Ergebnispuffer }
  2589.     Integer(DX) := CCode;   { Landescode: $FFFF = aktuelles Land }
  2590.     ES := Seg(CountryRec); DI := Ofs(CountryRec);
  2591.     Intr($21,Regs);
  2592.     if Flags and FCarry <> 0 then DosError := AX
  2593.       else DosError := 0;
  2594.   end;
  2595. end;
  2596. { Gemeinsame Rahmenroutine für die Funktionen $6502 bis $6507 }
  2597. { Ist nicht öffentlich deklariert, d.h. nur im Implementationsteil }
  2598. Procedure CallFunc650x(SubFunc: Byte; var Size: Word; var CharPtr);
  2599. Type TableStruc = Record
  2600.        Size: Word;
  2601.        Chars: Array [0..255] of Char;
  2602.      end;
  2603.      TablePtr = ^TableStruc;   { Zeiger auf eine solche Struktur }
  2604. var Regs: Registers;
  2605.     Buf: Record
  2606.           SubF: Byte;
  2607.           Res: TablePtr;
  2608.          end;
  2609. begin
  2610.   with Regs do
  2611.   begin
  2612.     AH := $65; AL := SubFunc;
  2613.     BX := $FFFF; DX := $FFFF;  { "aktuelle" Einstellungen }
  2614.     CX := $05;      { Puffergröße }
  2615.     ES := Seg(Buf); DI := Ofs(Buf);
  2616.     Intr($21,Regs);
  2617.     if (Flags and FCarry <> 0) or (Buf.SubF <> SubFunc)
  2618.       then DosError := AX
  2619.       else DosError := 0;
  2620.   end;
  2621.   with Buf do
  2622.   begin
  2623.     Size := Res^.Size;    { Größe des Arrays }
  2624.     Pointer(CharPtr) := Ptr(Seg(Res^),Ofs(Res^)+2); { Array-Adresse }
  2625.   end;
  2626. end;
  2627.  
  2628. Procedure GetASCIIHiXLate(var Size: Word; var TablePtr);
  2629. begin                                     { Funktion $6502 }
  2630.   CallFunc650x($02,Size,TablePtr);
  2631. end;
  2632.  
  2633. Procedure GetFNamecase(var Size: Word; var TablePtr);
  2634. begin                                     { Funktion $6504 }
  2635.   CallFunc650x($04,Size,TablePtr);
  2636. end;
  2637.  
  2638. Procedure GetFNameTerminators(var Size: Word; var TablePtr);
  2639. begin                                     { Funktion $6505 }
  2640.   CallFunc650x($05,Size,TablePtr);
  2641. end;
  2642.  
  2643. Procedure GetSortTable(var Size: Word; var TablePtr);
  2644. begin                                     { Funktion $6506 }
  2645.   CallFunc650x($06,Size,TablePtr);
  2646. end;
  2647.  
  2648. Procedure GetDBCSTable(var Size: Word; var TablePtr);
  2649. begin                                     { Funktion $6507 }
  2650.   CallFunc650x($07,Size,TablePtr);
  2651. end;
  2652.  
  2653. { Landesspezifische Umsetzung von Klein- in Großbuchstaben }
  2654. Function Upcase6520(Ch: Char): Char;      { Funktion $6520 }
  2655. var Regs: Registers;
  2656. begin
  2657.   Regs.AX := $6520;  { Funktion: "Capitalize Character" }
  2658.   Regs.DL := Ord(Ch);
  2659.   Intr($21,Regs);
  2660.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2661.    else DosError := 0;
  2662. Upcase6520 := Chr(Regs.DL);
  2663. end;
  2664.  
  2665. Function Upcase6521(s: String): String;
  2666. var Regs: Registers;                     { Funktion $6521 }
  2667. begin
  2668.   Regs.AX := $6521;  { Funktion: "Capitalize String" }
  2669.   Regs.CX := Ord(s[0]);  { Länge des Strings }
  2670.   Regs.DS := Seg(s); Regs.DX := Ofs(s)+1;
  2671.   Intr($21,Regs);
  2672.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2673.    else DosError := 0;
  2674.   Upcase6521 := s;
  2675. end;
  2676.  
  2677. Procedure Upcase6522(s: Pointer);  { Umsetzung ASCIIZ-String }
  2678. var Regs: Registers;                    { Funktion $6522 }
  2679. begin
  2680.   Regs.AX := $6522;  { Funktion: "Capitalize ASCIIZ String" }
  2681.   Regs.DS := Seg(s^); Regs.DX := Ofs(s^);
  2682.   Intr($21,Regs);
  2683.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2684.    else DosError := 0;
  2685. end;
  2686.  
  2687. { Prüfung auf "Ja", "Nein" oder "weder noch" }
  2688. Function Query6523(Ch: Char): Integer;      { Funktion $6523 }
  2689. var Regs: Registers;
  2690. begin
  2691.   Regs.AX := $6523;  { Funktion: "Get Yes/No Prompt" }
  2692.   Regs.DL := Ord(Ch);
  2693.   Intr($21,Regs);
  2694.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2695.    else DosError := 0;
  2696.   Query6523 := Regs.AL;  { 0 = Nein, 1 = Ja, 2 = weder noch }
  2697. end;
  2698. Procedure GetCodePage(var CurrPage, SysPage: Word);
  2699. var Regs: Registers;            { Funktion $6601 }
  2700. begin
  2701.   Regs.AX := $6601;  { Funktion "Get Code Page" }
  2702.   Intr($21,Regs);
  2703.   if Regs.Flags and FCarry <> 0
  2704.     then DosError := Regs.AX
  2705.     else DosError := 0;
  2706.   CurrPage := Regs.BX;
  2707.   SysPage := Regs.DX;
  2708. end;
  2709.  
  2710. Procedure SetCodePage(NewPage: Word);
  2711. var Regs: Registers;            { Funktion $6602 }
  2712. begin
  2713.   Regs.AX := $6602;  { Funktion "Set Code Page" }
  2714.   Regs.BX := NewPage;
  2715.   Intr($21,Regs);
  2716.   if Regs.Flags and FCarry <> 0
  2717.     then DosError := Regs.AX
  2718.     else DosError := 0;
  2719. end;
  2720.  
  2721. Procedure SetHandleCount(Handles: Word);    { Funktion $67 }
  2722. var Regs: Registers;
  2723. begin
  2724.   Regs.AH := $67;  { Funktion: "Set Handle Count" }
  2725.   Regs.BX := Handles;
  2726.   Intr($21,Regs);
  2727.   if Regs.Flags and FCarry <> 0 then DosError := Regs.AX
  2728.     else DosError := 0;
  2729. end;
  2730.  
  2731. Procedure UpdateFile(Handle: Word);         { Funktion $68 }
  2732. var Regs: Registers;
  2733. begin
  2734.   Regs.AH := $68;  { Funktion: "Update File (Entry)" }
  2735.   Regs.BX := Handle;
  2736.   Intr($21,Regs);
  2737.   if Regs.Flags and FCarry <> 0 then InOutRes := Regs.AX;
  2738. end;
  2739.  
  2740. Procedure GetDiskSerialNo(Drive: Byte; var Buf: DiskSerialInfo);
  2741. var Regs: Registers;         { Funktion $6900 }
  2742. begin
  2743.   Regs.AX := $6900;  { Funktion: "Get Disk Serial Number" }
  2744.   Regs.BL := Drive;  { 0 = Standard, 1 = A: 2 = B: usw. }
  2745.   Regs.DS := Seg(Buf); Regs.DX := Ofs(Buf);
  2746.   Intr($21,Regs);
  2747.   if Regs.Flags and FCarry <> 0
  2748.     then DosError := Regs.AX
  2749.     else DosError := 0;
  2750. end;
  2751.  
  2752. Procedure SetDiskSerialNo(Drive: Byte; var Buf: DiskSerialInfo);
  2753. var Regs: Registers;         { Funktion $6901 }
  2754. begin
  2755.   Regs.AX := $6901;  { Funktion: "Set Disk Serial Number" }
  2756.   Regs.BL := Drive;  { 0 = Standard, 1 = A: 2 = B: usw. }
  2757.   Regs.DS := Seg(Buf); Regs.DX := Ofs(Buf);
  2758.   Intr($21,Regs);
  2759.   if Regs.Flags and FCarry <> 0
  2760.     then DosError := Regs.AX
  2761.     else DosError := 0;
  2762. end;
  2763.  
  2764. { *** Funktion $6A existiert, Arbeitsweise aber vorläufig noch unbekannt }
  2765.  
  2766. { Funktion $6B - undefiniert }
  2767.  
  2768. { Ergebnis: Handle der Datei }
  2769. Function CreateExtended(FName: String; Attr: Word; Action: Byte): Word;
  2770. var Regs: Registers;                 { Funktion $6C }
  2771. begin
  2772.   FName := StrtoZ(FName);  { Pascal -> ASCIIZ }
  2773.   with Regs do
  2774.   begin
  2775.     AH := $6C;                { Funktion: "Extended Create/Open" }
  2776.     BX := FileMode or $2000;  { kein Auto Commit, kein INT $24 für Fehler }
  2777.     CX := Attr;
  2778.     DX := Action;  { Verhalten bei neuen/existierenden Dateien }
  2779.     DS := Seg(FName); SI := Ofs(FName) + 1;
  2780.     Intr($21,Regs);
  2781.     if Flags and FCarry <> 0 then InOutRes := AX
  2782.       else CreateExtended := AX;  { Handle }
  2783.   end;
  2784. end;
  2785.  
  2786. { ------ Prüfung auf DR-DOS, Versionen 3.41 und 5.0 ------ }
  2787. Procedure CheckDRDos;
  2788. var Regs: Registers;
  2789.     p : ^Pointer;
  2790.     F: Text; Time: LongInt;
  2791. begin
  2792.   DRDos341 := False; DRDos500 := False;
  2793.   p := Pointer(GetDosDataArea);  { Adresse DOS-Datenbereich }
  2794.   if Swap(DosVersion) = $031F then  { Dos-Version 3.31? }
  2795.   begin  { Ja - Prüfung, ob Geräten eine "Öffnungszeit" zugeordnet wird }
  2796.     Assign(F,'CON'); Reset(F); GetFTime(F,Time); Close(F);
  2797.     if Time = 0 then  { OK - ist DR-DOS }
  2798.     begin
  2799.       p := Ptr(Seg(p^),Ofs(p^)+$04); { Adresse der SFT-Adresse }
  2800.       p := p^;  { SFT-Start }
  2801.       if (MemW[Seg(p^):Ofs(p^)+6] < 2) and  { Handle-Zahl von AUX }
  2802.          (MemW[Seg(p^):Ofs(p^)+6+$35] < 2)  { Handle-Zahl von CON }
  2803.        then DRDos341 := True    { gleich 1? -> DR-DOS 3.41 }
  2804.        else DRDos500 := True;   { > 1, d.h. MS-DOS-kompatibel? -> DR-DOS 5.0 }
  2805.     end;
  2806.   end;
  2807. end;
  2808.  
  2809. { --- Initialisierungsteil --- }
  2810. begin
  2811.   CheckDRDos;   { setzt die Variablen DRDos341 bzw. DRDos500 }
  2812.   CurrDosVersion := DosVersion; { echte DosVersion }
  2813. end.
  2814.  
  2815.