Turbo Pascal FAQ
Dieses Helpfile enthält oft gefragte oder interressante Sachen
zum Thema Pascal. Die Programme und Units sollten mit jedem Turbo
Pascal Compiler ab V4.0 lauffähig sein. (Ausnahmen: Assembler und
Protected Mode Programme). Sollte ein Programm nicht lauffähig sein
oder sich sonst irgendwelche Fragen und Probleme ergeben, schreibt
bitte an einer der folgenden Adressen:
Andreas Schlechte@tu-clausthal.de
Für alle die, die kein Assembler mögen, oder die eine TP-Version haben die
kein Assembler kann, sind alle Assembler-Routinen noch in Normalform dabei.
Für alle Benutzer der Versionen <= TP 7.0 (Nicht BP 7.0) sind nur die
Real-Mode Routinen zu beachten.
Alle erwähnten Dateien/Archive sind auch übers
WWW zu erhalten.
Weiter mit:
Benutzungsrechte
Dieser Text darf ausdruecklich zu privaten Zwecken weitergegeben werden.
Jegliche gewerbliche Nutzung wie beispielweise (aber nicht ausschliesslich)
in Zeitschriften, ist ausdrücklich verboten. Jegliche Weitergabe muss
voellig kostenlos geschehen. Es duerfen keine Kopiergebuehren erhoben
werden. Der Text darf nur vollständig weitergegeben werden.
Inhaltsverzeichnis
Inhalt:
1 : Wie ermittle ich in Pascal ob ein Laufwerk gültig ist?
2 : Wie ist es möglich einen Tastendruck Softwaremäßig zu simulieren?
3 : Wie stelle ich fest, ob die Ausgabe eines Programmes umgeleitet wird?
4 : Wie bekomme ich im Programm heraus wieviel Speicher benutzt wird?
5 : Wie finde ich raus, ob QEMM aktiv ist oder nicht?
6 : Wie funktioniert File- und Record-Locking in TP?
7 : Wie kann ich in Turbo Pascal den Rechner booten?
8 : Wie ermittle ich den gängigen Prozessortyp?
9 : Wie führe ich ein Dos-Kommando aus ohne den Command.Com zu starten?
10 : Wie erkenne ich ob es sich bei einem Laufwerk um ein CD-Rom handelt?
11 : Wie lassen sich alte Tp-Units in das Format einer neuen Version
bringen?
12 : Wie stelle ich fest, ob sich ein Rechner im Protected Mode befindet?
13 : Was bedeutet das reservierte Wort INHERITED?
14 : Wie konvertiere ich eine Dezimalzahl in andere Typen (z.B Binär)
15 : Wie stelle ich fest, ob Share installiert ist?
16 : Wie kann ich in Turbo Pascal die F11 und F12 Taste abfragen??
17 : Wie kann ich die Erscheinung des Cursors verändern?
18 : Wie kann ich feststellen, ob es sich bei einem Laufwerk um ein
Netzwerklaufwerk handelt?
19 : Wie sind die Dateien der Hudson/QBBS/FD-MSGBases aufgebaut?
20 : Wie vertausche ich die Anschlüsse von LPT1 und LPT2?
21 : Wie leite ich Ausgaben von Programmen (via Exec gestartet) in ein
Fenster um?
22 : Wie kann ich 16 Hintergrundfarben darstellen?
23 : Wie kann mit TP die Caps- und Num-Lock Modi ein- bzw. ausschalten.
24 : Wie kann ich das Komma der Nummerntastatur in einen Punkt umwandeln?
25 : Wie läßt sich mit TP ein AT erkennen?
26 : Kann man mit TP festellen, ob SmartDrive bzw. Hyperdisk geladen ist?
27 : Wie kann ich die letzte Stelle vom Bildschirm beschreiben?
28 : Exec funktioniert nicht richtig, oder mach ich was falsch?
29 : Wie kann ich feststellen, wie viele Dateien ich noch öffnen kann?
30 : Wie kann ich in Turbo Pascal den Tasterturpuffer löschen?
31 : Wie kann ich mit der Soundblaster-Karte VOC,WAV,MOD-Files etc.
abspielen?
32 : Wie kann ich mit Borland Pascal 7.0 im Protected Mode swappen?
33 : Wie kann ich Strings schnell in Großbuchstaben umwandeln?
34 : Kann man für Protected Mode Programme Overlays erzeugen?
35 : Wie ermittle ich den Typ der installieren Videokarte?
36 : Wie erkenne ich ob eine ET3000/ET4000-Grafikkarte installiert ist.
37 : Wie fange ich Tastenkombis wie CTRL-Alt-Del und CTRL-Break ab?
38 : Wie kann ich den Midi-Port meiner SB-Pro-Karte programmieren?
39 : Wie kann ich bei einem DosShell den Prompt ändern?
40 : Wie kann ich den Bildschirm für Grafik und Text aufteilen?
41 : Wie kann ich mit TP einen Barcode auf einem DeskJet drucken?
42 : Wie kann ich mit TP dBase-Dateien lesen bzw schreiben?
43 : Wie kann ich mit Turbo-Pascal Daten (Arrays) kopieren/verschieben
ohne dies für jedes Element tun zu müssen?
44 : Wie kann ich in TP auf Daten eingebundener OBJ Files zugreifen?
45 : Gibt es keine Möglichkeit ein Pascal-Prg gegen kopieren zu schützen??
46 : Gibt es in TP die Möglichkeit, die Tastatur zu sperren?
47 : Was muß ich besonderes beachten bei Dos-Funktionen in Interrupts?
48 : Ist es in Turbo Pascal möglich Prozedurübergreifende Sprünge zu
machen?
49 : Wie kann ich Voc & Wave-Dateien auf dem PC-Speaker ausgeben??
50 : Wie gebe ich unter den verschiedenen Multitaskern Zeitscheiben frei?
51 : Wie kann ich unter TP meine Adlib-Soundkarte nutzen?
52 : Ich öffne eine untypisierte Datei mittels Reset.Beim Lesen mit
Blockread werden teilweise Variablen zerstört, oder der Rechner
stürzt ab. Was mache ich falsch?
53 : Beim Arbeiten mit mehreren Dateien bekomme ich öfter die Fehler-
meldung Nr 4. Too many files open. Was kann ich dagegen tun?
54 : Wie erkenne ich, welche Soundkarte auf einem Rechner installiert ist?
55 : Wie kann ich beim Beenden meines Programmes einen Fehlercode an Dos
übergeben?
56 : Wie erzeuge ich mit TP Arrays > 64 KB ??
57 : Wie kann ich es denn einfachst anstellen, dass ich mit WRITELN
ganz normale ANSI-Files anzeigen lassen kann??
58 : Was ist der Unterschied zwischen Realmode und Protected-Mode??
59 : Gibt es eine genauere Delay-Funktion, als die aus der CRT Unit?
60 : Wie kann ich in TP Potenzen berechnen?
61 : Gibt es empfehlenswerte Bücher zur Programmierung?
62 : Wie schicke ich Steuerzeichen zum Drucker?
63 : Wie arbeitet man mit dem VESA-Far-Pointer?
64 : Wie kann ich mit TP meine Maus ansteuern?
65 : Wie kann ich bei eine Exec Aufruf die Ausgabe abstellen?
66 : Wie berechne ich in Pascal Funktionen wie Arctan(x)?
67 : AUSZUG AUS DEM STRAFGESETZBUCH
68 : Wie kann ich auf meine Nodeliste von Pascal aus zugreifen?
69 : Wie kann ich in TP Bits in einer Variablen ändern?
70 : Wie kann ich in Pascal Daten packen und entpacken?
71 : Wie kann ich unter TP das CMOS auslesen?
72 : Wie wandle ich den Text einer Datei in Blocksatz um?
73 : Wie kann ich in TP die Tastaturwiederholrate setzen?
74 : Meine TP-Copyroutine versagt bei schreibgeschützten Dateien. Wo
liegt der Fehler?
75 : Wie kann ich ein einzelnes Zeichen aus einem String auslesen?
76 : Wie kann ich die Ausgabe meiner TP-Programme umleiten?
77 : Wie ermittle ich die Größe einer offenen Textdatei?
78 : Wie kann ich ein fertiges Programm in der CONFIG.SYS aufrufen?
79 : Wie berechne ich, wann Ostern ist?
80 : Wie kann ich, Records vergleichen ohne jedes Feld miteinander
vergleichen zu muessen ?
81 : Wie konvertiere ich ein Datum ins UNIX Format und zurück ?
82 : Wie berechne ich in TP Ellipsen und Kreise?
83 : Wie lösche ich alle Leerzeichen in einem String?
84 : Wie kann ich in TP die Seriennummer eines Dateträgers verändern?
85 : Verständnis-Frage zu IF-Abfragen.
86 : Worin liegt der Vorteil der Objektorientierten Programmierung?
87 : Wie schreibe ich unter TP ins Clipboard von Windows?
88 : Wie lese ich Dateien, die das Datei-Ende-Zeichen im Text enthalten?
89 : Wie kann ich die Ausgabe von Programmen, die mit Exec ausgeführt
werden, umleiten ?
90 : Wie kann ich einzelne Zeichen eines Strings ändern?
91 : Wie ändere ich unter TP die Attribute eines Verzeichnisses?
92 : Wie schalte ich in den Mode13 und zurück in den Textmodus?
93 : Kann man mit TP compilierte EXE-Dateien wieder in Quelltext
recompilieren?
94 : Wie definiert man Arrays, deren Grenzen erst zur Laufzeit
festgelegt werden ?
95 : Wie kann ich unter TP Umgebungsvariablen setzen?
96 : Wie fragt man denn die Pfeiltasten (Cursortasten) ab?
97 : Wie erkenne ich, ob ein Ansi-Treiber geladen ist?
98 : Wie ermittle ich das letzte gültige Laufwerk?
99 : Wie berechne ich den Wochentag eines Datums?
100 : Gibt es eine leichte Möglichkeit, meine Sourcen neu zu formatieren?
101 : Was sind Interrupts ?
102 : Wie finde ich alle Dateien in einem Verzeichnis und dessen Unterver-
zeichnissen?
103 : Wie komme ich an die Kommandozeile eines Programmes?
104 : Kann man die Graphiktreiber direkt in die EXE-Dateien einbauen?
105 : TP bietet ja mit Font8x8 die Möglichkeit den Modus auf 43/50 Zeilen
zu schalten. Warum klappt SetTextMode(Font8x8) nicht?
106 : Wie kann ich den ganzen Bildschirm auslesen?
107 : Was ist der Unterschied zwischen PChar und einem String ?
108 : Wie konvertiere ich einen String in Pchar und umgekehrt?
109 : Wie kann ich testen, ob eine Datei bereits geöffnet ist?
110 : Wie berechne ich den Unterschied zwischen zwei Zeiten?
111 : Was bedeutet der Kürzel BCD?
112 : Wie frage ich den Fehlercode eines aufgerufenen Programmes ab?
113 : Wie kann ich kurzzeitig die Tastertur abstellen?
114 : Wie kann ich in TP den Namen einer Diskette/Festplatte ändern?
115 : Wie kommt der Wert von 18.2 Aufrufe/Sek. für den INT 8 zustande?
116 : Wie berechne ich in Pascal die 3. Wurzel aus einer Zahl?
117 : Wo liegt der Untschied zwischen SeekEof und Eof?
118 : Wie wird die CMOS-CRC berechnet?
119 : Welche Modi kann ich für FileMode verwenden?
120 : Runtime Error 200 bei schnellen Rechnern!
Frage 1
F: Wie ermittle ich in Pascal ob ein Laufwerk gültig ist ?
A: Mit folgender Funktion läßt sich dieses ermitteln.
Achtung es wird nicht überprüft ob eine Diskette vorhanden
ist.
FUNCTION DriveValid(Drive: Char): Boolean; assembler;
asm
MOV AH,19H { aktuelles Laufwerk in BL sichern }
INT 21H
MOV BL,AL
MOV DL,Drive { Gegebenes Laufwerk wählen }
SUB DL,'A'
MOV AH,0EH
INT 21H
MOV AH,19H
INT 21H
MOV CX,0 { Nimm False an}
CMP AL,DL { Is das aktuelle LW das gegebene LW? }
JNE @@1
MOV CX,1 { Ja, also Lw gültig }
MOV DL,BL { Altes Laufwerk wieder anwählen }
MOV AH,0EH
INT 21H
@@1: XCHG AX,CX { Rückgabewert in AX }
END;
Frage 2
F: Wie ist es möglich einen Tastendruck softwaremäßig zu simulieren?
A: Es gibt hier allgemein gesehen zwei Möglichkeiten. Entweder man
nutzt die Bios-Funktionen, oder man schreibt direkt in den
Tasterturpuffer.
Mit der folgenden Procedure wird der entsprechende Tastencode
direkt in den Tastaturpuffer geschrieben. Als Taste muß ein
gültiger Scan-Code angegeben werden. (Enter entspricht $130D)
FUNCTION StoreKey(Taste:word):Boolean;
{ Schreibt den Code 'Taste' in den Tastaturpuffer.
Gibt FALSE zurueck, wenn der Tastaturpuffer
voll ist, sonst TRUE.
Diese Funktion ist bis auf den Rueckgabewert
mit der Funktion 5 des INT $16 des AT-BIOS identisch.
}
VAR KbdHead:word ABSOLUTE $40:$1A;
KbdTail:word ABSOLUTE $40:$1C;
KbdPos:word;
KbdOrg:word ABSOLUTE $40:$80;
KbdEnd:word ABSOLUTE $40:$82;
BEGIN
StoreKey:=TRUE;
ASM cli END;
KbdPos:=KbdTail+2;
IF KbdPos=KbdEnd THEN KbdPos:=KbdOrg;
IF KbdPos=KbdHead THEN { Puffer voll }
StoreKey:=FALSE
ELSE BEGIN
memw[$40:KbdTail]:=Taste;
KbdTail:=KbdPos;
END;
ASM sti END
END;
Jetzt noch eine Funktion, die die Bios-Funktionen nutzt:
FUNCTION StoreKey (key: word):Boolean; ASSEMBLER;
ASM
MOV CX, key
MOV AH, 5
INT $16
XOR AH,AH
XOR AL,1
END;
und ohne ASM:
FUNCTION StoreKey (key: word):Boolean;
VAR R:Registers;
BEGIN
R.CX := Key;
R.AH := 5;
Intr($16,R);
StoreKey := R.AL = 1;
END;
Frage 3
F: Wie stelle ich fest, ob die Ausgabe eines Programmes umgeleitet
wird ?
A: Dies läßt sich leicht über das "Program Segment Prefix" in
Erfahrung bringen.
CONST STDOUT = 1; { Standardausgabegerät (Eingabegerät STDIN = 0) }
FUNCTION Umgeleitet:Boolean;
BEGIN
Umgeleitet := Mem[PrefixSeg:$18+STDOUT] <> STDOUT;
END;
Frage 4
F: Wie bekomme ich im Programm heraus wieviel Speicher benutzt
wird ?
A: Auch diese Information läßt sich mit Hilfe des PSP in Erfahrung
bringen.
TYPE TMCB = RECORD { Memory Control Block }
MorZ : Char; {'Z'=letzter Block}
Dummy : Word;
SizeOfProgram : Word; { In 16 Byte Blöcken }
END;
PMCB = ^TMCB;
FUNCTION Bytes_used:Longint;
BEGIN
Bytes_Used := PMCB(PTR(System.PrefixSeg-1,0))^.SizeOfProgram
* LongInt(16);
END;
Frage 5
F: Wie finde ich raus, ob QEMM aktiv ist oder nicht ?
A: QEMM läßt sich mit Hilfe der folgenden Funktion aufspüren.
FUNCTION QEMM_Installed:Boolean;
Var R : Registers;
F : Text;
L : LongInt;
BEGIN
{$I-}
ASSIGN(F,'QEMM386$');
RESET(F);
FILLCHAR( R, SIZEOF(R), 0);
R.FLAGS := $FFFF;
IF IoResult = 0 THEN
WITH R DO
BEGIN
AX := $4402;
BX := TextRec(F).Handle;
CX := $0004;
DS := Seg(L);
DX := Ofs(L);
INTR ($21,R);
CLOSE(F);
END;
{$I+}
QEMM_Installed := (R.FLAGS AND FCARRY) =0
END;
Frage 6
F: Wie funktioniert File- und Record-Locking in TP?
A: Unter der Voraussetzung, daß SHARE.EXE oder ein anderer Treiber,
der Locking ermöglicht, geladen ist, kann mit der folgenden
Funktion ein beliebiger Ausschnitt einer Datei gesperrt werden.
Bei den Dateien muß jedoch der Shared-Modus gesetzt werden.
FILEMODE=$42 { Share Read&Write }
USES DOS;
FUNCTION Lock(VAR Datei:FILE; From,Size:LONGINT):BOOLEAN;
VAR Regs : REGISTERS;
BEGIN
WITH Regs DO
BEGIN
Ax:=$5c00;
Bx:=FILEREC(Datei).HANDLE;
Cx:=From SHR 16;
Dx:=From AND $ffff;
Si:=Size SHR 16;
Di:=Size AND $ffff;
MSDOS(Regs);
Lock:=Flags AND Fcarry = 0;
END;
END;
Das Entsperren geht folgendermaßen :
PROCEDURE Unlock(VAR Datei:FILE; From,Size:LONGINT);
VAR Regs : REGISTERS;
BEGIN
WITH Regs DO
BEGIN
Ax:=$5c01;
Bx:=FILEREC(Datei).HANDLE;
Cx:=from SHR 16;
Dx:=from AND $ffff;
Si:=Size SHR 16;
Di:=Size AND $ffff;
MSDOS(Regs);
END;
END;
Damit kann man natürlich auch die gesamte Datei sperren/freigeben :
Lockfile:=Lock(Datei,0,MAXLONGINT);
Unlock(Datei,0,MAXLONGINT);
Im übrigen kann ich die Unit TPNOV von Peter Schmid empfehlen.
Zu requesten bei 2:317/2 (0043-05223-44085) Inntal Connection
Austria das File TPNOV.ZIP (ca 5Kb)
Frage 7
F: Wie kann ich in Turbo Pascal den Rechner booten?
A: Die folgende Prozedur führt mit Boot(true) einen Cold Boot aus (mit
vollständigem Selbsttest), mit Boot(false) einen Warm Boot.
{$IFDEF DPMI} BP: !!! NUR REALMODE !!! {$ENDIF}
PROCEDURE Boot(Cold:BOOLEAN);
VAR P : PROCEDURE;
BootFlag : WORD ABSOLUTE $40:$72;
BEGIN
IF Cold THEN BootFlag:=0
ELSE BootFlag:=$1234;
@P:=PTR($F000,$FFF0);
INLINE($fa); { CLI }
P;
END;
Manche Leute meinen, daß der Aufruf des INT 19 auch einen Reset ausführt.
Dies ist jedoch meistens nicht der Fall, da der INT 19 nur ein Teil des
Bootvorganges ist.
Hierzu ein Auszug aus Ralph Browns Interruptliste :
INT 19 - SYSTEM - BOOTSTRAP LOADER
Desc: This interrupt reboots the system without clearing memory or
restoring interrupt vectors. Because interrupt vectors are
preserved, this interrupt usually causes a system hang if any
TSRs have hooked vectors from 00h through 1Ch, particularly
INT 08.
Notes: Usually, the BIOS will try to read sector 1, head 0, track 0 from
drive A: to 0000h:7C00h. If this fails, and a hard disk is
installed, the BIOS will read sector 1, head 0, track 0 of the
first hard disk. This sector should contain a master bootstrap
loader and a partition table. After loading the master boot
sector at 0000h:7C00h, the master bootstrap loader is given
control. It will scan the partition table for an active par-
tition, and will then load the operating system's bootstrap
loader (contained in the first sector of the active partition)
and give it control.
True IBM PCs and most clones issue an INT 18 if neither floppy
nor hard disk have a valid boot sector to accomplish a warm boot
equivalent to Ctrl-Alt-Del, store 1234h in 0040h:0072h and jump
to FFFFh:0000h. For a cold boot equivalent to a reset, store 0000h
at 0040h:0072h before jumping.
****************************************************************
DER INT 19h FUEHRT WEDER EINEN KALT- NOCH EINEN WARMSTART AUS!!!!
****************************************************************
Der Aufruf des INT 19h ist nur _ein Teil_ des Boot-Vorganges, naemlich
der letzte in einer Kette vieler Vorgaenge. INT 19h macht nicht mehr
und nicht weniger, als das DOS zu laden, _nachdem_ das BIOS folgendes
bereits erledigt hat:
- Selbsttest, falls Kaltstart auch Speichertest
- Konfigurationstest
- BIOS-Datensegment initialisiert
- Alle Controller initialisert
- Alle Interrupt-Handler auf die Default-Interrupt-Routinen im BIOS
gesetzt.
ERST DANN wird INT 19h vom BIOS aufgerufen. Und der macht dann folgendes:
- Gemaess Boot-Reihenfolge die Laufwerke nach einem gueltigen BOOT-Sector
abklappern
- Den BOOT-Sektor laden und die darin enthaltene BOOT-Strap-Routine
ausfuehren.
- Falls kein Boot-Sektor gefunden werden kann (Defekt, kein Laufwerk
oder so),
ruft das BIOS den INT 18h auf. Dieser springt beim Original-IBM in das
ROM-BASIC. Bei allen kompatiblen, die ein solches nicht haben, kommt
dann die Meldung "ROM-BASIC not present" oder so und die Kiste steht.
(Manche haben an der Stelle dann auch einen eingebauten Mini-Debugger.)
[Bis hierher fuer alle Betr.systeme auf'm PC, ab jetzt DOS-spezifisch]
- BOOT-Strap-Routine sucht nach IO.SYS und MSDOS.SYS auf der Platte/
Diskette und laedt selbige.
- MSDOS.SYS macht dann den Rest: CONFIG, AUTOEXEC laden usw.
Interessant ist auch die folgende Methode, die sich einfach
der ExitProc des Programmes bedient.
PROCEDURE Reboot;
BEGIN
ExitProc := Ptr ($ffff,0);
RunError (0);
END;
Bleibt noch, darauf hinzuweisen, das ein Reboot auch tragische Folgen
haben kann. Im Falle, daß ein Schreibcache aktiviert ist, können durch
die o.a. Art des Reboot Daten verloren gehen. Man sollte deshalb
sicherheitshalber einen Disk Reset durchführen. Jedes gute Cacheprogramm
lehrt in diesem Fall den Cache. Der Reset erfolgt durch den Aufruf von
Funktion 0 des INT $13:
PROCEDURE ResetDisk; ASSEMBLER;
ASM
MOV AH, $7F { All Disks }
INT $13
END;
bzw.
PROCEDURE ResetDisk;
VAR R:Registers;
BEGIN
R.AH := $7F;
Intr($13,R);
END;
Sicherheitshalber sollte auch noch ein kleiner Delay nach diesen Reset
eingefügt werden.
Frage 8
F: Wie ermittle ich den gängigen Prozessortyp ?
A: Die Function GetCPU ermittelt den arbeitenden CPU-Typ. Der
zurückgelieferte Code entspricht: (Eine weiter gute Routine
kann bei der MIB unter dem Namen CPUID.ARJ requestet werden)
0 - Intel 8088 1 - Intel 8086
2 - NEC V20 3 - NEC V30
4 - Intel 80188 5 - Intel 80186
6 - Intel 80286 7 - Intel 80386
8 - Intel 80486 9 - Intel Pentium
FUNCTION GetCpu: BYTE; ASSEMBLER;
CONST Processor: Byte= $FF; { Ergebnis fuer spaeter merken }
ASM
mov al, processor
cmp al, 0FFh { haben wir schon mal getestet? }
jne @get_out { ja, also nicht schon wieder... }
{ TEST 80(1)86/(1)88/NEC VS. 80286+ }
pushf
xor bx,bx
push bx
popf
pushf
pop bx
and bx,0F000h
cmp bx,0F000h
je @no286
{ TEST 80286 VS. 80386+ }
mov bx,07000h
push bx
popf
pushf
pop bx
and bx,07000h
jne @test486
mov dl,6
jmp @end
{ TEST 80386 VS. 80486+ }
@test486:
mov dl,7
xor si,si
mov ax,cs
{$IFDEF DPMI}
add ax,SelectorInc { use alias segment selector }
{$ENDIF}
mov es,ax
mov byte ptr es:[@queue486+11], 46h { 46h == "INC SI" }
@queue486:
nop; nop; nop; nop; nop; nop; nop; nop; nop; nop; nop; nop
or si,si
jnz @end
{ TEST 80486 VS. PENTIUM }
inc dl
db 66h ; pushf { pushfd }
db 66h ; pushf { pushfd }
db 66h ; pop ax { pop eax }
db 66h ; mov cx,ax { mov ecx,eax }
db 66h,35h
db 00h,00h,20h,00h { xor eax,(1 shl 21) (Pentium ID flag) }
db 66h ; push ax { push eax }
db 66h ; popf { popfd }
db 66h ; pushf { pushfd }
db 66h ; pop ax { pop eax }
db 66h,25h
db 00h,00h,20h,00h { and eax,(1 shl 21) }
db 66h,81h,0E1h
db 00h,00h,20h,00h { and ecx,(1 shl 21) }
db 66h ; cmp ax,cx { cmp eax,ecx }
je @is486
inc dl
@is486:
db 66h ; popf { popfd }
jmp @end
@no286:
{ TEST IF 80188/186 }
mov dl,5
mov al,0FFh
mov cl,21h
shr al,cl
jnz @testdatabus
{ TEST 8088/86 VS. NEC V20/30 }
mov dl,2
sti
xor si,si
mov cx,0FFFFh
{$IFDEF DPMI} { muss eigtl. gar nicht sein, }
push es { XTs koennen eh kein DPMI ;-) }
push ds
pop es { Notloesung; kann schiefgehn... }
{$ENDIF}
rep seges lodsb { == rep lods byte ptr es:[si] }
{$IFDEF DPMI}
pop es
{$ENDIF}
or cx,cx
jz @testdatabus
mov dl,1 { argh. intel 8088/86 inside... }
@testdatabus:
{ TEST 8 BIT DATA BUS (80(1)88/NEC V30) VS. 16 BIT (80(1)86/V20) }
push cs
{$IFDEF DPMI}
pop ax
add ax,SelectorInc { use alias segment selector }
mov es,ax
{$ELSE}
pop es
{$ENDIF}
xor bx,bx
std
mov al,90h
mov cx,3
call @ip2di
cli
rep stosb
cld
nop; nop; nop
inc bx
nop
sti
or bx,bx
jz @end { v20 or 8086 or 80186 }
cmp dl,1
je @its8088
cmp dl,2
je @itsV30
cmp dl,5
jne @end
dec dl
jmp @end
@its8088:
dec dl
jmp @end
@itsV30:
inc dl
jmp @end
@ip2di:
pop di
push di
add di,9
retn
@end:
popf
mov al,dl
mov processor,al
@get_out:
End;
Frage 9
F: Wie führe ich ein Dos-Kommando aus ohne den Command.Com zu starten ?
A: Dazu gibt es eine Funktion ab Dos 2.0, die über den Interrupt 2E
aufgerufen wird.
PROGRAM ExecCommand;
{ Fuer ein Commando ueber COMMAND.COM aus OHNE ihn zu laden !
(c)1993 by Ulrich Schlechte }
{$M 20384,0,0}
CONST ss_save : WORD = 0; { Wird in DoCommand gebraucht, da INT 2eh
SS und SP zerstoert. Konstanten liegen im
Codesegment }
sp_save : WORD = 0;
FUNCTION DoCommand ( Param : STRING) : INTEGER; ASSEMBLER;
ASM
PUSH BP { Register retten }
PUSH SP
PUSH SS
PUSH DS
PUSH SI
LDS SI,param { DS:SI -> Param }
MOV CS:SS_SAVE,SS { SS und SP ins Codesegment sichern }
MOV CS:SP_Save,SP
INT 2eh { undokumentierte Function Exec-Command }
STI
JB @Error { Fehler ? }
XOR AX,AX
@Error:
CLI
MOV SS,CS:SS_SAVE { Register zurueckholen }
MOV SP,CS:SP_SAVE
POP SI
POP DS
POP SS
POP SP
POP BP
END;
VAR Result : INTEGER; { Ergebnis }
Command : STRING; { Commando an COMMAND.COM }
BEGIN
Command:='Mem /DEBUG';
{ Befehl wie er von der Tastatur kommen wuerde }
Command[Length(Command)+1]:=#13;
{ Das Commando MUSS mit CR abgeschlossen werden. Das CR wird NICHT
im Laengenbyte gezaehlt ! }
Result := DoCommand(Command);
END.
Frage 10
F: Wie erkenne ich ob es sich bei einem Laufwerk um ein CD-Rom
handelt ?
A: Folgende Funktion liefer TRUE zurück, wenn dies der Fall ist.
Uses DOS;
FUNCTION Is_CDROM(Drv : Char):BOOLEAN;
VAR R : Registers;
CDR: string;
cnt: byte;
BEGIN
Is_CDROM := false;
CDR := '';
WITH R DO
BEGIN
AX := $1500;
BX := $0000;
CX := $0000;
Intr( $2F, R );
IF BX > 0 THEN
BEGIN
FOR cnt := 0 TO (bx-1) DO
CDR := CDR +CHAR( CL + Byte('A') + cnt );
END;
Is_CDROM := POS( upcase(Drv), CDR ) > 0
END
END;
Frage 11
F: Ich habe mehrere .TPU Files von einer alten Turbo Pascal Version. Kann
ich diese in einer neueren Version von TP benutzen ? (z.B. 5.0 -> 5.5)
A: Nein, wenn das versucht wird, so wird der Compiler sich mit der Fehler-
meldung 72: "Unit file format error" melden. Man muß im Besitz des
Source-Codes sein und diese Unit neu kompilieren, damit Turbo Pascal sie
akzeptiert. Ohne den Source-Code muß leider auf diese Unit verzichtet
werden.
F: Warum nicht ?
A: Alle TPU Files sind versionsabhängig. Die Syntax der Sprache ändert sich,
und damit auch das Format der TPUs.
Im Gegensatz zu anderen Compilern, die .OBJ -Dateien erstellen, begann
TP mit der Version 4.0 mit den Modulen (Units), die als .TPU Files
generiert werden. Dieses bietet Vorteile gegenüber OBJ-Dateien.
Im Compiler selbst ist eine Tabelle, die auf die Einsprünge der Unit
SYSTEM.TPU verweist. Ein Konstrukt wie folgt, würde mehrere Aufrufe
von Routinen aus der Run-Time-Library (RLE) erzeugen:
WriteLn(Boolean(1 = 2), AnInteger:3, AReal:2:2, 'text');
Diese Routinen sind vom Compiler bekannt - nicht mit Namen - aber
mit einer Art Nummer. D.h. es gibt in der RLE keine Routine, die
Writeln heißt, aber es gibt eine Routine, die ein Boolschen Wert aus-
gibt, eine Routine für Integer etc.
Die Einträge in der Tabelle (können) von Version zu Version variieren,
soger ganz verschwinden, oder ersetzt werden durch neuere. Zum Beispiel:
von TP 4.0 - 6.0 kopierte Routine #18 einen String, in BP 7.0 wird
dies durch eine INLINE-Codierung übernommen. Die Routine #18 wird nun
aufgerufen um Überläufe zu erkennen, wenn {$Q+} angegeben wird.
F: Gibt es eine Möglichkeit oder ein Programm, daß .TPU Files für neuere
Versionen konvertieren kann?
A: IMHO gibt es kein solches Programm. Theoretisch wäre es möglich, ein
solches Programm zu entwickeln, allerdings wird dies wirklich nicht
benötigt. Dies mag überraschen, aber die "richtigen" Programmierer
sind der Meinung, daß solche Units, die ohne Source-Code geliefert
werden oft ihr Geld nicht wert sind.
Außerdem dürfte es sehr schwer werden, dieses Programm zu entwickeln,
da Borland noch nicht den Aufbau des TPU-Format bekannt gegeben hat.
Fazit: Leider ist das Konvertieren von alten TPUs nicht möglich, da
z.T. gravierende Änderungen am Linker von TP gemacht worden sind.
Das einizige was immer hilft: Der Source ;-)
Frage 12
F: Wie stelle ich fest, ob sich ein Rechner im Protected Mode
befindet?
A: Dies läßt sich mit Hilfe des MSW (Machine Status Word) feststellen.
FUNCTION ProtectedMode:Boolean; ASSEMBLER;
ASM
XOR AX,AX
{ Teste CPU auf < 286 }
PUSH SP
POP BX
CMP BX,SP
JMP @CPU86
{ CPU >= 286, hole MSW }
DB $0F, $01, $E0 { SMSW AX }
AND AX,1
@CPU86:
END;
Frage 13
F: Was bedeutet das reservierte Wort INHERITED ?
A: Das reservierte Wort INHERITED ist dazu da (Objektorientierte
Programmierung) beim Aufruf einer Methode den direkten Vorfahren
eines Objektes aufzurufen.
Beispiel :
Var Count:Integer;
Type TMyStringCollection=Object(TStringCollection)
Procedure Insert(Item:Pointer); VIRTUAL;
END;
PROCEDURE TMyStringCollection.Insert(Item:Pointer);
Var Index:Integer;
BEGIN
If Search(Item,Index) Then
BEGIN
Inc(Count);
DisposeStr(PString(Item));
END
ELSE INHERITED Insert(Item);
{ ruft also TStringCollection.Insert auf }
END;
Wird nun als Vorfahre ein anderes Object eingesetzt als
TStringCollection, so wird automatisch dessen Insert-
Methode aufgerufen.
Frage 14
F: Wie konvertiere ich eine Dezimalzahl in andere Typen (z.B Binär)
A: Mit der folgenden Funktion kann man alle Typen erreichen, die eine
Basis haben, die kleiner ist als 17.
z.B: DezConvert (13,2) -> '1101' Binärdarstellung
DezConvert (13,8) -> '15' Oktaldarstellung
DezConvert (13,16) -> 'C' Hexadezimaldarst.
FUNCTION DezConvert (Zahl : LongInt; Basis : Byte) : String;
CONST HexStr : STRING[16]='0123456789ABCDEF';
VAR HlpStr : STRING;
BEGIN
IF Zahl=0 THEN HlpStr:='0' ELSE HlpStr := '';
WHILE Zahl <> 0 DO
BEGIN
HlpStr := HexStr [(Zahl MOD Basis)+1]+HlpStr;
Zahl := Zahl DIV Basis;
END;
DezConvert := HlpStr;
END;
Frage 15
F: Wie stelle ich fest, ob Share installiert ist ?
A: Das geht über den Interrupt $2F Funktionsnummer $1000.
FUNCTION ShareAvail:Boolean; ASSEMBLER;
ASM
MOV AX,$1000 { s. Tabelle unten }
INT $2F { Multiplexor Interrupt }
CMP AL,$FF { $FF wenn Share installiert ist }
JNE @NO { Share ist nicht inst. }
MOV AX,1 { 1 für True nach AX }
JMP @Out
@NO: XOR AX,AX { AX löschen für FALSE }
@OUT:
END;
Folgende Werte für AX entsprechen den Programmen :
$0600 Assign $0800 Driver.Sys $1000 Share
$1600 Windows 386 $1A00 Ansi.Sys (4.0+) $1B00 XMA2EMS.Sys
$4300 Himem XMS-Treiber $7A00 Novell Netw. IPX $AD00 Display.SYS
$B700 Append (3.3+)
In Klammern die minimale Dosversion, falls dies bekannt ist.
Weiteres zu ANSI.SYS unter Frage 97.
Frage 16
F: Wie kann ich in Turbo Pascal die F11 und F12 Taste abfragen ??
A: Die Tasten kann man mit Hilfe des Tastaturinterrupts ($16) und
der Funktion $10 abfragen.
FUNCTION ReadChar: Word; | FUNCTION ReadChar: Word; Assembler;
Var Regs:Registers; | ASM
BEGIN | MOV AX,$1000
Regs.AH := $10; | INT $16
Intr( $16, Regs); | CMP AL,$E0
IF (AL=$E0) AND (AH<>0) | JNE @exit
THEN AL:=0; | CMP AH,0
ReadChar := Regs.AX; | JE @exit
END; | MOV AL,0
| @exit:
| END;
Diese Funktion liefert für jede Taste ein WORD zurück. Für
F11 ist dies 34048 (für F12 - 34304). Dies Scancodes sind
die gleichen, wie die kbXXXX Konstanten aus der Drivers-Unit.
Wenn man aber trotzdem mit ReadKey und Keypressed weiterarbeiten will
und moechte, dass bereits geschriebene auf ReadKey und KeyPressed ba-
sierende Funktionen mit erweiterter Funktionalitaet weiterverwendet
werden koennen, bietet sich eine andere Loesung an, und zwar das Ueber-
laden von CRT.ReadKey und CRT.KeyPressed.
Das neue ReadKey endet mit einem Einsprung in CRT.ReadKey, um volle
Kompatibilitaet des -handlings zu gewaehrleisten.
{********************************************************
* Substitution for CRT.ReadKey and CRT.KeyPressed *
* using INT $16, functions $10 and $11 in order to *
* detect MFII-Scancodes. *
* *
* This version is probably compatible with existing *
* software written for CRT.Readkey and CRT.KeyPressed *
* with Turbo Pascal 6.0 and 7.0. *
* *
* It depends on the code of CRT.ReadKey. It won't work, *
* if Borland will change CRT-ReadKey in further *
* versions. *
* *
* If you are using CRT, too, you have to use ExtKey *
* AFTER Crt, i.e. *
* uses *
* CRT, ExtKey; *
* *
* You still may access CRT.ReadKey and CRT.KeyPressed *
* *
* Horst Kraemer 2:2410/121.16@fidonet.org *
* 13.09.91 *
*********************************************************}
UNIT ExtKey;
{$S-}
INTERFACE
USES CRT;
FUNCTION ReadKey:Char;
FUNCTION KeyPressed:Boolean;
IMPLEMENTATION
CONST scancode : Char = #0;
{ this variable must be global to the module }
FUNCTION ReadKey; ASSEMBLER;
{
This function does what CRT.ReadKey would do, except that it uses
function 10h of int 16h. As function 10h does not destroy codes
XYE0 ( XY<>0 ) which represent extended codes produced by the
cursor block, the translation to XY00 except for 00E0 has to be
done here.
}
ASM
XOR AL,AL
XCHG AL,ScanCode { new default: no scancode pending }
OR AL,AL { old scancode pending ? }
JNZ @Exit { if yes, return it }
MOV AH,10h { call extended bios function }
INT 16h
CMP AL,0E0h { is it pseudo-ascii: cursor block ? }
JNE @ChkScan { no, check for no-ASCIIs }
OR AH,AH { is it greek 'Alpha' 00E0 ? }
JZ @Exit { if yes, exit }
XOR AL,AL { replace $E0 by 0 }
@ChkScan:
OR AL,AL { extended keycode ? }
JNE @Exit { if no, exit }
MOV ScanCode,AH { store scancode }
OR AH,AH { is it 0 too ? }
JNE @Exit { if no, exit }
MOV AL,3 { CtrlBreak, return ^C }
@Exit: JMP CRT.ReadKey+1Eh { jmp to CRT's CtrlBreak test entry }
END;
FUNCTION KeyPressed;ASSEMBLER;
{
this function does what CRT.KeyPressed would do,
except that it reports keystrokes ignored by
function 01 of int 16h.
}
ASM
{ check for hi-byte pending
from last call to ReadKey }
CMP ScanCode,0
JNE @True
MOV AH,11h
INT 16h
MOV AL,FALSE
JE @Exit
@True:
MOV AL,TRUE
@Exit:
END;
END.
Frage 17
F: Wie kann ich die Erscheinung des Cursors verändern ?
A: Mit dem Videointerrupt $10 Funktion $01 läßt sich die Form ändern.
Hier elementare Funktionen.
PROCEDURE CursorOff; | PROCEDURE CursorOff; Assembler;
VAR Regs:Registers; | ASM
BEGIN | MOV AX,$0F00
Regs.Ax:=$0F00; | INT 10h
INTR($10,Regs); | CMP AL,$07
IF Regs.AL=7 THEN | JE @MONO
Regs.CX:=$2000 | MOV CX,$2000
ELSE | JMP @OTHER
Regs.CX:=$3000; | @MONO: MOV CX,$3000
Regs.AX:=$0100; | @Other: MOV AX,$0100
INTR($10,Regs); | INT 10h
END; | END;
PROCEDURE CursorBlock; | PROCEDURE CursorBlock; Assembler;
Var Regs:Registers; | ASM
BEGIN | MOV AX,$0F00
Regs.AX:=$0F00; | INT 10h
INTR($10,Regs); | CMP AL,$07
IF Regs.AL=7 THEN | JE @MONO
Regs.CX:=$0007 | MOV CX,$0007
ELSE | JMP @OTHER
Regs.CX:=$000C; | @MONO: MOV CX,$000C
Regs.AX:=$0100; | @Other: MOV AX,$0100
INTR($10,Regs); | INT 10h
END; | END;
PROCEDURE CursorNorm; | PROCEDURE CursorNorm; Assembler;
Var Regs:Registers; | ASM
BEGIN | MOV AX,$0F00
Regs.AX:=$0F00; | INT 10h
INTR($10,Regs); | CMP AL,$07
IF Regs.AL=7 THEN | JE @MONO
Regs.CX:=$0607 | MOV CX,$0607
ELSE | JMP @OTHER
Regs.CX:=$0B0C; | @MONO: MOV CX,$0B0C
Regs.AX:=$0100; | @Other: MOV AX,$0100
INTR($10,Regs); | INT 10h
END; | END;
Durch verändern der Werte von CX lässt sich die Form ändern.
Frage 18
F: Wie kann ich feststellen, ob es sich bei einem Laufwerk um ein Netzwerk-
laufwerk handelt ?
A: Über den MSDos Interrupt IOCTL ($44) Funktion 9 Device Remote Test.
Eingabe BL=Laufwerk. Ausgabe : Bit 12 gesetzt dann Netzlaufwerk
FUNCTION NetDrive (Drive:BYTE):BOOLEAN; { 0 = Current; 1 = A ...}
VAR Regs : REGISTERS;
BEGIN
Regs.AX:=$4409;
Regs.BX:=Drive;
INTR($21,Regs);
IF (Regs.Flags AND FCarry ) <> FCarry THEN
NetDrive:= ( Regs.AX and $4000= $4000 )
ELSE
NetDrive:=FALSE;
END;
FUNCTION NetDrive (Drive:BYTE):BOOLEAN; Assembler;
ASM { 0 = Current; 1 = A ...}
MOV AX,$4409
MOV BL,Drive
INT 21H
JC @NONET
AND AX,$4000
CMP AX,$4000
JNE @NONET
MOV AX,$0001
JMP @OUT
@NONET: XOR AX,AX
@OUT:
END;
Frage 19
F: Wie sind die Dateien der Hudson/QBBS/FD-MSGBases aufgebaut ?
A: Hier eine kleine Dokumentation zum Aufbau:
The little programers guide to the hudsonbase
---------------------=*=---------------------
Was Sie schon immer über die
Strukturen der Hudson-Messagebase
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
wissen wollten -
bisher aber nicht zu fragen wagten ...
----------------------------------------------------------------------------
DIE DATEIEN
~~~~~~~~~~~
Die Messagebase besteht aus fünf Dateien, in denen alle Mails aller Areas
gespeichert werden (ausser den Mailer *.MSG's natürlich):
MSGINFO .BBS MSG-Anzahl in den Boards (höchste,niedrigste,gesamt)
MSGIDX .BBS Message Nr x gehört zu Board y
MSGHDR .BBS Anschriftenteil der MSG's (BY:XX, TO:XX, RE:XX, Flags ..)
MSGTXT .BBS Der eigentliche Text (ohne BY:, TO:, etc.)
MSGTOIDX.BBS Indexdatei für TO:xxx, enthält Namen bzw. *Received*
Die Messagebase arbeitet nicht mit den Namen der Echoboards, sondern
organisiert sich ausschließlich mit den Board-Nummern (1 - 200). Boardnamen
werden nur vom Tosser/Scanner verwendet - der damit die Zuordnung zu der vom
SysOp definierten Boardnummer aufbaut (zB: REQUEST.GER = Board# 100). Die
fünf Dateien enthalten also KEINE Boardnamen (ausser bei Fehlern :-).
VARIABLENAUFBAU
~~~~~~~~~~~~~~~
Folgende Variablenarten werden verwendet (Pascal-Strukturen):
1-Byte-Zeiger = Byte = ASCII 0 bis ASCII 255
2-Byte-Zeiger = Integer = LSB,MSB
String = PASCSTRG = [LängenByte]TEXT
DIE STRUKTUREN
~~~~~~~~~~~~~~
MSGINFO.BBS
===========
Randomdatei mit Satzlänge 2
Satzanzahl immer 203
Bedeutung: Enthält die Gesamtzahl der Messages und die Zahl in den
einzelnen Boards. Damit kann zB. ein MSG-Editor anzeigen
wieviele Nachrichten in einem Board liegen.
Satzaufbau:
InfoRecord = Record
LowMsg: Integer;
HighMsg: Integer;
TotalActive: Integer;
ActiveMsgs: Array[1..200] of Integer;
End;
Felder: Also, alles 2-Byte-Zeiger:
(Low)(High)(Total)(Area1)(Area2)(Area3)(Area...200)
2 2 2 2 2 2 ... = 406 Byte
Alle Zeigerwerte liegen zwischen 1 und 32768.
Low = Niedrigste Nr aller aktiven MSG's
High = Höchste Nr aller aktiven MSG's
Total = Anzahl aller aktiven MSG's
AreaX = Anzahl der aktiven MSG's in Area 1 - 200
(aktiv=ungelöscht=ohne Löschvermerk)
Hinweis: Manche Tosser verdoppeln diesen Dateiinhalt indem sie aus
Sicherheitsgründen die Gesamtstruktur zweimal hintereinander anlegen:
(Low)(High)(Total)(Area1)(Area2)(Area..200)(Low)(High)(Total)(Area1)...
^^^^^^^^^^^^^^^^^^^^^^^^...
Dann ist die MSGINFO.BBS = 812 Byte groß. Gültig sind aber nur die
ersten 406 Byte.
MSGIDX.BBS
==========
Randomdatei mit Satzlänge 3
Je Message existiert ein Satz.
Bedeutung: Hält für jede Message(-Nr) fest zu welchem Board sie
gehört. Damit findet ein Editor beim Weiterschalten die
jeweils nächste oder vorige Message in einem Board.
Satzaufbau:
IdxRecord = Record
MsgNum: Integer;
Board: Byte;
End;
Felder: Also 2-Byte-Zeiger plus 1-Byte-Zeiger:
(MSG-Nr) (Board)
2 1 = 3
MSG-Nr zwischen 1 und 32768
Board zwischen 1 und 200
MSGHDR.BBS
==========
Randomdatei mit Satzlänge 187
Je Message existiert ein Satz.
Bedeutung: Enthält den gesamten Message-Header, incl. aller Angaben
zu Sender, Empfänger, Nodeadressen, etc.
Ebenso einen Zeiger auf den eigentlichen Messagetext.
Satzaufbau:
Bytes
HdrRecord = Record
MsgNum, Integer 2
ReplyTo, Integer 2
SeeAlsoNum, Integer 2
TimesRead: Integer { Not used } 2
StartRec: Word 2
NumRecs, Integer 2
DestNet, Integer 2
DestNode, Integer 2
OrigNet, Integer 2
OrigNode: Integer 2
DestZone, Byte 1
OrigZone: Byte 1
Cost: Integer 2
MsgAttr, Byte 1
NetAttr, Byte 1
Board: Byte 1
PostTime: String[5] 6
PostDate: String[8] 9
WhoTo, String[35] 36
WhoFrom: String[35] 36
Subj: String[72] 73
End;
Felder: Alle Strings sind in der Form "[Längenbyte]Text" aufgebaut.
MsgNum - Fortlaufende Nummer 1 - 32768
ReplyTo - Rück-Verweis (Verkettung zurück) auf
Msg Nr xx oder 0
SeeAlsoNum - Vor-Verweis (Verkettung vorwärts) auf
Msg Nr xx oder 0
StartRec - ist als WORD aufgebaut und enthält die
Blocknummer bei der der Messagetext in
der MSGTXT.BBS beginnt.
NumRecs - Anzahl der Blöcke die die Message in der
MSGTXT.BBS belegt.
DestNet/
Node/Zone - Bei Netmails Ziel-Zone, -Node und -Netz
OrgNet/
Node/Zone - Bei Netmails Origin-Zone, -Node und Netz
Cost - Kostenkennung der Mail
MsgAttr - Msg Attributes:
Bit 0: Deleted
Bit 1: Unsent net mail message
Bit 2: Net mail message
Bit 3: Private message
Bit 4: Received
Bit 5: Unsent echomail message
Bit 6: Local message
Bit 7: Not used
NetAttr - Net Attributes:
Bit 0: Kill after sent
Bit 1: Sent OK
Bit 2: File attach
Bit 3: Crash mail
Bit 4: Request Receipt
Bit 5: Audit Request
Bit 6: Is a Return Receipt
Bit 7: Not used
Dieses Byte wird nur bei Netmails verwendet.
Board - Boardnummer, Board zu dem die Msg gehört
PostTime - Uhrzeit der Msg, in der Stringform:
12:45 Uhr => (ASCII_5)12:45
PostDate - Datum der Msg, als Monat-Tag-Jahr:
24.06.92 => (ASCII_8)06-24-92
WhoTo - Empfängername in Stringform
WhoFrom - Ansendername in Stringform
Subj - Betreff in Stringform
MSGTXT.BBS
==========
Randomdatei mit Satzlänge 256.
Pro Message existieren unterschiedlich viele Sätze.
Bedeutung: Enthält den Messagetext - und NUR den Text.
Satzaufbau: Messagetext in 256-Byte-Blöcken:
Byte 1 = Blocklänge (1 bis 255)
Byte 2 - 256 = Text
Ein Text der zB. 300 Byte lang ist, wird dann so gespeichert:
Block 1 (ASCII_255) + die ersten 255 Byte Text
Block 2 (ASCII_45) + die restlichen 45 Byte Text
Der Rest des 2.Blocks bleibt leer.
Block 3 (LängenByte ... der nächsten Nachricht ...
Für jede Message existieren also unterschiedlich viele
Blöcke. Bei welchem Block die Message beginnt und wieviele
Blöcke sie belegt, steht im zugehörigen Satz der
MSGHDR.BBS (-StartRec-, -NumRegs-).
Hinweis: Das gelegentlich _IM_ Text vorkommende ASCII 141 »ì« dient
als Soft-Return und hat sonst keine Bedeutung.
MSGTOIDX.BBS
============
Randomdatei mit Satzlänge 36 Byte.
Für jede Message existiert ein Satz.
Bedeutung: Lesemerker für die User. Ein Editor oder BBS ermittelt
hiermit, welche ungelesenen Mails an den jeweiligen User
noch vorhanden sind.
Satzaufbau:
ToIndex = Record
WhoTo: String[35]
End;
Felder: Also: Byte 1 = Textlänge
Byte 2 - 36 = Name des Message-Empfängers
Wurde die Mail vom User gelesen, dann steht anschließend in
Byte 2-36 nicht mehr der Username, sondern "* Received *"
Beispiel: Empfänger heißt "Hans Huber" = 10 Zeichen
(ASCII_10)Hans Huber
nach dem Lesen:
(ASCII_12)* Received *
ZUSAMMENSPIEL
~~~~~~~~~~~~~
Die fünf Dateien hängen nach folgendem Schema von einander ab:
Ú---> Empfängername als Kopie in MSGTOIDX.BBS
|
Ú---> Header in MSGHDR.BBS
|
Message >-----> Text in MSGTXT.BBS
|
À---> BoardNr in MSGIDX.BBS
|
À---> Gesamtzahl und Anzahl/Board in MSGINFO.BBS
Die Ordnungsfolge der Datensätze folgender Dateien entspricht einander:
1. Satz in MSGHDR.BBS -
- gehört zu 1. Satz in MSGIDX.BBS -
- gehört zu 1. Satz in MSGTOIDX.BBS
(MSGTXT.BBS und MSGINFO.BBS sind logischerweise nicht so zuzuordnen.)
WIE LESE ICH NUN EINE MESSAGE AUS DER BASE?
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Nehmen wir zB. Messagenummer 452
a) Satz 452 aus MSGHDR.BBS lesen,
BY:, TO:, RE:, etc extrahieren,
b) Feld -StartRec- auslesen,
Feld -NumRecs- auslesen
c) In der MSGTXT ab dem Block (StartRec) lesen,
undzwar (NumRecs) Blöcke lang.
Und schon haben wir die Mail!
MSGHDR.BBS MSGTXT.BBS
... ...
-StartRec- -NumRecs- (ASCII_60)textetxtetxtet.
ÈÍÍÍÍÍÍÍÍÍÍÍØÍÍÍÍÍÍÍ(ab hier)ÍÍÍÍÍ>Ú (ASCII_255)Texttxtetxtetxtextte
ÀŽŽŽŽŽŽŽŽ(zB. 4)ŽŽŽŽŽŽŽ (ASCII_255)textetxtetxtetxtetxt
à (ASCII_255)textetxtetxtetxtetxt
À (ASCII_50)textetxtet.
(ASCII_255)Textetxtetxtetxtetxt
...
Zeilenumbrüche sind entweder als Hardreturn ASCII_13 (CR) oder als
Softreturn ASCII_141 (ì) im Text enthalten:
( soll ASCII_13 darstellen)
"ðHallo, das ist eine erste Zeileìund das die zweiteund hier die dritte..."
^ ^ ^
ÀŽ Längenbyte ÀŽ Zeilenumbrüche ŽÙ
-----------------------------------------------------------------------------
The little programers guide to the hudsonbase.
* Origin: Munich, 15.09.92
-Rainer-
(2:246/54)
Frage 20
F: Wie vertausche ich die Anschlüsse von LPT1 und LPT2 ?
A: Die Adressen der Ports stehen im Bios-Datensegment an den Adressen
$0008 und $000A.
PROCEDURE SWAPLPT;
VAR P1 : WORD ABSOLUTE $0040:$0008;
P2 : WORD ABSOLUTE $0040:$000A;
HlpWord : WORD;
BEGIN
HlpWord:=P1;
P1:=P2;
P2:=HlpWord;
END;
Frage 21
F: Wie leite ich Ausgaben von Programmen (via Exec gestartet) in ein
Fenster um ?
A: Der Interrupt $29 wird bei Bildschirmausgaben aufgerufen. Also kann man
durch eine Umleitung des Interrupts die Ausgabe auf einen Teil des
Bildschirms beschränken.
{$M 1024,0,0}
USES Crt, Dos;
PROCEDURE NewInt29(Flags,CS,IP,AX,BX,CX,DX,SI,DI,DS,ES,BP : Word);
INTERRUPT;
BEGIN
WRITE(Char(Lo(AX))); { Write schreibt mittels CRT }
END; { automatisch nur in das Fenster }
VAR ORGINT29 : Pointer;
BEGIN
GetIntVec($29, OrgINT29);
SetIntVec($29, @NewInt29); { AUSABE Umleiten }
Window(10, 5, 70, 15); { Fenster begrenzen }
ClrScr; { Fenster löschen }
SwapVectors;
Exec(GetEnv('COMSPEC'), '/C DIR /P'); { Command.Com starten }
SwapVectors;
SetIntVec($29, OrgInt29); { Orginal wieder herstellen }
Window(1,1,80,25);
END.
Frage 22
F: Wie kann ich 16 Hintergrundfarben darstellen ?
A: Man kann mit der Funktion 3 des VideoInterrupts $10 den Status des Bits
ändern, daß für das Blinken zuständig ist. Will man 16 Hintergrundfarben
darstellen, so ist es nicht möglich, gleichzeitig blinkenden Text darzu-
stellen.
PROCEDURE SetBlinkBit(Blinken:Boolean);
VAR Regs : registers;
BEGIN
Regs.ax:=$1003;
Regs.bl:=BYTE(Blinken);
Intr($10,Regs);
END;
PROCEDURE SetBlinkBit(Blinken:Boolean);ASSEMBLER;
ASM
MOV AX,$1003
MOV BL,Blinken
INT 10h
END;
SetBlinkBit(True) -> Blinkender Text möglich
SetBlinkBit(False) -> 16 Hintergrundfarben darstellbar
Und hier die angestaubten Varianten für CGA und Hercules:
Hercules: Port[$3b8] := $09; {heller Hintergrund + Seite 0 + Text}
CGA: Port[$3d8] := $09; {heller Hintergrund + Farbe + Text + 80x25}
Frage 23
F: Wie kann mit TP die Caps-Lock und Num-Lock Modi ein- bzw. ausschalten.
A: Die Parameter dieser Modi stehen im Bios-DatenSegment an der Adresse $17.
Mit der folgenden Prozedur lassen sich die Werte ändern. Allerdings
werden die Werte erst beim nächsten Tastendruck aktiviert.
PROCEDURE SetLockMode(Num,Caps,Scroll:Boolean);
BEGIN
MEM[$0040:$0017]:=(MEM[$0040:$0017] AND NOT $70) OR
(Byte(Scroll) SHL 4) OR
(Byte(Num) SHL 5) OR
(Byte(Caps) SHL 6);
END;
Anmerkung: Sollen die Werte sofort aktiviert werden, so ist die
Prozedur wie folgt zu ändern:
PROCEDURE SetLockMode(Num,Caps,Scroll:Boolean);
VAR Regs: Registers;
BEGIN
MEM[$0040:$0017]:=(MEM[$0040:$0017] AND NOT $70) OR
(Byte(Scroll) SHL 4) OR
(Byte(Num) SHL 5) OR
(Byte(Caps) SHL 6);
Regs.AH := 1;
Intr($16,Regs);
END;
Der Nachteil dieser Prozedur besteht jetzt darin, daß ein Tastendruck,
der sich im Tasterturpuffer befinden entfernt wird.
So jetzt das ganze nochmal in Assembler:
(286 Instruktionen müssen enabled sein)
PROCEDURE SetLockMode(Num,Caps,Scroll:Boolean);ASSEMBLER;
ASM
MOV AX,40h
MOV ES,AX
MOV DI,17h
MOV AL,ES:[DI]
AND AL,$8F
MOV AH,Scroll
SHL AH,4
OR AL,AH
MOV AH,Byte(Num)
SHL AH,5
OR AL,AH
MOV AH,Byte(Caps)
SHL AH,6
OR AL,AH
MOV ES:[DI],AL
END;
Für die zweite Version der Prozedur ist vor dem END; noch
MOV AH,1
INT $16
einzufügen.
------ So, und nun noch eine ganz andere Lösung:
TYPE Shifts = (ShiftR, ShiftL, Ctrl, Alt, Scroll, Num, Caps);
ShiftState = SET OF Shifts;
VAR ShiftFlags: ShiftState ABSOLUTE $0040:$0017;
PROCEDURE SetLockMode (SetShift: ShiftState);
BEGIN
ShiftFlags:= SetShift;
END;
Die Syntax ist zwar etwas anders, dafuer ist's universeller.
Noch besser ist es, wenn der aktuelle Zustand berücksichtigt
wird:
PROCEDURE SetShiftMode (SetShift, ClearShift: ShiftState);
BEGIN
ShiftFlags:= ShiftFlags- ClearShift+ SetShift;
END;
Leider funktioniert keine der angegebenen Prozeduren bei allen
BIOSen (bei meinem z.B. nicht). Viele BIOSe berücksichtigen
die Status-Flags im BIOS-Segment nur dann, wenn auch tatsäch-
lich eine Lock-Taste gedrückt wird.
Der Zweck dieser Flags ist folgender: Es ist nicht möglich,
den Status der Lock-LEDs von der Tastatur abzufragen, und man
kann nur den Status aller drei LEDs auf einmal ändern. Wenn
man also nur eine einzige LED ein- oder ausschalten möchte
(was normalerweise der Fall ist), muß man den Status der ande-
ren beiden kennen. Dazu hat das BIOS eben jenes Byte im BIOS-
Segment. Warum allerdings manche BIOSe schon beim Druck einer
beliebigen Taste (oder beim Aufruf von int16/1) die LEDs up-
daten, ist mir ein Rätsel. Wie gesagt, viele BIOSe tun dies
nicht (sinnvollerweise), weshalb obige Verfahren zum Ein-/Aus-
schalten der LEDs in solchen Fällen nicht funktionieren.
Langer Rede kurzer Sinn: Wenn man die LEDs zuverlässig (und
unabhängig vom BIOS) ein-/ausschalten möchte, sollte man die
entsprechenden Kommandos direkt an den Tastaturcontroller sen-
den. Das hat außerdem den Vorteil, daß es schneller ist.
In Pascal:
repeat until port[$64] and 2 = 0;
port[$60] := $ed;
repeat until port[$64] and 2 = 0;
port[$60] := LED_Status
Wobei die unteren drei Bits von LED_Status angeben, welche LEDs
aufleuchten sollen: 1 = Scroll-, 2 = Num-, 4 = Caps-Lock.
Für Scroll- und Caps-Lock z.B. wäre der Wert 5 einzusetzen.
Frage 24
F: Wie kann ich das Komma der Nummerntastatur in einen Punkt umwandeln?
A: Dazu muß sich das Programm in den Tastaturinterrupt einhängen, und im
entsprechenden Fall das Komma abfangen und durch einen Punkt ersetzen.
Das nachfolgende Programm ist allerdings nicht für den Protected Mode
geeignet.
USES DOS;
VAR OldInt9 : PROCEDURE;
{$F+}
PROCEDURE NewInt9;INTERRUPT;
BEGIN
IF PORT[$60] < $80 THEN { Taste gedrückt ?)
BEGIN
INLINE($9C);Oldint9;
IF MemW[$40:Mem[$40:$1A]]=21292 THEN { Code für , & DEL }
MemW[$40:Mem[$40:$1A]]:=13358; { Code für . }
END ELSE
BEGIN
INLINE($9C);Oldint9; { Alten Interrupt aufrufen }
END;
END;
{$F-}
BEGIN
GetIntVec($9,@OldInt9);
SetIntVec($9,@NewInt9);
Readln;
SetIntVec($9,@OldInt9);
Readln;
END.
Frage 25
F: Wie läßt sich mit TP ein AT erkennen ?
A: An der Adresse $F000:$FFFE steht im ein Byte, an dem sich der Rechnertyp
erkennen läßt. Enthält dieses Byte den Wert $FC, so handelt es sich um
einen AT, sonst um XT/PC.
RechnerIstAT:=Mem[$F000:$FFFE]=$FC;
Frage 26
F: Kann man mit TP festellen, ob SmartDrive bzw. Hyperdisk geladen ist ?
A: Ja, SmartDrive liefert über den Multiplax-Interrupt ($2F) Funktion
$4A10 seine Existenz. Bei Hyperdisk ist die Erkennung etwas schwerer.
Hyperdisk sucht den ersten freien Funktionscode des Multiplax ab $DF
bis $FF. Dort hängt sich Hyperdisk dann ein.
FUNCTION SmartDriveAvail:Boolean; | FUNCTION SmartDriveAvail:Boolean;
VAR Regs:Registers; | ASSEMBLER;
BEGIN | ASM
Regs.AX:=$4A10; | MOV AX,$4A10 { Funkt.Nr }
Regs.BX:=0; | XOR BX,BX { Inst-Check}
INTR($2F,Regs); | INT 2Fh { Mutiplax }
IF AX<>$BABE THEN | CMP AX,$BABE
SmartDriveAvail:=False | JNE @FOUT { AX<>$BABE }
ELSE | MOV AX,1 { TRUE }
SmartDriveAvail:=True | JMP @OUT
END; | @FOUT: XOR AX,AX { FALSE }
| @OUT:
| END;
CONST HypApiNum : Byte = $DE;
FUNCTION HyperdiskAvail : Boolean; ASSEMBLER;
ASM
@LP: MOV AH,HypApiNum { Functionscode }
XOR AL,AL
MOV BX,'DH' { Hyperdisk }
XOR CX,CX { CX und DX leer }
XOR DX,DX
INT 2Fh
OR AL,AL
JE @NOHYP { AL =0 dann nicht inst. }
CMP AL,-1
JNE @NOHYP { AL<>$FF dan nicht inst. }
CMP CX,'YH' { Hyperware Produkt ? }
JE @OK { JA -> OK }
CMP HypApiNum,$FF { Alle Ints belegt ? }
JE @NOHYP
INC HypApiNum
JMP @LP
@OK: MOV AX,1 { TRUE liefern }
JMP @OUT
@NOHYP: XOR AX,AX
@OUT:
END;
CONST HypApiNum : Byte = $DE;
FUNCTION HypAvail:Boolean;
VAR Regs:Registers;
BEGIN
REPEAT
Regs.AX:=HypAPINum*256;
Regs.BX:=$4448;
Regs.CX:=0;Regs.DX:=0;
INTR($2F,Regs);
IF (Regs.AL=$FF) AND (Regs.CX<>$5948) THEN
IF HypAPINum < $FF THEN INC(HypApiNum)
ELSE BEGIN
HypAvail:=False;EXIT;
END;
UNTIL (Regs.AL=0)OR((Regs.CX=$5948)AND(Regs.AL=$FF));
IF Regs.AX=0 THEN HypAvail:=False ELSE HypAvail:=True;
END;
HypApiNum enthält hinterher die Funktionsnummer, mit der man auf Hyper-
disk zugreifen kann. ( Natürlich nur, wenn die Funktion TRUE liefert :)
Ein wesentlich einfacherer Weg fuehrt via Devices.
Smartdrive richtet ja einen Device names "SMARTAAR" ein.
Um nun zu ueberpruefen ob Smartdrive installiert ist:
Assign (F, 'SMARTAAR');
Reset(F);
IF IoResult=0 THEN Smartdrive:=True;
oder eben das ganze fuer Hyperdisk:
Assign(F,'CACHE$$$');
Reset(F);
IF Ioresult=0 THEN HyperDisk:=True;
Ebenso kann man vorgehen bei Qemm(=QEMM386$), Last Byte usw.
Dies funktioniert nicht nur besser, sondern bei Smartdrive benoetigt man
den erhaltenen Handle sowieso um die Smartdrive API INT 21/440? zu be-
nutzen. Natuerlich muß man die Handles wieder schliessen, wenn IOResult
0 zurückliefert.
Für genauere Angaben verweise ich auf meine UNIT FCache, die
im Rahmen meiner Mitarbeit bei PRUSSG entstand.
Frage 27
F: Ich will den gesamten Bildschirm beschreiben, aber beim letzten Zeichen
scrollt der Inhalt eine Zeile weiter. Wie kann ich die letzte Stelle vom
Bildschirm beschreiben ?
A: Für dieses Problem gibt eine F"ulle von Möglichkeiten, es zu lösen.
Hier zwei verbreitete Lösungen:
1. Das direkte Schreiben in den Bildschirmspeicher. Bei monochromer
Darstellung beginnt der Bildschirmspeicher bei $B000, sonst bei $B800.
Für jedes Zeichen werden zwei Bytes benötigt. Das Erste gibt den ASCII-
Code des Zeichens und das Zweite die Farbe an.
Für das letzte Zeichen also z.B. Mem[$B800:(24*80+79)*2]:=65 damit
ein A erscheint.
2. Das Erhöhen des Bildschirmfensters auf 26 Zeilen. Die aktuelle
Bildschirmgröße ist in der Variablen WindMax gespeichert, die in
der Unit CRT definiert wird.
USES crt;
BEGIN
ClrScr;
INC(WindMax); { <=== erhoeht die untere rechte Ecke }
gotoxy(80,25);
Write('A');
DEC(WindMax); { <=== und wieder zurueck }
Readln;
END.
Frage 28
F: Ich habe ein Programm geschrieben, welches über den Exec-Befehl ein
anderes Programm (oder Dos-Befehl) aufrufen soll. Beim Starten des
Programmes passiert jedoch nichts.
Uses DOS;
BEGIN
Exec('C:\COMMAND.COM','/CDIR');
END.
Was mache ich falsch ?
A: Das ist ein Fehler, der allen mal unterlaufen ist. Hier wurde vergessen,
Turbo mitzuteilen, daß das ausführende Programm nicht den gesammten
Speicher an sich reißen soll. Wie in der ONLINE-Hilfe beschrieben rea-
giert Dos sonst mit dem Fehlercode 8. Abzufragen über DosError.
Das kurze Beispiel erfüllt nun seine Aufgabe:
{$M 1024,0,65536} { 1K Stack und max 64Kb Heap }
Uses DOS;
BEGIN
Exec('C:\COMMAND.COM','/CDIR');
END.
Frage 29
F: Wie kann ich feststellen, wie viele Dateien ich noch öffnen kann, ohne
daß ein Runtime-Error 4 (Too Many Files open) auftritt.
A: Es gibt verschiedene Möglichkeiten, dies festzustellen. Zum Einen kann
man ein File sooft öffnen, bis ein Fehler auftritt. Diese Methode sollte
man im Protected-Mode verwenden. Zum Anderen kann man mit Hilfe der
Multiplax Funktion $1216 einen Eintrag aus der SFT (System File Table)
auslesen. Beginnend bei Eintrag Nr.1 weiterzählen, bis das Carry-Flag
gesetzt ist. Hier noch eine Funktion, die die Anzahl ermittelt.
Die Routine ist von Tom Mai mit einigen Änderungen von mir.
{$IFNDEF DPMI}
FUNCTION FileHandlesLeft: INTEGER;
VAR X, OpenFiles : INTEGER;
P : ^WORD;
FUNCTION GetSFT(No: INTEGER): POINTER;
ASSEMBLER;
ASM
MOV AX,$1216
MOV BX,No
INT $2F
JNC @OK
XOR AX,AX
XOR DX,DX
JMP @OUT
@OK: MOV AX,DI
MOV DX,ES
@OUT:
END;
BEGIN
X := 0;
OpenFiles := 0;
REPEAT
P := GetSFT(x);
IF (P<> NIL)AND(P^<>0) THEN Inc(OpenFiles);
INC(X);
UNTIL P=NIL;
FileHandlesLeft := X-1-OpenFiles;
END;
{$ELSE}
FUNCTION FileHandlesLeft: INTEGER;
CONST TmpName = '\~1982837.TMP';
VAR F : FILE;
i : INTEGER;
FUNCTION MaxOpenFiles(Nr:Integer):Integer;
Var G:File;
BEGIN
Assign(G,TmpName);
{$I-}
Reset(G);
{$I+}
IF IoResult<>0 THEN MaxOpenFiles:=Nr
ELSE
BEGIN
MaxOpenFiles:=MaxOpenFiles(Nr+1);
Close(G);
END;
END;
BEGIN
Assign(F, TmpName);
{$I-}
Rewrite(F);
{$I+}
I := IOResult;
IF (I<>0) THEN
BEGIN
IF (i<>18) THEN FileHandlesLeft:= 255
ELSE FileHandlesLeft:= 0;
Exit;
END; { if }
FileHandlesLeft:=MaxOpenFiles(0)+1;
Erase(F);
END;
{$ENDIF}
Hier noch die Non-Assembler-Version der Funktion GetSFT :
(USES Dos nicht vergessen)
FUNCTION GetSFT(No: INTEGER): POINTER;
VAR R : Registers;
BEGIN
R.AX := $1216; R.BX := No;
Intr($2F);
IF R.Flags AND FCarry <> 0 THEN GetSFT := NIL
ELSE GetSFT := Ptr(R.ES,R.DI);
END;
Man beachte bitte, daß Dos einem Programm maximal 20 Handles zur
Verfügung stellt. Zieht man nun die 5 Standard-Handles abzieht beiben
nur noch 15 für das Programm. Der Wert der über GetSFT ermittelt wird
kann auch > 15 sein, das Prg kann jedoch nur über 15 verfügen.
Frage 30
F: Wie kann ich in Turbo Pascal den Tasterturpuffer löschen?
A: Für diese Aufgabe gibt es sehr viele verschieden Lösungen. Die
schnellste ist der direkte Zugriff auf das Bios, in dem der
Puffer liegt:
MemW[$40:$1a] := MemW[$40:$80]
MemW[$40:$1c] := MemW[$40:$80]
Für Leute, die lieber "reinen" Pascal-Code haben möchten eignet
sich die Befehlsfolge
VAR y:Char; ...
WHILE KeyPressed DO y:=Readkey;
Frage 31
F: Wie kann ich mit der Soundblaster-Karte VOC,WAV,MOD-Files etc. abspielen?
A: Ein kompletter Source-Code für alle Formate wäre sicherlich zu lang, um
hier in der Liste zu erscheinen. Allerdings kann ein Source zum Abspielen
von Samples (Formate von VOC und WAV in der CT 1/93 zu finden) bei der
MIB (2:2437/125) unter dem Namen SBPLAY.ARJ requestet werden.
Dieser Source ist von Hagen Lehman in der Pascal.Ger gepostet worden.
Ein OBJ-File mit TP-Demo kann bei der MIB 2:2437/125 unter dem Namen
MODOBJ.ZIP requestet werden. (30 KB)
Ein kompletter Source ist unter dem Namen VTPLAY.ZIP zu erhalten.
(380 KB)
Frage 32
F: Wie kann ich mit Borland Pascal 7.0 im Protected Mode swappen?
A: Mit der untenstehenden Unit, die aus dem internationalen PASCAL-Echo
stammt läßt sich Swapping auch im Protected-Mode verwirklichen.
UNIT RTMSwap;
INTERFACE
CONST rtmOK = $0;
rtmNoMemory = $1;
rtmFileIOError = $22;
FUNCTION MemInitSwapFile(FileName: PChar; FileSize: Longint): Integer;
{ Opens a swapfile of the specified size. If a swapfile
already exists, and the new size is larger, the swapfile
will grow, otherwise the previous swap file parameters are
used. FileSize spezified in Bytes }
Returns: rtmOK - Successful
rtmNoMemory - Not enough disk space
rtmFileIOError - Could not open/grow file }
FUNCTION MemCloseSwapFile(var Delete: Integer): Integer;
{ Closes the swapfile if it was created by the current task.
If the value returned in "Delete" is non-zero, the swapfile
was deleted.
Returns: rtmOK - Successful
rtmNoMemory - Not enough physical memory to run
without the swap file
rtmFileIOError - Could not close/delete the file }
IMPLEMENTATION
FUNCTION MemInitSwapFile; EXTERNAL 'RTM' INDEX 35;
FUNCTION MemCloseSwapFile; EXTERNAL 'RTM' INDEX 36;
END.
Gleich ein kleines Beispiel zur Benutzung :
USES RTMSwap;
VAR P:PChar;
BEGIN
P:='SWAP.SWP'#0;
Writeln(MemAvail);
Writeln(MemInitSwapFile(P,1024*1024)); 1MB Größe
Writeln(MemAvail);
END.
Meinen Tests zur Folge, muß die Größe zwischen 1024 KB und 16384 KB
liegen (wie auch bei der IDE).
Frage 33
F: Ich muß oft Strings in Großbuchstaben umwandeln. Eine Umwandlung mittels
der normalen Upcase Routine dauert mir zu lange. Gibt es eine schnellere
Version ?
A: Hier eine Unit von Bernd Nawothnig@2:2437/120.28. Diese Routinen sind
durch Benutzung eines LookUp-Tables und des XLAT Befehles mit die
Schnellsten. Für Dos Versionen >= 4.0 werden sogar die Country-Infos
ausgewertet.
UNIT UpperStr;
{$DEFINE ASM}
(********************************************************************)
(* *)
(* upString-Routinen in Assembler *)
(* *)
(* PD 1/95 Bernd Nawothnig @ 2:2437/120.28 *)
(* *)
(********************************************************************)
Interface
Function Upcase(c: Char): Char;
Procedure Upper(var Str: String);
Function UpString(s: String): String;
Function upString7(s: String): String;
Implementation
{ Die Table ins Codesegment, dadurch bleiben DS und
ES fürs Kopieren frei }
Procedure Table; { Dummy Procedure }
Assembler;
asm
db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37
db 38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55
db 56,57,58,59,60,61,62,63,64
db 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
db '[\]^_',96
db 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
db '{|}~',127,'Ç'
{ #129 --> #154, #130 --> #144, #131 --> #65 }
db 'ÜÉA'
{ #132 --> #142, #133 --> #65, #134 --> #143 }
db 'ÄAÅ'
{ #135 --> #128, #136 --> #69, #137 --> #69 }
db 'ÇEE'
{ #138 --> #69, #139 --> #73, #140 --> #73 }
db 'EIIIÄÅÉ'
{ #145 --> #146, #147 --> #79, #148 --> #153 }
db 'ÆÆOÖ'
{ #149 --> #79, #150 --> #85, #151 --> #85 }
db 'OUU'
{ #152 --> #89, #160 --> #65, #161 --> #73 }
{ #162 --> #79, #163 --> #85, #164 --> #165 }
db 'YÖÜ'
db 155,156,157,158,159,'AIOUÑÑ'
db 166,167,168,169,170,171,172,173,174,175,176,177,178
db 179,180,181
db 182,183,184,185,186,187,188,189,190,191,192,193,194
db 195,196,197
db 198,199,200,201,202,203,204,205,206,207,208,209,210
db 211,212,213
db 214,215,216,217,218,219,220,221,222,223,224,225,226
db 227,228,229
db 230,231,232,233,234,235,236,237,238,239,240,241,242
db 243,244,245
db 246,247,248,249,250,251,252,253,254,255
end;
Procedure Table7; { Dummy Procedure für 7 Bit }
Assembler;
asm
db 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19
db 20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37
db 38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55
db 56,57,58,59,60,61,62,63,64
db 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
db '[\]^_',96
db 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
db '{|}~',127,'C'
{ #129 --> #154, #130 --> #144, #131 --> #65 }
db 'ÜEA'
{ #132 --> #142, #133 --> #65, #134 --> #143 }
db 'ÄAA'
{ #135 --> #128, #136 --> #69, #137 --> #69 }
db 'CEE'
{ #138 --> #69, #139 --> #73, #140 --> #73 }
db 'EIIIÄAE'
{ #145 --> #146, #147 --> #79, #148 --> #153 }
db 'ÆÆOÖ'
{ #149 --> #79, #150 --> #85, #151 --> #85 }
db 'OUU'
{ #152 --> #89, #160 --> #65, #161 --> #73 }
{ #162 --> #79, #163 --> #85, #164 --> #165 }
db 'YÖÜ'
db 155,156,157,158,159,'AIOUNN'
db 166,167,168,169,170,171,172,173,174,175,176,177,178
db 179,180,181
db 182,183,184,185,186,187,188,189,190,191,192,193,194
db 195,196,197
db 198,199,200,201,202,203,204,205,206,207,208,209,210
db 211,212,213
db 214,215,216,217,218,219,220,221,222,223,224,225,226
db 227,228,229
db 230,231,232,233,234,235,236,237,238,239,240,241,242
db 243,244,245
db 246,247,248,249,250,251,252,253,254,255
end;
{ Initialisieren des Table durch DOS (ab Version 4.0) }
Procedure InitDos4;
Assembler;
asm
push ds { DS sichern ... }
mov ah,30h
int 21h { DOS-Version abfragen }
cmp al,4 { >=4? }
jb @Exit { Nein, dann fertig }
cld { Set direction to forward }
push cs
pop es { Table steht im Codesegment }
lea di,Table { Anfangsadresse UpCaseTable ==> CS:DI }
xor al,al { 0 in erstes Element }
mov cx,256 { 256 Elemente lang }
@loop:
stosb { AL ==> CS:[DI+UpCaseTable] }
inc al
loop @loop
push cs { CS ==> DS }
pop ds
mov CX,256
lea DX,Table { DS:DX points to UpCaseTable to capitalise }
mov AX,$6521 { function $6521 = capitalise string }
int $21 { call DOS }
@Exit:
pop ds
end;
{ Ersatz für die gleichnamige Funktion der Unit System }
Function upCase(c: Char): Char;
{$IFDEF ASM}
Assembler;
asm
lea bx,Table
mov al,c
segcs xlat
end;
{$ELSE}
begin
Case c of
'ä' : UpCase := 'Ä';
'ö' : UpCase := 'Ö';
'ü' : UpCase := 'Ü';
'ñ' : UpCase := 'Ñ';
'é' : UpCase := 'É';
'å' : UpCase := 'Å';
'æ' : UpCase := 'Æ';
'ç' : UpCase := 'Ç';
'â','à' : UpCase := 'A';
'ê','ë','' : UpCase := 'E';
'ô','ò','ó' : UpCase := 'O';
'ï','î','','í' : UpCase := 'I';
'û','ù','ú' : UpCase := 'U';
'ÿ' : UpCase := 'Y';
else
UpCase := System.UpCase(c)
end;
end;
{$ENDIF}
{ wandelt Strings in Großbuchstaben um }
Procedure Upper(var Str: String); Assembler;
asm
cld
les di,Str
mov cl,es:[di]
xor ch,ch
jcxz @Exit
inc di
lea bx,Table
@More:
mov al,es:[di]
segcs xlat
stosb
loop @More
@Exit:
end;
{ dto. als Function }
Function upString(s: String): String;
{$IFDEF ASM}
Assembler;
asm
push ds { DS sichern }
cld { Directionflag auf "Vorwärts" }
lds si,s { Quellstring ==> DS:SI }
les di,@Result { Addr(Ergebnis) ==> ES:DI }
lodsb { Längenbyte via AL kopieren ... }
stosb
mov cl,al { ... und nach CL kopieren }
sub ch,ch { Highbyte löschen }
jcxz @Ende { Nullstring? Ja, dann fertig }
lea bx,Table { Offset (bzgl. CS) der Übersetzungstabelle laden }
@More:
lodsb { lade nächstes Zeichen (bzgl. DS) ... }
segcs xlat { gemäß Tabelle in CS:[BX] übersetzen }
stosb { ... und speichere es wieder (bzgl. ES) }
loop @More { weiter im Text ;-) }
@Ende:
pop ds { DS restaurieren }
end;
{$ELSE}
begin
Upper(s);
UpString := s;
end;
{$ENDIF}
{ wie upString, es werden zusätzlich Umlaute in 7-Bitzeichen konvertiert }
{ Geht _nicht_ als Procedure, da der String dabei länger werden kann! }
Function upString7(s: String): String;
Assembler;
asm
push ds { DS sichern }
cld { Directionflag auf "Vorwärts" }
lds si,s { Quellstring ==> DS:SI }
les di,@Result { Addr(Ergebnis) ==> ES:DI }
lodsb { Längenbyte via AL kopieren ... }
stosb
mov cl,al { ... und nach CL kopieren }
sub ch,ch { Highbyte löschen }
jcxz @Ende { Nullstring? Ja, dann fertig }
mov dx,di { Startoffset merken }
add dx,255 { maximal 255 Zeichen kopieren }
lea bx,Table7 { Offset (bzgl. CS) der Übersetzungstabelle laden }
@More:
lodsb { lade nächstes Zeichen (bzgl. DS) ... }
segcs xlat { gemäß Tabelle in CS:[BX] übersetzen }
cmp al,'Ä'
jne @OE
@AE:
mov ax,'EA'
stosw
jmp @Check
@OE:
cmp al,'Æ'
je @AE
cmp al,'Ö'
jne @UE
mov ax,'EO'
stosw
jmp @Check
@UE:
cmp al,'Ü'
jne @SS
mov ax,'EU'
stosw
jmp @Check
@SS:
cmp al,'ß'
jne @Store
mov ax,'SS'
stosw
jmp @Check
@Store:
stosb { ... und speichere es wieder (bzgl. ES) }
@Check:
cmp di,dx
jae @WriteLength
loop @More
@WriteLength:
sub dx,255
sub di,dx
mov ax,di
les di,@Result
stosb
@Ende:
pop ds { DS restaurieren }
end;
begin
InitDos4
end.
Frage 34
F: Kann man für Protected Mode Programme Overlays erzeugen ?
A: Nein, entweder OVRs oder DPMI, d.h. Du musst zwei Versionen Deiner
Software ausliefern, wenn diese auf jedenfall lauffähig sein soll. Eine
DPMI-Vers. fuer Rechner mit >1.5MB DPMI-Mem und eine Real-Mode-Appli-
kation fuer Rechner mit weniger XMS, nur EMS oder garnix...
Allerdings sollte ein guter DPMI-Server Programmteile auslagern können.
Bei BP geht das mit Hilfe der Compiler-Direktive $C,$S,$G, deren Bedeu-
tung in der Online-Hilfe deutlich genug beschrieben ist.
Dann kann man das Hauptprogramm von einer (kompilierten) Batchdatei aus
starten, die zunaechst versucht die DPMI-Version zu starten oder, wenn
das misslingt, die Real-Mode-Version
-----------------------------------------
DPMIPROG.EXE
IF errorlevel 255 goto dpmi2
goto ende
:dpmi2
REALPROG.EXE
:ende
-----------------------------------------
Frage 35
F: Wie ermittle ich den Typ der installieren Videokarte ?
A: 1. Über den Interrupt $10 Funktion $1A Unterfunktion $00 (im VGA-Bios)
Eingabe: AX=$1A00
Ausgabe: AL=$1A
BL=Gerätecode für die aktive Video-Karte
BH=Gerätecode für die inaktive Video-Karte
$FF Karte unbek. $00 keine Karte
$01 MDA mit Monochrom-Monitor
$02 CGA mit Farb-Monitor
$04 EGA mit Farb-Monitor
$05 EGA mit Monochrom-Monitor
$06 Professional graphics controller
$07 VGA mit Monochrom-Monitor
$08 VGA mit Farb-Monitor
$0A MCGA mit (digital) Farb-Monitor
$0B MCGA mit (analog) Monochrome-Monitor
$0C MCGA mit (analog) Farb-Monitor
Wird im Register AL nicht der Wert $1A zurückgegeben, hat der Rechner
kein VGA-Bios, und diese Funktion wurde also nicht erfolgreich ausge-
führt.
FUNCTION VideoType:INTEGER;
VAR R:Registers;
BEGIN
R.AX:=$1A00;
INTR($10,R);
IF R.AL<>$1A THEN
VideoType:=-1
ELSE VideoType:=R.BL;
END;
FUNCTION VideoType:INTEGER;ASSEMBLER;
ASM
MOV AX,$1A00
INT 10h
CMP AL,$1A
JNE @FOUT
XOR AH,AH
MOV AL,BL
JMP @OUT
@FOUT: MOV AX,$FFFF
@OUT:
END;
Frage 36
F: Wie erkenne ich ob eine ET3000 oder eine ET4000- Grafikkarte installiert
ist.
A: Die folgende Funktion ermittelt dies und unterscheidet außerdem noch
einige andere Karten. Allerdings geht es nur in Assembler.
Leider läuft die Funktion bisher nur im Realmode. :(
Ausgabe : 0 - Unbekannt 1 - Tseng Et3000 2 - Tseng Et4000
3 - Trident 4 - Paradise 5 - Oak
6 - Video7
FUNCTION VideoKarte : Integer; ASSEMBLER;
ASM
PUSH ES
PUSH BP
INT $11 { Equipment ermitteln }
MOV BX,$B000
AND AL,30h { 30h für monochrome }
CMP AL,30h
JZ @ini1
MOV BX,$B800 { Farbdarstellung }
@ini1: MOV WORD PTR @textsegment,BX
{ VGA-Bios testen }
MOV BP,offset @vgachips { Tabelle laden }
MOV DI,CS:word ptr [BP] { Basisadresse laden }
MOV ES,CS:word ptr [BP+2]
MOV DX,CS:word ptr [BP+4] { Blockgröße laden }
ADD BP,6 { Header überspringen }
@Bdet1: MOV SI,BP { ersten Steuerungsblock laden }
@Bdet2: MOV CX,CS:word ptr [SI] { ID-Länge laden }
JCXZ @Bdet6 { Ende der Tabelle }
MOV AX,CS:word ptr [SI+2] { Typennummer laden }
ADD SI,4 { ID-string adressieren }
CMP DX,CX { Blockgröße ausreichend? }
JB @Bdet5
PUSH DI
@Bdet3: MOV BL,CS:byte ptr [SI] { Zeichen laden }
MOV BH,byte ptr ES:[DI]
INC SI
INC DI
CMP BH,'a' { in Großbuchstaben wandeln }
JB @Bdet4
CMP BH,'z'
JA @Bdet4
ADD BH,'A'-'a'
@Bdet4: CMP BL,BH { Zeichen vergleichen }
LOOPZ @Bdet3
POP DI
JZ @Bdet7 { ID gefunden }
@Bdet5: ADD SI,CX { Reststring überspringen }
JMP @Bdet2
@Bdet6: INC DI { nächste Adresse }
DEC DX
JNZ @Bdet1
MOV AX,0 { nichts gefunden }
@Bdet7:
CMP AX,0 { Keine ID gefunden? }
JZ @cdet1
CMP AX,1 { Tseng-chip? }
JNZ @cdet2
{ TSENG Chip testen }
MOV ES,word ptr @textsegment { Videosegment laden }
MOV BP,0 { Testadresse laden }
MOV DX,$03CD { Segmentwahlregister laden }
IN AL,DX { Segmente merken }
MOV AH,AL
MOV AL,01000100b { ET-4000-Segmente wählen }
OUT DX,AL
MOV SI,word ptr ES:[BP] { wort an Testadresse retten }
MOV AL,01100100b { ET-3000-Segmente wählen }
OUT DX,AL
MOV DI,word ptr ES:[BP] { wort an Testadresse retten }
MOV BX,5555h { Testmuster laden }
MOV word ptr ES:[BP],BX { Schreib-/Lesezugriff testen }
MOV CX,word ptr ES:[BP]
CMP BX,CX
JNZ @tdet1 { Fehler -> ET-4000 }
NOT BX { alternatives Testmuster laden }
MOV word ptr ES:[BP],BX { Schreib-/Lesezugriff testen }
MOV CX,word ptr ES:[BP]
CMP BX,CX
JNZ @tdet1
MOV BX,1 { ET-3000 }
MOV word ptr ES:[BP],DI { Testadresse wiederherstellen }
JMP @tdet2
@tdet1: MOV BX,2 { ET-4000 }
MOV AL,01000100b { Testadresse wiederherstellen }
OUT DX,AL
MOV word ptr ES:[BP],SI
@tdet2: MOV AL,AH { vorherige Segmente wählen }
OUT DX,AL
MOV AX,BX { Chip-id laden }
JMP @cdet2
@cdet1: MOV AX,6f00h { Video seven? }
MOV BX,0
INT $10
CMP BX,'V7'
MOV AX,6
JZ @cdet2
MOV AX,0 { unbekannte Karte }
@cdet2: JMP @OUT
@Textsegment : DW 0h
@Vgachips:
dw 0,0c000h { Basisadresse (offset, segment) }
dw 0ffffh { Blockgröße }
dw 18,1 { Tseng ET-3000/4000 }
db 'TSENG LABORATORIES'
dw 07,3 { Trident }
db 'TRIDENT'
dw 08,4 { Paradise }
db 'PARADISE'
dw 14,5 { Oak }
db 'OAK TECHNOLOGY'
dw 0 { ende }
@OUT : POP BP { Gesicherte Register zurück }
POP ES { Ergebnis in AX }
END;
Frage 37
F: Wie fange ich Tastenkombis wie CTRL-Alt-Del und CTRL-Break ab ?
A: Einen Abbruch bei CTRL-Break kann man durch das Setzen der Variable
CheckBreak auf False verhindern. Um jedoch Ctrl-Break abzufragen, muß
man sich in den Interrupt $1B einhängen, da dieser beim Druck von
CTRL-Break aufgerufen wird.
Für CTRL-Alt-Del besteht keine Abfangmöglichkeit durch Setzen einer
Variablen. Der Anwender muß den Keyboard-Interrupt 09 auf eine eigene
Routine umbiegen, und die entsprechende Tastenkombination abgefangen.
Hier ein kleines Demoprogramm:
PROGRAM NoCADBoot;
USES DOS;
{ $F+ }
VAR Oldkbdint, OldExitProc : Pointer;
CONST CtrlP : byte = $1d;
AltP : byte = $38;
DelP : byte = $53;
VAR Keys : ARRAY [0..127] OF boolean; { mögliche Scan Codes }
PROCEDURE StartProc(PToRun: pointer);
BEGIN
INLINE($9c/ { PUSHF }
$ff/$5e/$06); { CALL DWORD PTR [BP+6] }
END;
PROCEDURE NewInt; INTERRUPT;
VAR AL,AH:byte;
BEGIN
{ Keyboard Status von Port 60h holen }
Keys[port[$60] mod 128] := (port[$60] < 128);
IF Keys[DelP] AND Keys[CtrlP] AND Keys[AltP] THEN
BEGIN
AL:=port[$61]; { Keyboard control Lines holen }
ah:=al; { und speichern }
al:=al or $80; { Bit für Keyboard enable setzen }
Port[$61]:=al; { senden }
Port[$61]:=ah; { Orginal Werte senden }
Port[$20]:=$20; { Hardware EOI Signal an 8259 }
END
ELSE Startproc(Oldkbdint);
INLINE($FB);
END;
PROCEDURE Nocad;
BEGIN
fillchar(Keys[0],128,false);
getintvec($09, oldkbdint);
setintvec($09, @newint);
INLINE($fb);
END;
PROCEDURE MayCAD;
BEGIN
setintvec($09, oldkbdint);
INLINE($FB);
ExitProc:=OldExitProc;
END;
BEGIN
OldExitProc:=ExitProc;
Exitproc:=@MayCAD;
NoCad;
Writeln('Try CTRL_ALT_DEL');
Readln;
END. { Automatisch MayCAD aufrufen }
-------------
Hier noch ein zweiter Source :
{Program: NoBoot v1.0, PD
Aufg: Demo: Ctrl-Alt-Del abfangen
Autor: Markus Eckert/Rheinstr 27/55276 Dienheim/BRD/Tel 06133-3741}
USES Dos;
CONST CADFlag:Boolean=False; {Flag, ob Ctrl-Alt-Del gedrueckt}
VAR ShiftStat : Byte ABSOLUTE 0:$417; {BIOS-ShiftState}
Old09 : PROCEDURE; {alter Int09-Handler}
PROCEDURE Handler09;INTERRUPT;
BEGIN
IF Port[$60]=$53 Then{Del gedrueckt?}
BEGIN
IF (ShiftStat and 12)=12 {Ctrl-Alt aktiv?} THEN
BEGIN {Flag setzen}
CADFlag:=True;
{XT-Tastaturbehandlung}
Port[$61]:=Port[$61] or $80;
Port[$61]:=Port[$61] and $7F;
{nochmal lesen=verzoegerung!}
{EOI=EndOfInterrupt}
Port[$20]:=$20
END
END ELSE
BEGIN
{alten Handler aufrufen}
INLINE($9C);{pushf}
Old09
END
END;
PROCEDURE Handler09_A;ASSEMBLER;
ASM {Keyboard-Handler fuer 1 Hotkey}
PUSH AX {00}
IN AL,$60 {01}
CMP AL,$53 {03}
JE @TestShift {05}
@JmpNext:
POP AX {07}
DB $EA {08}
DD -1 {09}
@TestShift:
PUSH DS
XOR AX,AX
MOV DS,AX
MOV AL,[$417]
AND AL,12
CMP AL,12
POP DS
JNE @JmpNext
IN AL,$61 {XT-Tastaturbehandlung}
OR AL,$80
OUT $61,AL
JMP @Next
@Next:
AND AL,$7F
OUT $61,AL
MOV AL,$20 {EOI}
OUT $20,AL
PUSH DS {Flag setzen}
MOV AX,SEG @Data
MOV DS,AX
MOV CADFlag,True
POP DS
POP AX
IRET
END;
BEGIN
GetIntVec(9,@Old09);
SetIntVec(9,@Handler09);
WriteLn('So - jetzt faengt die Pas-Proc Ctrl-Alt-Del ab...');
ReadLn;
SetIntVec(9,@Old09);
IF CADFlag THEN
BEGIN
WriteLn('Maec> Kein Vertrauen!');
CADFlag:=False
END
ELSE WriteLn('Maec> Viel zu naiv!');
GetIntVec(9,Pointer(MemL[CSeg:Ofs(Handler09_A)+9]));
SetIntVec(9,@Handler09_A);
WriteLn('Nun ist aber die Asm-Proc an der Reihe...');
ReadLn;
SetIntVec(9,Pointer(MemL[CSeg:Ofs(Handler09_A)+9]));
IF CADFlag THEN WriteLn('Maec> Ja - es funktioniert auch in ASM!')
ELSE WriteLn('Maec> Asm ist langweilig?');
END;
-------
Eine komplette Unit für das Behandeln der Tasten Pause, CTRL-Break,
PrtScr und CTRL-Alt-Del wird von der PRUSSG ('Pascal related unit
system support group') zur Verfügung gestellt. Die aktuelle Release
der Units dieser Gruppe ist bei der MIB requestbar unter dem MAGIC
PRUSSG. (>100KB)
Frage 38
F: Wie kann ich den Midi-Port meiner SB-Pro-Karte programmieren ?
A: Wie dies genau funktioniert habe ich leider auch keine Ahnung, aber
in der internationalen PASCAL-Area wurde der folgende Source-Code
gepostet. (bisher nicht von mir getestet. :( )
Unit SBMIDI;
{ MIDI Port communication for Sound Blaster Pro
Erik Olbrys January 29-31, 1993 CIS 71236,1245
Based indirectly on fuzzy information from:
"Sound Blaster: The Official Book" ISBN 0-07-881907-5
by Heimlich, Golden, Luk and Ridge
Dedicated to the memory of my grandfather, Anthony T. Olbrys 1/8/08-1/29/93 }
INTERFACE
FUNCTION ReadMIDI : byte;
FUNCTION MIDI2read : boolean;
PROCEDURE WriteMIDI( datA: byte );
PROCEDURE NoteOn( Channel, note, velocity : byte);
PROCEDURE NoteOff( Channel, note, velocity : byte);
PROCEDURE InitMidi;
PROCEDURE ClearMIDIin;
IMPLEMENTATION
USES crt;
CONST Base_Port = $220; { change this depending on card config }
DSP_Reset = Base_Port+ $6;
DSP_Read = Base_Port+ $A;
DSP_Write = Base_Port+ $C;
DSP_Command = Base_Port+ $C;
DSP_W_Status = Base_Port+ $C;
DSP_R_Status = Base_Port+ $E;
FUNCTION MIDI2read: Boolean;
{ Returns true if there is a byte to read at the SB MIDI Port }
BEGIN
MIDI2read := ((Port[ DSP_R_Status ] and $80) = $80)
END;
PROCEDURE WriteMIDI(data: byte);
{ Writes a byte to the SB MIDI Port. Waits until the Port can take another byte }
BEGIN
REPEAT UNTIL (Port[ DSP_W_Status ] AND $80) = $00;
Port[ DSP_Write ] := data;
END;
FUNCTION ReadMIDI : byte;
{ Reads a byte from the SB MIDI Port. Waits until a byte is ready. }
BEGIN
REPEAT UNTIL (Port[ DSP_R_Status ] AND $80) = $80;
ReadMIDI := Port[ DSP_Read ];
END;
PROCEDURE ClearMIDIin;
{ Reads and discards all in-coming bytes until no more are present }
VAR discard : byte;
BEGIN
REPEAT
discard := Port[ DSP_Read ];
UNTIL (Port[ DSP_R_Status ] AND $80) = $00;
END;
PROCEDURE InitMIDI;
{ Initializes MIDI Port on Sound Blaster Pro card. Put into UART (dumb) mode }
VAR A: word;
BEGIN
Port[ DSP_Reset ] := 01; { Send first byte of reset command }
delay(1); { wait at least three microseconds;
one millisecond is more than enough }
Port[ DSP_Reset ] := 00; { Send second byte of reset command }
REPEAT UNTIL ReadMIDI = $AA; { DSP will xmit $AA when it has reset }
WriteMIDI( $34 ); { UART mode, polling (non-interrupt) }
END;
PROCEDURE NoteOn( Channel, note, velocity : byte);
BEGIN
WriteMIDI( $8F + channel); { note on }
WriteMIDI( note); { note }
WriteMIDI( velocity ); { velocity }
END;
PROCEDURE NoteOff( Channel, note, velocity : byte);
BEGIN
WriteMIDI( $7F + channel);
WriteMIDI( note);
WriteMIDI( velocity );
END;
BEGIN
InitMIDI;
END.
Frage 39
F: Wie kann ich bei einem DosShell den Prompt ändern ?
A: Da es mehrere Möglichlichkeiten. Die erste wäre, eine Batchdatei aufzu-
rufen, die als erstes das Prompt ändert. Als z.B :
EXEC('C:\COMMAND.COM','/CDOIT.BAT');
Als erstes in der DOIT.BAT Datei @PROMPT neuen Prompt
und dann erst die eigentliche Shell durch einen erneuten Aufruf von
Command.Com einleiten.
Der Nachteil dieser Methode liegt darin, daß eine Menge Speicher ver-
schwendet wird, da Command.Com zweimal gestartet wird.
Die zweite Möglichkeiten dringt weiter in den Aufbau von DOS vor.
Jedem Programm wird von DOS beim Start ein Block mitgegeben, der
Program Segment Prefix (PSP). In diesem PSP steht auch die Adresse,
an der das Environment zu finden ist. Nun kann man den gesammten
Block kopieren und den Eintrag PROMPT abändern. Die Adresse des geänder-
ten Blocks wird wieder in das PSP eingetragen. Beim Aufruf der EXEC-
Funktion wird nun dieser neue Environment-Bereich kopiert und an das
aufgerufene Programm gegeben (über dessen PSP). Wird also der Kommando-
interpreter gestartet, so wird das neue Prompt dargestellt.
Hier eine Unit aus dem internationalen PASCAL-Echo dazu :
{$A+,B-,F-,L-,N-,O-,R-,S-,V-}
UNIT prompt;
{ Author: Trevor J Carlsen
PO Box 568
Port Hedland
Western Australia 6721
61-[0]-91-73-2026 (voice)
61-[0]-91-73-2930 (data )
Released into the public domain.
This unit will automatically create a predefined prompt when shelling to
DOS. If you wish to create your own custom prompt, all that is required
is to give the VARiable NPrompt another value and call the PROCEDURE
ChangeShellPrompt. }
INTERFACE
USES Dos;
PROCEDURE ChangeShellPrompt(Nprompt: STRING);
IMPLEMENTATION
TYPE EnVARray = ARRAY[0..32767] OF byte;
EnvPtr = ^EnVARray;
VAR EnvSize, EnvLen, EnvPos: word;
NewEnv, OldEnv : EnvPtr;
TempStr : STRING;
x : word;
PROCEDURE ChangeShellPrompt(Nprompt: STRING);
FUNCTION MainEnvSize: word;
VAR x : word;
found : boolean;
BEGIN
found := false; x := 0;
REPEAT
IF (OldEnv^[x] = 0) AND (OldEnv^[x+1] = 0) THEN
found := true
ELSE Inc(x);
UNTIL found;
MainEnvSize := x - 1;
END; { MainEnvSize}
PROCEDURE AddEnvStr(VAR s; VAR offset: word; len: word);
VAR st : EnvArray ABSOLUTE s;
BEGIN
move(st[1],NewEnv^[offset],len);
inc(offset,len+1);
END;
BEGIN
OldEnv := ptr(MemW[PrefixSeg:$2C],0);
{ this gets the actual starting segment of the current env }
EnvSize := MemW[seg(OldEnv^)-1:3] shl 4;
{ Find the size of the current environment }
IF MaxAvail < (EnvSize+256) THEN Exit;
GetMem(NewEnv, EnvSize + $100);
IF ofs(NewEnv^) <> 0 THEN
BEGIN
Inc(longint(NewEnv),$10000 + ($10000 * (longint(NewEnv) DIV 16)));
longint(NewEnv) := longint(NewEnv) AND $ffff0000;
END;
FillChar(NewEnv^,EnvSize + $100,0);
{ Allocate heap memory for the new environment adding enough to
allow alignment to a paragraph boundary or a longer prompt than
the default and initialise to nuls }
EnvPos := 0;
NPrompt:='PROMPT='+NPrompt;
AddEnvStr(Nprompt,EnvPos,length(Nprompt));
FOR x := 1 TO EnvCount DO
BEGIN
TempStr := EnvStr(x);
IF Pos('PROMPT=',TempStr) <> 1 THEN
AddEnvStr(TempStr,EnvPos,length(TempStr));
END; { for }
Inc(EnvPos);
{ Transfer old env Strings except the prompt to new environment }
IF lo(DosVersion) > 2 THEN
AddEnvStr(OldEnv^[MainEnvSize + 2],EnvPos,EnvSize-
(MainEnvSize + 2));
{ Add the rest of the environment }
MemW[PrefixSeg:$2C] := seg(NewEnv^);
{ let the program know where the new environment is }
END; { ChangeShellPrompt }
END. { prompt }
!!! Ich weiß nicht, ob das bei 4Dos,NDos,DR-Dos etc klappt !!!
:( Leider bisher nur im RealMode lauffähig. :(
Frage 40
F: Ich will den Bildschirm in einen oberen und in einen unteren Bereich
teilen. Fuer den oberen Bereich soll der Grafik-Modus gelten, fuer
den Unteren, der Textmodus und das >beides gleichzeitig<. Wie wirds
gemacht.
A: Richtig teilen geht nicht. :) Aber man kann ja komplett im Grafikmodus
arbeiten und auf dem einen Teil den Textmodus simulieren.
Das folgende Programm teilt den Bildschirm in eine Text und eine Grafik
haelfte. Es wird im Modus 2x640x400 (nur VGA!) gearbeitet.
Wenn man Int $29 verbiegen wuerde, liesse sich auch per Exec(..) eine
Anwendung in diesem Modus aufrufen, dazu muesste man die Animation aber
noch mit in den Timer-Interrupt legen.
!! Der INT29 steht nur auf Systemen zur Verfügung, die den DOS-ANSI.SYS
eingebunden haben. Nicht alle ANSI-Treiber unterstützen die Ausgabe
über diesen INT.
USES Crt,Dos;
VAR vio_seg : Word;
page : Byte;
Ofstab : ARRAY[0..399] OF Word;
PROCEDURE Init;ASSEMBLER;
ASM
MOV AX,0EH
INT 10h
MOV DX,3d4h
MOV AL,9
OUT DX,AL
INC DX
IN AL,DX
AND AL,01110000b
OUT DX,AL
MOV vio_seg,0a000h
MOV page,0
XOR AX,AX
MOV DI,offset Ofstab
PUSH DS
POP ES
MOV CX,400
@L:
STOSW
ADD AX,80
LOOP @L
END;
PROCEDURE flip;ASSEMBLER; { Page-Flipping fuer Annimation }
ASM
XOR BX,BX
CMP page,0
JE @s0
MOV BX, 7d0h
@s0:
ADD BX,0a000h
MOV vio_seg,BX
XOR BX,BX
CMP page,1
JE @s1
MOV BX, 7d00h
MOV page,1
JMP @w
@s1:
MOV page,0
@w:
MOV DX, 3dah
@WaitNotVSyncLoop:
IN AL, DX
AND AL, 8
JNZ @WaitNotVSyncLoop
@WaitVSyncLoop:
IN AL, DX
AND AL, 8
JZ @WaitVSyncLoop
MOV DX, 3d4h
MOV AL, 0DH
CLI
OUT DX, AL
INC DX
MOV AL, BL
OUT DX, AL
DEC DX
MOV AL, 0CH
OUT DX, AL
INC DX
MOV AL, BH
OUT DX, AL
STI
END;
PROCEDURE PutPixel(X,y:Word;C:Byte);ASSEMBLER;
ASM
MOV BX,y
ADD BX,BX
MOV AX,[offset Ofstab+BX]
MOV BX,X
MOV CL,BL
SHR BX,3
ADD BX,AX
AND CL,7
XOR CL,7
MOV AH,1
SHL AH,CL
MOV DX,3ceh
MOV AL,8
OUT DX,AX
MOV AX,(02h SHL 8) + 5
OUT DX,AX
MOV AX,vio_seg
MOV ES,AX
MOV AL,ES:[BX]
MOV AL,C
MOV ES:[BX],AL
END;
PROCEDURE PutLine(X,y:Word;L,C:Byte);ASSEMBLER;
ASM
MOV BX,y
ADD BX,BX
MOV AX,[offset Ofstab+BX]
MOV BX,X
ADD BX,AX
MOV AH,L
MOV DX,3ceh
MOV AL,8
OUT DX,AX
MOV AX,(02h SHL 8) + 5
OUT DX,AX
MOV AX,0a000h
MOV ES,AX
MOV AL,ES:[BX]
MOV AL,C
MOV ES:[BX],AL
MOV AX,0a7d0h
MOV ES,AX
MOV AL,ES:[BX]
MOV AL,C
MOV ES:[BX],AL
END;
TYPE ZDEF = ARRAY[#0..#255,0..7] OF Byte;
ZPtr = ^ZDEF;
CONST BIOS_Font : ZPtr = NIL;
PROCEDURE Get_Font; { 8x8 Font aus dem VGA-BIOS holen }
VAR Regs:Registers;
BEGIN
Regs.AH:=$11;
Regs.AL:=$30;
Regs.BH:= 3;
Intr($10,Regs);
BIOS_Font:=Ptr(Regs.ES,Regs.BP);
END;
PROCEDURE WriteChr(X,Y:Integer;Farbe,Farbe2:Byte;Z:Char);
VAR CH:Char;
I,Maske : Byte;
BEGIN
FOR i:=0 TO 7 DO BEGIN
PutLine(X SHR 3,y+i,$FF,Farbe2); { Mit Hintergrundfarbe ausfuellen }
PutLine(X SHR 3,y+i,BIOS_Font^[Z,i],Farbe); { Bitmaske zeichnen }
END;
END;
PROCEDURE WriteStr(X,y:Integer;Farbe,Farbe2:Byte;S:String);
VAR I:Byte;
BEGIN
IF X=-1 THEN X:=320-(Ord(S[0]) SHL 2);
IF y=-1 THEN y:=196;
FOR i:=1 TO Length(S) DO BEGIN
WriteChr(X,y,Farbe,Farbe2,S[i]);
Inc(X,8); { Schneller als Multiplikation }
END;
END;
PROCEDURE Kreis( x_k, y_k, rad : Integer; Farbe : Word );
VAR xp,yp,fehler : Integer;
BEGIN
xp :=0; yp:= rad;
fehler := 3-rad-rad;
WHILE (xp <= yp) DO BEGIN
PutPixel(xp+x_k,-yp+y_k,Farbe);
PutPixel(-yp+x_k,xp+y_k,Farbe);
PutPixel(xp+x_k,yp+y_k,Farbe);
PutPixel(-yp+x_k,-xp+y_k,Farbe);
PutPixel(-xp+x_k,-yp+y_k,Farbe);
PutPixel(yp+x_k,xp+y_k,Farbe);
PutPixel(-xp+x_k,yp+y_k,Farbe);
PutPixel(yp+x_k,-xp+y_k,Farbe);
Inc(xp);
IF (fehler >= 0) THEN BEGIN
Dec(yp);
fehler := fehler - 4*yp;
END;
fehler := fehler + 4 * xp + 2;
END;
END;
PROCEDURE Linie(x1,y1,x2,y2:Word;C:Byte);
VAR f,L,DX,dy,ddx,ddy,px,py:Integer;
BEGIN
px:=1;
py:=1;
DX:=x2-x1;
dy:=y2-y1;
IF DX<0 THEN BEGIN
DX:=-DX;px:=-1;
END;
IF dy<0 THEN BEGIN
dy:=-dy;py:=-1;
END;
ddx:=DX SHL 2;
ddy:=dy SHL 2;
IF DX>dy THEN BEGIN
f:=ddy-DX;
FOR L:=0 TO DX DO BEGIN
PutPixel(x1,y1,C);
IF f>0 THEN BEGIN
y1:=y1+py;
f:=f-ddx;
END;
f:=f+ddy;
x1:=x1+px;
END; { FOR }
END ELSE BEGIN
f:=ddx-dy;
FOR L:=0 TO dy DO BEGIN
PutPixel(x1,y1,C);
IF f>0 THEN BEGIN
x1:=x1+px;
f:=f-ddy;
END;
f:=f+ddx;
y1:=y1+py;
END; { FOR }
END;
END;
PROCEDURE ZeigSp(X,y:Word;C:Byte);
BEGIN
Linie(X-2,y-2,X+2,y+2,C AND Yellow);
Linie(X-2,y+2,X+2,y-2,C AND Yellow);
Kreis(X,y,3,C AND LightRed);
END;
TYPE point = RECORD X,Y:Integer ; END;
ViAR = ARRAY [0..25-1,0..80-1] OF RECORD
Z : Char;
A : Byte;
END;
{-- globale Variablen -------------------------------------------------}
VAR vid : ViAR;
C : Char;
X,Y : Byte;
CX,
CY : ShortInt;
k:Word;
P,V,L,ll: point;
PC_Time : Byte ABSOLUTE $0000:$046C;
{- Timer-Interrupt fuer blinkenden Cursor -----------------------}
VAR timeIntVec : PROCEDURE;
{$F+}
PROCEDURE EQ; interrupt;
VAR X:Byte;
BEGIN
PutLine(CX ,207+(cy SHL 3),$FF,(3 AND PC_Time) SHL 3);
Inline ($9C); { PUSHF -- Push flags }
timeIntVec; { Call old ISR using saved vector }
END;
{$F-}
{----------------------------------------------------------------}
CONST vordergrund = Yellow;
hintergrund = Blue;
BEGIN
Init;
Get_Font;
GetIntVec($1C,@timeIntVec);
FOR y:=0 TO 24 DO
FOR X:=0 TO 79 DO BEGIN
vid[y,X].A:=vordergrund + (hintergrund SHL 4);
vid[y,X].Z:=' ';
WriteChr(X SHL 3,200+(y SHL 3),vid[y,X].A AND 15,vid[y,X].A SHR 4,vid[y,X].Z);
END;
Writestr(0,200,White,LightBlue,'Text & Grafik - geben sie bel.. Text ein - ESC bricht ab - Axel Plinge 03.95');
CX:=0;cy:=2;C:=#0;
{- Sprite zuruecksetzen -----------------------------------------}
P.X:=10;
P.y:=10;
L:=P;ll:=L;
v.X:=2;
v.y:=2;
{----------------------------------------------------------------}
SetIntVec($1C,@EQ);
REPEAT
IF KeyPressed THEN BEGIN
C:=ReadKey;
PutLine(CX,207+(cy SHL 3),$FF,vid[y,X].A SHR 4);
CASE C OF
#0 : BEGIN
CASE ReadKey OF
#75 : Dec(CX);
#77 : Inc(CX);
END;
END;
#10,#13 : BEGIN
Inc(cy);
CX:=0;
END;
' '..#255 : BEGIN
vid[cy,CX].Z:=C;
WriteChr(CX SHL 3,200+(cy SHL 3),vid[cy,CX].A AND 15,vid[cy,CX].A SHR 4,vid[cy,CX].Z);
Inc(CX);
IF CX>79 THEN BEGIN
Inc(cy);CX:=0;
END;
END;
END;
IF CX<0 THEN CX:=1;
IF CX>79 THEN BEGIN
Inc(cy);CX:=0;
END;
END;
flip;
ll:=L;
L:=P;
P.X:=P.X+v.X;
P.y:=P.y+v.y;
ASM CLI END;
ZeigSp(ll.X,ll.y,0 );
ZeigSp(P.X, P.y ,15);
ASM STI END;
IF P.X>630 THEN v.X:=v.X*-1;
IF P.X<010 THEN v.X:=v.X*-1;
IF P.y>180 THEN v.y:=v.y*-1;
IF P.y<010 THEN v.y:=v.y*-1;
UNTIL (C=#27) OR (cy>24);
SetIntVec($1C,@timeIntVec);
TextMode(lastmode);
{ Text in den Textspeicher kopieren }
Move(vid,Ptr($B800,0)^,Sizeof(vid));
GotoXY(CX+1,cy+1);
END.
Frage 41
F: Wie kann ich mit TP einen Barcode auf einem DeskJet drucken ?
A: Zum Thema (EAN) Barcode gibt es sicherlich nicht gerade viel Literatur.
Vor längerer Zeit wurde mal das folgende Listing im ZNetz gepostet.
Die Ausgabe funktioniert auf NEC P7 Nadeldrucker, sollte jedoch leicht an
andere Drucker anzupassen sein.
{
ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͯ
-=- EAN -=-
Drucken von EAN-13,EAN-8,UPC-12 -Barcodes in variabler Größe
Mit Prozeduren zur direkten Ansteuerung
Gesamt-Modifikation 1
Copr. (C) P.Scholz Juli 1991 Version 1.00 Patch 1
€ŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽŽ
Sprache : Pascal; Compiler : Turbo-Pascal V5.00
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͦ
}
{$B-,S-,V-,I-,R-}
UNIT EAN;
INTERFACE
USES Printer;
TYPE EANart = (EAN13,EAN8,UPC12,ean13l,ean8l);
CONST EANgraphikein : string[5] = #28#90;
EANfaktor : byte = 4;
version = 10001;
PROCEDURE eanzIFfera(zIFfer:byte);
PROCEDURE eanzIFferb(zIFfer:byte);
PROCEDURE eanzIFferc(zIFfer:byte);
PROCEDURE eantrenn;
PROCEDURE eanrand;
PROCEDURE eanzeile(nummer:string;vergr:byte;typ:eanart);
IMPLEMENTATION
CONST eanparity : array [0..9,1..6] of byte =
( (1,1,1,1,1,1), (1,1,2,1,2,2), (1,1,2,2,1,2),
(1,1,2,2,2,1), (1,2,1,1,2,2), (1,2,2,1,1,2),
(1,2,2,2,1,1), (1,2,1,2,1,2), (1,2,1,2,2,1),
(1,2,2,1,2,1) );
eancodeA: array [0..9] of string[7] =
( #000#000#000#255#255#000#255, #000#000#255#255#000#000#255,
#000#000#255#000#000#255#255, #000#255#255#255#255#000#255,
#000#255#000#000#000#255#255, #000#255#255#000#000#000#255,
#000#255#000#255#255#255#255, #000#255#255#255#000#255#255,
#000#255#255#000#255#255#255, #000#000#000#255#000#255#255 );
eancodeb : array [0..9] of string[7] =
( #000#255#000#000#255#255#255, #000#255#255#000#000#255#255,
#000#000#255#255#000#255#255, #000#255#000#000#000#000#255,
#000#000#255#255#255#000#255, #000#255#255#255#000#000#255,
#000#000#000#000#255#000#255, #000#000#255#000#000#000#255,
#000#000#000#255#000#000#255, #000#000#255#000#255#255#255 );
eancodec : array [0..9] of string[7] =
( #255#255#255#000#000#255#000, #255#255#000#000#255#255#000,
#255#255#000#255#255#000#000, #255#000#000#000#000#255#000,
#255#000#255#255#255#000#000, #255#000#000#255#255#255#000,
#255#000#255#000#000#000#000, #255#000#000#000#255#000#000,
#255#000#000#255#000#000#000, #255#255#255#000#255#000#000 );
PROCEDURE eanzIFfera(zIFfer:byte);
VAR i,j,x : Byte;
BEGIN
Write(LST,EANgraphikein,chr(7*EANfaktor),#0);
FOR i := 1 to 7 DO
FOR x := 1 to EANfaktor DO
FOR j := 1 to 3 DO
Write(LST,eancodea[zIFfer,i])
END;
PROCEDURE eanzIFferb(zIFfer:byte);
VAR i,j,x : Byte;
BEGIN
Write(LST,EANgraphikein,chr(7*EANfaktor),#0);
FOR i := 1 to 7 DO
FOR x := 1 to EANfaktor DO
FOR j := 1 to 3 DO
Write(LST,eancodeb[zIFfer,i])
END;
PROCEDURE eanzIFferc(zIFfer:byte);
VAR i,j,x : Byte;
BEGIN
Write(LST,EANgraphikein,chr(7*EANfaktor),#0);
FOR i := 1 to 7 DO
FOR x := 1 to EANfaktor DO
FOR j := 1 to 3 DO
Write(LST,eancodec[zIFfer,i])
END;
PROCEDURE eantrenn;
CONST eantrennz : STRING[5] = #000#255#000#255#000;
VAR i,j,x : Byte;
BEGIN
Write(LST,EANgraphikein,chr(5*EANfaktor),#0);
FOR i := 1 to 5 DO
FOR x := 1 to EANfaktor DO
FOR j := 1 to 3 DO
Write(LST,eantrennz[i])
END;
PROCEDURE eanrand;
CONST eanrandz :STRING[3]= #255#000#255;
VAR i,j,x : Byte;
BEGIN
Write(LST,EANgraphikein,chr(3*EANfaktor),#0);
FOR i := 1 to 3 DO
FOR x := 1 to EANfaktor DO
FOR j := 1 to 3 DO
Write(LST,eanrandz[i])
END;
PROCEDURE eanzeile(nummer:string;vergr:byte;typ:eanart);
VAR i : Byte;
BEGIN
EANfaktor := vergr;
CASE Typ OF
ean13 : IF length(nummer) = 13 THEN
BEGIN
eanrand;
FOR i := 2 to 7 DO
IF eanparity[ord(nummer[1]) - ord('0'),i-1] = 1 THEN
eanzIFfera(ord(nummer[i]) - ord('0'))
ELSE eanzIFferb(ord(nummer[i]) - ord('0'));
eantrenn;
FOR i := 8 to 13 DO
eanzIFferc(ord(nummer[i]) - ord('0'));
eanrand
END;
ean8 : IF length(nummer) = 8 THEN
BEGIN
eanrand;
FOR i := 1 to 4 DO
eanzIFfera(ord(nummer[i]) - ord('0'));
eantrenn;
FOR i := 5 to 8 DO
eanzIFferc(ord(nummer[i]) - ord('0'));
eanrand
END;
UPC12: IF length(nummer) = 12 THEN
BEGIN
eanrand;
FOR i := 1 to 6 DO
eanzIFfera(ord(nummer[i]) - ord('0'));
eantrenn;
FOR i := 7 to 12 DO
eanzIFferc(ord(nummer[i]) - ord('0'));
eanrand
END;
ean13l: IF length(nummer) = 13 THEN
BEGIN
eanrand;
Write(LST,EANgraphikein,chr(6*7*EANfaktor),#0);
FOR i := 1 to 6*7*3*EANfaktor DO Write(LST,#000);
eantrenn;
Write(LST,EANgraphikein,chr(6*7*EANfaktor),#0);
FOR i := 1 to 6*7*3*EANfaktor DO Write(LST,#000);
eanrand
END;
ean8l: BEGIN
eanrand;
Write(LST,EANgraphikein,chr(4*7*EANfaktor),#0);
FOR i := 1 to 4*7*3*EANfaktor DO Write(LST,#000);
eantrenn;
Write(LST,EANgraphikein,chr(4*7*EANfaktor),#0);
FOR i := 1 to 4*7*3*EANfaktor DO Write(LST,#000);
eanrand
END
END
END
END.
Frage 42
F: Wie kann ich mit TP dBase-Dateien lesen bzw schreiben ?
A: Um dBase Dateien zu behandeln, muß man sogenannte LoLevel Dateizu-
griffe realisieren. Diese Art Zugriff ist am besten mit der Block-
read und Blockwrite Prozedur zu erreichen.
Eine Source-Sammlung zum Zugriff auf sämtliche Dateien ist bei
der MIB unter dem Namen GSDBF.ZIP zu requesten. (TP >= 5.5)
Frage 43
F: Wie kann ich mit Turbo-Pascal Daten (Arrays) kopieren/verschieben ohne
dies für jedes Element tun zu müssen?
Zum einen kann man dazu den MOVE Befehl von TP benutzten, der in der
Online-Hilfe beschrieben ist.
Allerdings arbeitet MOVE mit movsb. Das folgende Programm sollte etwa
doppelt so schnell sein (movsw), auf 386ern laest sich mit movsd nochmal
was rausholen.
!!! Es werden keine Ueberschneidungen beruecksichtigt, wie MOVE das tut!
PROCEDURE MovSeg(Source,Dest:Word);ASSEMBLER;
{Das Seg Source ins Seg Dest kopieren}
ASM
PUSH DS { Datensegment retten }
CLD
MOV DS,Source
XOR SI,SI { SI -löschen }
MOV ES,Dest
XOR DI,DI { DI -löschen }
MOV CX,$8000
REP MOVSW { 1 Segment kopieren }
POP DS
END;
PROCEDURE FastMov(Source,Dest:Pointer;Count:Word);ASSEMBLER;
{Schnelleres MOVE, Bereiche sollten aber an geraden Adressen beginnen,
sonst ist der Vorteil wieder dahin ($A+) }
ASM
PUSH DS
CLD
LDS SI,Source
LES DI,Dest
MOV CX,Count
SHR CX,1
REP MOVSW
ADC CX,0
REP MOVSB
POP DS
END;
Frage 44
F: Wie kann ich in TP auf Daten eingebundener OBJ Files zugreifen ?
A: Für Daten sieht das wie folgt aus :
{$L DATEI.OBJ} <- Die einzubindende Datei
PROCEDURE Data;EXTERNAL; <- worauf zugegriffen werden soll,
z.B: eine Tabelle
CONST Dataptr : POINTER = @Data; <- mit der Constante DataPtr kann jetzt
jeder Zeit auf die Tabelle zuge-
griffen werden.
Dies Prinzip ist natürlich auch für Funktionsaufrufe gültig.
Außerdem ist es egal, was für ein Objektfile eingebunden wird.
Jede beliebige Datei kann in eine OBJ-Datei gewandelt werden.
TP liegt dazu das Tool binobj.exe bei. Soll beispielsweise
die Datei text.txt eingebunden werden, so kann dies erreicht werden
durch
binobj.exe text.txt datei.obj data
und der obigen Methode.
Der letzte Parameter für binobj.exe ist der Name, unter dem die
Daten in Pascal bekannt gemacht werden. Der übergebene Parameter
muß mit dem Namen der EXTERNAL-Prozedur übereinstimmen.
Frage 45
F: Gibt es keine Möglichkeit ein Pascal-Prg gegen kopieren zu schützen ??
A: Einen idealen Kopierschutz gibt es genausowenig wie einen immer
funktionierenden. Deshalb mußt man wohl abwägen zwischen Programmier-
aufwand, Raubkopieraufwand und Benutzungsaufwand.
folgende "Lösungen" wären denkbar :
1) Code-Abfrage:
^^^^^^^^^^^^^^^^^
Jedesmal beim Programmstart (oder auch an ganz bestimmten Stellen
innerhalb des Programms) läßt du den Benutzer Daten eingeben, die nur
dem Handbuch oder einer beigelegten Codescheibe zu entnehmen sind. Hier
haben Raubkopierer leichtes Spiel, da es nur Papier zu kopieren gilt.
Selbst spezielle Papier- und Druckfarben stellen für heutige Kopierer
kein Hindernis mehr dar.
2) Dongle:
^^^^^^^^^^^
Eine kleine elektronische Codierschaltung (das sogenannte Dongle) wird
auf eine freie serielle oder parallele Schnittstelle aufgesteckt und bei
Programmstart abgefragt. Aufwendige und teure Angelegenheit.
3) reiner Kopierschutz:
^^^^^^^^^^^^^^^^^^^^^^^^
Teile der Originaldiskette werden mehr oder weniger unleserlich gemacht,
so daß möglichst viele Kopierprogramme entweder Daten übersehen oder mit
einer Fehlermeldung abbrechen, in beiden Fällen mit dem Resultat, daß nur
ein Teil der Daten kopiert wird. Zwar kann prinzipiell jede auf diese
Weise geschützte Diskette irgendwie kopiert werden, aber je unleserlicher
die Diskette ist, desto mehr Kopierprogramme werden an ihr scheitern. Auf
der anderen Seite wird so auch ein Starten des Programms von Festplatte
in der Regel unmöglich.
4) Key-Disk:
^^^^^^^^^^^^^
Ähnlich wie beim reinen Kopierschutz wird auch hier die Diskette
präpariert, allerdings ohne ein Kopieren der Programmdaten auf Festplatte
oder andere Disketten zu verhindern. Lediglich die Präparation an sich
wird so unnachahmbar wie möglich gemacht. Bei Programmstart werden dann
die momentan eingelegten Disketten auf solche Präparationen hin
überprüft. Die Originaldiskette wird auf diese Weise zur Schlüssel-
diskette oder "Key-Disk".
5) Selbstzerstörung:
^^^^^^^^^^^^^^^^^^^^^
Die Original-Diskette selbst ist durch reinen Kopierschutz vor dem
Vervielfältigen gesichert, beinhaltet aber ein Programm zum Installieren
auf Festplatte. Dies markiert einerseits die Diskette als bereits
installiert, andererseits bindet es Rechnerspezifische Daten in das
installierte Programm ein, z.B. HDD-Nummer , ROM-BIOS-Version oder
ähnliches.
Einen absolut sicheren Kopierschutz kann es dennoch nicht geben. Wenn er
unüberwindlich ist, wird er von irgend einem Hacker einfach ausgebaut
werden.
Frage 46
F: Gibt es in TP die Möglichkeit, die Tastatur zu sperren?
A: Ja, dies geht einfach über einen Port :
PROCEDURE KeyboardEnable; {unlocks keyboard}
BEGIN
Port[$21] := Port[$21] AND 253;
END;
PROCEDURE KeyboardDisable; {locks keyboard}
BEGIN
Port[$21] := Port[$21] or 2;
END;
Achtung: Für Eingaben muß selbstverständlich die Tastatur freigegeben
sein, sonst hilft nur noch der Reset-Taster.
Frage 47
F: Ich habe eine Interruptroutine geschrieben, nun will ich in dieser Rou-
tine Dos-Funktionen aufrufen, ab der Rechner hängt sich immer auf.
Was muß ich besonderes beachten ?
A: Dos ist ein System, das nicht reentrant ist. D.h. wenn eine Interrupt-
Routine eine Dos-Funktion unterbricht, und dann seinerseits wieder eine
Dos-Funktion aufruft, so kann Dos dies nicht bewältigen. Daher muß man
sich vergewissern, daß gerade keine Dos-Funktion aktiv ist.
Folgende Funktion liefert einen Zeiger auf ein Byte zurück. Wenn
dieses Byte 0 ist, dann hat DOS gerade nichts zu tun, und man kann ohne
Bedenken Dos-Funktionen aufrufen.
FUNCTION GetInDosByte:Pointer; ASSEMBLER;
ASM
MOV AH,$34
INT $21
MOV DX,ES
MOV AX,BX
END;
- int21,34 selbst ist nicht reentrant und sollte vor der
TSR-Installation ausgefuehrt werden - die Adresse aendert
sich nicht und kann somit in einem Pointer gespeichert werden
- es MUSS auch das CriticalError-Flag geprueft werden (0= alles ok),
seine Adresse:
DOS 2.x: es:bx+1
COMPAQ DOS 3.0: es:bx-$1AA
DOS 3.0+ es:bx-1
- es muessen vor dem Aufruf von Dos-Funktionen einige Daten
gesichert und/oder geaendert werden .
- es empfiehlt sich, sich auch int28 einzuklinken, um auch waehrend
DOS-Eingabefunktionen aktivierbar zu sein:
Innerhalb eines int28 duerfen unter der Bedingung, dass
CritErr=0 und Indos=1 ist, alle Dos-Funktionen ausser den
auf CON zugreifenden aufgerufen werden.
- LiteraturTip : Arne Schaepers
DOS 5 fuer Programmierer
Addison-Wesley
ISBN 3-89319-350-2
incl Disk 99DM
Frage 48
F: Ist es in Turbo Pascal möglich Prozedurübergreifende Sprünge zu machen ?
A: Von TP ist das nicht vorgesehen, aber mit ein bischen Assembler kann man
das leicht realisieren. Hier eine Unit die in der Pascal.Ger gepostet
wurde :
{$A-,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
Unit UFarJump;
{Autor Markus Eckert/Rheinstr 27/55276 Dienheim/Germany/Tel 06133-3741}
INTERFACE
TYPE FarLabel = RECORD
SP : Word;
BP : Word;
CASE Byte OF 0: ( IP,CS : Word );
1: ( Jump : Pointer)
END;
FUNCTION DefineFarLabel(Var FLabel : FarLabel):Word;
INLINE( $5F/ { pop di }
$07/ { pop es }
$FC/ { cld }
$89/$E0/ { mov ax,sp }
$AB/ { stosw }
$89/$E8/ { mov ax,bp }
$AB/ { stosw }
$E8/$00/$00/ { call $+3 }
$58/ { pop ax }
$05/$0A/$00/ { add ax,000Ah }
$AB/ { stosw }
$8C/$C8/ { mov ax,cs }
$AB/ { stosw }
$31/$C0 ); { xor ax,ax }
PROCEDURE GotoFarLabel(FLabel : FarLabel; Code : Word);
IMPLEMENTATION
PROCEDURE GotoFarLabel(FLabel : FarLabel; Code : Word);ASSEMBLER;
ASM
mov ax, Code
les bx, FLabel
mov sp, es:[bx].FarLabel.&SP
mov bp, es:[bx].FarLabel.&BP
jmp es:[bx].FarLabel.Jump
END;
End.
Frage 49
F: Wie kann ich Voc & Wave-Dateien auf dem PC-Speaker ausgeben ??
A: Die Werte in einer VOC-Datei entsprechen der Position einer Lautsprecher
Membran und nicht einer Frequenz!!! Leider kann der Lautsprecher des
PC's nur ein und ausgeschaltet werden. Um das Problem doch zu loesen,
ist mir nur ein Verfahren bekannt: Man schiebt eine so hohe Frequenz auf
den Lautsprecher, dass die Membran nicht mehr nachkommt. Dann kann man
durch Aenderung des Puls/Pause-Verhaeltnisses des Ausgabesignals die
Membran in jede beliebige Position bringen.
Die Ergebnisse sind natuerlich nicht berauschend, aber es funktioniert!
Es existieren einige PD/Shareware-Programme, die auch VOC-Dateien
mit solch einem Verfahren ausgeben.
Einfacher ist es sich einen kleine D/A-Wandler fuer den Druckerausgang
zu basteln. Hier die einfache und billige Schaltung:
Signal Pin
20k 20k
D0 2 >--####---+---####---- 0v
|
# 10k
#
20k |
D1 3 >--####---+
|
# 10k
#
|
... 4-8 ...
20k |
D7 9 >--####---+
|
# 10k
#
| 100nF
+-------||---> OUT
|
# 10k
#
|
GND 20 >---------+------------>
|
0v
#
# ### - Wiederstaende
|| - Kondensator
Die Schaltung stammt vom Programm "modplay" (zum Abspielen von Amiga-
Soundmodulen) und ist von einem "Harry Stox" erstellt worden.
Die Wiederstaende sollten nur eine Abweichung von 1% haben, damit sich
die Schaltung gut anhoert.
Das Ganze muss nur noch an einen Verstaerker (Heimische Stereoanlage)
angeschlossren werden und soll sich so gut wie eine Soundblaster-
Karte (8 Bit,Mono) anhoeren.
Hiermit ist das Abspielen von VOC-Dateien nun kein Problem mehr:
Einfach die einzelnen Bytes in der Datei mit der entsprechenden
Samplerate direkt auf den Druckerport schicken (port[3B7H]:=byte; in
Turbo Pascal - glaub ich ;-).
Du kannst natuerlich mal in den Boxen deiner Umgebung stoebern, ob
du nicht noch ein paar Programme fuer diese Schaltung findest (Es
existieren recht viele dafuer, da die LPT-Blaster in den USA recht
beliebt sind ...).
----------
Hier ein kleiner Source, der Wav-Dateien auf dem Speaker ausgibt.
Von wem der stammt, läßt sich leider nicht ermitteln, daher ist das
Teil ohne Doku. (Ich weiß nicht wie, aber es geht.)
USES Dos,Crt;
VAR O: Pointer;
F: File;
P,S,C,I,M,A: WORD;
B: ARRAY[0..64000] OF BYTE;
T: ARRAY[BYTE] OF BYTE;
PROCEDURE N; assembler;
asm
db 80,83 {push ax
push bx}
mov bx,P
cmp bx,S
jae @2
add bx,offset B
mov al,[bx]
mov bx,offset T
xlat
out 66,al
cmp C,1
jne @1
mov C,-1
mov ax,A
add P,ax
@1:
inc C
@2:
db 176,32,230,32,91,88,207;
{ mov al,$20
out $20,al
pop bx
pop ax
iret}
end;
begin
FillChar(T,50,1);
FOR I:=0 TO 14 DO FillChar(T[I*10+50],10,1+3*I);
FillChar(T[200],55,46);
Val(ParamStr(2),M,I);
IF I<>0 THEN Halt;
Val(ParamStr(3),A,I);
IF I<>0 THEN Halt;
M:=596590 DIV M;
Assign(F,ParamStr(1));
Reset(F,1);
WHILE NOT (EoF(F) OR KeyPressed) DO
BEGIN
P:=0;
C:=0;
BlockRead(F,B,64000,S);
GetIntVec(8,O);
Port[33]:=Port[33] OR 27;
SetIntVec(8,@N);
Port[67]:=52;
Port[64]:=M;
Port[64]:=0;
Port[67]:=144;
Port[97]:=Port[97] OR 3;
InLine($FA);
Port[33]:=Port[33] AND $FC;
InLine($FB);
REPEAT
UNTIL P>=S;
InLine($FA);
Port[33]:=Port[33] OR 1;
InLine($FB);
Port[97]:=Port[97] AND $FC;
Port[67]:=52;
Port[64]:=0;
Port[64]:=0;
Port[67]:=182;
Port[66]:=51;
Port[66]:=5;
SetIntVec(8,O);
Port[33]:=Port[33] AND 228;
end;
end.
Erfolgreiche Werte für die Parameter sind : 1-2 für Parameter 2 und
1-30 für Parameter 3.
Frage 50
F: Wie gebe ich unter den verschiedenen Multitaskern Zeitscheiben frei ?
A: Alle Multitasker stellen zum Abgeben von Time-Slices (Zeitscheiben)
eine Funktion zur Verfügung, die durch einen Interrupt aufgerufem wird.
Leider ist dieser Interrupt nicht einheitlich.
Bei der MIB kann eine entsprechende Unit requestet werden unter
dem Namen MTASKER.ZIP
Frage 51
F: Wie kann ich unter TP meine Adlib-Soundkarte nutzen ?
A: Da ich keine Adlib-Karte besitze, kann ich nicht sagen worauf die
folgende Unit basiert, und ob sie funktioniert.
UNIT ADLIB;
INTERFACE
USES DOS;
CONST SOUNDINSTALLED : BOOLEAN = FALSE;
NOTENLAENGE : INTEGER = 16;
TYPE OPERATOR = RECORD
KSL,MULTI,FB,AR,SL,SS,DR,RR,OL,AM,VIB,KSR,FM : INTEGER;
END;
TYPE INSTRUMENTTYP = RECORD
MODE,SZ : BYTE;
OP1,OP2 : OPERATOR;
END;
PROCEDURE SYNTH(FUNC,P1,P2,P3,P4,P5:INTEGER);
FUNCTION SYNTHBUSY:BOOLEAN;
PROCEDURE NO(N,L:INTEGER);
PROCEDURE PA(L:INTEGER);
FUNCTION MULTFAKT(NR:INTEGER):REAL;
PROCEDURE SYNTHRESET;
PROCEDURE SYNTHSTART;
PROCEDURE SYNTHSTOP;
PROCEDURE LEEREWARTESCHLANGE;
PROCEDURE SYNTHMODUS(MODE:INTEGER);
PROCEDURE SETTICKS(ANZAHL:INTEGER);
PROCEDURE TEMPO(TEMP:INTEGER);
PROCEDURE STIMME(NR:INTEGER);
PROCEDURE RELSTART(Z,N:INTEGER);
PROCEDURE LAUTSTAERKE(LAUT:INTEGER);
PROCEDURE LAUTVERZOEGERT(LAUT,VN,VZ:INTEGER);
PROCEDURE STIMMUNG(Z,N:INTEGER);
PROCEDURE STIMMUNGVERZOEGERT(Z,N,VZ,VN:INTEGER);
PROCEDURE INSTRUMENT(P:POINTER);
PROCEDURE CHECKDRIVER;
IMPLEMENTATION
TYPE CHARRAY = ARRAY[1..19] OF CHAR;
SOF = RECORD O,S : WORD; END;
CONST IDSTRING : CHARRAY = 'SOUND-DRIVER-AD-LIB';
VAR PAR : ARRAY[1..5] OF INTEGER;
R : REGISTERS;
P : POINTER;
P1 : ^CHARRAY ABSOLUTE P;
{ EIN KOMMANDO AN SOUND.COM SENDEN -
DIE PARAMETER MÜSSEN IM ARRAY PAR[] EINGETRAGEN SEIN
}
PROCEDURE CMD(FUNC:INTEGER);
BEGIN
WITH R DO BEGIN
SI := FUNC;
ES := SEG(PAR);
BX := OFS(PAR);
INTR($65,R);
END; { WITH }
END; { CMD }
{ SYNTHESIZER BUSY ABFRAGEN }
FUNCTION SYNTHBUSY:BOOLEAN;
BEGIN
WITH R DO BEGIN
SI := 4;
ES := SEG(PAR);
BX := OFS(PAR);
INTR($65,R);
SYNTHBUSY := (AL AND 1) <> 0;
END; { WITH }
END; { SYNTHBUSY }
{ EIN KOMMANDO AN SOUND.COM SENDEN -
ES MÜSSEN FUNKTION UND ALLE 5 MÖGLICHEN PARAMETER ÜBERGEBEN WERDEN
}
PROCEDURE SYNTH(FUNC,P1,P2,P3,P4,P5:INTEGER);
BEGIN
PAR[1] := P1;
PAR[2] := P2;
PAR[3] := P3;
PAR[4] := P4;
PAR[5] := P5;
WITH R DO BEGIN
SI := FUNC;
ES := SEG(PAR);
BX := OFS(PAR);
INTR($65,R);
END; { WITH }
END; { SYNTH }
{ GIBT DEN FREQUENZ- MULTIPLIKATIONSFAKTOR ZURÜCK }
FUNCTION MULTFAKT(NR:INTEGER):REAL;
BEGIN
CASE NR OF
0 : MULTFAKT := 0.5;
1..10,12 : MULTFAKT := NR;
11 : MULTFAKT := 10.0;
13 : MULTFAKT := 12.0;
14 : MULTFAKT := 15.0;
ELSE
MULTFAKT := -1;
END;
END; { MULTFAKT }
{ -------------------------------------------------------------- }
{
HIGLEVEL- PROZEDUREN
DIESE PROZEDUREN ERHALTEN NUR SOVIELE PARAMETER, WIE BENÖTIGT
UM DIE ANZAHL PARAMETER FÜR NOTE UND PAUSE KLEIN ZU HALTEN, IST EINE
GRUND- NOTENLÄNGE IN DER TYPISIERTEN KONSTANTEN NOTENLÄNGE ABGELEGT.
WENN NOTENLÄNGE 16 IST, SIND DIE KÜRZESTEN SPIELBAREN NOTEN 1/16, DIE
NOTENLÄNGE FÜR NO() UND PA() WIRD IN VIELFACHEN DIESES WERTS ANGEGEBEN.
DIE TONHÖHE IST EIN VORZEICHENBEHAFTETER INTEGER- WERT :
0 IST DAS C, ES SIND PRO OKTAVE 12 TÖNE UND HALBTÖNE VORHANDEN }
PROCEDURE SYNTHRESET;
BEGIN
SYNTH( 0,0,0,0,0,0); { RESET }
END; { SYNTHRESET }
PROCEDURE SYNTHSTART;
BEGIN
SYNTH( 3,1,0,0,0,0); { START }
END; { SYNTHSTART }
PROCEDURE SYNTHSTOP;
BEGIN
SYNTH( 3,0,0,0,0,0); { STOP }
END; { SYNTHSTART }
PROCEDURE LEEREWARTESCHLANGE;
BEGIN
SYNTH( 5,0,0,0,0,0); { WARTESCHLANGE LEEREN }
END; { LEEREWARTESCHLANGE }
PROCEDURE SYNTHMODUS(MODE:INTEGER);
BEGIN
SYNTH( 6,MODE,0,0,0,0); { MODUS 0 = SCHLAGZEUG, 1 = MELODISCH }
END; { SYNTHMODUS }
PROCEDURE SETTICKS(ANZAHL:INTEGER);
BEGIN
SYNTH(18,ANZAHL,0,0,0,0); { TICKS / SCHLAG }
END; { SETTICKS }
PROCEDURE TEMPO(TEMP:INTEGER);
BEGIN
SYNTH( 9,TEMP,0,1,0,0); { Z/N TEMPO, Z/N VERZÖGERUNG }
END; { TEMPO }
PROCEDURE STIMME(NR:INTEGER);
BEGIN
SYNTH(12,NR,0,0,0,0); { STIMME NR. }
END; { STIMME }
PROCEDURE RELSTART(Z,N:INTEGER);
BEGIN
SYNTH( 2,Z,N,0,0,0); { Z/N RELATIVER START }
END; { RELSTART }
PROCEDURE LAUTSTAERKE(LAUT:INTEGER);
BEGIN
SYNTH( 8,LAUT,100,0,0,0); { Z/N REL. LAUTSTÄRKE, Z/N VERZÖGERUNG }
END; { LAUTSTAERKE }
PROCEDURE LAUTVERZOEGERT(LAUT,VN,VZ:INTEGER);
BEGIN
SYNTH( 8,LAUT,100,VN,VZ,0); { Z/N REL. LAUTSTÄRKE, Z/N VERZÖGERUNG }
END; { LAUTSTAERKE }
PROCEDURE STIMMUNG(Z,N:INTEGER);
BEGIN
SYNTH(17,0,Z,N,0,0); { OKTAVE (0), Z/N STIMMUNG, Z/N VERZÖGERUNG }
END; { STIMMUNG }
PROCEDURE STIMMUNGVERZOEGERT(Z,N,VZ,VN:INTEGER);
BEGIN
SYNTH(17,0,Z,N,VZ,VN); { OKTAVE (0), Z/N STIMMUNG, Z/N VERZÖGERUNG }
END; { STIMMUNGVERZOEGERT }
PROCEDURE INSTRUMENT(P:POINTER);
BEGIN
SYNTH(16,SOF(P).O + 2,SOF(P).S,0,1,0);
END; { INSTRUMENT }
{ EINE NOTE MIT NOTENLAENGE LÄNGE SPIELEN }
PROCEDURE NO(N,L:INTEGER);
BEGIN
SYNTH(15,N,L,NOTENLAENGE,0,0);
END; { NO }
{ EINE PAUSE MIT NOTENLAENGE LÄNGE }
PROCEDURE PA(L:INTEGER);
BEGIN
SYNTH(14,0,0,NOTENLAENGE,L,NOTENLAENGE);
END; { PA }
PROCEDURE CHECKDRIVER;
BEGIN
{ Prüfen, ob SOUND.COM vorhanden ist
wenn ja, wird SOUNDINSTALLED True }
GETINTVEC($65,P);
{ WENN DER SOUND- INTERRUPT- VEKTOR = NIL IST, IST KEIN TREIBER INSTALLIERT
}
IF (P <> NIL) THEN BEGIN
{ 16H BYTES VOR DER SERVICE- ROUTINE FÜR DEN SOUND- INTERRUPT
STEHT DER ID- STRING IN SOUND.COM
}
DEC(SOF(P).O,$16);
IF P1^ = IDSTRING THEN SOUNDINSTALLED := TRUE;
END;
END; { CHECKDRIVER }
{ DIESE PROZEDUR WIRD AUTOMATISCH BEIM PROGRAMMSTART AUSGEFÜHRT ! }
BEGIN { MAIN }
CHECKDRIVER;
END.
Frage 52
F: Ich öffne eine untypisierte Datei mittels Reset. Beim Lesen mit
Blockread werden teilweise Variablen zerstört, oder der Rechner
stürzt ab. Was mache ich falsch ?
A: Der Fehler liegt nicht in der Blockread-Funktion sondern schon beim
Reset. Ein Beispiel :
VAR F:FILE;
B:WORD;
A:BYTE;
BEGIN
Assign(F,'TEST.PAS');
Reset(F); { FALSCHER AUFRUF !!! s.u }
BlockRead(F,A,Sizeof(A),B);
Hier soll ein Byte aus der Datei gelesen werden. Turbo Pascal öffnet
jedoch untypisierte Dateien grundsätzlich mit der Blockgröße 128 Bytes,
falls keine andere Größe angegeben wird. Es werden also tatsächlich 128
Bytes eingelesen. In B steht jedoch der Wert eins, weil nicht die Zahl
der Bytes zurückgeliefert wird, sondern die Anzahl der gelesenen Blöcke.
Der richtige Aufruf für Reset muß hier lauten Reset(F,1), um die Datei
mit der Blockgröße 1 Byte geöffnet wird.
Ein weiterer beliebter Fehler ist das öffnen der Datei mit der Block-
größe 0, also Reset(F,0). Dies führt bei Schleifen wie z.B.
WHILE NOT EOF(F) DO
BlockRead(F,A,Sizeof(A),B);
zu Endlosdruchläufen, da bei jeder Leseanweisung 0*Sizeof(A) = 0 Bytes
gelesen werden.
Frage 53
F: Beim Arbeiten mit mehreren Dateien bekomme ich öfter die Fehlermeldung
Nr 4. Too many files open. Was kann ich dagegen tun ?
A: Nun, dazu sollte man erst einmal die Ursache dieses Fehlers begutachten.
Werden weniger als 15 Dateien geöffnet, so kann man das Problem dadurch
lösen, daß man die Zahl der Dateihandles (in der Config.sys definiert)
erhöht. Das Erhöhen der Filehandles geht auch von Pascal aus, dann kann
ein Programm auch mehr als 15 Dateien öffnen. Hier drei verschiedene
Units:
---- Unit 1 ----
{$O-,F+,X+,B-,P+,I-,G+}
UNIT MaxFiles;
INTERFACE
IMPLEMENTATION
CONST
MaxFile = 255; { Entspricht 250 Dateien }
VAR
Index : INTEGER;
Puffer : ARRAY[1..MaxFile] OF BYTE;
BEGIN
FOR Index := 1 TO MaxFile DO
Puffer[Index] := $FF;
FOR Index := 1 TO 5 DO
Puffer[Index] := Mem[PrefixSeg:$18+PRED(Index)];
MemW[PrefixSeg:$32] := MaxFile;
MemW[PrefixSeg:$34] := Ofs(Puffer);
MemW[PrefixSeg:$36] := Seg(Puffer);
END.
---- Unit 2 ----
{* Bem: Die Unit muß als erste gestartet werden. Sie muß also in *
* alle Units eingebunden werden, die IO ausführen. Sie *
* darf fernerhin nicht als Overlay deklariert werden. *
* Ausserdem muß CONFIG.SYS entsprechend geändert werden. *
* Diese Unit läuft sowohl im Real- als auch im Protected Mode *}
Unit MaxFProt;
INTERFACE
USES
DOS;
TYPE
ProtRegisters = Record
EDI, ESI, EBP, RES, EBX, EDX, ECX, EAX : Longint;
Flags, ES, DS, FS, GS, IP, CS, SP, SS : Word;
END;
VAR
Reg : Registers;
P : ProtRegisters;
IMPLEMENTATION
BEGIN
(** Ist DPMI Installiert ? **)
Reg.AX := $1686; (** Funktion $16, Unterfunktion $86 **)
Intr($2F, Reg); (** Int 2fH **)
If Reg.AX = 0 Then (** Ist DPMI installiert **)
Begin
(** Simulation eines Real-Mode Interrupts **)
Reg.AX := $0300; (** Funktion des Interrupts $31 **)
Reg.BL := $21; (** Simulierter Interrupt **)
Reg.BH := 0; (** Flags **)
Reg.CX := 0; (** Words für Stack **)
P.EAX := $6700; (** Funktion des Real-Mode Interrupts **)
P.EBX := 255; (** Anzahl der zu öffnender Dateien **)
Reg.ES := Seg(P);
Reg.DI := Ofs(P);
Intr ($31, Reg); (** Aufruf des Protected-Mode Interrupts **)
End
(** Ist kein DPMI installiert **)
Else
Begin
Reg.AH := $67; (** Funktion 67H von Int 21H **)
Reg.BX := 255; (** Anzahl der zu öffnender Dateien **)
Intr($21, Reg); (** Int 21H **)
End
End.
---- Unit 3 ----
{$O-,F-,R-,S-,I-,V-,B-}
UNIT FExtend;
{ -------------------------------------------------------------------------- }
{ Diese Unit ermöglicht das Arbeiten mit mehr als 20 FileHandles. }
{ Dazu muß diese Unit nur in der USES-Anweisung im Hauptprogramm als erstes }
{ aufgeführt werden. Alles weitere geschieht von selbst. Extend versucht die }
{ Maximal-Anzahl auf 255 zu setzen. Die reale Handle-Anzahl wird von dem }
{ CONFIG.SYS Eintrag FILES=xxx festgelegt. Extend arbeitet mit allen DOS- }
{ Versionen ab 3.xx zusammen. }
{ }
{ Zielsysteme: Real, Protected, Windows }
{ -------------------------------------------------------------------------- }
INTERFACE
{ -------------------------------------------------------------------------- }
CONST MaxHandles = 255;
{ -------------------------------------------------------------------------- }
{ Dieser Wert legt die theoretische Maximal-Anzahl von File-Handles fest. }
{ Der Wert kann maximal 255 betragen und sollte unbedingt ungerade sein. }
IMPLEMENTATION {$IFDEF WINDOWS} USES WinProcs; {$ENDIF}
{$IFDEF MSDOS}
VAR Handles: Array[0..MaxHandles] of Byte;
PROCEDURE Install; NEAR; Assembler;
ASM
CLD
MOV DX,DS
MOV BX,MaxHandles
MOV ES,[PrefixSeg]
MOV DI,OFFSET [Handles]
MOV CX,[ES:$32]
LDS SI,[ES:$34]
MOV [ES:$32],BX
MOV [ES:$34],DI
MOV [ES:$36],DX
MOV AL,$FF
MOV ES,DX
SUB BX,CX
REP MOVSB
MOV CX,BX
REP STOSB
MOV DS,DX
END;
{$ENDIF}
{$IFDEF DPMI}
PROCEDURE Install; NEAR; Assembler;
VAR T: RECORD
EDI,ESI,EBP,Reserved,EBX,EDX,ECX,EAX: LongInt;
Flags,ES,DS,FS,GS,IP,CS,SP,SS: Word;
END;
ASM
CLD
MOV CX,Type(T)/2
XOR AX,AX
LEA DI,[T]
PUSH SS
POP ES
PUSH DI
REP STOSW
POP DI
MOV [T.EAX.Byte[1]],$67
MOV [T.EBX.Word],MaxHandles
MOV AX,$0300
MOV BX,$0021
INT $31
END;
{$ENDIF}
{$IFDEF WINDOWS}
PROCEDURE Install; NEAR; Assembler;
ASM
PUSH Word(MaxHandles)
CALL SetHandleCount
END;
{$ENDIF}
BEGIN Install; END.
Frage 54
F: Wie erkenne ich, welche Soundkarte auf einem Rechner installiert ist ?
A: Zu dieser Problemstellung läßt sich ein Source bei der MIB requesten
unter dem Namen DTSOUND.ARJ (4Kb). Allerdings sollte man immer dem
Benutzer die Möglichkeit lassen, es besser zu wissen, als das eigene
Erkennungsprogramm.
Frage 55
F: Wie kann ich beim Beenden meines Programmes einen Fehlercode an Dos
übergeben ?
A: Dies geschieht mit der Halt Routine (vgl Online Hilfe).
Halt bricht die Ausführung eines Programms ab und kehrt zur Betriebs-
systemebene zurück.
Deklaration: procedure Halt [ ( Exitcode: Word ) ];
wobei gilt:
Exitcode ist ein (optionaler) Ausdruck des Typs Word und kann benutzt
werden, um den Exit-Code einen Programms anzugeben.
Der Exit-Code kann entweder vom Elternprozeß oder in einer
DOS-Batch-Datei über ERRORLEVEL ausgewertet werden.
Frage 56
F: Wie erzeuge ich mit TP Arrays > 64 KB ??
A: Dies ist weder bei Turbo Pascal noch bei Borland Pascal 7.0 möglich.
Grund dafür ist NICHT, wie häufig behauptet, die Einschränkung der
Segmentgröße auf 64 KByte - jeder C-Compiler beweist das Gegenteil.
Zum Verwalten größerer Datenstrukturen sollten Sie diese aufteilen und
über Zeiger adressieren, oder eine Unit für virtuelle Arrayverwaltung
verwenden (was allerdings deutliche Performanceverluste bringt).
Hierzu ein kleiner Einschub von Holger Lembke :
Exkurs 1: Notwendigkeit von "Arrays größer 64K" oder
Wozu sowas überhaupt tun wollen???
Es gibt nur sehr wenige Anwendungen, bei denen tatsächlich xK
Speicher am Stück benötigt werden. Die allermeisten Probleme
lassen sich zergliedern, sodaß sich eine Anzahl kleiner
"Unterarrays" ergeben, die entweder direkt oder über eine
verkettete Liste verwaltet werden können.
Dazu zwei Beispiele:
1.) praktische Übung: große Grafiken in Speicher laden
type ptriple = ^ttriple;
ttriple = record r,g,b : byte; end;
pzeile = ^tzeile;
tzeile = array[0..1023] of ttriple;
pbild = ^tbild;
tbild = array[0..1023] of pzeile; {p!!}}
function loadbild(name : string):pbild;
Var datei : file;
tmp : pbild;
i : integer;
begin
assign(datei,name);
reset(datei,1);
getmem(tmp,sizeof(tbild));
fillchar(tmp^,sizeof(tbild),0);
i:=0;
repeat
getmem(tmp^[i],sizeof(tzeile));
blockread(datei,tmp^[i]^[0],sizeof(tzeile));
inc(i);
until (eof(datei));
close(datei);
loadbild:=tmp;
end;
2.) Speicherung dünn besetzter Matrizen
Manch' einer meint, daß er für seine Matrix 1000*1000 unbedingt
ein "Array[1..1000,1..1000] of Real" benötigen täte. Abgesehen
davon, daß sich das Problem nach obigem Muster lösen liese,
ergibt sich noch ein anderer Gesichtspunkt: im Einsatz ist die
Matrix dann tatsächlich nur mit einigen hundert Elementen
gefüllt, obwohl sie doch eine Million aufnehmen könnte.
Dieser Fall ist übrigens typisch für Probleme der FEM (Finiten
Elemente Methode) jeder Art: Die Matrizen sind in aller Regel
dünn besetzt mit höherer Elementdichte um die Hauptdiagonale.
Dazu kommt, daß dort selten mit so kleinen Matrizen gearbeitet
wird....
Hier wäre es also sinnvoll, statt einer Matrix eine verkettete
Liste der Matrixelemente zu implementieren, in der dann z.B.
immer nur Unterbereiche der Matrix wie ein Wand voller Kacheln
aneinander gelegt sind.
Groß: Zwischenschritt: Klein:
1 2 3 4 5 6 7 8 9 1 2 3 4 5 6 7 8 9 ==> 1:1 4:4
1x x 1x x U U U 1 2 3 1 2 3
2 x x x x 2 x x x x U U U 1x x 1 x x
3 x x x 3 x x x U U U 2 x x 2x x x
4 x x x 4U U U x x x 3 x 3 x x
5 x x x x 5U U U x x x x 4:1 7:4
6 x x x x 6U U U x x x x 1 2 3 1 2 3
7 x x x x 7U U U U U U x x x 1 1x
8 x x x 8U U U U U U x x x 2x x 2x
9 x 9U U U U U U x 3x x 3x x
U: unbesetzte 3*3-Matrix
Exkurs 2: Und es geht doch!!
Vorraussetzung ist allerdings Borland Pascal DPMI oder WINDOWS
als Entwicklungsplattform! Wer das nicht hat/will braucht nicht
weiter zu lesen.
Der Trick ist relativ einfach: Über GLOBALALLOC läßt sich vom
System Speicher in fast beliebig großen Brocken anfordern. Die
Zugriffe darüber sind allerdings nicht "trivial", da wegen der
Speicherschutzmechanismen doch noch einiges an Aufwand getrieben
werden muß. Wo Licht ist, ist auch Schatten, das Licht: Die
Schutzmechanismen bieten eine fast 100% Schutz gegen fehlerhafte
Speicherzugriffe im Einsatz, Programme werden also stabiler und
korrekter. Der Schatten: Naja, es dauert seine Rechenzeit...
Das folgende Beispiel sollen als Muster und Gedankenanstoß
dienen, LINCPTR ist einer (schlechten) Unit für "große
Collections" entnommen.
USES WinTypes, WinProcs;
Function LIncPtr (aPtr: Pointer; anOffset: LongInt): Pointer;
Assembler;
Asm
Mov Dx,Word(anOffset+2)
Mov Ax,Word(anOffset)
Mov Cx,OFFSET AHShift
Shl Dx,Cl
Add Dx,Word(aPtr+2)
Add Ax,Word(aPtr)
Jnc @@1
Add Dx,Offset AHincr
@@1:
End;
Var MemH : word; { Handle des Speicherblocks, "sein Name" }
adress : pointer; { Zeigert auf den Speicher }
memptr : pointer; { lokaler Zeiger auf den Speicher }
begin
{ein Megabyte Speicher holen...}
MemH:=GlobalAlloc(GMEM_MOVEABLE or GMEM_ZEROINIT,$1000000);
{und jetzt einen Zeiger auf die Speicherzelle $0823BCD bauen }
{1. Speicher ggf. laden, sperren und Zeiger holen }
Adress:=GlobalLock(MemH);
{2. Zeiger berechnen }
if (adress=nil) then begin
writeln('Schade, kein Platz zum Laden des Speichers.);
halt;
end else
memptr:=lincptr(adress,$0823bcd);
{...hier könnte man jetzt was tun...}
{3. Speicher wieder entladbar machen }
GlobalUnlock(MemH);
{und Speicher verwerfen.. }
globalfree(MemH);
end.
Hier wurde kurz und knapp demonstriert, wie ein 1MB großes
Speicherstück angelegt und darauf zugegriffen werden kann. Und
der Laufzeitmanager ist sogar so pfiffig, daß er den Speicher
auslagert, wenn er nicht benötigt wird. Erst mit GLOBALLOCK wird
ein Laden erzwungen.
Nachteile: Die Pointer-Rumrechnerei ist nicht ganz trivial. Und
der Speicher sollte nach Benutzung immer wieder entladbar gemacht
werden (GLOBALUNLOCK), da sonst andere Prozesse ihre Speicher-
blöcke ggf. nicht laden können. Dadurch kostet das ständige Laden
und Entladen natürlich wieder viel Zeit, andererseits können auf
einem Rechner mit 2MB Hauptspeicher OHNE weiteres auch 10 Kacheln
mit jeweils 1MB angelegt werden. Dennoch wäre auch hier
anzuraten, lieber viele kleine Stücke anzufordern als ein großes.
Und bei den kleine Stücken besteht dann immerhin die Chance, daß
es nach dem letzten Zugriff noch nicht entladen wurde...
Frage 57
F: Wie kann ich es denn einfachst anstellen, dass ich mit WRITELN
ganz normale ANSI-Files anzeigen lassen kann ??
(Ohne CRT geht es wunderbar.. aber sobald CRT geused wird geht
es nicht mehr.. arggggggggg)
A: Die CRT Unit leitet bei der Initialisierung die Ausgabe auf eine
Eigene Routine um. Damit die Ausgabe wieder ueber DOS laueft, sind
folgende Befehle noetig :
ASSIGN (Output, ''); REWRITE (Output);
Somit geht die komplette Ausgabe wieder ueber DOS. Rueckgaengig
machen kann man den ganzen Kram spaeter mit
ASSIGNCRT (Output);
WICHTIG: ANSI.SYS muß natürlich geladen sein.
Frage 58
F: Was ist der Unterschied zwischen Realmode und Protected-Mode ??
A: Realmode ist der 8088/8086 Mode, d.h. urspruengliche Modus, fuer den
DOS konzipiert wurde, der bei 1 MB Adressraum endet und im Prinzip
ein 64K Modus ist, bei dem durch das Segmentregister die fehlenden
4 Bit geliefert werden. (Die beiden 16-Bit Adressteile werden um 4
Bit verschoben addiert)
80286 und 80386/80486 haben darueberhinaus einen Protected mode, in
dem ein groesserer Speicherbereich direkt vom Prozessor adressiert
werden kann, also in dem man auch den Speicher über 1MB anfordern kann,
ohne irgendwelche besonderen Maßnahmen zu treffen.
Frage 59
F: Gibt es eine genauere Delay-Funktion, als die aus der CRT Unit?
A: AB 80286 Prozessoren ist mit der folgenden Routine ein Delay über die
Echtzeituhr möglich. Als Funktion sieht das dann wie folgt aus:
PROCEDURE Delay(ms: WORD); ASSEMBLER;
ASM
MOV AX, ms
MOV BX, 1000
MUL BX
MOV CX, DX
MOV DX, AX
MOV AH, $86
INT $15
END;
besserer Stil ist:
PROCEDURE Delay(w:longint);ASSEMBLER;
{ Delay(1000000) wartet genau eine Sekunde }
ASM
MOV CX,word ptr w+2 ;{ CX:DX = Mikrosekunden zu warten }
MOV DX,word ptr w
MOV AH,$86 ;{ Service 86H }
INT 15H ;{ Bios Interrupt 15H }
END;
und als Non-ASM:
PROCEDURE Dely(W:LongInt);
VAR Regs : Registers;
BEGIN
Regs.CX := Word(W SHR 16);
Regs.DX := Word(W MOD $10000);
Regs.AH := $86;
Intr($15,Regs);
END;
Frage 60
F: Wie kann ich in TP Potenzen berechnen ?
A: Da es keine Standardfunktion gibt, muß eine aus den zur Verfügung
stehenden Funktionen zusammengebastelt werden. Mit mathematischen
Kentnissen sollte das kein Problem sein:
exponent
basis = exp(exponent*ln(basis))
Also
FUNCTION Potenz(basis,exponent:real):real;
BEGIN
Potenz:=exp(exponent*ln(basis));
END;
Für Integerzahlen gibt es eine auch noch die folgende Methode:
FUNCTION Potenz (Basis: Integer; Exponent: Byte): LongInt;
VAR bit : Byte;
Result : LongInt;
BEGIN
IF Exponent=0 THEN
BEGIN
Potenz := 1;
Exit;
END;
bit := $80;
WHILE (Exponent AND bit)=0 DO bit := bit SHR 1;
Result := Basis;
WHILE bit > $01 DO
BEGIN
Result := Sqr(Result);
bit := bit SHR 1;
IF (Exponent AND bit)<>0 THEN Result := Result * Basis;
END;
Potenz := Result;
END;
Frage 61
F: Gibt es empfehlenswerte Bücher zur Programmierung ?
A: Es gibt natürlich eine Menge von empfehlenswerten Büchern für die
verschiedenen Gebiete. Hier eine "kleine" Liste:
Titel: Die Programmierung der EGA/VGA Grafikkarte
Autor: Matthias Uphoff
Verlag: Addison-Wesley
ISBN: 3-89319-274-3
Diskette: eine 5.25"-Diskette mit sämtlichen Listings
Preis: 79,00 DM
--Da stehen ALLE Register der VGA-Karte drin - ALLES super erklärt
--(auch: Eigene Modi entwerfen!)
Name: Programmer's Guide to the EGA and VGA Cards
Autor: Richard F. Ferraro
--Rest unbekannt--
(leider - ich frag aber noch nach!)
--Hier wird auch die Programmierung der VGA-Karten besprochen.
--Außerdem gibt es noch ein Kapitel das die _SVGA_ -Programmierung (z.B.
--von ET 4000, 3000) enthält.
Titel: Grafik mit Turbo Pascal
Autoren: Winfreid Kassera und Horst Schröder
Verlag: Markt&Technik
ISBN: 3-89090-905-1
Disketten: zwei 5.25"-360KB mit sämtlichen Listings
Preis: 89,00 DM
In den definierten (also Standard) Videomodis diverse Sachen
programmieren:
-Pull-down-Menüs
-Flugsimulation
-3D-Apfelmännchen
-Drehungen und Verschiebungen im Raum
-Balken- und Tortendiagramm-Programmierung
Titel: PC Intern 4.0
Autor: Michael Tischer
Verlag: Data Becker
ISBN: 3-8158-1094-9
Diskette: CD-ROM mit sämtlichen Listings, dem ganzen Buch und dem ganzen
Zeuchs aus den vorangehenden Ausgaben
Preis: 99,00 DM
(soweit ich das noch weiß!)
In diesem Buch ist so ziemlich alles enthalten:
-CD-ROM-Programmierung
-SB-Programmierung
-Netzwerkprogrammierung
-Bootsektorbeschreibung
-VGA-Programmierung
-Programmierung der seriellen / paralellen Schnittstelle
-DPMI
-TSRs
-FAT / Dateiverwaltung
-Speicherverwaltung
-Disketten- / Festplattenverwaltung
Ab hier: Aus Werbetext:
-Multimediaprogrammmierung
-Systemoptimierung
-innerer Aufbau von DOS
Auf CD-ROM:
Das gesamte Buch als Hypertext. zusätzliche Kapitel aus vorangehenden
Auflagen sowie alle Programmlistings.
Titel: Referenzhandbuch Dateiformate
Autor: Günter Born
Verlag: Addison-Wesley
ISBN: 3-89319-446-0
Preis: 89,90 DM
Enthält die Beschreibung vieler Dateiformate (z.B. TIFF, GIF, RLE,
HP-GL/2, WORD, dBASE, LOTUS 1-2-3)
Frage 62
F: Wie schicke ich Steuerzeichen zum Drucker?
A: Das Prinzip ist das gleiche, als wenn man in eine Datei schreibt.
Tatsächlich wird der Drucker von TP wie eine Datei behandelt. Durch
einbinden der Unit Printer wird der Dateivariablen LST der erste
Druckerport zugewiesen. Mit Writeln(lst,"text oder escapesequenz")
kann man nun sowohl Text als auch Steuerseuqenzen an den Drucker
senden.
Frage 63
F: Wie arbeitet man mit dem VESA-Far-Pointer ?
A: Die VESA-SVGA-Modi lassen sich ueber standardisierte Zugriffe des
Interrupt 10h, Funktion 4Fh nutzen.
WICHTIG: Bei den Infopuffern sollten immer 256 Bytes frei sein!
Zeigt der Puffer-Zieger auf einen Speicherbereich, der
nicht fuer 256 Bytes reserviert ist, kann es zu kompli-
kationen kommen.
VESA arbeitet mit 2 Zugriffsfenstern auf das Video-RAM.
Interrupt 10.4F.00 VESA-Informationen holen
----------------------------------------------
Eingabe: AH = 4F, AL = 00
ES:DI = Far-Pointer auf Info-Puffer (256 Byte)
Ausgabe: AL = 4F, AH = 00 -> VESA wird unterstuetzt
Info-Puffer: 00 "VESA"
04 uebergeordnete Version
05 untergeordnete Version
06 Far-Pointer auf ASCIIZ-String Karten-Hersteller
0A Leistungsfaehigkeit (0000)
0E Far-Pointer auf Liste mit Codenummer der unter-
stuetzen Video-Modi, abgeschlossen mit $FFFF
Interrupt 10.4F.01 Modus-Informationen holen
-----------------------------------------------
Eingabe: AH = 4F, AL = 01
CX = Modus
ES:DI = Far-Pointer auf Info-Puffer (256 Byte)
Ausgabe: wie immer.
Info-Puffer: 00 Modus-Flag
Bit 0 1 = Modus vom Monitor unterstuetzt
Bit 1 1 = optionale Inforamtionen vorhanden (12-1D)
Bit 2 1 = BIOS-Text-Funktioen unterstuetzt
Bit 3 0 = Monochrom, 1 = Farbe
Bit 4 0 = Textmodus, 1 = Grafikmodus
02 Flags fuer das erste Zugriffsfenster
Bit 0 1 = Fenster verfuegbar
Bit 1 1 = Lesezugriff moeglich
Bit 2 1 = Schreibzugriff moeglich
03 Flags fuer das zweite Zugriffsfenster
Bit 0 1 = Fenster verfuegbar
Bit 1 1 = Lesezugriff moeglich
Bit 2 1 = Schreibzugriff moeglich
04 Granularitaet der Verschiebung der Zugriffsfenster in KByte
06 Groesse der Zugriffsfenster in KByte
08 Segmentadresse der ersten Zugriffsfensters
0A Segmentadresse der zweiten Zugriffsfensters
0C Far-Pointer auf Routine zum Einstellen des sichtbaren
Bereichs in den beiden Zugriffsfenstern
(0000:0000, wenn nicht unterstuetzt)
10 Anzahl der Bytes einer Zeile im Video-RAM
Interrupt 10.4F.02 Modus setzen
---------------------------------
Eingabe: AH = 4F, AL = 02
BX = Modus
Ausgabe: wie immer.
Interrupt 10.4F.05 Zugriffsfenster setzen
--------------------------------------------
Eingabe: AH = 4F, AL = 05
BH = 0
BL = Nummer (0,1)
DX = Start
Ausgabe: wie immer.
Der Wert in DX muss mit der Granularitaet multipliziert werden, um die
tatsaechliche Startadresse zu erhalten.
(Es gilt immer: X = Adr MOD Breite, Y = Adr / Breite)
Interrupt 10.4F.07 Display Start setzen/lesen (ab VESA v1.1)
--------------------------------------------------------------
Eingabe: AH = 4F, AL = 07
BX = 0 : StartAdresse eingeben
1 : StartAdresse auslesen
CX = Spalte des 1.Pixels (links oben) (=X-Wert)
DX = Zeile des 1.Pixels (=Y-Wert)
Ausgabe: wie immer.
========================================================================
{
Ich habe mir jetzt die Muehe gemacht ein dokumentiertes Beispielproggie
zu schreiben, da es viele Fragen nach der Ermittlung und Nutzung des
Far-Pointers gab. Ich hoffe, das hilft allen, die noch Fragen hatten.
Bei mir laeuft das einwandfrei, aber man weiss ja nie..
Sollte ich irgendwelche groben Fehler gemacht haben oder jemand die
Erfahrung machen, das man bei ihm anders Arbeiten muss z.B. noch zu-
saetzliche Abfragen / Berechnungen erforderlich sind, bitte ich um
Rueckmeldung.
Vorraussetung fuer das Funktionieren ist eine VESA Karte/ein VESA Treiber
und die Wahl eines unterstuetzten Modus in Hauptprogramm.
}
{ Demonstration des Umgangs mit dem VESA Far-Pointer,
Axel Plinge 1995 (public domain) }
USES CRT;
TYPE TVESAInfoBuf = RECORD
Kennung : ARRAY[1..4] OF Char;
Version1 : Byte;
Version2 : Byte;
Hersteller : ^Char;
LeistungsFlag : LongInt;
Modi : ^Word;
Buf : ARRAY[1..242] OF Byte;
END;
TVESAModiBuf = RECORD
{00} ModusFlag : Word;
{02} Fenster1Flags : Byte;
{03} Fenster2Flags : Byte;
{04} Granularitaet : Word; { in KByte }
{06} FensterGroesse : Word; { in KByte }
{08} Fenster1Seg : Word;
{0A} Fenster2Seg : Word;
{0C} SetzBereich : Pointer;
{10} BytePerLine : Word;
{12} XAufloesung : Word;
{14} YAufloesung : Word;
{16} MatrixBreite : Byte;
{17} MatrixHoehe : Byte;
{18} BitPlanes : Byte;
{19} BitsPerPixel : Byte;
{1A} SpeicherBloecke : Byte;
{1B} Speichermodell : Byte;
{1C} SpeicherBlockGroesse : Byte; { in KByte }
{--} Buf : ARRAY[1..227] OF Byte;
END;
(* Interrupt 10.4F.00 VESA-Informationen holen
----------------------------------------------
Eingabe: AH = 4F, AL = 00
ES:DI = Far-Pointer auf Info-Puffer (256 Byte)
Ausgabe: AL = 4F, AH = 00 -> VESA wird unterstuetzt
Info-Puffer: 00 "VESA"
04 uebergeordnete Version
05 untergeordnete Version
06 Far-Pointer auf ASCIIZ-String Karten-Hersteller
0A Leistungsfaehigkeit (0000)
0E Far-Pointer auf Liste mit Codenummer der unter-
stuetzen Video-Modi, abgeschlossen mit $FFFF *)
{ Demonstration des Umgangs mit dem VESA Far-Pointer, Axel Plinge 1995
(public domain) }
FUNCTION GetModusInfo(Mo:Word;VAR M:TVESAModiBuf):Boolean;
(* Interrupt 10.4F.01 Modus-Informationen holen
-----------------------------------------------
Eingabe: AH = 4F, AL = 01
CX = Modus
ES:DI = Far-Pointer auf Info-Puffer (256 Byte)
Ausgabe: AL = 4F, AH = 00 -> VESA wird unterstuetzt
Info-Puffer: 00 Modus-Flag
Bit 0 1 = Modus vom Monitor unterstuetzt
Bit 1 1 = optionale Inforamtionen vorhanden (12-1D)
Bit 2 1 = BIOS-Text-Funktioen unterstuetzt
Bit 3 0 = Monochrom, 1 = Farbe
Bit 4 0 = Textmodus, 1 = Grafikmodus
02 Flags fuer das erste Zugriffsfenster
Bit 0 1 = Fenster verfuegbar
Bit 1 1 = Lesezugriff moeglich
Bit 2 1 = Schreibzugriff moeglich
03 Flags fuer das zweite Zugriffsfenster
Bit 0 1 = Fenster verfuegbar
Bit 1 1 = Lesezugriff moeglich
Bit 2 1 = Schreibzugriff moeglich
04 Granularitaet der Verschiebung der Zugriffsfenster in KByte
06 Groesse der Zugriffsfenster in KByte
08 Segmentadresse der ersten Zugriffsfensters
0A Segmentadresse der zweiten Zugriffsfensters
0C Far-Pointer auf Routine zum Einstellen des sichtbaren
Bereichs in den beiden Zugriffsfenstern
(0000:0000, wenn nicht unterstuetzt)
10 Anzahl der Bytes einer Zeile im Video-RAM *)
VAR F:Word;
BEGIN
ASM
LES DI,M { ES:DI -> InfoBuffer }
MOV AH,4Fh
MOV AL,01h
MOV CX,Mo
INT 10h
MOV F,AX
END;
GetModusInfo:=(F=$004F);
END;
FUNCTION SetzModus(Mo:Word):Boolean;
VAR F:Word;
(* Interrupt 10.4F.02 Modus setzen
---------------------------------
Eingabe: AH = 4F, AL = 02
BX = Modus
Ausgabe: AL = 4F, AH = 00 -> VESA wird unterstuetzt *)
BEGIN
ASM
MOV AH,4Fh
MOV AL,02h
MOV BX,Mo
INT 10h
MOV F,AX
END;
SetzModus:=(F=$004F);
END;
{ hier soll der beruechtigte Pointer hin }
VAR The_Pointer:pointer;
procedure SetzZugriffsfenster(Nr:Byte;Start:Word);assembler;
(* Interrupt 10.4F.05 Zugriffsfenster setzen
--------------------------------------------
Eingabe: AH = 4F, AL = 05
BH = 0
BL = Nummer (0,1)
DX = Start
Ausgabe: AL = 4F, AH = 00 -> VESA wird unterstuetzt *)
ASM
MOV AH,4Fh
MOV AL,05h
MOV BH,0
MOV BL,Nr
MOV DX,Start
CALL The_Pointer
END;
VAR Modus:TVESAModiBuf; { Infos zum aktuellen Modus }
FUNCTION Init(M:word):Boolean;
BEGIN { Modus Einschalten wenn Far-Pointer vorhanden }
The_Pointer:=NIL;
IF SetzModus(M) THEN
IF GetModusInfo(M,Modus) THEN
IF Modus.SetzBereich=NIL THEN TextMode(lastmode)
ELSE The_Pointer := Modus.SetzBereich;
{ besser hier noch was in der Art
IF The_Pointer=NIL THEN The_Pointer:=Zeiger auf INT 10
damit das auch auf Rechnern ohne Far-Ptr laeuft ... }
Init:=The_Pointer<>NIL;
END;
VAR Bank,Letzte_Bank : word;
Segment : word;
Nr_Schreib_Fenster : shortint;
I : word; { Schleifenzaehler }
BEGIN
{## Einschalten ###########################################################}
{ Keine Aufwendige Ermittlung mit dem VESA-Infoblock, einfach stur
einschalten (zuviel Aufwand wollte ich dann doch nicht in dieses
Beispiel investieren :-) }
IF Init($101) THEN BEGIN { bel. Modus, 101h = 640x480x256 }
{ Ermitteln eines Schreib-Fensters }
Nr_Schreib_Fenster:=-1; { kein Schreibfenster ? }
IF (Modus.Fenster1Flags and 4)>0 then Nr_Schreib_Fenster:=0
else IF (Modus.Fenster2Flags and 4)>0 then Nr_Schreib_Fenster:=1;
{ 4 = Bit 2 = Schreiben Moeglich }
CASE Nr_Schreib_Fenster OF
-1 : BEGIN
TextMode(LastMode);
WriteLN('Kein Schreibfenster? ');
Halt;
END;
0 : Segment:=Modus.Fenster1Seg; { Segment fuer Zugriff merken }
1 : Segment:=Modus.Fenster2Seg;
END;
{## Werte berechnen #######################################################}
WITH Modus DO
{ Bei Nicht-256-Farben-Modi besser "BytesPerLine" statt "XAufloesung" }
Letzte_Bank:=((Longint(BytePerLine)*Longint(YAufloesung)) SHR 10)
DIV Longint(granularitaet);
Inc(Letzte_Bank);
{ kein Clipping fuer das letzte "halbe" Fenster, Fenstergroesse bleibt
auch unberuecksichtigt, nur die Granularitaet wird beachtet um den
ganzen Bildschirm zu erfassen
(ist nur eine Demo, und es funzt :-) }
{## Demo - Endloses Pixelsetzen ###########################################}
REPEAT
Bank:=Random(Letzte_Bank); { zufaellig auswaehlen }
SetzZugriffsfenster(Nr_Schreib_Fenster,Bank); { Schreib-Bank Umschalten }
FOR I:=1 TO 100 DO
{ als Geschwindigkeitstest koennte man die FOR Scheife auch weglassen }
Mem[Segment:random($ffff)]:=Random(256); { zufaellig auswehlen }
{ sollte die aktuelle Bank die letzte sein, und ein Teil von ihr nicht
auf dem Schirm, so werden hier evtl. Punkte ins nichts gesetzt... }
UNTIL KeyPressed;
TextMode(LastMode);
END ELSE WriteLN('Konnte Modus nicht einschalten / verwENDen! ');
END.
Frage 64
F: Wie kann ich mit TP meine Maus ansteuern ?
A: Die Maussteuerung wird vom INT 33h ausgef"uhrt. Hier eine kleine
Unit zur Demonstration.
UNIT MOUSE;
{
Mouse
- by Bjarke Viksoe
- by Bojan Landekic
- 2 other authors found in SWAG's MOUSE.SWG (Mouse_ED.PAS)
One of the standard "hey, I can handle the mouse, too" units.
}
INTERFACE
TYPE
GCursor = record
ScreenMask,
CursorMask : array[0..15] of word;
hotX,hotY : integer;
end; {record}
CONST
HAMMER : GCursor = {As in the hammer of THOR, my favorite}
(ScreenMask : ($8003,$0001,$0001,$1831,
$1011,$0001,$0001,$8003,
$F83F,$F83F,$F83F,$F83F,
$F83F,$F83F,$F83F,$F83F);
CursorMask : ($0000,$3FF8,$4284,$4104,
$4284,$4444,$3FF8,$0380,
$0380,$0380,$0380,$0380,
$0380,$0380,$0380,$0000);
HotX : $0007;
HotY : $0003);
ARROW : GCursor = {Your run-of-the-mill Graphics Arrow cursor}
(ScreenMask : ($1FFF,$0FFF,$07FF,$03FF,
$01FF,$00FF,$007F,$003F,
$001F,$003F,$01FF,$01FF,
$E0FF,$F0FF,$F8FF,$F8FF);
CursorMask : ($0000,$4000,$6000,$7000,
$7800,$7C00,$7E00,$7F00,
$7F80,$7C00,$4C00,$0600,
$0600,$0300,$0400,$0000);
HotX : $0001;
HotY : $0001);
CHECK : GCursor = {A check-mark cursor}
(ScreenMask : ($FFF0,$FFE0,$FFC0,$FF81,
$FF03,$0607,$000F,$001F,
$803F,$C07F,$E0FF,$F1FF,
$FFFF,$FFFF,$FFFF,$FFFF);
CursorMask : ($0000,$0006,$000C,$0018,
$0030,$0060,$70C0,$3980,
$1F00,$0E00,$0400,$0000,
$0000,$0000,$0000,$0000);
HotX : $0005;
HotY : $0010);
CROSS : GCursor = {A circle with center cross cursor}
(ScreenMask : ($F01F,$E00F,$C007,$8003,
$0441,$0C61,$0381,$0381,
$0381,$0C61,$0441,$8003,
$C007,$E00F,$F01F,$FFFF);
CursorMask : ($0000,$07C0,$0920,$1110,
$2108,$4004,$4004,$783C,
$4004,$4004,$2108,$1110,
$0920,$07C0,$0000,$0000);
HotX : $0007;
HotY : $0007);
GLOVE : GCursor = {The hand with pointing finger cursor}
(ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF,
$E1FF,$E049,$E000,$8000,
$0000,$0000,$07FC,$07F8,
$9FF9,$8FF1,$C003,$E007);
CursorMask : ($0C00,$1200,$1200,$1200,
$1200,$13B6,$1249,$7249,
$9249,$9001,$9001,$8001,
$4002,$4002,$2004,$1FF8);
HotX : $0004;
HotY : $0000);
IBEAM : GCursor = {Your normal text entering I shaped cursor}
(ScreenMask : ($F3FF,$E1FF,$E1FF,$E1FF,
$E1FF,$E049,$E000,$8000,
$0000,$0000,$07FC,$07F8,
$9FF9,$8FF1,$C003,$E007);
CursorMask : ($0C30,$0240,$0180,$0180,
$0180,$0180,$0180,$0180,
$0180,$0180,$0180,$0180,
$0180,$0180,$0240,$0C30);
HotX : $0007;
HotY : $0007);
KKG : GCursor = {KKG symbol, a little sorority stuff}
(ScreenMask : ($FFFF,$1040,$1040,$0000,
$0000,$0000,$0411,$0411,
$0001,$0001,$0001,$1041,
$1041,$1041,$FFFF,$FFFF );
CursorMask : ($0000,$0000,$4517,$4515,
$4925,$5144,$6184,$6184,
$5144,$4924,$4514,$4514,
$4514,$0000,$0000,$0000 );
HotX : $0007;
HotY : $0005);
SMILEY : GCursor = {a Smiley face for you!}
(ScreenMask : ($C003,$8001,$07E0,$0000,
$0000,$0000,$0000,$0000,
$0000,$0000,$0000,$8001,
$C003,$C003,$E007,$F81F );
CursorMask : ($0FF0,$1008,$2004,$4002,
$4E72,$4A52,$4E72,$4002,
$4992,$581A,$2424,$13C8,
$1008,$0C30,$03C0,$0000 );
HotX : $0007;
HotY : $0005);
XOUT : GCursor = {a BIG X marks the spot}
(ScreenMask : ($1FF8,$0FF0,$07E0,$03C0,
$8181,$C003,$E007,$F00F,
$F81F,$F00F,$E007,$C003,
$8181,$03C0,$07E0,$0FF0 );
CursorMask : ($8001,$C003,$6006,$300C,
$1818,$0C30,$0660,$03C0,
$0180,$03C0,$0660,$0C30,
$1818,$300C,$6006,$C003 );
HotX : $0007;
HotY : $0008);
SWORD : GCursor = {For the D&D buffs...}
(ScreenMask : ($F83F,$F83F,$F83F,$F83F,
$F83F,$F83F,$F83F,$F83F,
$8003,$8003,$8003,$8003,
$8003,$F83F,$F01F,$F01F );
CursorMask : ($0100,$0380,$0380,$0380,
$0380,$0380,$0380,$0380,
$0380,$3398,$3398,$3FF8,
$0380,$0380,$0380,$07C0 );
HotX : $0007;
HotY : $0000);
HOURGLASS : GCursor = {Hour glass, for working...etc}
(ScreenMask : (65535,63519,59367,57083,
57083,48893,48645,49149,
57339,57339,59367,63519,
65535,65535,65535,65535);
CursorMask : (0, 2016, 6168, 8452,
8452,16642,16890,16386,
8196,8196, 6168, 2016,
0, 0, 0, 0);
HotX : $0008;
HotY : $0008);
function InitMouse : boolean;
{Initialize mouse to its default values for current screenmode.
Mouse is turned off.
Returns TRUE if mouse is present.}
function MouseDriverPresent : boolean;
{Returns TRUE if there were a mouse driver out there...}
procedure MouseOn;
{Turns mouse image on}
procedure MouseOff;
{Turns mouse image off}
procedure MouseInfo(VAR x,y : integer; VAR lb,rb : boolean);
{Get information about current x- and y-positions.
Also return info about current status of mouse buttons}
function LeftButton : boolean;
{Retuns TRUE if left mouse button is pressed}
function RightButton : boolean;
{Retuns TRUE if right mouse button is pressed}
procedure LastButtonPress(button : integer; VAR x,y : integer);
{Returns last x/y mouse pos when 'button' was pressed}
procedure LastButtonRelease(button : integer; VAR x,y : integer);
{Returns last x/y mouse pos when 'button' was released}
procedure SetMousePos(x,y : integer);
{Set mouse position on screen...}
procedure SetMouseWindow(x1,y1,x2,y2 : integer);
{Set mouse window limit}
Procedure SetMouseCursor(CursorMask : GCursor);
{Change mouse pointer image.}
procedure ReadMouseMotionCounters(VAR x,y : integer);
{Read mouse's motion counters}
procedure DefineMouseRatio(h,v : word);
{Change mouse Mickey/pixel ratio}
IMPLEMENTATION
Uses Dos;
Var
Regs : Registers;
function InitMouse : boolean; assembler;
asm
xor ax,ax
int $33
not ax
xor ax,1
and ax,1
end;
function MouseDriverPresent : boolean; assembler;
asm
mov ax,$21 {try to reset mouse}
int $33
cmp ax,-1
je @found
mov ax,$0 {not there. might be bad driver version... try setup mouse}
int $33
push ax
mov ax,$2 {quickly hide it again}
int $33
pop ax
@found:
inc ax
xor ax,1
end;
procedure MouseOn; assembler;
asm
mov ax,$0001
int $33
end;
procedure MouseOff; assembler;
asm
mov ax,$0002
int $33
end;
procedure MouseInfo(VAR x,y : integer; VAR lb,rb : boolean); assembler;
asm
mov ax,$0003
int $33
les si,x
mov [es:si],cx
les si,y
mov [es:si],dx
mov ax,bx
and al,1
les si,lb
mov [es:si],al
shr bl,1
and bl,1
les si,rb
mov [es:si],bl
end;
function LeftButton : boolean; assembler;
asm
mov ax,3
int $33
mov ax,bx
and ax,1
end;
function RightButton : boolean; assembler;
asm
mov ax,3
int $33
mov ax,bx
shr ax,1
and ax,1
end;
procedure LastButtonPress(button : integer; VAR x,y : integer); assembler;
asm
mov ax,5
mov bx,button
int $33
les di,x
mov [es:di],cx
les di,y
mov [es:di],dx
end;
procedure LastButtonRelease(button : integer; VAR x,y : integer); assembler;
asm
mov ax,6
mov bx,button
int $33
les di,x
mov [es:di],cx
les di,y
mov [es:di],dx
end;
procedure SetMousePos(x,y : integer); assembler;
asm
mov ax,$0004
mov cx,x
mov dx,y
int $33
end;
procedure SetMouseWindow(x1,y1,x2,y2 : integer); assembler;
asm
mov ax,$0007
mov cx,x1
mov dx,x2
int $33
mov ax,$0008
mov cx,y1
mov dx,y2
int $33
end;
Procedure SetMouseCursor(CursorMask : GCursor);
Begin
Regs.AX := $0009;
Regs.BX := CursorMask.HotX;
Regs.CX := CursorMask.HotX;
Regs.ES := Seg(CursorMask.ScreenMask);
Regs.DX := Ofs(CursorMask.ScreenMask);
Intr($33,Regs);
End;
procedure DefineMouseRatio(h,v : word); assembler;
asm
mov ax,$000F
mov cx,h
mov dx,v
int $33
end;
procedure ReadMouseMotionCounters(VAR x,y : integer); assembler;
asm
mov ax,$000B
int $33
les di,x
mov [es:di],cx
les di,y
mov [es:di],dx
end;
end.
Frage 65
F: Wie kann ich bei eine Exec Aufruf die Ausgabe abstellen ?
A: Da gibt es zunächst die Möglichkeit, den INT 29h abzuklemmen,
da dieser die Ausgabe vornimmt. Einfacher ist es jedoch
die Ausgabe auf das Gerät NUL umzuleiten:
Exec(GetEnv('COMSPEC'),'/Ctest.exe >NUL');
Frage 66
F: Wie berechne ich in Pascal Funktionen wie Arctan(x)?
A: Diese mathematischen Routinen sind leider bisher nicht implementiert,
können aber leicht durch die gegebenen Funktionen realisiert werden:
UNIT math;
{ Written by William C. Thompson - wct@po.cwru.edu }
{ changes by A.Schlechte }
{ This unit was written TO perform several basic mathematical calculations }
{ This unit automatically generates a random seed }
INTERFACE
CONST e=2.7182818284905;
FUNCTION adjust(a:real):real;
PROCEDURE quad(a,b,c: real; VAR x1,x2: real; VAR im:real);
FUNCTION relerror(observed,actual: real):real;
FUNCTION pow(a,b:real):real;
FUNCTION sign(r:real):integer;
FUNCTION rmax(r,s:real):real;
FUNCTION rmin(r,s:real):real;
FUNCTION imax(m,n:integer):integer;
FUNCTION imin(m,n: integer):integer;
FUNCTION log(x,base: real): real;
FUNCTION tan(a:real):real;
FUNCTION arcsin(x:real):real;
FUNCTION arccos(x:real):real;
FUNCTION arctan2(y,x:real):real;
FUNCTION degtorad(d:real):real;
FUNCTION radtodeg(r:real):real;
FUNCTION gcd(m,n:longint):word;
FUNCTION lcm(m,n:integer):integer;
FUNCTION prime(n:longint):boolean;
FUNCTION rnd(a,b:real):real;
FUNCTION rnd2(a,b:real):real;
FUNCTION gaussian(mu,sigma:real):real;
FUNCTION distance(x1,y1,x2,y2:real):real;
FUNCTION findline(x1,y1,x2,y2: real; VAR a,b:real):boolean;
FUNCTION hero(a,b,c:real):real;
FUNCTION factorial(n:word):extended;
FUNCTION stirling(x:real):extended;
FUNCTION combination(n,r:word):word;
FUNCTION permutation(n,r:word):word;
IMPLEMENTATION
FUNCTION adjust(a:real):real;
{ Adjusts angle TO fit into (-pi,pi] }
BEGIN
REPEAT
IF a<=-pi THEN a:=a+2*pi;
IF a>pi THEN a:=a-2*pi
UNTIL (a>-pi) AND (a<=pi);
adjust:=a
END;
procedure quad(a,b,c:real; VAR x1,x2: real; VAR im:real);
{ Solves any quadratic equation. IF im=0, x1 AND x2 are
two real solutions. IF im<>0, x1 AND x2 are real parts
of two solutions AND im is imaginary part. The two
solutions would be x1 + im I AND x2 - im I }
VAR d,q: real;
BEGIN
im:=0.0;
IF a=0 THEN BEGIN
x1:=-c/b;
x2:=-c/b
END
ELSE BEGIN
b:=b/a;
c:=c/a;
a:=1;
d:=b*b-4*c;
q:=-b/2;
IF d<0 THEN BEGIN
x1:=q;
x2:=q;
im:=sqrt(-d)/2
END
ELSE BEGIN
IF b<0 THEN q:=q+sqrt(d)/2
ELSE q:=q-sqrt(d)/2;
x1:=q;
IF q=0 THEN x2:=-b
ELSE x2:=c/q;
IF x2=0 }
END { a<>0 }
END;
FUNCTION relerror(observed, actual: real):real;
{ Relative error }
BEGIN
IF actual=0.0 THEN relerror:=abs(observed)
ELSE relerror:=abs(observed/actual-1)
END;
FUNCTION pow(a,b: real):real;
{ Computes a^b }
BEGIN
IF a=0 THEN
IF b=0 THEN pow:=1 { 0^0 = 1 }
ELSE IF b<0 THEN pow:=exp(b*ln(a)) { force error }
ELSE pow:=0 { 0^x = 0 }
ELSE IF a<0 THEN
IF abs(b)<1e-10 THEN pow:=1
ELSE IF relerror(b,round(b))<1e-8 THEN
pow:=(1-2*ord(odd(round(b))))*exp(b*ln(abs(a)))
ELSE IF (relerror(1/b,round(1/b))<1e-8) AND odd(round(1/b)) THEN
pow:=-exp(b*ln(abs(a)))
ELSE pow:=exp(b*ln(a)) { force error }
ELSE pow:=exp(b*ln(a))
END;
FUNCTION sign(r:real):integer;
BEGIN
IF r<0 THEN sign:=-1
ELSE IF r>0 THEN sign:=1
ELSE sign:=0
END;
FUNCTION rmax(r,s:real):real;
BEGIN IF s>=r THEN rmax:=s ELSE rmax:=r END;
FUNCTION rmin(r,s:real):real;
BEGIN IF s<=r THEN rmin:=s ELSE rmin:=r END;
FUNCTION imax(m,n:integer):integer;
BEGIN IF m>=n THEN imax:=m ELSE imax:=n END;
FUNCTION imin(m,n:integer):integer;
BEGIN IF m<=n THEN imin:=m ELSE imin:=n END;
FUNCTION log(x,base:real):real;
{ Computes log of x base base }
BEGIN
IF (base=0) AND (x=0) THEN log:=1
ELSE IF (base=0) AND (x=1) THEN log:=0
ELSE log:=ln(x)/ln(base)
END;
FUNCTION tan(a:real):real;
BEGIN
a:=adjust(a);
IF abs(a-pi/2)<1e-10 THEN tan:=9.99e+37
ELSE IF abs(a-3*pi/2)<1e-10 THEN tan:=-9.99e+37
ELSE tan:=sin(a)/cos(a)
END;
FUNCTION arcsin(x:real):real;
BEGIN
IF x<0 THEN arcsin:=-arcsin(-x)
ELSE
IF x=1 THEN arcsin:=pi/2
ELSE arcsin:=arctan(x/sqrt(1-x*x))
END;
FUNCTION arccos(x:real):real;
BEGIN
IF x<0 THEN arccos:=pi-arccos(-x)
ELSE
IF x=0 THEN arccos:=pi/2
ELSE arccos:=arctan(sqrt(1-x*x)/x)
END;
FUNCTION arctan2(y,x:real):real;
{ Computes angle of point (x,y) }
VAR at2:real;
BEGIN
IF x=0 THEN
IF y>=0 THEN arctan2:=pi/2
ELSE arctan2:=-pi/2
ELSE BEGIN
at2:=arctan(abs(y/x));
IF x>0 THEN
IF y>0 THEN arctan2:=at2
ELSE arctan2:=adjust(-at2)
ELSE
IF y>0 THEN arctan2:=adjust(pi-at2)
ELSE arctan2:=adjust(-pi+at2);
END
END;
FUNCTION degtorad(d:real):real;
{ Convert degrees TO radians }
BEGIN
degtorad:=d*pi/180
END;
FUNCTION radtodeg(r:real):real;
{ Convert radians TO degrees }
BEGIN
radtodeg:=r*180/pi
END;
FUNCTION gcd(m,n:longint):word;
{ Greatest Common Divisor }
VAR k,l,r:integer;
BEGIN
m:=abs(m); n:=abs(n);
IF m=0 THEN gcd:=n ELSE BEGIN
k:=m;
l:=n;
WHILE n<>0 DO BEGIN
r:=m MOD n;
m:=n;
n:=r
END;
gcd:=m
END
END;
FUNCTION lcm(m,n:integer):integer;
{ Least common multiple }
BEGIN
IF (m=0) AND (n=0) THEN lcm:=0
ELSE lcm:=abs(round((m*1.0)*n) div gcd(m,n))
END;
FUNCTION prime(n:longint):boolean;
{ Tests a number FOR primeness }
VAR
p: boolean;
i, limit: word;
BEGIN
n:=abs(n);
IF (n=0)OR(n=1) THEN prime:=false
ELSE IF (n=2)OR(n=2) THEN prime:=true
ELSE BEGIN
p:=false;
i:=2;
limit:=round(sqrt(n));
WHILE (i<=limit) AND NOT p DO BEGIN
IF (n MOD i=0) THEN p:=true;
i:=i+1
END;
prime:=NOT p
END
END;
FUNCTION rnd(a,b:real):real;
{ divides interval from a TO b, inclusive, into 65535 values AND
chooses one }
BEGIN
rnd:=a+random(65535)/65534*(b-a)
END;
FUNCTION rnd2(a,b: real):real;
{ Similar TO rnd, but MANY more divisions (over 4 million) }
BEGIN
rnd2:=a+(65535.0*random(65535)+random(65535))/(sqr(65535.0)-1)*(b-a)
END;
FUNCTION gaussian(mu,sigma:real):real;
{ Produces a Gaussian distributed random variable with mean mu
AND standard deviation sigma }
VAR
r,v1,v2: real;
BEGIN
repeat
v1:=rnd(-1,1);
v2:=rnd(-1,1);
r:=sqr(v1)+sqr(v2)
until (r<1) AND (r>0);
gaussian:=v1*sqrt(-2*ln(r)/r)*sigma+mu
END;
FUNCTION distance(x1,y1,x2,y2:real):real;
BEGIN
distance:=sqrt(sqr(x1-x2)+sqr(y1-y2))
END;
FUNCTION findline(x1,y1,x2,y2: real; VAR a,b:real):boolean;
{ Finds equation FOR line y=ax+b between (x1,y1) AND (x2,y2) }
BEGIN
IF x2=x1 THEN BEGIN
findline:=false;
exit
END;
findline:=true;
a:=(y2-y1)/(x2-x1);
b:=(x2*y1-x1*y2)/(x2-x1);
END;
FUNCTION hero(a,b,c:real):real;
{ Finds area of triangle with sides of length s }
VAR
s: real;
BEGIN
s:=a/2+b/2+c/2;
hero:=sqrt(s*(s-a)*(s-b)*(s-c));
END;
FUNCTION factorial(n:word):extended;
{ computes factorial }
VAR
i: word;
f: extended;
BEGIN
f:=1;
FOR i:=1 TO n DO f:=f*i;
factorial:=f
END;
FUNCTION stirling(x:real):extended;
{ computes factorial according TO Stirling's approximation -
this may NOT be correct... it should be, but ask your math professor }
VAR
s: extended;
i: word;
BEGIN
s:=1;
FOR i:=1 TO round(x) DO s:=s/e*round(x);
stirling:=s*sqrt(round(x))*sqrt(2.0*pi);
END;
FUNCTION combination(n,r:word):word;
{ computes nCr }
BEGIN
combination:=round((factorial(n)/factorial(n-r))/factorial(r))
END;
FUNCTION permutation(n,r:word):word;
{ computes nPr }
BEGIN
permutation:=round(factorial(n)/factorial(n-r))
END;
BEGIN
randomize
END.
Frage 67
F: Da immer wieder Leute vom Ändern von Deteien sprechen, die nicht von Ihnen
stammen, hier ein kleiner Auszug aus dem STGB:
§ 303a StGB (Datenveraenderung):
(1) Wer rechtswidrig Daten (§202a Abs.2) loescht, unterdrueckt,
unbrauchbar macht oder veraendert, wird mit Freiheitsstrafe bis zu zwei
Jahren oder mit Geldstrafe bestraft.
(2) Der Versuch ist strafbar.
§ 303b StGB (Computersabotage):
(1) Wer eine Datenverarbeitung, die fuer einen fremden Betrieb, ein
fremdes Unternehmen oder eine Behoerde von wesentlicher Bedeutung ist,
dadurch stoert,dass er
1. eine Tat nach § 303a Abs.1 begeht oder
2. eine Datenverarbeitungsanlage oder einen Datentraeger zerstoert,
beschaedigt, unbrauchbar macht oder veraendert,
wird mit Freiheitsstrafe bis zu fuenf Jahren bestraft.
(2) Der Versuch ist strafbar.
Frage 68
F: Wie kann ich auf meine Nodeliste von Pascal aus zugreifen?
A: Bei der MIB kann die Datei V7ENG10.ARJ requestet werden.
Diese Datei (12KB) enthält den Source einer Unit samt Doku.
Frage 69
F: Wie kann ich in TP Bits in einer Variablen ändern ?
A: Zunächst einen kleinen Ausflug in den Aufbau der Variablen:
Ein Byte besteht aus 8 Bits, die von rechts nach links von 0 bis 7
durchnummeriert sind. Jedem Bit wird der Wert 2^Bitnummer zugeordnet
Ist also nur Bit 0 gesetzt, so hat das Byte den Wert 2^0 = 1. Die
Bitfolge 01010110 entspricht also dem Wert 2^6+2^4+2^2+2^1 = 86.
Für Integervariablen wird das höchste Bit zur Vorzeichendarstellung
genutzt. Daher läßt sich mit einem Integer auch maximal nur 32767
darstellen, sowohl im negativen, als auch im positiven Bereich.
1 1 1 1 1 1
5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 Bit Nr
Byte [ | | | | | | | ]
Word [ | | | | | | | | | | | | | | | ]
Integer [V| | | | | | | | | | | | | | | ]
Einzelne Bits können nun gesetzt werden, indem die Variable mit einer
ODER-Verknüpfung behandelt wird. Soll beispielsweise das Bit 5 gesetzt
werden, so ist der Befehl Variable := Variable OR 32 (2^5) zu verwenden.
Ebenso leicht können mehrere Bits gleichzeitig gesetzt werden. Durch
Variable := Variable OR 86, werden die Bits 6,4,2 und 1 gesetzt.
Das Löschen von Bits, erreicht man durch das AND-Verknüpfen mit Inversen.
Zum Löschen des Bits 5 wird der Befehl Variable := Variable AND NOT 32
genutzt. Die gleiche Vorgehensweise funktioniert auch für Bitfolgen.
Soll ein Bit nur invertiert werden, d.h. gesetzt werden, falls es nicht
gesetzt ist und umgekehrt, so wird die XOR-Verknüpfung verwendet.
Der Befehl Variable := Variable XOR 32 invertiert also das Bits 5.
Nun noch eine UNIT, die das Arbeiten mit den Bits erleichtert:
Unit Bits;
{***********************************************************}
{* *}
{* Diese Bibliothek stellt eine Reihe von Funktionen *}
{* zur Bitmanipulation in Integer-und Word - Variablen *}
{* zur Verfuegung *}
{* *}
{* *}
{* ITSTBIT BTSTBIT: *}
{* Testet die angegebene Bitposition. TRUE wird ueber- *}
{* geben, wenn das getestete Bit gesetzt ist *}
{* *}
{* ISetBit,BSetbit: Setzt das angegebene Bit *}
{* *}
{* IROL,BROL. Rotiert die Zahl nach links *}
{* Das hoechstwertige Bit wird nachgeschoben *}
{* *}
{* IROR,BROR. Rotiert die Zahl nach rechts *}
{* Das niedrigstwertige bit wird nachgeschoben. *}
{* *}
{* IclrBit,BclrBit. Loescht das angegebene Bit. *}
{* *}
{* Intstr,BytStr. Wandelt eine Zahl in einen *}
{* Binaerstring *}
{* *}
{* Intval,Bytval. Wandelt einen Binaerstring in eine Zahl*}
{* *}
{* Die Funktionen, die mit einem "I" beginnen, werden *}
{* zur Bearbeitung von Zahlen der Typen Integer und *}
{* Word benutzt, die mit einem "B" beginnen, sind fuer *}
{* die Typen Byte und Shortint gedacht. *}
{* *}
{* *}
{* *}
{***********************************************************}
Interface
{Teste Bit mit Nummer Bitnr : True bedeutet Bit gesetzt }
Function Itstbit ( Zahl : Word; Bitnr : Integer ) : Boolean;
Function Btstbit ( Zahl : Byte; Bitnr : Integer ) : Boolean;
{Setze Bit mit Nummer Bitnr. }
Function Isetbit ( Zahl: Word; Bitnr: Integer ) : Word;
Function BsetBit ( Zahl: Byte; Bitnr: Integer ) : Byte;
{Rotiert Zahl um Bits-Stellen nach links }
Function Irol ( Zahl : Word; Bits : Integer ) : Word;
Function Brol ( Zahl : Byte; Bits : Integer ) : Byte;
{Rotiert Zahl um Bits-Stellen nach rechts }
Function Iror ( Zahl : Word; Bits : Integer ) : Word;
Function Bror ( Zahl : Byte; Bits : Integer ) : Byte;
{ Loesche Bit mit Nummer BitNr. }
Function Iclrbit ( Zahl : Word; Bitnr : Integer ) : Word;
Function Bclrbit ( Zahl : Byte; Bitnr : Integer ) : Byte;
{ wandelt Zahl in Binaerstring um }
Function Intstr ( Zahl : Word ) : String;
Function Bytstr ( Zahl : Byte ) : String;
{Wandle Binaerstring in Integer um }
Function Intval ( Str1 : String ) : Word;
Function Bytval ( Str1 : String ) : Byte;
Implementation
Function Itstbit ( Zahl : Word; Bitnr : Integer ) : Boolean;
Begin
Bitnr := Bitnr And $000F;
Itstbit := (( Zahl Shr Bitnr ) And 1 ) = 1
End;
Function Btstbit ( Zahl : Byte; Bitnr : Integer ) : Boolean;
Begin
Bitnr := Bitnr And $0007;
Btstbit := (( Zahl Shr Bitnr ) And 1 ) = 1
End;
Function Isetbit ( Zahl : Word; Bitnr : Integer ) : Word;
Var I : Word;
Begin
Bitnr := Bitnr And $000F;
I := 1;
Isetbit := Zahl Or ( I Shl Bitnr )
End;
Function Bsetbit ( Zahl : Byte; Bitnr : Integer ) : Byte;
Var I : Byte;
Begin
Bitnr := Bitnr And $0007;
I := 1;
Bsetbit := Zahl Or ( I Shl Bitnr )
End;
Function Irol ( Zahl : Word; Bits : Integer ) : Word;
Var
Bit15 : Boolean;
X : Word;
I : Integer;
Begin
Bits := Bits And $000F;
X := Zahl;
For I := 1 To Bits Do
Begin
Bit15 := Itstbit ( X, 15 );
X := X Shl 1;
If Bit15 Then X := Isetbit ( X, 0 )
End;
Irol := X
End;
Function Brol ( Zahl : Byte; Bits : Integer ) : Byte;
Var
Bit7 : Boolean;
X : Byte;
I : Integer;
Begin
Bits := Bits And $0007;
X := Zahl;
For I := 1 To Bits Do
Begin
Bit7 := Btstbit ( X, 7 );
X := X Shl 1;
If Bit7 Then X := Bsetbit ( X, 0 )
End;
Brol := X
End;
Function Iror ( Zahl : Word; Bits : Integer ) : Word;
Var
Bit0 : Boolean;
X : Word;
I : Integer;
Begin
Bits := Bits And $000F;
X := Zahl;
For I := 1 To Bits Do
Begin
Bit0 := Itstbit ( X, 0 );
X := X Shr 1;
If Bit0 Then X := Isetbit ( X, 15 )
End;
Iror := X
End;
Function Bror ( Zahl : Byte; Bits : Integer ) : Byte;
Var
Bit0 : Boolean;
X : Byte;
I : Integer;
Begin
Bits := Bits And $0007;
X := Zahl;
For I := 1 To Bits Do
Begin
Bit0 := Btstbit ( X, 0 );
X := X Shr 1;
If Bit0 Then X := Bsetbit ( X, 7 );
End;
Bror := X
End;
Function Iclrbit ( Zahl : Word; Bitnr : Integer ) : Word;
Var X : Word;
Begin
Bitnr := Bitnr And $000F;
X := $Fffe;
Iclrbit := Zahl And Irol ( X, Bitnr )
End;
Function Bclrbit ( Zahl : Byte; Bitnr : Integer ) : Byte;
Var X : Byte;
Begin
Bitnr := Bitnr And $0007;
X := $Fe;
Bclrbit := Zahl And Brol ( X, Bitnr )
End;
Function Intstr ( Zahl : Word ) : String;
Var I : Integer;
W : String[16];
Begin
W := '0000000000000000';
For I := 15 Downto 0 Do
If Itstbit ( Zahl, I ) Then
Insert ('1', W, 16 - I );
Intstr := W
End;
Function Bytstr ( Zahl : Byte ) : String;
Var I : Integer;
W : String[8];
Begin
W := '00000000';
For I := 7 Downto 0 Do
If Btstbit ( Zahl,I ) Then
Insert ('1',W,8 - I );
Bytstr := W
End;
Function Intval ( Str1 : String ) : Word;
Var I : Integer;
J : Integer;
K : Word;
Begin
K := 0;
J := Length ( Str1 );
If ( J > 16 ) Then J := 16;
For I := J Downto 1 Do
If ( Str1[I] = '1' ) Then
K := Isetbit ( K, J - I );
Intval := K
End;
Function Bytval ( Str1 : String ) : Byte;
Var
I,J : Integer;
K : Byte;
Begin
K := 0;
J := Length ( Str1 );
If ( J > 8 ) Then J := 8;
For I := J Downto 1 Do
If ( Str1[I] = '1') Then
K := Bsetbit ( K, J - I );
Bytval := K
End;
End.
Frage 70
F: Wie kann ich in Pascal Daten packen und entpacken ?
A: Mit der folgenden Unit können Daten entsprechend behandelt werden.
(Bei der MIB kann ein 120KB Packet mit verschiedenen Packern, sowie
Format-Dokus requestet werden. incl. LZW, LZH, LZSS, ZIP, PKZIP ...)
UNIT packer;
{$DEFINE ASM}
{ Es werden nur Zeichenwiederholungen und mehrfach vorkommende
Zeichenketten komprimiert. Jeder Gruppe von 16 Tokens steht ein
16-Bit Word (Command) voran. Ist das betreffende Bit von Command = 0,
dann wird das nächste Byte normal kopiert, sonst wird eine
Fallunterscheidung getroffen:
Im Sourcebuffer (bzgl. Decompress) steht jetzt ein 16-Bit Word
mit folgender Bedeutung:
A) Originalversion:
------------ ----
12 Bit 4 Bit
Offset Länge-3
Ist Offset=0, dann liegt eine einfache Zeichenwiederholung vor.
wird die Länge um 1 weiteres Byte zu einem 12-Bit Wert erweitert
(Länge). Es folgt das zu replizierende Byte (Gesamtlänge also:
4 Byte :-(() Außerdem werden nur Längen >16 komprimiert:
Länge := Länge-16; (warum??)
sonst:
Das Zeichenmuster der Länge steht an -
Gesamtlänge des Tokens: 2 Byte.
B) Meine Version:
---- ------------
4 Bit 12 Bit
Länge Offset
Ist Länge=$F, so liegt eine Zeichenwiederholung vor. In diesem Fall
werden die 2 Bytes folgendermaßen interpretiert:
---- ---- --------
4 Bit 4 Bit 8 Bit
$F Länge-3 Zeichen
Es wird also die Länge 15+3=18 bei Mehrfachzeichenketten geopfert.
Außerdem können nur Längen von 3..18 komprimiert werden. Liegt eine
größere Länge vor, so werden mehrere Tokens benötigt.
Da aber größere Längen nicht so häufig vorkommen, dürfte das den
Vorteil des 2-Byte Tokens gegenüber 4 Byte nicht aufwiegen.
sonst:
Wie Originalversion, mit dem Unterschied, daß die Länge 18 entfällt und
das Längennibble vorangestellt ist.
Jeder dieser 3 Fälle wird als ein Token behandelt, die Länge zwischen
2 Commands variiert also.
Bernd Nawothnig 12/94
Weitere Änderung:
* High- und Lowbyte vertauscht, um xchg ah,al zu sparen.
* Das Verfahren der Originalversion, die Länge der _gepackten_ Daten
an Decompress zu übergeben ist nicht korrekt. Da immer alle 16 Bit
eines Commands abgearbeitet werden, werden also i.d.R. ein paar
Byte zu viel "ausgepackt". Darum:
* Anstelle des Compressflags wird die Originallänge*2 in die ersten
2 Bytes geschrieben (ebenfalls Lowbyte first).
Das LS-Bit ist Copyflag (kopiert wenn gesetzt).
* Die Dekompressionsroutine entpackt nun einfach so lange, bis
diese Länge erreicht ist.
* Nachteil: Geht nur bis 32K.
* Komplette Dekompressions- und Teile der Kompressionsroutine
in Assembler umgeschrieben.
Bernd Nawothnig
}
INTERFACE
CONST BufferMaxSize = 65530;
BufferMax = pred(BufferMaxSize);
TYPE BufferIndex = 0..BufferMax;
BufferSize = 0..BufferMaxSize;
BufferArray = ARRAY [BufferIndex] OF BYTE;
BufferPtr = ^BufferArray;
FUNCTION Compress (Source,Dest : BufferPtr;
SourceSize : BufferSize): BufferSize;
FUNCTION Decompress (Source,Dest : BufferPtr): BufferSize;
FUNCTION OrigLength (Source: Pointer): Word;
IMPLEMENTATION
Const
MinRepLength = 3; { min. Länge Zeichenwiederholungen }
MaxRepLength = 18; { max. Länge Zeichenwiederholungen }
MinDupLength = 3; { min. Länge doppelte Zeichenketten }
MaxDupLength = 17; { max. Länge doppelte Zeichenketten }
Empty = -1;
OutOfRange = $1000;
RLE = $F;
Multiplikator = 40543;
TYPE HashTable = ARRAY [0..4095] OF INTEGER;
FUNCTION Compress(Source,Dest: BufferPtr;
SourceSize: BufferSize): BufferSize;
Var
Hash : HashTable;
Key,Command : Word;
Size : Byte;
X,Y,Z : BufferIndex;
Pos : Integer;
Bit : 0..15+1;
Function GetMatch: Boolean;
{$IFDEF ASM}
Assembler;
asm
cld
push ds { DS sichern }
push bp { BP sichern }
mov bp,[bp+4] { lokale Procedure: BP von Compress laden }
lds si,Source { Pointer auf Source ==> DS:SI }
mov bx,x { akt. Index ==> BX }
add si,bx { ... und addieren }
{-------- Hashwert berechnen -----------}
mov cl,4 { um 4 Bit shiften }
sub dh,dh { MS-Byte löschen }
lodsw { 1. + 2. Byte laden ... }
mov dl,al { ... 1. Byte ==> DL ... }
shl dx,cl { ... und um 4 Bit shiften }
xor dl,ah { ... 2. Byte durch XOR mit DL verknüpfen ... }
shl dx,cl { ... dann wieder DX um 4 Bit nach links shiften }
lodsb { 3. Byte laden }
sub ah,ah { MS-Byte löschen }
xor ax,dx { Ergebnis ==> AX }
mov dx,Multiplikator
mul dx
shr ax,cl { durch 4-Bit Rechtsshift in 12-Bit Wert wandeln }
{-------- in AX steht jetzt der 12 Bit Hashwert --------}
shl ax,1 { 1 Bit nach links (in Wordindex).
Shift um 3 Bit geht nicht, sonst ist das
LS-Bit nicht gelöscht }
lea di,Hash { Offset bzgl. SS ==> DI }
add di,ax { Hashwert addieren }
mov ax,bx { X ==> AX }
xchg ax,ss:[di] { Neuen Index mit Hashindex austauschen }
cmp ax,Empty { schon was eingetragen? }
je @NotFound { Nein, fertig }
mov cx,bx { akt. Index ==> CX }
sub cx,ax { HashIndex probeweise subtrahieren }
cmp cx,OutOfRange { Differenz > 4095? }
jae @NotFound { Ja, Eintrag nicht zu gebrauchen,
da nicht mit 12 Bit adressierbar }
mov pos,ax { Index aus HashTable an Compress übergeben }
sub si,3 { die 3 Byte wieder vom Source Index abziehen }
les di,Source { Pointer auf Source ==> ES:DI }
add di,ax { Index aus Hashtable addieren }
mov cx,MaxDupLength { maximal MaxDupLength Zeichen vergleichen }
repe cmpsb
je @MaxLengthReached { wenn REPE bis Zählerende abgelaufen ist, }
inc cx { stimmt CX, sonst ist um das getestete
Byte zuviel dekrementiert }
@MaxLengthReached:
mov ax,MaxDupLength
sub ax,cx { Länge der identischen Zketten berechnen }
cmp al,MinDupLength { mindestens 3 Zeichen? }
jb @NotFound { Nein, lohnt Kompression nicht }
add ax,bx { akt. Index auf Länge addieren }
cmp ax,SourceSize { Läuft Stringende über SourceSize hinaus? }
jbe @Ok { Nein, Ok }
mov ax,SourceSize { ja, ist größer: abschneiden }
@Ok:
sub ax,bx { akt. Index wieder abziehen }
mov Size,al { an Compress übergeben }
mov al,True { Return True }
jmp @Ende
@NotFound:
sub al,al { Return False }
@Ende:
pop bp { BP restaurieren }
pop ds { DS restaurieren }
end;
{$ELSE}
VAR HashValue : WORD;
BEGIN
HashValue := (((((Source^[X] SHL 4)
XOR Source^[X+1]) SHL 4)
XOR Source^[X+2]) * Multiplikator) SHR 4;
Pos := Hash[HashValue];
Hash[HashValue] := X; { neue Position, der Wert "wandert" mit }
IF (Pos <> Empty) AND (X-Pos < OutOfRange) THEN BEGIN
Size := 0;
WHILE ((Size < MaxDupLength) AND (Source^[X+Size] = Source^[Pos+Size])
AND (X+Size < SourceSize)) DO INC(Size);
Getmatch := (Size >= MinDupLength);
END else GetMatch := FALSE;
END;
{$ENDIF}
BEGIN
FillChar(Hash,4096*SizeOf(Integer),$FF);
X := 0; { erstes Byte Sourcefile }
Z := 2; { Position von Command }
Y := Z+2; { Start erstes Byte }
Bit := 0; { Bitzähler (für Command) }
Command := 0;
WHILE (X < SourceSize) AND (Y <= SourceSize) DO BEGIN
IF (Bit >= 16) THEN BEGIN
Dest^[Z+1] := HI(Command); { Intel-gerecht speichern }
Dest^[Z] := LO(Command);
Z := Y;
Bit := 0;
INC(Y,2)
END;
Size := 1;
WHILE (Source^[X] = Source^[X+Size]) AND (Size < MaxRepLength)
AND (X+Size < SourceSize) DO INC(Size);
IF Size>=MinRepLength THEN BEGIN
Dest^[Y+1] := (Size-MinRepLength) or $F0; { Kennungsnibble $F }
Dest^[Y] := Source^[X];
INC(Y,2);
INC(X,Size);
Command := (Command SHL 1) or 1;
END ELSE IF GetMatch THEN BEGIN
Key := (Word(Size-MinDupLength) shl 12) or ((X-Pos) and $0FFF);
Dest^[Y+1] := HI(Key);
Dest^[Y] := LO(Key);
INC(Y,2);
INC(X,Size);
Command := (Command SHL 1) or 1;
END ELSE BEGIN
Dest^[Y] := Source^[X];
INC(Y);
INC(X);
Command := Command SHL 1
END;
INC(Bit);
END;
Command := Command SHL (16-Bit);
Word(Pointer(@Dest^[Z])^) := Command;
IF (Y > SourceSize) THEN BEGIN
move(Source^[0],Dest^[2],SourceSize);
Compress := SourceSize+2;
SourceSize := (SourceSize shl 1) or 1; { CopyFlag }
END else begin
Compress := Y;
SourceSize := (SourceSize shl 1); { LS-Bit = 0 }
end;
Dest^[0] := LO(SourceSize);
Dest^[1] := HI(SourceSize);
END;
FUNCTION Decompress(Source,Dest: BufferPtr): BufferSize;
{$IFDEF ASM}
Assembler;
{***********************************************************************
Register:
DX Command
BH Shiftzähler (Bit)
BL erstes Nibble
AH zweites Nibble
**************************************************************************}
Var
unCompressedSize, Check : Word;
asm
push ds
cld { vorwärts kopieren }
lds si,Source { Pointer laden }
les di,Dest
lodsw { Kopfwort laden }
shr ax,1 { Copybit ins Carrybit schieben }
mov unCompressedSize,ax{ Originallänge sichern }
jc @Copy { Carry gesetzt? Dann kopieren }
mov Check,di { Startoffset merken }
add Check,ax { Länge auf Destinationindex addieren }
jc @Ende { Safety first ;-) }
sub bh,bh { Shiftzähler mit 0 initialisieren, damit
sofort Command geladen wird }
@MainLoop:
cmp di,Check { Ende schon erreicht? }
jae @Ende { Ja, fertig }
sub bh,1 { Shiftzähler schon abgelaufen? }
jnc @Continue { Nein, weiter }
lodsw { neues Command laden ... }
mov dx,ax { ... und nach DX bringen }
mov bh,15 { 16 Bits zu shiften }
@Continue: { weiter ohne Command zu laden }
shl dx,1 { MS-Bit testen }
jnc @Normal { keine Ersetzung, normal kopieren }
lodsw { Token ==> AX }
mov bl,ah { HighNibble ==> BL }
and ah,0fh { LowNibble ==> AH (HighN. ausblenden) }
{ in AX steht jetzt das 12-Bit Offset }
mov cx,4 { gleichzeitig 0 ==> CH }
shr bl,cl { HighNibble nach rechts shiften }
cmp bl,RLE { Zeichenwiederholung? }
je @RLE { Ja, da weiter }
add bl,MinDupLength { Länge um MinDupLength erhöhen }
mov cl,bl { Anzahl der zu kopierenden Bytes ==> CX }
neg ax { Offset invertieren .. }
xchg bx,ax { ... ==> BX & Shiftzähler in AH sichern }
@CopyLoop: { Der Aufwand zum Sichern von DS u. SI + }
mov al,es:[di+bx] { Laden des neuen Pointers verbunden mit }
stosb { abschließenden Restaurierungsarbeiten }
loop @CopyLoop { ist IMHO höher als der Gewinn durch ein
REP MOVSB (i.d.R. werden nur 4-5 Byte kopiert) }
mov bh,ah { Shiftzähler restaurieren }
jmp @MainLoop
@RLE:
add ah,MinRepLength
mov cl,ah
rep stosb { FillChar }
jmp @MainLoop
@Normal:
movsb { einfach kopieren }
jmp @MainLoop
@Copy:
mov cx,ax
rep movsb
@Ende:
mov ax,unCompressedSize
pop ds
end;
{$ELSE}
Var
X,Y,Pos : BufferIndex;
unCompressedSize, Command : Word;
k,Size : Byte;
HighNibble,
LowNibble : 0..15;
Bit : 0..15+1;
CopyFlag : Boolean;
BEGIN
unCompressedSize := Word(Pointer(Source)^);
CopyFlag := (UnCompressedSize and 1) = 1;
UnCompressedSize := UnCompressedSize shr 1;
IF CopyFlag THEN begin
move (Source^[2],Dest^[0],UnCompressedSize);
y := UnCompressedSize;
end else begin
Y := 0;
X := 4;
Command := (Source^[3] SHL 8)+Source^[2];
Bit := 16;
While Y
Frage 71
F: Wie kann ich unter TP das CMOS auslesen ?
A: Hier ein kleiner Artikel, der einmal in der Area gepostet wurde.
Leider weiß ich nicht mehr, von wem dieser Artikel stammt.
Ein weiterer Artikel kann bei der MIB requestet werden.
Die Datei heißt CMOS.ARJ (10KB).
Das CMOS RAM, das ab IBM AT in jedem PC kompatiblen Computer
vorhanden ist, enthaelt auch die RTC ( Realtime Clock = Echtzeit
Uhr ). Beim AT sind 64 Bytes adressierbar, ab dem NEAT 286 sind
es 128 Bytes. In den ersten Bytes kann die Uhrzeit gelesen und
geschrieben werden, auch eine Weckzeit, die von einigen wenigen
Programmen benutzt wird. Der groesste Teil der ersten 64 Bytes
des CMOS RAM / Uhrenbausteins sind quasi genormt, auch die
Checksumme ueber diese Daten ( soweit ich weiss wird die Checksumme
bei IBM PS/2 Computern anders berechnet ). Die Daten in den 2. 64
Bytes des CMOS RAM enthalten ebenfalls eine Checksumme, aber die
Daten sind abhaengig vom jeweiligen BIOS.
Zur Begriffsverwirrung traegt ein erweitertes CMOS RAM bei, das
die IBM PS/2 Computer mit Microchannel enthalten; in diesem CMOS
RAM sind die Konfigurationsdaten fuer den Microchannel abgelegt,
es ist ueber andere Portadressen zugaenglich.
Das "normale" CMOS RAM und die Echtzeituhr werden wie viele andere
Ein- Ausgabe Bausteine ueber 2 Portadressen angesprochen, das Index-
und das Datenregister. Die Adressen sind $70 fuer Index und $71
fuer Daten. Ungluecklicher weise liegt im hoechsten Bit des
Indexregisters ein Steuerbit, das festlegt, ob der NMI ( z.B. fuer
Memory Parity Check ) aktiv ist oder nicht - man kann sehen, dass
bei IBM sogar der _nicht_ maskierbare Interrupt maskierbar ist.
Um den Zustand des NMI enable Bit nicht zu veraendern, wenn man auf
das CMOS RAM / die Uhr zugreift, sollte wie folgt vorgegangen werden :
PORT[$70] := PORT[$70] AND $7F OR CMOS_RAM_Adresse;
Daten := PORT[$71];
bzw. zum Schreiben von Daten :
PORT[$70] := PORT[$70] AND $7F OR CMOS_RAM_Adresse;
PORT[$71] := Daten;
Erklaerung :
PORT[$70] ist das Indexregister
PORT[$70] AND $7F ist das NMI enable Bit
PORT[$70] := PORT[$70] AND $7F OR CMOS_RAM_Adresse;
gibt eine Adresse aus, ohne das NMI enable Bit zu veraendern.
Wenn die Uhr ausgelesen werden soll, ist zu beachten, dass
1. nur die niederwertigen 4 Bit der Daten gueltig sind
Die Daten der Uhr sollten Daten := PORT[$71] AND $F; gelesen werden.
2. dass, wenn sich die Zeit veraendert hat, seit sie zuletzt ausgelesen
wurde, auf allen Digits der Uhrzeit / des Datums das "Time changed Flag"
gelesen wird, d.h. statt der Daten ein $F.
Erneutes Lesen nach dem Einlesen des Time Changed Flag liefert auf
jeden Fall die korrekten Daten.
Also sollten z.B. die Sekunden wie folgt ausgelesen werden :
PORT[$70] := PORT[$70] AND $7F; { Sekunden sind auf Adresse 0 }
Daten := PORT[$71] AND $F;
{ falls sich die Zeit seit dem letzten Lesen geaendert hat }
IF Daten = $F THEN Daten := PORT[$71] AND $F;
Das Auslesen der RAM Zellen und der Statusregister der Uhr wird nicht
vom Time changed Flag beeinflusst.
Ein meiner Erfahrung nach brauchbarer Test auf CMOS RAM Groesse
128 Bytes ist es, die Indices 0 und 64 zu vergleichen; wenn sie
gleich sind, warten, bis Index 0 sich veraendert ( Sekundensprung )
und nochmals die Indices 0 und 64 vergleichen - sind sie dann
immer noch gleich, sind nur 64 Bytes CMOS RAM vorhanden, sonst
128 Bytes.
Frage 72
F: Wie wandle ich den Text einer Datei in Blocksatz um ?
A: Zunächst sucht man sich die längste Zeile heraus. Diese Zeile bestimmt
nun die Länge aller anderen Zeilen. Nun wird Zeile für Zeile nach dem
folgenden Schema bearbeitet:
Zunächst merkt man sich die Anzahl der Wörter, indem man mit
den String nach Trennzeichen durchsucht. Trennzeichen sind neben
den Spaces auch Kommata, Punkte und andere. Dabei sollte man auch
die Länge der Wörter insgesamt zählen (ohne Trennzeichen).
Anschließend berechnet man die Anzahl der Spaces, die *immer*
zwischen zwei Wörtern eingefügt werden müssen:
SpacesEverywhere = Zeilenbreite - Gesamtwörterlänge
--------------------------------
Anzahl der Wörter - 1
Hat man diese Größe, kann man die Anzahl der Wörter, bei denen
ein Space mehr als sonst eingefügt werden muß, berechnen:
SpacesSomewhere = Zeilenbreite - Gesamtwörterlänge
- SpacesEverywhere * (Anzahl der Wörter - 1)
Nun geht man wieder mit den String durch. Das erste Wort wird
unverändert durchgereicht. Anschließend wird vor jedem Wort
SpacesEverywhere Spaces eingefügt. Bei den ersten oder letzten
oder mittleren (je nach Geschmack) SpacesSomewhere Wörtern wird
ein zusätzliches Space eingefügt.
Fertig ist der Blocksatz.
Hier noch ein kleines Beispiel, welches das Prinzip umsetzt.
Da dies nur ein kleines Beispiel ist, gibt es den Nachteil,
das auch die letzte Zeile des Absatzes bearbeitet wird.
{$I-}
PROGRAM BlockSatz;
USES Dos,Crt;
VAR Fin : Text;
Fout : Text;
InBuffer : ARRAY [1..16384] OF Byte;
OutBuffer : ARRAY [1..16384] OF Byte;
Breite : Word;
Line : STRING;
Line2 : STRING;
ValErr : Integer;
FUNCTION MakeLine (S:STRING):STRING;
CONST Leer = ' '+
' '+
' '+
' '+
' ';
VAR Words : Word;
Wordlen : Word;
EverySp : Word;
SomeSp : Word;
I,J : Integer;
AnfSp : Byte;
EndSp : Byte;
HlpStr : STRING;
DoWord : Word;
DoSomeSp : Word;
BEGIN
Wordlen := 0;
Words := 1;
AnfSp := 0;
EndSp := 0;
{ Spaces am Anfang und am Ende löschen }
WHILE (S<>'') AND (S[1]=' ') DO
BEGIN
Inc(AnfSP);
Delete(S,1,1);
END;
WHILE (S<>'') AND (S[Length(S)]=' ') DO
BEGIN
Inc(EndSp);
Dec(S[0]);
END;
IF S<>'' THEN
BEGIN
I := 1;
WHILE (I<=Length(S)) DO
BEGIN
IF S[I] = ' ' THEN
BEGIN
INC(Words);
WHILE (S[I]=' ') AND (I <= Length(S)) DO INC(I);
DEC(I);
END
ELSE Inc(Wordlen);
INC(I);
END;
IF Words > 1 THEN
BEGIN
EverySP := (Breite - Wordlen-AnfSp-EndSp) DIV (Words-1);
SomeSp := (Breite - Wordlen-AnfSp-EndSp) MOD (Words-1);
HlpStr := '';
DoWord := 0;
DoSomeSp := SomeSp;
I := 1;
WHILE (I <= Length(S)) DO
BEGIN
IF S[I] = ' ' THEN
BEGIN
WHILE (S[I] = ' ') AND (I <= Length(S)) DO Inc(I);
Dec(I);
Inc(DoWord);
HlpStr := HlpStr+ Copy(Leer,1,EverySp);
IF (DoWord MOD (Words DIV (Somesp+1)) = 0) AND (DoSomeSp>0) THEN
BEGIN
HlpStr := HlpStr+' ';
Dec(DoSomeSp);
END;
END ELSE HlpStr := HlpStr+S[I];
Inc(I);
END;
END ELSE HlpStr := S;
END ELSE HlpStr:='';
MakeLine := Copy(Leer,1,AnfSp)+HlpStr+Copy(Leer,1,EndSp);
END;
BEGIN
Writeln('BlockSatzDemo, 1995 by Andreas Schlechte');
IF ParamCount < 2 THEN
BEGIN
Writeln('Syntax: Blocksatz [Breite]');
Halt;
END;
IF ParamCount=3 THEN Val(ParamStr(3),Breite,ValErr)
ELSE Breite := 70;
IF (ValErr <> 0) OR (Breite =0) THEN Breite := 70;
Assign(Fin,ParamStr(1));
SetTextBuf(Fin,InBuffer);
Reset(FIn);
IF IoResult <> 0 THEN
BEGIN
Writeln('Fehler beim Öffnen der Datei ',ParamStr(1));
Halt;
END;
Assign(FOut,ParamStr(2));
Reset(FOut);
IF IoResult = 0 THEN
BEGIN
Write('Ausgabedatei existiert bereits. Überschreiben? ');
IF Upcase(ReadKey)<>'J' THEN
BEGIN
Writeln;
Close(Fin);
Close(Fout);
Halt;
END;
Writeln;
END;
Rewrite(FOut);
SetTextBuf(FOut,OutBuffer);
IF IoResult <> 0 THEN
BEGIN
Writeln('Fehler beim Anlegen der Ausgabedatei');
Close(Fin);
Halt;
END;
WHILE NOT EOF(FIn) DO
BEGIN
Readln(FIn,Line);
Writeln(FOut,MakeLine(Line));
IF IoResult <> 0 THEN
BEGIN
Writeln('Fehler bei der Bearbeitung.');
Close(Fin);
Close(Fout);
Halt;
END;
END;
Close(Fin);
Close(Fout);
END.
Frage 73
F: Wie kann ich in TP die Tastaturwiederholrate setzen?
A: Für diese Arbeit stellt das Bios eine Funktion zur Verfügung,
die über den INT $16, Unterfunktion $03 zu erreichen ist.
Mit Hilfe der Funktion SetTyperate kann sowohl die Rate,
als auch das Delay bestimmt werden. Erlaubte Werte sind für
Delaytime 0-3 (250ms, 500ms, 750ms und 1000ms) und für Rate
0-31 (30/sec bis 2/sec)
PROCEDURE SetTyperate(Delaytime,Rate: Byte); ASSEMBLER;
ASM
MOV AX,$0305
MOV BH,Delay
MOV BL,Rate
INT $16
END;
------
Und jetzt noch ein kleines Programm, das zum Setzen der Werte
genutzt werden kann. Diese arbeitet jedoch nicht mit der Bios-
funktion, sondern direkt auf dem Port, über den die Tastertur
zu erreichen ist.
PROGRAM REPRATE;
{ REPEAT- RATE DER TASTATUR EINSTELLEN }
USES CRT;
VAR I,J : INTEGER;
ANSP,WIED : BYTE;
CH : CHAR;
DISP : BOOLEAN;
PROCEDURE SETRATE;
VAR OBYTE : BYTE;
BEGIN
PORT[$60] := $F3;
DELAY(10);
{
D5..D6 = ANSPRECHZEIT IN 250 MS
D0..D4 = WIEDERHOLRATE
}
OBYTE := (ANSP AND 3) SHL 5 + (WIED AND $1F);
PORT[$60] := OBYTE;
IF DISP THEN
BEGIN
WINDOW(1,1,80,25);
TEXTCOLOR(4);
GOTOXY(19,8); WRITE(ANSP:2);
GOTOXY(19,9); WRITE(WIED:2);
TEXTCOLOR(7);
WINDOW(2,13,78,13);
END;
END;
PROCEDURE INCANSP;
BEGIN
IF ANSP < 3 THEN
BEGIN
INC(ANSP);
SETRATE;
END ELSE WRITE(CHR(7));
END;
PROCEDURE DECANSP;
BEGIN
IF ANSP > 0 THEN
BEGIN
DEC(ANSP);
SETRATE;
END ELSE WRITE(CHR(7));
END;
PROCEDURE DECWIED;
BEGIN
IF WIED > 0 THEN
BEGIN
DEC(WIED);
SETRATE;
END ELSE WRITE(CHR(7));
END;
PROCEDURE INCWIED;
BEGIN
IF WIED < 31 THEN
BEGIN
INC(WIED);
SETRATE;
END ELSE WRITE(CHR(7));
END;
PROCEDURE FUNKTAST;
VAR CH : CHAR;
BEGIN
CH := READKEY;
CASE ORD(CH) OF
72 : INCANSP;
80 : DECANSP;
75 : DECWIED;
77 : INCWIED;
END; { CASE }
DELAY(6*(WIED XOR $1F));
END;
BEGIN
DISP := FALSE;
IF PARAMCOUNT = 2 THEN
BEGIN
VAL(PARAMSTR(1),ANSP,I);
VAL(PARAMSTR(2),WIED,J);
IF (I+J) <> 0 THEN HALT(0);
IF NOT(ANSP IN [0..3]) THEN HALT(0);
IF NOT(WIED IN [0..31]) THEN HALT(0);
SETRATE;
HALT(0);
END;
DISP := TRUE;
TEXTBACKGROUND(0);
CLRSCR;
TEXTCOLOR(14);
GOTOXY(1,2);
WRITE(''); FOR I := 1 TO 77 DO WRITE('Í'); WRITE('¯');
FOR I := 3 TO 5 DO
BEGIN
GOTOXY(1,I);
WRITE('');
GOTOXY(79,I);
WRITE('');
END;
GOTOXY(1,6);
WRITE('€');
FOR I := 1 TO 77 DO WRITE('Ž');
WRITE('');
FOR I := 7 TO 11 DO
BEGIN
GOTOXY(1,I);
WRITE('');
GOTOXY(79,I);
WRITE('');
END;
GOTOXY(1,12);
WRITE('€');
FOR I := 1 TO 77 DO WRITE('Ž');
WRITE('');
FOR I := 13 TO 13 DO
BEGIN
GOTOXY(1,I);
WRITE('');
GOTOXY(79,I);
WRITE('');
END;
GOTOXY(1,14);
WRITE('È'); FOR I := 1 TO 77 DO WRITE('Í');
WRITE('¦');
TEXTCOLOR(7);
WINDOW(3,3,77,5);
TEXTBACKGROUND(1);
TEXTCOLOR(15);
CLRSCR;
GOTOXY(8,2);
WRITE('Einstellen der Ansprechzeit und Wiederholrate des Autorepeat');
WINDOW(1,1,80,25);
TEXTBACKGROUND(0);
TEXTCOLOR(7);
GOTOXY(3,8);
WRITE(' Ansprechzeit = 1 (0..3) ',#24,
' = länger, ',#25,' = kürzer');
GOTOXY(3,9);
WRITE('Wiederholrate = 12 (0..31) ',#27,
' = schneller, ',#26,' = langsamer');
GOTOXY(39,10);
WRITE('Ende mit ');
ANSP := 1; { 0..3 }
WIED := 12; { 0..31 }
SETRATE;
WINDOW(2,13,78,13);
REPEAT
CH := READKEY;
IF CH = ^@ THEN FUNKTAST ELSE
BEGIN
IF CH <> ^[ THEN
BEGIN
WRITE(' ');
SOUND(1000+(30*(WIED XOR $1F)));
DELAY(4);
SOUND(500-(70*ANSP));
DELAY(10);
NOSOUND;
END;
END;
UNTIL CH = ^[;
WINDOW(1,1,80,25);
GOTOXY(1,14);
END.
Frage 74
F: Meine TP-Copyroutine versagt bei schreibgeschützten Dateien. Wo
liegt der Fehler?
A: Die Hauptfehlerquelle in diesem Gebit liegt darin, den Zugriffsmodus
auf die Datei nicht richtig zu setzen. Nehmen wir als Beispiel das
Programm aus der Onlinehilfe:
program CopyFile;
{ Simple, fast file copy program with NO error-checking }
var
FromF, ToF: file;
NumRead, NumWritten: Word;
Buf: array[1..2048] of Char;
begin
Assign(FromF, ParamStr(1)); { Open input file }
Reset(FromF, 1); { Record size = 1 }
Assign(ToF, ParamStr(2)); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
Writeln('Copying ', FileSize(FromF), ' bytes...');
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
Close(FromF);
Close(ToF);
end.
Ist die Quelldatei (Parameter 1) schreibgeschützt, so steigt dieses
Programm bei der Anweisung Reset(FromF,1) mit einer Fehlermeldung aus.
Fügen wir vor dieser Anweisung die Zeile
Filemode := 0;
ein, so wird die Datei ordnungsgemäß geöffnet. Damit wird der Zugriffs-
modus für Dateien auf Leseoperationen gesetzt. Doch nun tritt bei der
Anweisung Rewrite(ToF,1) eine Fehlermeldung auf. Dies liegt daran, daß
auch diese Datei mit den Zugriffsrechten "Nur Lesen" geöffnet werden
soll. Die Zugriffsrechte müssen also neu gesetzt werden. Die erreichen
wir durch die Zeile FileMode := 2; vor dem Rewrite. Das Programm sieht
nun also wie folgt aus:
program CopyFile;
{ Simple, fast file copy program with NO error-checking }
var
FromF, ToF: file;
NumRead, NumWritten: Word;
Buf: array[1..2048] of Char;
begin
Assign(FromF, ParamStr(1)); { Open input file }
FileMode := 0;
Reset(FromF, 1); { Record size = 1 }
Assign(ToF, ParamStr(2)); { Open output file }
FileMode := 2;
Rewrite(ToF, 1); { Record size = 1 }
Writeln('Copying ', FileSize(FromF), ' bytes...');
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
Close(FromF);
Close(ToF);
end.
Für FileMode gibt es, je nach Anwendung, viele verschiedene Werte, und
das Entziffern des Zugriffsmodus wird so erschwert.
Am besten ist es, wenn man sich Konstanten definiert, und diese dann
Filemode zuweist.
FM_ReadOnly = $00;
FM_WriteOnly = $01;
FM_ReadWrite = $02;
FM_DenyAll = $10;
FM_DenyWrite = $20;
FM_DenyRead = $30;
FM_DenyNONE = $40;
FM_Private = $80;
Damit kann Filemode := 0; auch durch FileMode := FM_ReadOnly; erreicht
werden, und die Bedeutung ist gleich klar. Wollen wir zusätzlich
sicherstellen, daß auch andere Programme (z.B. in Netzwerken) gleich-
zeit auf unsere Datei zugreifen können, so benutzen wir dazu die
Werte FM_Deny____. Mit FileMode:=FM_ReadOnly+FM_DenyNone; erlauben wir
allen anderen Programmen sowohl lesend als auch schreibend auf die
Datei zuzugreifen. Mit FileMode:=FM_ReadOnly+FM_DenyWrite verbieten
wir den anderen Programmen das schreiben in unsere Datei usw.
Frage 75
F: Wie kann ich ein einzelnes Zeichen aus einem String auslesen?
A: Einen String ist nichts anderes, als ein ARRAY[0..255] OF CHAR.
Dabei steht im 0-ten Eintrag die Länge des String, und der Rest
enthält die entsprechenden Zeichen:
VAR S:STRING;
BEGIN
S := 'HSLLO';
S[2] :='A';
Writeln(S);
END;
Genauso leicht kann man dann auch die Länge eines String manipulieren.
Man greift einfach auf S[0] zu:
S:='HALLOAAA';
Dec(S[0],3);
Frage 76
F: Wie kann ich die Ausgabe meiner TP-Programme umleiten?
A: Dazu muß die Dateivariable OUTPUT neu initialisiert werden. Wenn
am Anfang des Programms die beiden Befehle
Assign(OUTPUT,'');
Rewrite(OUTPUT);
stehen, wird die Ausgabe ordnungsgemäß ungeleitet. Für die Eingabe
existiert eine äquivalente Variable namens INPUT (steht alles im
Handbuch).
Frage 77
F: Wie ermittle ich die Größe einer offenen Textdatei?
A: Da dies TP nicht selbst kann, muß es vom Anwender über die ent-
sprechenden INT-21 (Dos) übernommen werden. Nachstehend die Funktion
in ASM und Normal. Bei einem Fehler liefert die Funktion den Wert -1.
TYPE LongWord = RECORD
W1,W2 : WORD;
END;
FUNCTION TSize(VAR TextDatei:Text):LongInt; ASSEMBLER;
Var Current : LongWord;
ASM
MOV AX,$4201 { Parameter für Dos-Funktion }
LES DI,TextDatei
MOV BX,ES:[DI] { bereitlegen }
XOR DX,DX { keine Offset Adresse für Seek }
XOR CX,CX { von der akt. Position }
INT 21H { Seek liefert die akt. Pos }
JC @Err { Carry=1 ? dann Fehler }
MOV Current.W1,AX
MOV Current.W2,DX { Aktuelle Position Retten }
MOV AX,$4202
XOR DX,DX { keine Offset Adresse für Seek }
INT 21H { vom Ende der Datei }
JC @Err { Carry=1 ? dann Fehler }
PUSH AX
PUSH DX
MOV AX,$4200
MOV DX,Current.W1 { Position wieder herstellen }
MOV CX,Current.W2
INT 21H { Seek vom Anfang }
POP DX
POP AX
JC @Err { Carry=1? dann Fehler }
JMP @Out { Ergebnis steht in DX,AX }
@ERR: MOV DX,$FFFF
MOV AX,$FFFF
@OUT:
END;
FUNCTION TSize(VAR TextDatei:Text):LongInt;
Var W1,W2 : Word;
Regs : Registers;
BEGIN
TSize := -1;
Regs.AX := $4201; { Parameter für Dos-Funktion }
Regs.BX := TextRec(TextDatei).Handle;
Regs.CX := 0; { keine Offset Adresse für Seek }
Regs.DX := 0; { von der akt. Position }
MSDos(Regs);
IF Regs.Flags AND FCarry <> 0 THEN
BEGIN
TSize := -1;
Exit;
END;
W1 := Regs.AX;
W2 := Regs.DX; { Aktuelle Position Retten }
Regs.AX := $4202;
Regs.DX := 0; { keine Offset Adresse für Seek }
MsDos(Regs); { vom Ende der Datei }
IF Regs.Flags AND FCarry <> 0 THEN Exit
ELSE TSize := LongInt(Regs.DX SHL 16 + Regs.AX);
Regs.AX := $4200;
Regs.DX := W1;
Regs.CX := W2;
MsDos(Regs);
IF Regs.Flags AND FCarry <> 0 THEN TSize := -1
END;
Frage 78
F: Wie kann ich ein fertiges Programm in der CONFIG.SYS aufrufen?
A: Dazu kann der Dos-Befehl INSTALL benutzt werden, allerdings erst
in neueren Dos-Versionen.
INSTALL=C:\BP\SOURCE\MYPROG.EXE
Frage 79
F: Wie berechne ich in wann Ostern ist?
----------------------------------------------------------------------
A:
======================================
Datumsarithmetik mit den PC und Pascal
======================================
Dieser Informationstext soll allen Programmierern helfen, die mit
der Berechnung von Tagesdaten oder der Logik der kirchlichen Feier-
tage kaempfen. Diese Text kann frei verteilt werden, solange die
folgenden Informationen nicht daraus entfernt werden.
OSTERBERECHNUNGEN:
==================
Dieser Algorithmus basiert nicht auf der Berechnung von Gauss und
kommt ohne Ausnahmen aus (lt. Paul Schlyter). Werte ueber 31 be-
zeichnen den Tag im April-31, Werte darunter bezeichnen den Tag
im Maerz.
FUNCTION Easter(year : INTEGER) : INTEGER;
VAR a, b, c, d, e, f, g, h, i, k, l, m : INTEGER;
BEGIN
a := year MOD 19;
b := year DIV 100;
c := year MOD 100;
d := b DIV 4;
e := b MOD 4;
f := ( b + 8 ) DIV 25;
g := ( b - f + 1 ) DIV 3;
h := ( 19 * a + b - d - g + 15 ) MOD 30;
i := c DIV 4;
k := c MOD 4;
l := ( 32 + 2 * e + 2 * i - h - k ) MOD 7;
m := ( a + 11 * h + 22 * l ) DIV 451;
Easter := h + l - 7 * m + 22;
END{FUNC};
Eine weitere Moeglichkeit, Ostern sehr schnell zu berechnen, besteht
darin, den auf das juedische Passahfest folgenden Sonntag zu berechnen.
Der sog. Passah-Vollmond wird berechnet, in dem das Jahr durch 19 ge-
teilt wird und der Rest mit der folgenden Tabelle verglichen wird:
0: Apr 14 5: Apr 18 10: Mrz 25 15: Mrz 30
1: Apr 03 6: Apr 08 11: Apr 13 16: Apr 17
2: Mrz 23 7: Mrz 28 12: Apr 02 17: Apr 07
3: Apr 11 8: Apr 16 13: Mrz 22 18: Mrz 27
4: Mrz 31 9: Apr 05 14: Apr 10
Faellt dieses Datum auf einen Sonntag, ist Ostern der naechste Sonntag!
Beispiel: 1992 MOD 19 = 16, daraus folgt 17.04., der naechste Sonntag
ist dann der 19. April (Ostersonntag)
Feiertage
---------
Massgebend fuer die kirchlichen Feiertage ist sowohl das Osterdatum
als auch der 1. Advent, der Beginn des Krichenjahres. Wie man Ostern
berechnet, wurde oben erlaeutert. Hier nun also die Berechnungen der
restlichen Feiertage.
Aschermittwoch: 40 Tage vor dem Ostersonntag,
dann zurückgehen bis zum Mittwoch
Bsp.: result := GetOstern;
Dec(result,40);
WHILE DayOfWeek(result) <> 3 DO
Dec(result);
Palmsonntag: Der Sonntag vor dem Ostersonntag, die Berechnung
ist damit trivial.
Weisser Sonntag: Der Sonnrtag nach Ostern, ebenfalls simpel.
Christi Himmelfahrt: 39 Tage nach dem Ostersonntag oder anders gesagt,
der zweite Donnerstag vor Pfingsten.
Pfingsten: 49 Tage nach dem Ostersonntag.
Fronleichnam: 60 Tage nach dem Ostersonntag.
Maria Himmelfahrt: Fest am 15. August (nicht ueberall Feiertag!)
1. Advent: Vom 24.12. zurück bis zum nächsten Sonntag,
dann noch drei Wochen zurück.
Sollte der 24.12. ein Sonntag sein, dann nur
noch drei Wochen zurückgehen.
Bsp.: result := MakeDate(24,12,year);
WHILE DayOfWeek(result) <> 0 DO
Dec(result);
Dec(result,21);
Buss- und Bettag: Der vorvorige Mittwoch vor dem 1. Advent, also
vom 1. Advent aus den Mittwoch suchen, dann noch
eine Woche zurück.
Bsp: <-- wie oben
WHILE DayOfWeek(result) <> 3 DO
Dec(result);
Dec(result,7);
Hl. drei Köinige: Fest am 06.01.
Allerheiligen: Fest am 01.11.
Tag der Arbeit: Fest am 01.05.
Tag der dt. Einheit: Fest am 03.10. Hier wird im Zuge von Sparmassnahmen
für die einzuführende Pflegeversicherung allerdings
überlegt, diesen Feiertag immer auf den ersten Sonn-
tag im Oktober zu legen, man sollte hier also die
politischen Nachrichten verfolgen!
Berechnung der Kalenderwoche
----------------------------
Die Woche 1 ist die Woche, die den ersten Donnerstag des Jahres
enthaelt, also mehr als die Haelfte diesem Jahr angehoert.
Berechnung des julianischen Datums
----------------------------------
Diese Routinen dienen der Umwandlung des Datums in eine serielle
julianische Zahl im Bereich von 01.01.1900 bis zum 31.12.2078,
wobei 0 fuer den 01.01.1900 steht (uebringens: 1900 war kein Schalt-
jahr und der 01.01. war ein Montag).
In der Astronomie und Raumfahrt gibt es ein festgelegtes Julianisches
Datum, das als Nullpunkt den 1.1.4713 v.u.Z. hat.
Im bezug auf Computer bastelt sich fast jeder sein eigenes
"Julianisches Datum", das teilweise am 1.1. 1900, 1970 oder 1980 den
Nullpunkt hat. Diese Erkenntnis ist dann wichtig, wenn irgendjemand
versucht, mit einem vorgegebenen Julianischen Datum zu rechen oder
die Routinen zur Zeitberechnung auf das astronomische Julianische
Datum anwenden will; er wird naemlich mit grosser Wahrscheinlichkeit
einen Misserfolg haben.
Um beim Begriff Julianisches _Datum_ zu bleiben : Dabei handelt es
sich um die Anzahl _Tage_ seit einem bestimmten Tag. Diese Angabe
ist als Erstellungs- oder Modifikationszeitpunkt fuer Dateien
natuerlich zu ungenau, deshalb wird in das Dateidatum zusaetzlich
die Zeit eingearbeitet. Eine solche Angabe ist im eigentlichen Sinn
kein "Julianisches _Datum_", man sollte in diesem Zusammenhang besser
von "Timestamps" ( Zeitmarken ) sprechen.
Frage 80
F: Wie kann ich, Records vergleichen ohne jedes Feld miteinander
vergleichen zu muessen ?
A: Das folgende Programm demonstriert Vergleicht mittels der
Function RecComp.
type tDemo=record
b:byte;
w:word;
s:string[20];
i:longint;
t:boolean;
end;
function RecComp(var x,y; Size:word):boolean;
var i,SegX,SegY,OfsX,OfsY:word;
begin
RecComp:=true;
SegX:=SEG(x); OfsX:=OFS(x);
SegY:=SEG(y); OfsY:=OFS(y);
for i:=0 to Size-1 do
if mem[SegX:OfsX+i]<>mem[SegY:OfsY+i] then
begin
RecComp:=false;
exit; {Raus bei Ungleichheit=unnoetige Vergleiche vermeiden}
end;
end;
var ra,rb:tDemo;
begin
{ Init Records }
ra.b:=2; ra.w:=42333; ra.s:='test'; ra.i:=-2001; ra.t:=true;
rb.b:=2; rb.w:=42333; rb.s:='Test'; rb.i:=-2001; rb.t:=true;
writeln(RecComp(ra,rb,SizeOf(ra))); { Vergleich nicht ok = false }
ra.s:='Test'; {jetzt mit grossem 'T'}
writeln(RecComp(ra,rb,SizeOf(ra))); { Vergleich ok = true }
end.
Frage 81
F: Wie konvertiere ich ein Datum ins UNIX Format und zurück ?
A: Mit der folgenden Unit stehen für diese Aufgabe einige Routinen
zur Verfügung.
Unit UnixDate;
(***************************************************************************)
(* UNIX DATE Version 1.00 *)
(* This unit provides access to UNIX date related functions and procedures *)
(* A UNIX date is the number of seconds from January 1, 1970. This unit *)
(* may be freely used. If you modify the source code, please do not *)
(* distribute your enhancements. *)
(* (C) 1991 by Brian Stark. *)
(* A programming release from Desert Fox Productions *)
(* FidoNet 1:289/3.8 + Columbia, MO - USA *)
(* Hatched via Pascal24 FileNetwork Germany by M.Mucko (2:242/94) *)
(* ----------------------------------------------------------------------- *)
(* bstark@pro-aasgard.cts.com *)
(* brian.stark@p8.f3.n289.z1.fidonet.org *)
(***************************************************************************)
INTERFACE
Uses
DOS;
Function GetTimeZone : ShortInt;
{ Returns the value from the enviroment variable "TZ". If not found, UTC is
assumed, and a value of zero is returned}
Function IsLeapYear(Source : Word) : Boolean;
{Determines if the year is a leap year or not}
Function Norm2Unix(Y, M, D, H, Min, S : Word) : LongInt;
{Convert a normal date to its UNIX date. If environment variable "TZ" is
defined, then the input parameters are assumed to be in **LOCAL TIME**}
Procedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);
{Convert a UNIX date to its normal date counterpart. If the environment
variable "TZ" is defined, then the output will be in **LOCAL TIME**}
Const
DaysPerMonth :
Array[1..12] of ShortInt = (031,028,031,030,031,030,031,
031,030,031,030,03);
DaysPerYear : Array[1..12] of Integer = (031,059,090,120,151,181,212,
243,273,304,334,36);
DaysPerLeapYear : Array[1..12] of Integer = (031,060,091,121,152,182,213,
244,274,305,335,36);
SecsPerYear : LongInt = 31536000;
SecsPerLeapYear : LongInt = 31622400;
SecsPerDay : LongInt = 86400;
SecsPerHour : Integer = 3600;
SecsPerMinute : ShortInt = 60;
IMPLEMENTATION Function GetTimeZone : ShortInt;
{}
Var
Environment : String;
Index : Integer;
Begin
GetTimeZone := 0; {Assume UTC}
Environment := GetEnv('TZ'); {Grab TZ string}
For Index := 1 To Length(Environment) Do
Environment[Index] := Upcase(Environment[Index]);
If Environment = 'EST05' Then GetTimeZone := -05; {USA EASTERN}
If Environment = 'EST05EDT' Then GetTimeZone := -06;
If Environment = 'CST06' Then GetTimeZone := -06; {USA CENTRAL}
If Environment = 'CST06CDT' Then GetTimeZone := -07;
If Environment = 'MST07' Then GetTimeZone := -07; {USA MOUNTAIN}
If Environment = 'MST07MDT' Then GetTimeZone := -08;
If Environment = 'PST08' Then GetTimeZone := -08;
If Environment = 'PST08PDT' Then GetTimeZone := -09;
If Environment = 'YST09' Then GetTimeZone := -09;
If Environment = 'AST10' Then GetTimeZone := -10;
If Environment = 'BST11' Then GetTimeZone := -11;
If Environment = 'CET-1' Then GetTimeZone := 01;
If Environment = 'CET-01' Then GetTimeZone := 01;
If Environment = 'EST-10' Then GetTimeZone := 10;
If Environment = 'WST-8' Then GetTimeZone := 08; {Perth, Western
Austrailia}
If Environment = 'WST-08' Then GetTimeZone := 08;
End; Function IsLeapYear(Source : Word) : Boolean;
{}
Begin
If (Source Mod 4 = 0) Then
IsLeapYear := True
Else
IsLeapYear := False;
End; Function Norm2Unix(Y,M,D,H,Min,S : Word) : LongInt;
{}
Var
UnixDate : LongInt;
Index : Word;
Begin
UnixDate := 0; {initialize}
Inc(UnixDate,S); {add seconds}
Inc(UnixDate,(SecsPerMinute * Min)); {add minutes}
Inc(UnixDate,(SecsPerHour * H)); {add hours}
(*************************************************************************)
(* If UTC = 0, and local time is -06 hours of UTC, then *)
(* UTC := UTC - (-06 * SecsPerHour) *)
(* Remember that a negative # minus a negative # yields a positive value *)
(*************************************************************************)
UnixDate := UnixDate - (GetTimeZone * SecsPerHour); {UTC offset}
If D > 1 Then {has one day already passed?}
Inc(UnixDate,(SecsPerDay * (D-1)));
If IsLeapYear(Y) Then
DaysPerMonth[02] := 29
Else
DaysPerMonth[02] := 28; {Check for Feb. 29th}
Index := 1;
If M > 1 Then For Index := 1 To (M-1) Do {has one month already passed?}
Inc(UnixDate,(DaysPerMonth[Index] * SecsPerDay));
While Y > 1970 Do
Begin
If IsLeapYear((Y-1)) Then
Inc(UnixDate,SecsPerLeapYear)
Else
Inc(UnixDate,SecsPerYear);
Dec(Y,1);
End;
Norm2Unix := UnixDate;
End; Procedure Unix2Norm(Date : LongInt; Var Y, M, D, H, Min, S : Word);
{}
Var
LocalDate : LongInt; Done : Boolean; X : ShortInt; TotDays : Integer;
Begin
Y := 1970; M := 1; D := 1; H := 0; Min := 0; S := 0;
LocalDate := Date + (GetTimeZone * SecsPerHour); {Local time date}
(*************************************************************************)
(* Sweep out the years... *)
(*************************************************************************)
Done := False;
While Not Done Do
Begin
If LocalDate >= SecsPerYear Then
Begin
Inc(Y,1);
Dec(LocalDate,SecsPerYear);
End
Else
Done := True;
If (IsLeapYear(Y+1)) And (LocalDate >= SecsPerLeapYear) And
(Not Done) Then
Begin
Inc(Y,1);
Dec(LocalDate,SecsPerLeapYear);
End;
End;
(*************************************************************************)
M := 1; D := 1;
Done := False;
TotDays := LocalDate Div SecsPerDay;
If IsLeapYear(Y) Then
Begin
DaysPerMonth[02] := 29;
X := 1;
Repeat
If (TotDays <= DaysPerLeapYear[x]) Then
Begin
M := X;
Done := True;
Dec(LocalDate,(TotDays * SecsPerDay));
D := DaysPerMonth[M]-(DaysPerLeapYear[M]-TotDays) + 1;
End
Else
Done := False;
Inc(X);
Until (Done) or (X > 12);
End
Else
Begin
DaysPerMonth[02] := 28;
X := 1;
Repeat
If (TotDays <= DaysPerYear[x]) Then
Begin
M := X;
Done := True;
Dec(LocalDate,(TotDays * SecsPerDay));
D := DaysPerMonth[M]-(DaysPerYear[M]-TotDays) + 1;
End
Else
Done := False;
Inc(X);
Until Done = True or (X > 12);
End;
H := LocalDate Div SecsPerHour;
Dec(LocalDate,(H * SecsPerHour));
Min := LocalDate Div SecsPerMinute;
Dec(LocalDate,(Min * SecsPerMinute));
S := LocalDate;
End;
BEGIN
END.
Frage 82
F: Wie berechne ich in TP Ellipsen und Kreise?
A: Die folgende Unit stellt eine Prozedur zur Erstellung von
Ellipsen zur Verfügung. Der Algorithmus kann der Prozedur
entnommen werden.
UNIT Ellipsen;
INTERFACE
USES Graph;
PROCEDURE Ellipse (HalbX, HalbY: integer);
PROCEDURE Circle (Radius: integer);
PROCEDURE PlotPoint (x, y: integer);
VAR CurrentX,
CurrentY: integer;
CONST ScreenX: word = 1; { zur Anpassung an das Breiten- }
ScreenY: word = 1; { Hoehen-Verhaeltnis des Bildschirms }
Color: word = white;
Plot: PROCEDURE (x, y: integer) = PlotPoint;
IMPLEMENTATION
(* --------------- Prozeduren ---------------- *)
PROCEDURE PlotPoint (x, y: integer);
{ ja, ich weiss - nichts ist langsamer als BGI - aber alles andere
muss man halt selber schreiben - bitte, steht jedem frei! ,-}
BEGIN (* PlotPoint *)
PutPixel (x, y, Color);
END (* PlotPoint *);
PROCEDURE Ellipse (HalbX, HalbY: integer);
{ Basiert auf einer Abwandlung des Bresenhamschen Kreisalgorithmus' }
VAR
x0, y1,
x, y: integer;
dx, dy, r: longint {real};
BEGIN (* Ellipse *)
x:= HalbX; y:= 0;
dy:= 2* HalbY* HalbY;
dx:= 2* HalbX* HalbX;
r:= HalbY* HalbY* HalbX;
Plot (CurrentX+ x, CurrentY);
Plot (CurrentX- x, CurrentY);
WHILE x > 0 DO BEGIN (* ein Quadrant *)
IF r >= 0 THEN BEGIN (* y-Schritt *)
Inc (y); r:= r- dx* y;
END (* IF r >= 0 *);
IF r < 0 THEN BEGIN (* x-Schritt *)
Dec (x); r:= r+ dy* x;
END (* IF r < 0 *);
Plot (CurrentX+ x, CurrentY+ y); (* 1. *)
Plot (CurrentX- x, CurrentY+ y); (* 2. *)
Plot (CurrentX- x, CurrentY- y); (* 3. *)
Plot (CurrentX+ x, CurrentY- y); (* 4. *)
(* Quadrant *)
END (* WHILE x > y *);
END (* Ellipse *);
PROCEDURE Circle (Radius: integer);
{ Ein Kreis ist eine Ellipse mit zwei gleichgrossen Halbachsen }
BEGIN
Ellipse (Radius, (Radius* ScreenY) DIV ScreenX);
END (* Circle *);
END (* Ellipsen *).
Frage 83
F: Wie lösche ich alle Leerzeichen in einem String?
A: Hier werden drei verschiedene Möglichkeiten angegeben, wie
dies zu bewerkstelligen ist.
BEGIN
while i<=s[0] do
begin
inc(i);
if S[i]=' ' then
begin
delete(s,i,1);
dec(i);
end;
end;
END;
oder noch besser:
PROCEDURE Kuerzen(VAR S:STRING);
VAR i:INTEGER;
BEGIN
i := 1;
WHILE I < Length(S) DO
BEGIN
IF S[i]=' ' THEN
DELETE(S, i, 1)
ELSE INC(I);
END;
END;
noch besser:
BEGIN
while pos(' ',s)>0 do
begin
i:=pos(' ',s);
while s[i]=' ' do delete(s,i,1);
end;
END;
und jetzt noch den Einzeiler:
WHILE POS(' ',S)>0 DO DELETE(S,Pos(' ',S),1);
Frage 84
F: Wie kann ich in TP die Seriennummer eines Dateträgers verändern?
A: Dos stellt zu diesem Zweck eine Funktion zur Verfügung. Das
nachfolgende Programm demonstriert die Vorgehensweise.
(* ------------------------------------------------------ *)
(* SSN.PAS *)
(* Setzen der Seriennummer eines Datenträgers *)
(* (c) 1992 Sebastian Schönberg & DMV-Verlag *)
(* ------------------------------------------------------ *)
PROGRAM SSN;
USES
Crt, Dos;
TYPE
CharSet = SET OF CHAR;
CONST
Confirm : CharSet = (['Y', 'J', 'N']);
VAR
InfoRec : RECORD
w, LL, Lh : WORD;
vL, ft : ARRAY [0..10] OF CHAR;
END;
Regs : Registers;
c : CHAR;
fs : STRING;
i, L : BYTE;
FUNCTION Hex(w : WORD) : STRING;
CONST
z : STRING [16] = '0123456789ABCDEF';
BEGIN
Hex := z[Hi(w) SHR 4 + 1] +
z[Hi(w) AND $F + 1] +
z[Lo(w) SHR 4 + 1] +
z[Lo(w) AND $F + 1];
END;
BEGIN
WriteLn('Disk-Information');
Write('Drive A..Z: ');
c := UpCase(ReadKey);
WriteLn(c);
L := Ord(c)-64;
Regs.BL := L;
Regs.DS := Seg(InfoRec);
Regs.DX := Ofs(InfoRec);
Regs.AX := $6900;
MsDos(Regs);
IF (Regs.Flags AND 1) = 1 THEN BEGIN
WriteLn('Error ', Regs.AX);
Halt(Regs.AX);
END;
Write('Volume Label : ');
FOR i := 0 TO 10 DO Write(InfoRec.vL[i]);
Write(#13#10'Fat type : ');
FOR i := 0 TO 7 DO Write(InfoRec.ft[i]);
WriteLn(#13#10'Serial Number : ',
Hex(InfoRec.Lh), ':', Hex(InfoRec.LL));
Write('New Number (Y/N) ');
REPEAT
c := UpCase(Readkey);
UNTIL c IN Confirm;
WriteLn(c);
IF c = 'N' THEN Halt(0);
Write('Number: '); ReadLn(InfoRec.Lh, InfoRec.LL);
Regs.AX := $6901;
Regs.BL := L;
Regs.DS := Seg(InfoRec);
Regs.DX := Ofs(InfoRec);
MsDos(Regs);
IF (Regs.Flags AND 1) = 1 THEN
Writeln('Error ', Regs.AX);
END.
Frage 85
F: Welche Routine wird in der folgenden IF-Abfrage wann ausgeführt?
IF bedingung1 THEN
routine1
ELSE IF begingung2 THEN
routine2
ELSE routine3;
A: Routine1 wird ausgeführt wenn bedingung1 TRUE ist, der Rest wird
nicht beachtet. Ist bedingung1 FALSE, so wird der zweite IF-Ast
abgearbeitet: IF bedingung2 THEN routine2 ELSE routine3;
routine2 wird also ausgeführt, wenn bedingung1 FALSE und bedingung2
TRUE liefert, und routine3, wenn alle bedingungen FALSE sind.
Tip: Durch übersichtlicheres Strukturieren, z.B. mit Hilfe von
BEGIN und END, ist leichter ein Überblick zu bekommen.
IF bedingung1 THEN
routine1
ELSE
BEGIN
IF begingung2 THEN
routine2
ELSE routine3;
END;
Frage 86
F: Worin liegt der Vorteil der Objektorientierten Programmierung?
A: Es gibt drei wesentliche Vorteile:
1. Kapselung: Daten und Code verschmelzen zu einer Einheit. Du hast
ein Objekt, dieses Objekt besitzt Daten und Methoden um mit diesen
Daten umzugehen. Das ist vergleichbar zu den abstrakten Datentypen,
die man immer schon kannte. Allerdings wird es durch die Syntax noch
staerker betont.
Die Details der Implementierung werden versteckt (information hiding).
Du Implementierst z.B. einen Stack als Feld. Von Aussen kannst Du aber
NICHT direkt auf das Feld, sondern nur ueber bestimmte Methoden auf
den Stack zugreifen. Nach einen halben Jahr aenderst Du die Implemen-
tierung auf eine verkettete Liste und NUR das innere des Objektes
wird beruehrt, NICHT die Schnittstelle nach aussen.
tEgal = Object
a: Integer; {Daten}
Procedure PrintMe; {Methode}
End; {tEgal}
Procedure tEGal.PrintMe;
Begin
Writeln(a); {direkter Zugriff auf EIGENE Daten}
End; {PrintMe}
2. Vererbung: Ein Objekt kann seine Daten und Methoden vererben. D.h.
ein Nachkomme besitzt alle Methoden und Daten seines Vorgaenger und
kann eigene Dazudefinieren oder alte ueberschreiben.
Du hast ein Objekt um Grafiken anzuzeigen. Wenn es herkoemmlich
programmiert ist und Du es aendern moechtest, so musst Du direkt
in den Sourcecode eingreifen. Wenn es objektorientiert ist, dann
legst Du ein abgeleitetes Objekt an und fuegst nur die Teile hinzu
die Du benoetigst. Der Rest ist ererbt.
3. Polymorphie: In einer solchen "Hierarchie" von Objekten, da die
Vererbung durchaus einige Stufen tief sein kann, kann z.B. eine
Methode immer wieder den gleiche Namen habe, aber der Compiler sucht
sich zur Laufzwit die Methode fuer das richtige Objekt heraus.
Frage 87
F: Wie schreibe ich unter TP ins Clipboard von Windows?
A: Im folgenden eine Unit, mit der es möglich ist Text ins Clipboard
zu übertragen:
Unit Clipboard;
{Routinen zur Benutzung des Windows-ClipBoards von DOS aus. Die
Funktionen sind daraufhin ausgelegt "Text" in das clipboard zu
schreiben bzw. aus ihm zu lesen}
{ Autor : Peter Schuette }
{ Indestrasse 21 }
{ D-52249 Eschweiler }
{ Tel. 02403/21375 }
{ Datum : 3.5.1994 }
{ letzte Aenderung : 5.5.1994 }
Interface
Function OpenClp: Byte;
{oeffnet das Clipboard fuer den Gebrauch. Wenn Rueckgabewert = 0, dann}
{war es chon offen}
Function CloseClp: Byte;
{schliesst das Clipboard nach dem Gebrauch. Wenn Rueckgabewert = 0, dann}
{ist ein Fehler aufgetreten}
Function EmptyClp: Byte;
{leert das Clipboard}
Function SetClpData(Var Data: Array of Char; Size: LongInt): Byte;
{schreibt das Data als "Text" in das Clipboard, Wenn der
Rueckgabewert = 0 ist, dann ist ein Fehler aufgetreten und die Daten
wurden NICHT ins Clipboard kopiert}
Function GetClpData(Var Data: Array of Char): Byte;
{liest Data als "Text" aus dem Clipboard. Wenn der Rueckgabewert = 0 ist
dann ist ein Fehler aufgetretne und die Daten wurden nicht aus dem
Clipboard kopiert}
Function GetClpDataSize(Var Size: LongInt): Byte;
{ermittelt die "Groesse" des Textes im CLipboard}
{(Die Groesse wird anscheinend immer auf den naechsten 32ByteBlock
aufgerundet)}
{wenn Size = 0 dann sind keine Text-Daten im Clipboard}
Implementation
Uses DOS, Conv;
Function OpenClp: Byte;
Var R: Registers;
Begin {OpenClp}
R.AX := $1701;
Intr($2F, R);
OpenClp := R.AX;
End; {OpenClp}
Function CloseClp: Byte;
Var R: Registers;
Begin {CloseClp}
R.AX := $1708;
Intr($2F, R);
CloseClp := R.AX;
End; {CloseClp}
Function EmptyClp: Byte;
Var R: Registers;
Begin {EmptyClp}
R.AX := $1702;
Intr($2f, R);
EmptyClp := R.AX;
End; {EmptyClp}
Function SetClpData(Var Data: Array Of Char; Size: LongInt): Byte;
Var R: Registers;
up, low: Word;
Begin {SetClpData}
R.AX := $1703;
R.DX := $01; {Daten sind Text}
R.ES := Seg(Data);
R.BX := Ofs(Data);
Long2DWord(Size, up, low);
R.SI := low;
R.CX := up;
Intr($2F, R);
SetClpData := R.AX;
End; {SetClpData}
Function GetClpData(Var Data: Array of Char): Byte;
Var R: Registers;
SizeS, SizeO : Word;
Begin {GetClpData}
R.AX := $1705;
R.DX := $01;
R.ES := Seg(Data);
R.BX := Ofs(Data);
Intr($2F, R);
GetClpData := R.AX;
End; {GetClpData}
Function GetClpDataSize(Var Size: LongInt): Byte;
Var R: Registers;
w1, w2 : Word;
Begin {GetClpDataSize}
R.AX := $1704;
R.DX := $01;
Intr($2F, R);
DWord2Long(R.AX, R.DX, Size);
End; {GetClpDataSize}
End. {Clipboard}
Frage 88
F: Wie lese ich Dateien, die das Datei-Ende-Zeichen im Text enthalten?
A: Mit Hilfe der u.a. Funktion RealEof, kann ermittelt werden, ob
man sich wirklich am Dateiende befindet. Wird über ein Datei
Ende-Zeichen gelesen, so wird diese behandelt wie ein normales
Zeilenende.
{ÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͯ
RealEof liefert das wahre Ende einer Textdatei.
ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹
Eingabe : Textdatei Variable
Ausgabe : Echtes Ende -> True , False
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͦ}
FUNCTION RealEof(VAR TextDatei:Text):Boolean; { Dateiende ohne $1A}
BEGIN
{$IFOPT R+}
{$DEFINE OptR}
{$R-}
{$ENDIF} { Rangechecking tempoeraer aus }
RealEof:=Eof(TextDatei) AND
(TextRec(TextDatei).BufPtr^[TextRec(TextDatei).BufPos]<>#$1A);
{$IFDEF OptR}
{$UNDEF OptR}
{$R+}
{$ENDIF} { Rangechecking wieder herstellen }
END;
Frage 89
F: Wie kann ich die Ausgabe von Programmen, die mit Exec ausgeführt
werden, umleiten ?
A: Hier gibt es viele Möglichkeiten, das Problem zu lösen. Der erste
Versuch sollte immer durch direktes Umleiten im Aufruf erfolgen:
EXEC(GETENV('COMSPEC'),'/C '+Programmname+'>'+Filename);
Wenn das Programm das Umleiten unterstützt (vergleiche Frage 76)
wird so die Ausgabe umgeleitet. (Dies klappt nicht bei allen
Programmen !) Wichtig ist auch, daß der Command.Com dabei aufgerufen
wird, denn dieser ist für das Umleiten zuständig.
Eine weitere Möglichkeit besteht darin, das ganze selbst zu
programmieren, indem ein TEXT-File geöffnet wird und ueber die DOS
Funktion "force duplicate handle" dessen TEXTREC.HANDLE dem Handle
1 (StdOutput) zugewiesen wird (Handle 0 fuer Eingabe Umleitung).
Frage 90
F: Wie kann ich einzelne Zeichen eines Strings ändern?
A: Ein String ist in Pascal nichts anderes, als ein ARRAY [0..xxx] OF Char,
wobei xxx hier durch die maximale Länge des Strings zu ersetzen ist.
Das null-te Zeichen dieses Arrays enthält die aktuelle Länge des Strings,
also z.B. den Ascii-Code 0 für: keine Zeichen enthalten. Man kann nun
auf die einzelnen Zeichen wie in einem Array zugreifen, wie folgendes
Beispiel demonstriert.
VAR S:STRING;
BEGIN
S:=' PS';
S[1]:=S[3];
S[2]:='U';
Writeln(S);
END.
Frage 91
F: Wie ändere ich unter TP die Attribute eines Verzeichnisses?
A: Ein Verzeichnis läßt sich genauso behandeln wie eine normale Datei.
Man kann also getrost GetFAttr und SetFAttr --- die ja in der ONLINE
Hilfe beschrieben sind --- benutzen. Das einzige was zu beachten ist,
daß man immer das Attribut Directory ungesetzt läßt, wenn man SetFAttr
aufruft.
Der Aufruf
SetFAttr(F,Directory+ReadOnly+Hidden)
liefert einen Fehler, aber der Aufruf
SetFAttr(F,ReadOnly+Hidden)
leistet das Gewünschte.
Frage 92
F: Wie schalte ich in den Mode13 und zurück in den Textmodus?
A: Ein normales Textmode(13) reicht hier oft nicht mehr aus. Dies kann zu
Problemen bei der Zeichenausgabe (zu große Zeichen etc.) führen.
Wenn man direkt über den Videointerrupt geht, entfallen diese Probleme:
PROCEDURE SetText; ASSEMBLER;
ASM
MOV ax, $0003 {ah = $00: Set Mode; al = $03: Textmode 25x80}
INT $10 {Video-Interrupt}
END;
bzw. non-ASM:
PROCEDURE SetText;
VAR R:Registers;
BEGIN
R.AX:=$0003;
Intr($10,R);
END;
und der Weg in den Mode13:
PROCEDURE SetMode13; ASSEMBLER;
ASM
MOV AX,$0013
INT $10
END;
non-ASM:
PROCEDURE SetMode13;
VAR R:Registers;
BEGIN
R.AX:=$0013;
Intr($10,R);
END;
In diesem Grtafikmodus stehen dem Benutzer nun 320x200 Pixel
zur Verfügung, die von $A000:0 an angesprochen werden können.
Frage 93
F: Kann man mit TP compilierte EXE-Dateien wieder in Quelltext
recompilieren?
A: Nein, dies ist nicht möglich. Es gibt zwar einige Programme, die
dies versuchen, doch auch diese können keinen vernünftigen Pascal-
Code generieren. Die meisten Stellen werden hier durch Assembler-
teile übernommen.
Frage 94
F: Wie definiert man Arrays, deren Grenzen erst zur Laufzeit
festgelegt werden ?
A: Zu diesem Zweck wird einfach der Heap herangezogen. Das eigentliche
Array wird auf ein Element beschränkt. Dann wird auf den Heap der
notwendige Speicher für das Array (so groß wie es werden soll)
reserviert. Jetzt kann man -- bei ausgeschaltetem Rangechecking --
auch die anderen Felder nutzen.
Hier ein Beispielprogramm:
PROGRAM Laufzeit; { ut. 1995 }
USES Crt;
{ symbolische Typen, hier ist die
wahre Groesse nicht vorgegeben }
TYPE Feld = ARRAY [1..1] OF Real;
Feld2 = ARRAY [1..1] OF ^Feld;
VAR F : ^Feld;
F2 : ^Feld2;
I,J : Integer;
R : Real;
{$R-} {RangeCheck Off}
BEGIN
ClrScr;
Writeln ('Freier Heap bei Programmstart: ',MemAvail);
{ eindimensionales Array ZUR LAUFZEIT
mit 5 Elementen erzeugen..
Speicher belegen: }
GetMem (F,5*Sizeof(Real));
{ mit Werten besetzen }
R := 1.0;
FOR I := 1 TO 5 DO
BEGIN
F^[I] := R;
R := R+0.25;
END;
{ auslesen }
FOR I := 1 TO 5 DO Write (F^[I]:7:3);
{ Speicher freigeben, wenn nicht mehr noetig }
FreeMem (F,5*Sizeof(Real));
Writeln;
Writeln;
{ nun mit einem 2 dimensionalen Array
mit 3*10 Elementen }
GetMem (F2,3*Sizeof(Pointer));
FOR I := 1 TO 3 DO
BEGIN
GetMem (F2^[I],10*Sizeof(Real));
FOR J := 1 TO 10 DO
F2^[I]^[J] := I+J/10;
END;
FOR I := 1 TO 3 DO
BEGIN
FOR J := 1 TO 10 DO Write (F2^[I]^[J]:7:3);
Writeln;
END;
FOR I := 1 TO 3 DO
FreeMem (F2^[I],10*Sizeof(Real));
FreeMem (F2,3*Sizeof(Pointer));
Writeln;
Writeln ('Freier Heap bei Programmende: ',MemAvail);
Writeln;
Writeln ('Ende mit Taste...');
IF Readkey = #0 THEN;
END.
Frage 95
F: Wie kann ich unter TP Umgebungsvariablen setzen?
A: Dies kann nicht erreicht werden, indem einfach der Command.com
gestartet wird, da jedes Dos-Programm sein eigenes Environment
bekommt. Beispiel:
- Das Programm X hat das Environment ENVIR1.
- In X wird jetzt der Command.Com mit dem Befehl
SET XXX=HUHU gestartet.
- Dieser Command.Com erhält eine Kopie von ENVIR1, nennen
wir sie ENVIR2
- ENVIR2 wird um XXX=HUHU erweitert
- Der Command.Com beendet sich, ENVIR2 wird freigegeben
- Das Programm X hat immer noch das unveränderte ENVIR1.
Um nun auf das Environment eines Programmes zuzugreifen, muß man
zunächst über den MCB die Adresse des Environments ermitteln, und
kann dann direkt im Speicher das Env verändern. Die folgende Unit
nimmt einem diese Arbeiten ab:
{$R- !!!!}
Unit PutEnvMt;
INTERFACE
Var PutEnvError : Word;
Procedure PutEnv(S : String);
IMPLEMENTATION
Const AlteGroesse : Word = MaxInt;
AlterZeiger : Pointer = NIL;
Type MCB = Record
ID : Char;
PSPSeg : Word;
Size : Word;
Unbenutzt : Array [0..10] Of Byte;
EnvTab : Array [0..0] Of Char;
End;
MCBZgr = ^MCB;
Var MCBPtr : MCBZgr;
Function EnvSize : Word;
Var Start : Integer;
Begin
Start := (MCBPtr^.Size-1)*16-65;
If Start<0 Then Start := 0;
With MCBPtr^ Do
While Not ((EnvTab[Start]=#0) And (EnvTab[Start+1]=#0)) Do
Inc(Start);
EnvSize := Start+2;
End;
Function CopyEnv(NewSize : Word) : Boolean;
Var Dest : MCBzgr;
Begin
If NewSizeNIL Then FreeMem(AlterZeiger,AlteGroesse);
AlteGroesse := (NewSize+2*15+SizeOf(MCB));
GetMem(Dest,AlteGroesse);
AlterZeiger := Dest;
Dest := Ptr(Seg(Dest^)+(Ofs(Dest^)+15) DIV 16,0);
Dest^.Size := (NewSize+15) DIV 16;
Move(MCBPtr^.EnvTab,Dest^.EnvTab,Dest^.Size*16);
MemW[PrefixSeg:$2C] := Seg(Dest^)+1;
MCBPtr := Dest;
CopyEnv := True;
End
Else CopyEnv := False;
End;
Procedure LoescheAltenEintrag(S : String);
Var P,I,Size : Integer;
Gleich : Boolean;
Begin
P := 0;
Size := EnvSize;
While P#0 DO
Inc(I);
If Gleich Then
Begin
Move(MCBPtr^.EnvTab[P+I+1],MCBPtr^.EnvTab[p],Size-(P+I));
P := Ord(CopyEnv(Size-I+15));
Exit;
End;
Inc(P,I+1);
End;
End;
Procedure PutEnv(S : String);
Var P,I : Integer;
Begin
PutEnvError := 0;
P := Pos('=',S);
If P>0 Then
If Length(S)<=253 Then
Begin
For I:=1 To P Do S[I] := UpCase(S[I]);
LoescheAltenEintrag(Copy(S,1,P));
If Length(S)>P Then
Begin
S := S+#0#0;
P := EnvSize;
If CopyEnv(P+Length(S)-1) Then
Move(S[1],MCBPtr^.EnvTab[P-1],Ord(S[0]))
Else
PutEnvError := 3;
End
Else PutEnvError := 2;
End
Else PutEnvError := 1;
End;
BEGIN
MCBPtr := Ptr(MemW[PrefixSeg:$2C]-1,0);
END.
Frage 96
F: Wie fragt man denn die Pfeiltasten (Cursortasten) ab?
A: Die Cursortasten liefern bei der Abfrage mit Readkey einen
erweiterten Tasterturcode. Dieser ist daran zu erkennen, daß
zunächst der Wert 0 geliefert wird. Nach diesem Wert folgt ein
weiterer Wert, der die Taste spezifiziert.
72
^
|
75 <----#----> 77
|
v
80
Die Tasten können also wie folgt abgefragt werden:
VAR X:Char;
BEGIN
X:=ReadKey;
IF X=#0 THEN
CASE ReadKey OF
#72: hoch
#77: rechts
#80: unten
#75: links
END;
END;
Hier noch eine zweite einfache Loesung, die sowohl die normalen
als auch die erweiterten Tasten beruecksichtigt:
FUNCTION keycode:Word;
VAR code:Byte;
BEGIN
code := Ord (ReadKey);
IF code = 0 THEN
keycode := 1000 + ord (readkey)
ELSE keycode := code;
END;
Der Kniff ist also einfach, bei den normalen Tasten deren normalen
ASCII-Code zurueckzuliefern, aber bei den erweiterten Tasten, die
ja einen Doppelcode zurueckliefern, den sog. "Scancode", den das
zweite ReadKey liefert, um 1000 (oder sonst eine Konstante, egal)
zu erhoehen. Die Scancodes aller Tasten stehen z.B. im Handbuch.
Dann kann man sich allerhand schoene Konstanten definieren...
CtrlA = 1; CtrlB = 2; CtrlC = 3; ...
F1 = 1059; F2 = 1060; F3 = 1061; ...
Up = 1072; Down = 1080; Left = 1075; ...
AltA = 1030; AltB = 1048; AltC = 1046; ...
...und im Programm schreiben...
VAR taste:Word;
taste := keycode;
CASE taste OF
CtrlA : ... ;
32..255 : ... ;
F1 : ... ;
PgUp : ... ;
END;
...und weiss auch noch nach Jahren, was gemeint ist. :-)
Und für die Assemblerfreaks nun noch die ultimative Routine,
die gleich die vom Bios gelieferten Werte benutzt:
FUNCTION ReadChar: Word; ASSEMBLER;
ASM
MOV AX,$1000
INT $16
END;
Hier kann man sich dann wieder Konstanten definieren. Besitzer
von Pascal-Versionen mit Turbo Vision sind sogar davon befreit,
denn in der Unit Drivers sind genau diese Konstanten definiert
wie beispielsweise kbF1, kbGrayPlus....
Frage 97
F: Wie erkenne ich, ob ein Ansi-Treiber geladen ist?
A: Sollen nur Dos-kompatible Ansi-Treiber enteckt werden, so
sei hier auf Frage 15 verwiesen. Andere Ansi-Treiber können
durch "Ausprobieren" gefunden werden. Das folgende Programm
demonstriert dies.
PROGRAM CHKAnsi;
{ 27.03.95 -mat (Martin Gerdes) - freeware - }
{ There was an ANSI-detection-routine in SWAG - and it didn't work :-(
So I wrote my own.
This is how it works:
- it saves the current cursor position via BIOS-call
- it outputs an ESC char and checks whether the cursor has changed
-> if yes: no terminal emulation present
-> if no: it positions the cursor via ANSI-Call in the screen
(at a position it's sure there is no scrolling)
[row;colH
- it reads back the cursor position via BIOS and compares
- if that fails, it blanks out the "hieroglyphes" using Backspaces
It's crucial you leave that "system" in system.write in; because
of writing directly to the screen, CRT unit's write doesn't work here.
}
CONST ansi :Boolean=False; {this way I'm sure it's initialized}
VAR sc : Word;
i : Word;
s,s1,s2 : STRING;
FUNCTION b_getcursor:Word;ASSEMBLER;
ASM
MOV AH,0fh;INT $10
MOV AH,3;INT $10
MOV AX,DX
END;
PROCEDURE b_setcursor(Pos:Word);ASSEMBLER;
ASM
MOV AH,0fh;INT $10
MOV AH,2;MOV DX,pos;INT $10
END;
PROCEDURE a_setcursor(cp:Word);
BEGIN
Str((Hi(cp)+1),s1);
Str((Lo(cp)+1),s2);
s:='['+s1+';'+s2+'H';
system.Write(s);
{I may need that string length later, so I cannot write directly}
END;
BEGIN
sc:=b_getcursor; {save cursor}
system.Write(#27);
IF sc=b_getcursor
THEN {terminal emulation detected}
BEGIN
a_setcursor($0202); {set cursor}
IF b_getcursor=$0202 {ok?}
THEN ansi:=True {yes! flip flag}
ELSE {test failed - rubout that control string}
BEGIN
FOR i:=0 TO Byte(s[0])DO system.Write(#8);
FOR i:=0 TO Byte(s[0])DO system.Write(' ');
FOR i:=0 TO Byte(s[0])DO system.Write(#8);
END;
END
ELSE
BEGIN
system.Write(#8#32#8); {rubout}
END;
b_setcursor(sc); {restore cursor}
WriteLn('Ansi?: ',ansi);
END.
Frage 98
F: Wie ermittle ich das letzte gültige Laufwerk?
A: Eine Möglichkeit besteht darin, den/die DPB (Drive Parameter Block)
von DOS auszuwerten. Allerdings ist diese Methode recht aufwendig.
Einfacher ist es, zu überprüfen, ob ein Laufwerk existiert. Man
beginnt beim ersten und hangelt solange weiter, bis ein Laufwerk nicht
existiert. Um auch Netzwerklaufwerke, die ja z.B. nach Z: gemappt
werden können, zu ermitteln, empfehle ich jedoch alle Laufwerke
durchzuprobieren und das ganze in einem Array of Boolean zu speichern.
USES Dos;
FUNCTION LastDrive:Char;
VAR I : Integer;
Regs : Registers;
BEGIN
I:=2;
REPEAT
Inc(I);
Fillchar(Regs,Sizeof(Regs),0);
Regs.AH:=$36;
Regs.AL:=i;
MsDos(Regs);
UNTIL (Regs.AX=$FFFF);
LastDrive := Chr(I+63);
END;
Frage 99
F: Wie berechne ich den Wochentag eines Datums?
A: Nun, eine der einfachsten Methode ist es, das Datum kurzfristig
mittels Setdate zu setzen und dann wieder auszulesen. DOS hat dann
automatisch den richtigen Wochentag berechnet.
CONST Tage:ARRAY[0..6] OF STRING[10]=('Montag','Dienstag',
'Mittwoch','Donnerstag','Freitag','Samstag','Sonntag');
VAR CY,CD,CM,CW : Word;
AY,AD,AM,AW : Word;
GetDate(CY,CM,CD,CW); { altes Datum sichern }
SetDate(1972,6,2);
GetDate(AY,AM,AD,AW);
SetDate(CY,CM,CD);
Writeln('Der 02.06.1972 war ein ',Tage[AW]);
Frage 100
F: Gibt es eine leichte Möglichkeit, meine Sourcen neu zu formatieren? 4
A: Für diese Aufgabe gibt es zahlreiche Programme. Eins davon,
"Ed's Pascal Beautifier" liegt unter dem Namen EPB232.ZIP
bei der MIB zum requesten/downloaden bereit.
Frage 101
F: Was sind Interrupts?
A: Ein Interrupt ist i.A. ein Signal an den Prozessor, das von einem
Programm, einem angeschlossenen Gerät oder dem Prozessor selbst aus-
gelöst wird. Durch dieses Signal wird das aktuell ablaufende Programm
unterbrochen und eine vorgegebene Routine ausgeführt. Es gibt 256
Interrupts, die viele verschieden Funktionen zur Verfügung stellen.
Einige sind für spezielle Aufgaben reserviert, wie zum Beispiel
der IRQ 0, der immer dann aufgerufen wird, wenn bei einer Division
ein Fehler aufgetreten ist (a/0).
Turbo Pascal hat zwei eingebaute Funktionen, mit denen man Inter-
ruppts auslösen/aufrufen kann. Die Erste ist MsDos, die eigentlich
nur ein Spezialfall der zweiten Funktion Intr ist (MsDos(R) gleich
Intr($21,R)).
Beispiele für Aufrufe sind in vielen Antworten dieser FAQ zu finden.
Wer genauer in die Materie einsteigen will, der sollte sich die
Interruptliste von Ralph Brown besorgen. Sie ist in jeder guten
Box unter INTER###.ZIP zu finden. Dabei steht ### für eine fort-
laufende Zahl (Version) und einen Buchstaben, da die Liste so
groß ist, daß sie auf mehrere Dateien geteilt ist.
Frage 102
F: Wie finde ich alle Dateien in einem Verzeichnis und dessen Unterver-
zeichnissen?
A: Eine entsprechende Routine ist eigentlich sehr einfach zu
entwickeln. Sie basiert auf einer elementaren Programmiertechnik,
der REKURSION, sowie auf den TP-Funktionen zur Dateisuche.
PROCEDURE FIND(Dir:STRING);
VAR S:SearchRec;
BEGIN
FindFirst(Dir+'\*.*');
WHILE DosError = 0 DO
BEGIN
Writeln(DIR+'\'+S.Name); { Dateiname ausgeben }
IF (S.Name[1]<>'.') AND { . und .. weglassen }
(S.Attr AND Directory <> 0) THEN { Verzeichnis ? }
Find(Dir+'\'+S.Name; { ja, durchsuchen }
FindNext(S); { nächsten Eintrag }
END;
END;
Frage 103
F: Wie komme ich an die Kommandozeile eines Programmes?
A: Will man nur die Parameter auswerten, so reicht es, wenn
man die Funktionen Paramcount und ParamStr benutzt. Sie sind
ausführlich in der Online-Hilfe beschrieben.
Bei einem Aufruf "prog huhu du da" ergibt paramstr die werte
"prog", "huhu", "du", "da" für den Aufruf mit 0-3. Allerdings
entfällt das zweite Leerzeichen zwischen huhu und du.
Will man nun die "genaue" Zeile haben, so muß man diese über
den PSP ermitteln:
Type Str127 = STRING[127];
VAR Line : ^Str127;
BEGIN
Line := Ptr(PrefixSeg,$80);
Writeln(Line^);
END;
WICHTIG ist, daß man dies gleich am Anfang seines Programmes
tut, und die Zeile irgendwo speichert, denn die Parameterzeile
des PSP kann durch manche Operationen (z.B. IO) verändert werden.
Dies gilt im Übrigen auch für Paramstr und ParamCount.
Frage 104
F: Kann man die Graphiktreiber direkt in die EXE-Dateien einbauen?
A: Die Aufgabe ist zwar mit ein wenig Arbeit verbunden, aber es geht.
Dazu sollten die folgenden Schritte ausgeführt werden:
1. Die benötigten Dateien, das sind die BGI-Treiber,
sollten ins Arbeitsverzeichnis kopiert werden.
Außerdem wird das Programm "binobj.exe" zur Konvertierung
benötigt. Dieses Programm liegt normalerweise im BIN
Verzeichnis von Turbo Pascal.
2. Die BGI-Treiber müssen konvertiert werden. Dies geschieht
durch den Aufruf von
binobj cga.bgi cga CGADriverProc
binobj egavga.bgi egavga EGAVGADriverProc
binobj herc.bgi herc HercDriverProc
binobj pc3270.bgi pc3270 PC3270DriverProc
binobj att.bgi att ATTDriverProc
Dabei ist der letzte Parameter der Name, mit dem im Pascal
Programm auf den Treiber verwiesen wird (s.u.)
3. Die Unit "DRIVERS" (TP < 6.0) bzw. "BGIDRIV" (>=6.0)
aus dem Beispiel-Verzeichnis muß kompiliert werden.
UNIT BGIDriv;
INTERFACE
PROCEDURE ATTDriverProc;
PROCEDURE CgaDriverProc;
PROCEDURE EgaVgaDriverProc;
PROCEDURE HercDriverProc;
PROCEDURE PC3270DriverProc;
IMPLEMENTATION
PROCEDURE ATTDriverProc; EXTERNAL; {$L ATT.OBJ }
PROCEDURE CgaDriverProc; EXTERNAL; {$L CGA.OBJ }
PROCEDURE EgaVgaDriverProc; EXTERNAL; {$L EGAVGA.OBJ }
PROCEDURE HercDriverProc; EXTERNAL; {$L HERC.OBJ }
PROCEDURE PC3270DriverProc; EXTERNAL; {$L PC3270.OBJ }
END.
4. Bei Bedarf können nun die .bgi und .obj Dateien wieder aus
dem Arbeitsverzeichnis entfernt werden. Die Treiber sind
jetzt in der Unit eingebunden.
5. Die Unit "DRIVERS" bzw. "BGIDRIV" wird mit "USES" im Programm
eingebunden. Weiterhin wird mit RegisterBGIDriver der Treiber
registriert und kann anschließend normal benutzt werden.
USES Graph, Drivers;
VAR Driver, Mode: Integer;
BEGIN
IF RegisterBGIdriver(@CgaDriverProc) < 0 THEN
BEGIN
Writeln('Error registering driver: ',
GraphErrorMsg(GraphResult));
Halt(1);
END;
Driver := CGA;
Mode := CGAHi;
InitGraph(Driver, Mode, '');
...
Frage 105
F: TP bietet ja mit Font8x8 die Möglichkeit den Modus auf 43/50 Zeilen
zu schalten. Warum klappt SetTextMode(Font8x8) nicht?
A: Dieser Fehler ist eigentlich ganz einfach. Die Konstante Font8x8
ist ein Wert, der zu den "normalen" Modi addiert werden muß.
Mit SetTextMode(CO80+Font8x8) sollte es also wieder klappen.
Man sollte jedoch vorher sicherstellen, daß auch eine EGA-Karte
installiert ist (vgl. Frage 35).
Frage 106
F: Wie kann ich den ganzen Bildschirm auslesen?
A: Dazu muß man direkt auf den Bildschirmspeicher zugreifen.
Zunächst ermittelt man die Basisadresse des BS-Speichers,
die im Monchrommodus bei ($B000:0) liegt und im Farbmodus
bei ($B800:0). Anschließend ermittelt man aus dem Bios die
Bildschirmgröße und kann mit Move den ganzen Inhalt in Eins
kopieren.
USES DOS;
VAR AnzSpalten : Word ABSOLUTE $0040:$4a; { BIOS Werte }
AnzZeilen : Byte ABOSLUTE $0040:$84;
Buffer : ARRAY [1..16000] OF Byte;
FUNCTION SBase:Word;
VAR R: Registers;
BEGIN
R.AX := $0F00;
Intr($10,R);
IF (R.AL = 7) THEN SBase := $B000 { Mono ? }
ELSE SBase := $B800;
END;
BEGIN
{ Bildschirm lesen }
Move(Ptr(Sbase,0)^,Buff[0],(AnzZeilen+1)*AnzSpalten*2);
ClrScr;
{ und zurück damit }
Move(Buff[0],Ptr(Sbase,0)^,(AnzZeilen+1)*AnzSpalten*2);
END;
Ist man ganz sicher das man sich im Modus 80x25 befindet,
so reicht es vollkommen aus, 80*25*2 = 4000 Bytes mittels
Move( .. , .. , 4000) zu kopieren. Für jedes Zeichen auf dem
Bildschirm werden 2 Bytes benötigt. Das erste enthält das
Zeichen, das zweite das Farbattribut.
Frage 107
F: Was ist der Unterschied zwischen PChar und einem String ?
A: Strings gibt es eigentlich in Pascal nicht, sie sind eine
Erweiterung in Turbo Pascal. Ein String setzt sich aus einer
Folge von Zeichen zusammen, und kann deshalb auch als ARRAY[0..x]
of Char betrachtet werden. Strings haben eine maximale Länge
von 255 Zeichen, wobei das Längenbyte das erste ist (vergleiche
auch Frage 75).
PChar gibt es erst in den neueren Versionen von Turbo Pascal.
Hier wird die Handhabung von Zeichenketten an die von anderen
Programmiersprachen, wie C, angeglichen. Der wesentliche Unterschied
besteht zunächst darin, das PChars Zeichenketten sind, die
durch ein 0-Byte abgeschlossen werden. Das Längenbyte an erster
Stelle entfällt. Weiterhin können diese "Nullterminierten Strings"
eine Länge von bis zu 64KB haben. PChars ist genau gesehen also
ein Zeiger auf ARRAY[0..x] of CHAR, wobei im 0-ten Feld der erste
Buchstabe steht.
Frage 108
F: Wie konvertiere ich einen String in Pchar und umgekehrt?
A: Für diese Aufgabe können die Funktionen der UNIT Strings, die
mitgeliefert wird, genutzt werden.
VAR S,T : STRING;
P : PCHAR;
BEGIN
S := 'HALLO';
GetMem(P,6); { Speicher für P reservieren }
P:=StrPCopy(P,S); { String -> PChar }
S:=StrPas(P); { Pchar -> String }
StrDispose(P);
END;
Für genauere Angaben sei auf die Hilfe verwiesen.
Frage 109
F: Wie kann ich testen, ob eine Datei bereits geöffnet ist?
A: Der Datentyp File ist nicht anderes als ein Record, nur das
TP den Zugriff auf die einzelnen Komponenten nur mit Typecasting
erlaubt.
FileRec = RECORD
Handle: Word;
Mode: Word;
RecSize: Word;
Private: array[1..26] of Byte;
UserData: array[1..16] of Byte;
Name: array[0..79] of Char;
END;
Für eine Datei F:FILE kann man also mittels
FileRec(F).Mode
den aktuellen Dateimodus in Erfahrung bringen. Diesen überprüft man
durch Vergleich mit der Konstanten fmClosed:
IF FileRec(F).Mode <> fmClosed THEN Writeln{'F ist geschlossen');
IF FileRec(F).Mode AND fmInput <> 0 THEN Writeln{'F offen (lesen)');
IF FileRec(F).Mode AND fmOutput <> 0 THEN Writeln{'F offen (schreiben)');
IF FileRec(F).Mode AND fmInOut <> 0 THEN Writeln{'F offen');
Frage 110
F: Wie berechne ich den Unterschied zwischen zwei Zeiten?
A: Liegen die Zeiten zwischen 1980 und 2079 helfen die Funktion
PackTime und UnPackTime (s. Online-Hilfe). Zunächst werden die
beiden Zeiten mittels PackTime in LongInts gewandelt, von
einander subtrahiert und mittels UnpackTime die Differenz
zurück konvertiert:
VAR A,B,D : DateTime;
AL,BL : LongInt;
Diff : LongInt;
BEGIN
...
PackTime(A,AL);
PackTime(B,BL);
IF AL <= BL THEN Diff := AL-BL
ELSE Diff := BL - AL;
UnPackTime(Diff,D);
...
Frage 111
F: Was bedeutet der Kürzel BCD?
A: BCD steht für Binaray Coded Decimal, eine spezielle Form der
Zahldarstellung. Bei BCD-Zahlen werden die einzelnen Dezimalstellen
einer Zahl getrennt codiert. D.h. pro Ziffer werden vier Bits
benötigt (n/a - unbenutzt):
0000 - 0 0100 - 4 1000 - 8 1100 - n/a
0001 - 1 0101 - 5 1001 - 9 1101 - n/a
0010 - 2 0110 - 6 1010 - n/a 1110 - n/a
0011 - 3 0111 - 7 1011 - n/a 1111 - n/a
Die Zahl -2.06 könnte beispielsweise durch
1111 0010 1100 0000 0110
beschrieben werden, wobei 1111 für -, 1110 für +, und 1100 für
den Dezimalpunkt verwendet wird. (Dies ist kein Standard!)
Der Vorteil der BCD-Arithmetik liegt in der Berechnung absolut
genauer Ergebnisse, der Nachteil im Speicheraufwand.
Zur Darstellung eines LongInt auf BCD-Basis würden z.B. 44 Bits
benötigt, fast das 1.5 fache der "normalen" Darstellung.
Frage 112
F: Wie frage ich den Fehlercode eines aufgerufenen Programmes ab?
A: Nach dem Aufruf eines Programmes mit Hilfe von Exec (vgl. Frage 28)
beinhaltet die Variable DosExitCode den Fehlercode des gestarteten
Programmes (Beispiel-Programm in der Online-Hilfe).
Frage 113
F: Wie kann ich kurzzeitig die Tastertur abstellen?
A: Zu diesem Zweck greift man über die Ports $60 und $61 direkt
auf den Tasterturcontroller zu:
USES Dos, Crt;
VAR NormalKbd : procedure;
I : Byte;
PROCEDURE DisableKeyboard; INTERRUPT;
VAR P60, P61 : Byte;
BEGIN
P60 := Port[$60]; { KB Controller Datenausgabepuffer }
P61 := Port[$61]; { KB Controller Port B }
Port[$61] := P61 or $80; { KB löschen }
Port[$61] := P61;
Port[$20] := $20;
END;
BEGIN
GetIntVec ($09, @NormalKeyboard);
SetIntVec ($09, @DisableKeyboard);
Write ('Tastertur gesperrt.');
FOR i := 1 to 5 do
BEGIN
Delay (1000);
Write (i:2);
END; {for}
Writeln;
SetIntVec ($09, @NormalKeyboard);
Write ('Tastertur freigegeben.');
FOR i := 1 TO 5 DO
BEGIN
Delay (1000);
Write (i:2);
END;
END.
ACHTUNG: Wer keine Ahnung von Ports hat, sollte auch nicht damit
spielen. Man kann bei falschen Aufrufen Daten oder sogar Hardware
zerstören !!!
Frage 114
F: Wie kann ich in TP den Namen einer Diskette/Festplatte ändern?
A: Mit den folgenden Deklarationen und Funktionen kann diese Aufgabe
erledigt werden. Allerdings sei davon abgeraten, in Programmen, die
verkauft (o.ä.) werden, solche Funktionen zu verwenden. Für alle,
die genaueres wissen wollen, sei auf die Interruptliste verwiesen.
TYPE ExFCB = RECORD
FF : Byte; {immer 0FFh}
Reserved0 : ARRAY[1..5] OF Byte; {immer 0s}
Attribute : Byte;
DriveID : Byte;
Filename : ARRAY[1..8] OF Char;
Extension : ARRAY[1..3] OF Char;
CurBlock : Word;
RecSize : Word;
FileSize : LongInt;
Date : Word;
Time : Word;
Reserved : ARRAY[1..8] OF Byte;
CurRec : Byte;
Relative : LongInt;
END;
VolString = STRING[12];
FUNCTION SetLabel(Drive : Byte; NuLabel : VolString) : Boolean;
VAR E : ExFCB;
BEGIN
WITH E DO
BEGIN
FillChar(Reserved0, 5, 0);
FF := $FF;
Attribute := VolumeID;
DriveID := Drive;
FillChar(FileName, 8, ' ');
FillChar(Extension, 3, ' ');
Move(NuLabel[1], Filename, length(NuLabel));
END;
ASM
PUSH DS
MOV AX, SS
MOV DS, AX
LEA DX, E {point DS:DX at Extended FCB}
MOV AH, 16h {create using FCB}
INT 21h
INC AL
MOV @result, AL
POP DS
END;
END;
Für ASM-Feinde das ganze in reinem Pascal:
FUNCTION SetLabel(Drive : Byte; NuLabel : VolString) : Boolean;
VAR E : ExFCB;
R : Registers;
BEGIN
WITH E DO
BEGIN
FillChar(Reserved0, 5, 0);
FF := $FF;
Attribute := VolumeID;
DriveID := Drive;
FillChar(FileName, 8, ' ');
FillChar(Extension, 3, ' ');
Move(NuLabel[1], Filename, length(NuLabel));
END;
R.DS := Seg(E);
R.DX := Ofs(E);
R.AH := $16;
MsDos(R);
IF R.AL=0 THEN Writeln('Ok');
END;
Frage 115
F: Wie kommt der Wert von 18.2 Aufrufe/Sek. für den INT8 zustande?
A: Der Wert berechnet sich aus der Basis-Frequenz des XT-Quarzes
(14.317.180 Hz), die zuerst durch 3 dividiert wird, um die XT-
Frequenz von ca. 4,77 MHz zu bilden. Nach einer weiteren Division
durch 4 wird die resultierende Frequenz dem Timer-Baustein 8253/54
zugefuehrt. Das Bios wiederum teilt diese Frequenz durch
65536 (2^16), um die Zeitbasis für den INT8 und IRQ0 zu erzeugen.
Der genaue Wert lautet: 18,20523579915364583333333...
Frage 116
F: Wie berechne ich in Pascal die 3. Wurzel aus einer Zahl?
A: Mit Hilfe von ein wenig Schulmathematik kommt man schnell zu
einer Lösung. Mit EXP(X * LN(A)) berechnet man A^X, also braucht
man nur 1/3 für X einzusetzen und erhält als Ergebnis die 3.
Wurzel aus A. Genauso kann man jede beliebige Wurzel ziehen:
Exp((1/Grad der Wurzel) * Ln(A))
Weitere mathematische Funktionen sind unter Frage 66 zu finden.
Frage 117
F: Wo liegt der Untschied zwischen SeekEof und Eof?
A: Zunächst kann SeekEof nur auf Textdateien angewendet werden, während
Eof auf jeden Dateityp angewendet werden kann. Eof überprüft nur,
ob das Ende der Datei erreicht ist. SeekEof macht ein bischen mehr.
SeekEof liest solange Zeichen aus der Datei, bis ein lesbares Zeichen
kommt oder das Dateiende erreicht ist. Ein lesbares Zeichen ist dabei
ein Zeichen, das kein Leerzeichen, Tabulator oder Zeilenvorschub ist.
Somit verschiebt SeekEof den Dateizeiger bis zum naechsten lesbaren
Zeichen (True) oder zum Dateiende (False).
Frage 118
F: Wie wird die CMOS-CRC berechnet?
A: Die CRC berechnet sich nach einem sehr einfachen Algorithmus. Es
werden einfach die Werte der Register $10 bis $2D addiert modulo
256 gerechnet. In Pascal läßt sich das durch Addition auf einem
Byte berechnen. Allerdings sollte das Rangechecking ausgeschaltet
werden. (Siehe auch Frage 71).
CONST Rtc_Floppy_Type = $10;
Rtc_Lo_Checksum = $2E;
Rtc_Hi_Checksum = $2F;
FUNCTION ReadRTC(N:Byte):Byte;
BEGIN
PORT[$70] := PORT[$70] AND $7F OR N;
ReadRTC:= PORT[$71];
END;
FUNCTION rtc_IsValidCmos: Boolean; { valid cmos checksum ? }
VAR CHK1,CHK2: Word;
C : Byte;
BEGIN
CHK1 := 0;
FOR C := rtc_floppy_type TO $2D DO
Inc(CHK1,ReadRTC(C)); {hier wird die checksum berechnet}
CHK2 := (Word(256) * ReadRTC(rtc_lo_checksum))
+ ReadRTC(rtc_hi_checksum);
rtc_IsValidCmos := (Chk1 = Chk2);
END;
Frage 119
F: Welche Modi kann ich für Filemode verwenden?
A: Die folgenden Konstanten liefern die Grundmodi. Durch Addition
zweier Werte erhält man den gewünschten Dateimodus.
CONST FM_ReadOnly = $00; { Nur Lesen }
FM_WriteOnly = $01; { Nur Schreiben }
FM_ReadWrite = $02; { Schreiben und Lesen }
FM_DenyAll = $10; { Andere dürfen Nichts }
FM_DenyWrite = $20; { nicht schreiben }
FM_DenyRead = $30; { lesen }
FM_DenyNONE = $40; { Alles }
Durch
Filemode := FM_ReadWrite+FM_DenyAll;
Assign(F,'Datei');
Rewrite(F);
wird beispielsweise eine Datei zum Schreiben geöffnet, auf die
andere Netzwerkteilnehmer nicht zugreifen dürfen. Mit
Filemode := FM_ReadOnly+FM_DenyWrite;
Assign(F,'Datei');
Reset(F);
kann eine Datei zum Lesen geöffnet werden. Gleichzeitig wird
sichergestellt, daß niemand anders die Datei verändert.
(Siehe auch Frage 6 und 109)
Frage 120
F: Meine alten Programme liefern auf neuen Rechnern (Pentium-II) nur
noch den Runtime-Error 200. Was ist der Grund?
A: Das ganze ist ein internes Problem von Turbo Pascal. Bei der Calibrierung
der Delayfunktion tritt bei neueren Rechnern eine Art I>underflow/I>
auf. Es resultiert ein Wert Null, durch den zu einem spaeteren Zeitpunkt
dividiert wird. Dies fuehrt zu der entsprechenden Fehlermeldung. Von
Seiten Borlands ist meines Erachtens nach kein offizieller Patch
herausgegeben worden. Allerdings bin ich bei einem Mirror der ftp-site
der CT fuendig geworden.
Der Patch der auf dem FTP-Server der CT erhaeltlich ist, enthaelt
sowohl einige Aenderungen an den Runtime-Quellen von Pascal sowie ein
einen Patch fuer aufuehrbare Programme.
Credits
Für Quelltexte und sonstige Anregungen, die zum Aufbau der FAQ bei-
(ge)tragen (haben), möchte ich mich bei folgenden Personen bedanken.
Bernd Nawothnig, Sieghard Schicktanz, Juergen Ulomek, Andreas Flach,
Achim Hohenstein, Paul Schubert, Wenzel Peppmeyer, Horst Kraemer,
Marc Wallowy, Ulrich Toennies, Martin Gerdes, Achim Hohenstein,
Klaus Hartnegg, Siegfried Jess, Oliver Fromme,
Mein besonderer Dank gilt Axel Plinge, der auch selbst Teile der FAQ
zusammen(ge)stellt (hat).
Fragebogen
Andreas Schlechte,
08.05.1995 (letzte Änderung 03.04.1996)
Diese Seite wurde 
mal angezeigt.