Turbo Toolbox/Turbo_Toolbox.iso/dtx9303/dup/duputil.pas

Pascal/Delphi Source File | 1993-05-28 | 6.8 KB | 197 lines

{$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-,X-}
{$IFDEF Ver70} {$P-,Q-,T-,Y-} {$ENDIF}
(*========================================================*)
(*                       DUPUTIL.PAS                      *)
(*  Copyright (c) 1993  Karsten Gieselmann & DMV-Verlag   *)
(*--------------------------------------------------------*)
(*   Unit mit allgemeinen Hilfsfunktionen für »DUP.PAS«   *)
(*  Turbo/Borland Pascal ab 6.0, Stony Brook Pascal+ 6.0  *)
(*                     DOS ab 3.30                        *)
(*        * NICHT FÜR TURBO PASCAL 4.0 und 5.X! *         *)
(*========================================================*)

Unit DupUtil;

INTERFACE

FUNCTION Long2Str(Num: LongInt): STRING;
FUNCTION SameBytes(VAR a, b; Size: WORD): BOOLEAN;
FUNCTION To_Upper(s: STRING): STRING;
FUNCTION To_Lower(s: STRING): STRING;
FUNCTION Pad(s: STRING; Width: BYTE): STRING;
FUNCTION PadNumZero(w: WORD): STRING;
FUNCTION GetTimerTicks: LongInt;
FUNCTION HardDiskDrive(Drive: BYTE): BOOLEAN;
FUNCTION LocalDrive(Drive: BYTE): BOOLEAN;

IMPLEMENTATION

TYPE
  LongRec = RECORD                 (* so auch in der Unit *)
    Lo, Hi: WORD;                  (* Objects definiert   *)
  END;

FUNCTION Long2Str(Num: LongInt): STRING;
(* Stellt einen numerischen Wert als Zeichenkette dar     *)
VAR
  s: STRING;
BEGIN
  Str(Num, s); Long2Str := s;
END;

FUNCTION SameBytes(VAR a,b; Size: WORD): BOOLEAN; ASSEMBLER;
(* Vergleicht zwei Speicherbereiche Byte für Byte auf     *)
(* Gleichheit                                             *)
ASM
  MOV   DX, DS    (* Datensegment-Register sichern        *)
  MOV   AX, TRUE  (* Default-Rückgabewert:                *)
                  (*    SameBytes := True                 *)
  MOV   CX, Size  (* Größe der Speicherbereiche als       *)
                  (*    Zähler holen                      *)
  JCXZ  @Done     (* bei Länge Null ist nichts zu tun     *)
  LES   DI, a     (* ES:DI ==> a                          *)
  LDS   SI, b     (* DS:SI ==> b                          *)
  CLD             (* Inkrementierender Speicherzugriff    *)
  REP   CMPSB     (* bis a[i] <> b[i] oder CX=0           *)
  JE    @Done     (* letzter Vergleich war ok, also a=b   *)
  MOV   AX, FALSE (* sonst SameBytes := False             *)
 @Done:
  MOV   DS, DX    (* Datensegment-Register restaurieren   *)
END;

FUNCTION To_Upper(s: STRING): STRING; ASSEMBLER;
(* Wandelt ASCII-Zeichenkette in Großbuchstaben um        *)
ASM
  MOV   DX, DS      (* Datensegment-Register sichern      *)
  CLD               (* Inkrementierender Stringzugriff    *)
  XOR   AX, AX      (* Arbeitsregister initialisieren     *)
  LDS   SI, s       (* DS:SI ==> s                        *)
  LES   DI, @Result (* ES:DI ==> Rückgabewert             *)
  LODSB             (* Längenbyte holen ...               *)
  STOSB             (* in die Zielvariable übertragen ... *)
  XCHG  AX, CX      (* und als Schleifenzähler speichern  *)
  JCXZ  @Done       (* falls Länge Null, dann fertig!     *)
 @Next:
  LODSB             (* nächstes Zeichen holen und prüfen  *)
  CMP   AL, 'a'
  JB    @putchar
  CMP   AL, 'z'
  JA    @putchar
  SUB   AL, 20H     (* umwandeln, falls Kleinbuchstabe    *)
 @putchar:
  STOSB             (* in Zielvariable speichern          *)
  LOOP  @Next       (* sooft bis alle Zeichen dran waren  *)
 @Done:
  MOV   DS, DX      (* Datensegment-Register restaurieren *)
END;

FUNCTION To_Lower(s: STRING): STRING; ASSEMBLER;
(* Wandelt ASCII-Zeichenkette in Kleinbuchstaben um       *)
ASM
  MOV   DX, DS      (* Datensegment-Register sichern      *)
  CLD               (* Inkrementierender Stringzugriff    *)
  XOR   AX, AX      (* Arbeitsregister initialisieren     *)
  LDS   SI, s       (* DS:SI ==> s                        *)
  LES   DI, @Result (* ES:DI ==> Rückgabewert             *)
  LODSB             (* Längenbyte holen ...               *)
  STOSB             (* in die Zielvariable übertragen ... *)
  XCHG  AX, CX      (* und als Schleifenzähler speichern  *)
  JCXZ  @Done       (* falls Länge Null, dann fertig!     *)
@Next:
  LODSB             (* nächstes Zeichen holen und prüfen  *)
  CMP   AL, 'A'
  JB    @putchar
  CMP   AL, 'Z'
  JA    @putchar
  ADD   AL, 20H     (* umwandeln, falls Großbuchstabe     *)
@putchar:
  STOSB             (* in Zielvariable speichern          *)
  LOOP    @Next     (* sooft bis alle Zeichen dran waren  *)
@Done:
  MOV     DS, DX    (* Datensegment-Register restaurieren *)
END;

FUNCTION Pad(s: STRING; Width: BYTE): STRING;
(* Füllt eine Zeichenkette bis zu einer bestimmten Länge  *)
(* mit Blanks auf                                         *)
VAR
  i: BYTE;
BEGIN
  FOR i := Succ(Length(s)) TO Width DO s[i] := #32;
  s[0] := Chr(Width);
  Pad := s;
END;

FUNCTION PadNumZero(w: WORD): STRING;
(* Wandelt einen numerischen Wert in die entsprechende    *)
(* Zeichenkette um und füllt gegebenfalls linksbündig mit *)
(* Nullen auf                                             *)
VAR
  s: STRING;
BEGIN
  Str(w: 0, s);
  IF Length(s) = 1 THEN s := '0' + s;
  PadNumZero := s;
END;


FUNCTION GetTimerTicks: LongInt;
(* Ermittelt die Systemzeit in Timer-Ticks (1/18,2 Sek.)  *)
VAR
  Ticks: LongRec;
BEGIN
  ASM
    XOR AH, AH                (* AH := 0                  *)
    INT 1Ah                   (* Systemzeit-Interrupt 1Ah *)
    MOV Ticks.Hi, CX
    MOV Ticks.Lo, DX
  END;
  GetTimerTicks := LongInt(Ticks);
END;

FUNCTION HardDiskDrive(Drive: BYTE): BOOLEAN; ASSEMBLER;
(* Prüft, ob ein Laufwerk auch ein Harddisk-Laufwerk ist  *)
VAR
  return: BOOLEAN;
ASM
  MOV  return, FALSE
  MOV  AX, 4408h                    (* DOS 4408h - IOCTL: *)
  MOV  BL, Drive                    (* Changeable Media   *)
  INT  21h
  JNS  @noerror                     (* CarryFlag gesetzt  *)
  MOV  InOutRes, AX                 (* IoResult setzen    *)
  JMP  @out
@noerror:
  OR   AX, AX                       (* AX = 0?            *)
  JZ   @out
  MOV  return, TRUE
@out:
  MOV  AL, return
END;

FUNCTION LocalDrive(Drive: BYTE): BOOLEAN; ASSEMBLER;
(* Prüft, ob ein Laufwerk lokal zum jeweiligen System ge- *)
(* hört oder über ein Netz betrieben wird                 *)
VAR
  return: BOOLEAN;
ASM
  MOV  return, FALSE
  MOV  AX, 4409h                   (* DOS 4409h - IOCTL:  *)
  MOV  BL, Drive                   (* Device Local/Remote *)
  INT  21h
  JNS  @noerror                    (* CarryFlag gesetzt?  *)
  MOV  InOutRes, AX                (* IoResult setzen     *)
  JMP  @out
@noerror:
  AND  AX, 1000h                   (* AX = 1000h?         *)
  JNZ  @out                        (* ja --> Remote Drive *)
  MOV  return, TRUE
@out:
  MOV  AL, return
END;

END.

(*========================================================*)
(*                   Ende von DUPUTIL.PAS                 *)