[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]
{
Hello Gayle Davis...
I would just like to say how pleased i am with the continuing success of
SWAGS..
Below I have included some source of my own. a cd-player, that I�believe
is quite nifty, anyways I like it.
I would be very pleased and honored if it was included in SWAGS...
Yours truly,
Lars Koudal
Denmark, 25th of february 1997
A bit of history:
------------------
I am one of those people who use my cd-rom drive for playing music while I am working,
eventhough at home I have my left shoulder about 5 inches from the volume knop on my
somewhat larger stereo..
This is a habbit from my good old days where I worked in far less equipped environments.
Nowadays I have what I need in win95...
Back then though, I was never really satisfied with the cd-players out there. So I wrote
my own... I used a lot of routines grabbed from SWAGS.. (Thanks...) I always intended this
to be only for personal use, but as the program grew larger I felt like I perhaps could
earn some bucks selling the damn thing... THAT was in my young and restless days...
I recently picked up a newer version of swags (haven't done that in more than a year),
and was very thrilled to see how alive this wonderful source of information is..
Therefore I decided to post the small version of my program... If people want it, I will
ofcourse send the full-scale version as well.. That hasn't been fully written yet, but
the damn thing works...
This version is called mini... Probaply due to it's small size (compared to the larger one),
but since it is some years ago, I am not quite sure... :-)
This program uses, as mentioned before, a lot of routines and units from other people. All
grabbed here from swags... Remember! Credit where credit is due!
When you run this damn thing, it pops up on your dos-screen with a single line...
It shows what song is playing, and how long it has been playing...
When you press Pgup, it goes one song up. Guess what happens when you press PgDn! :-)
Press '.' and up comes a list of songs you can pick. Just use up- and down-keys to scroll
and ENTER to make your selection...
The whole thing ends when you press ESC...
Try to press F1 from inside the player... I had forgotten this little nifty detail until I tried
it out a few minutes ago...
BTW: If you have a SoundBlaster in your computer, and the routines I use for detecting it
_can_ find it, you can use '+' and '-' to adjust the volume... Pretty nifty...
I used it a lot from inside Turbo Pascal.. I made it a tool, and just pressed Shift-F5,
and there it was... pretty handy... and a lot faster... Ever used QCD (comes with SndB)??
Goddamn slow!
(If you can't figure out how to make a new tool in TP, don't bother... put the keyboard down!)
Well, so much about the past, a bit about the future..:
--------------------------------------------------------
As I have written, this code is from my novice years. If you for some reason want to contact me,
don't do so if you just want to complain about the lousy code, the many unused variables and the many
work-arounds I did for making the whole thing work. I provide this code to
help novices people out, as I was helped myself some years ago...
If you DO decide to contact me, you can e-mail me... (Sorry, left FIDO years ago):
lkoudal@usa.net
Have fun!
Yours truly,
Lars Koudal.
{Installation notes... Cut and paste the files to their original names, and the compile MINI.PAS... THATS IT!
Play around as much as you like...}
{CUT ... Save this as MINI.PAS }
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROGRAM mini;
{ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß}
{This program is determined that you start it with a color-screen
If you don't have that, or you do not know how to change it to a monochrome
screen, don't bother... put the keyboard down...
Lars Koudal....
hint: look about 15 lines down, and read the comment...
}
USES
{ effects,
} CD_Unit,
CD_Vars,
DOS,
CRT,
TPTimer,
TCTimer,
TPBuffer,
ScanCode;
TYPE
TotPlayRec = RECORD
Frames,
Seconds,
Minutes,
Nada : Byte;
END;
CONST
TextVidSeg : Word = $b800;
vga_segment = $0A000;
fade_Delay = 20;
vSeg : Word = $B800; {change for mono}
VAR
CurrIndex : Word;
ScreenLoc : Pointer;
ScrollSize : Word;
vol_time : longint;
toslet : boolean;
sbfound,
portok : Boolean;
ScrBuf,
Pdwns : Word;
origmode : word;
lcv : Integer;
temp : Char;
a1,
a2,
a3 : Byte;
b1,
b2,
b3 : Byte;
crc : LongInt;
cdidstr : String;
number : Byte;
SaveExit : Pointer;
TrackInfo : ARRAY [1..99] OF PAudioTrackInfo;
I : Integer;
CH : Char;
SP,
EP : LongInt;
LeadOut,
StartP,
TotalPlayTime: LongInt;
TotPlay : TotPlayRec;
place : LongInt;
secs,
pps,
s : LongInt;
Track : Byte;
StartTrack,
EndTrack,
NumTracks : Integer;
Player : ARRAY [1..100] OF Byte;
PlayTime : TotPlayRec;
result : Word;
resultchar : Char;
Hi,
Hi2 : Byte;
crstyp : Word;
arbejder : Byte;
lvolume,
rvolume : Byte; {Volume-control}
Scroll_Lock,
Caps_Lock,
Num_Lock,
Ins,
Alt,
Ctrl,
Left_Shift,
Right_Shift : Boolean;
Bios_Keys : Byte ABSOLUTE $40:$17;
Procedure WaitForRetrace; Assembler;
Asm
Mov DX, 3DAh
@Rep1:
In AL, DX
Test AL, 08h
JZ @Rep1
@Rep2:
In AL, DX
Test AL, 08h
JNZ @Rep2
End;
Function LeadingZero (w : Word) : String;
Var
s : String;
Begin
Str (w: 0, s);
If Length (s) = 1 Then
s := '0' + s;
LeadingZero := s;
End;
Function ITOS ( nNum: LongInt; nSpaces: Integer ): String;
Var
s: ^String;
Begin
Asm
mov sp, BP
push ss
push Word Ptr @RESULT
End;
If nSpaces > 0 Then
Str ( nNum: nSpaces, s^ )
Else
Str ( nNum: 0, s^ );
End;
Function returnspace (s: String; wantedspace: Byte): String;
Var
i : Byte;
temp : String;
Begin
temp := '';
For i := Length (s) To wantedspace Do
Begin
temp := temp + ' ';
End;
returnspace := temp;
End;
{home-made-calculations of which track is currently being played}
Procedure calctrack;
Var
Min, Sec: Byte;
i: Byte;
svar: Boolean;
{**************}
Procedure addtime (m, s: Byte);
Begin
Min := Min + m;
Sec := Sec + s;
If Sec = 60 Then
Begin
Min := Min + 1;
Sec := 0;
End;
If Sec > 60 Then
Begin
Min := Min + 1;
Sec := Sec - 60;
End;
End;
{**************}
{**************}
Procedure bigger (m1, s1, m2, s2: Byte; svar: Boolean);
{calculates whether m1:s1 is bigger than m2:s2:}
Begin
If (m1 * 60 + s1) > (m2 * 60 + s2) Then svar := True
Else svar := False;
End;
{**************}
Begin
track := 0;
Min := 0;
Sec := 0;
secs := 0;
place := Head_Location (1);
For i := starttrack To endtrack Do
Begin
If trackinfo [i]^. startpoint < place Then
Begin
track := i;
End;
If track = 0 Then track := 1;
End;
End;
Procedure NoTracks;
Begin
WriteLn;
WriteLn ('No tracks on disk');
WriteLn;
ExitProc := SaveExit;
End;
Procedure Setup;
Begin
TotalPlayTime := 0;
LeadOut := AudioDiskInfo. LeadOutTrack;
StartTrack := AudioDiskInfo. LowestTrack;
EndTrack := AudioDiskInfo. HighestTrack;
NumTracks := EndTrack - StartTrack + 1;
For I := StartTrack To EndTrack Do
Begin
Track := I;
Audio_Track_Info (StartP, Track);
New (TrackInfo [I] );
FillChar (TrackInfo [I]^, SizeOf (TrackInfo [I]^), #0);
TrackInfo [I]^. StartPoint := StartP;
TrackInfo [I]^. TrackControl := Track;
End;
For I := StartTrack To EndTrack - 1 Do
TrackInfo [I]^. EndPoint := TrackInfo [I + 1]^. StartPoint - 1;
TrackInfo [EndTrack]^. EndPoint := AudioDiskInfo. LeadOutTrack - 1;
For I := StartTrack To EndTrack Do
Move (TrackInfo [I]^. EndPoint, TrackInfo [I]^. Frames, 4);
TrackInfo [StartTrack]^. PlayMin := TrackInfo [StartTrack]^. Minutes;
TrackInfo [StartTrack]^. PlaySec := TrackInfo [StartTrack]^. Seconds - 2;
For I := StartTrack + 1 To EndTrack Do
Begin
EP := (TrackInfo [I]^. Minutes * 60) + TrackInfo [I]^. Seconds;
SP := (TrackInfo [I - 1]^. Minutes * 60) + TrackInfo [I - 1]^. Seconds;
EP := EP - SP;
TrackInfo [I]^. PlayMin := EP Div 60;
TrackInfo [I]^. PlaySec := EP Mod 60;
End;
TotalPlayTime := AudioDiskInfo. LeadOutTrack - TrackInfo [StartTrack]^. StartPoint;
Move (TotalPlayTime, TotPlay, 4);
End;
Function KeyEnh: Boolean;
Var
Enh: Byte Absolute $0040:$0096;
Begin
KeyEnh := False;
If (Enh And $10) = $10 Then
KeyEnh := True;
End;
Function InKey (Var SCAN, ASCII: Byte): Boolean;
Var
i : Integer;
Shift,
Ctrl,
Alt : Boolean;
Temp,
Flag1 : Byte;
HEXCH,
HEXRD,
HEXFL : Byte;
reg : Registers;
Begin
If KeyEnh Then
Begin
HEXCH := $11;
HEXRD := $10;
HEXFL := $12;
End
Else
Begin
HEXCH := $01;
HEXRD := $00;
HEXFL := $02;
End;
reg. AH := HEXCH;
Intr ($16, reg);
i := reg. Flags And fZero;
reg. AH := HEXFL;
Intr ($16, reg);
Flag1 := Reg. AL;
Temp := Flag1 And $03;
If Temp = 0 Then
SHIFT := False
Else
SHIFT := True;
Temp := Flag1 And $04;
If Temp = 0 Then
CTRL := False
Else
CTRL := True;
Temp := Flag1 And $08;
If Temp = 0 Then
ALT := False
Else
ALT := True;
If i = 0 Then
Begin
reg. AH := HEXRD;
Intr ($16, reg);
scan := reg. AH;
ascii := reg. AL;
InKey := True;
End
Else
InKey := False;
End;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION UpStr (CONST s: String): String; ASSEMBLER;
ASM
push DS
lds SI, s
les DI, @result
lodsb { load and store length of string }
stosb
XOR CH, CH
mov CL, AL
jcxz @empty { FIX for null length string }
@upperLoop:
lodsb
cmp AL, 'a'
jb @cont
cmp AL, 'z'
ja @cont
sub AL, ' '
@cont:
stosb
loop @UpperLoop
@empty:
pop DS
END;
procedure vretrace; assembler; { vertical retrace }
asm
mov dx,3dah
@vert1:
in al,dx
test al,8
jz @vert1
@vert2:
in al,dx
test al,8
jnz @vert2
end;
Procedure Setupsc(Col, Row, ScrollSize : Word; Var ScreenLoc : Pointer);
Var Seg1, Ofs1 : Word;
Begin
{I guess we're assuming an 80 column text mode }
Ofs1 := (Row-1)*160 + ((Col-1)*2);
If (Mem[$40:$49] = 7) then Seg1 := $B000
else Seg1 := $B800;
ScreenLoc := Ptr(Seg1,Ofs1);
End;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION Get_svar: Byte ;
VAR
CH: Char;
no_svar: Boolean;
BEGIN
no_svar := TRUE;
REPEAT
CH := UpCase (ReadKey);
IF CH = NullKey THEN
BEGIN
CASE Ord (ReadKey) OF
dnarrow:
BEGIN
get_svar := dnarrow;
END;
uparrow:
BEGIN
get_svar := uparrow;
END;
lfarrow:
BEGIN
get_svar := lfarrow;
END;
rtarrow:
BEGIN
get_Svar := rtarrow;
END;
END;
END
ELSE
CASE CH OF
EnterKey :
BEGIN
get_svar := 100;
END;
EscapeKey :
BEGIN
get_svar := 27;
END;
END;
UNTIL no_svar <> FALSE;
END;
Procedure Update;Assembler;
ASM
CLD
LES DI, ScreenLoc
MOV CX, ScrollSize
MOV SI, CurrIndex
OR SI, SI
JZ @WriteString
DEC CX
@ShiftLeft:
MOV AL, ES:[DI+2]
STOSB
INC DI
LOOP @ShiftLeft
MOV AL, CS:[SI]
OR AL, AL
JNZ @NotEndOfStr
MOV SI, Offset @Message
MOV AL, CS:[SI]
@NotEndOfStr:
STOSB
INC SI
JMP @SaveIndex
@WriteString:
MOV SI, Offset @Message
@NextChar:
MOV AL, CS:[SI]
OR AL, AL
JZ @WriteString
STOSB
INC DI
INC SI
LOOP @NextChar
@SaveIndex:
MOV CurrIndex, SI
JMP @Exit
@Message:
DB ' '
DB ' '
DB '(\/)ini HELP! '
DB ' Function keys available:'
DB ' PgUP : One track up ... PgDN : One track down '
DB ' ... "." : Pick a track using arrow keys ... '
DB 'RightArrow : FastForward ... LeftArrow : Rewind ... '
DB 'If you have a Sound Blaster you can use the "+" & "-" keys to control '
DB 'the volume..... '
DB 0 { terminate it with NULL }
@Exit:
End;
procedure help;
Var Fedup : Boolean;
time:byte;
c:byte;
emptystr:string;
i:integer;
Begin
fillchar(emptystr,80,' ');
emptystr[0]:=#80;
ScrollSize := 80;
Setupsc(01,wherey,SCrollSize,ScreenLoc);
CurrIndex := 0;
time:=0;
fedup:=false;
textcolor(lightgray);
gotoxy(1,wherey);
write(emptystr);
while keypressed do readkey;
Repeat
waitforretrace;
Update;
if keypressed then
begin
c:=get_svar;
if c=uparrow then inc(time);
if c=dnarrow then dec(time);
Fedup := (c = 27);
end;
Until (Fedup);
End;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION IntToStr (I: LongInt): String;
{Converts any integer type to a string}
VAR
S: String [11];
BEGIN
Str (I, S);
IntToStr := S;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE ShowVolume;
var
i:byte;
BEGIN
gotoxy(33,wherey);
TEXTCOLOR (DarkGray);
FOR i := 1 TO 32 DO
BEGIN
WRITE ('þ');
END;
TEXTCOLOR (Yellow);
GOTOXY (33, wherey);
FOR i := 1 TO lvolume DIV 8 DO
BEGIN
WRITE ('Þ');
END;
vol_time:=readtimer;
toslet:=true;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE Cursoff;
{ Turns the cursor off. Stores its format for later redisplaying}
BEGIN
ASM
Mov AH, 03H
Mov BH, 00H
Int 10H
Mov Crstyp, CX
Mov AH, 01H
Mov CX, 65535
Int 10H
END;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE Curson;
{Turns the cursor back on, using the cursor display previously stored}
BEGIN
ASM
Mov AH, 01H
Mov CX, Crstyp
Int 10H
END;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE SetColor (Color, Red, Green, Blue : Byte);
{Sets the RGB-values for a given color}
BEGIN
port [$3C8] := Color;
port [$3C9] := Red;
port [$3C9] := Green;
port [$3C9] := Blue;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE GetColor (Nr: Byte; VAR R, G, B: Byte);
{Retrieves the RGB-values for a given color}
BEGIN
Port [$3C7] := Nr;
R := Port [$3C9];
G := Port [$3C9];
B := Port [$3C9];
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE wait_4_refresh; ASSEMBLER;
{Waits for the monitors vertical retrace}
LABEL
wait, retr;
ASM
mov DX, 3DAh
wait: IN AL, DX
Test AL, 08h
jz wait
retr: IN AL, DX
Test AL, 08h
jnz retr
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION ISCOLOR : Boolean;
{Returns FALSE for MONO or TRUE for COLOR}
VAR
regs : Registers;
video_mode : Integer;
equ_lo : Byte;
BEGIN
Intr ($11, regs);
video_mode := regs. AL AND $30;
video_mode := video_mode SHR 4;
CASE video_mode OF
1 : ISCOLOR := FALSE; { Monochrome }
2 : ISCOLOR := TRUE{ Color }
END
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE SAVESCR ( VAR screen );
{Saves the screen in an array of bytes}
VAR
vidc : Byte ABSOLUTE $B800: 0000;
vidm : Byte ABSOLUTE $B000: 0000;
BEGIN
IF NOT ISCOLOR THEN { if MONO }
Move (vidm, screen, 6000)
ELSE { else COLOR }
Move (vidc, screen, 6000)
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE RESTORESCR ( VAR screen );
{Restores the screen previous stored in an array of bytes}
VAR
vidc : Byte ABSOLUTE $B800: 0000;
vidm : Byte ABSOLUTE $B000: 0000;
BEGIN
IF NOT ISCOLOR THEN { if MONO }
Move (screen, vidm, 6000)
ELSE { else COLOR }
Move (screen, vidc, 6000)
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE working;
{Displays an 'working'-status on the screen}
VAR
X, Y: Byte;
c: Byte;
BEGIN
IF playing THEN
BEGIN
X := WhereX;
Y := WhereY;
c := TextAttr;
TextBackground (Blue);
TextColor (Black);
GotoXY (70, 3);
IF arbejder = 1 THEN Write ('');
IF arbejder = 2 THEN Write (' ');
IF arbejder = 3 THEN Write ('');
IF arbejder = 4 THEN Write (' ');
IF arbejder < 4 THEN Inc (arbejder)
ELSE
arbejder := 1;
GotoXY (X, Y);
TextAttr := c;
END;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE center (s: String; Y: Byte);
{Centers a given string on a given line on the screen}
BEGIN
GotoXY (40 - (Length (s) DIV 2), Y);
Write (s);
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
Function hex(a : Word; b : Byte) : String;
Const digit : Array[$0..$F] Of Char = '0123456789ABCDEF';
Var i : Byte;
xstring : String;
Begin
xstring:='';
For i:=1 To b Do
Begin
Insert(digit[a And $000F], xstring, 1);
a:=a ShR 4
End;
hex:=xstring
End; {hex}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
Procedure SoundPort;
Var xbyte1, xbyte2, xbyte3, xbyte4: Byte;
xword, xword1, xword2, temp, sbport: Word;
Begin
sbfound:=False;
xbyte1:=1;
While (xbyte1 < 7) And (Not sbfound) Do
Begin
sbport:=$200 + ($10 * xbyte1);
xword1:=0;
portok:=False;
While (xword1 < $201) And (Not portok) Do
Begin
If (Port[sbport + $0C] And $80) = 0 Then
portok:=True;
Inc(xword1)
End;
If portok Then
Begin
xbyte3:=Port[sbport + $0C];
Port[sbport + $0C]:=$D3;
For xword2:=1 To $1000 Do {nothing};
xbyte4:=Port[sbport + 6];
Port[sbport + 6]:=1;
xbyte2:=Port[sbport + 6];
xbyte2:=Port[sbport + 6];
xbyte2:=Port[sbport + 6];
xbyte2:=Port[sbport + 6];
Port[sbport + 6]:=0;
xbyte2:=0;
Repeat
xword1:=0;
portok:=False;
While (xword1 < $201) And (Not portok) Do
Begin
If (Port[sbport + $0E] And $80) = $80 Then
portok:=True;
Inc(xword1)
End;
If portok Then
If Port[sbport + $0A] = $AA Then
sbfound:=True;
Inc(xbyte2);
Until (xbyte2 = $10) Or (portok);
If Not portok Then
Begin
Port[sbport + $0C]:=xbyte3;
Port[sbport + 6]:=xbyte4;
End;
End;
If sbfound Then
Begin
End
Else
Inc(xbyte1);
End;
End;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION pickatrack: Byte;
{Displays the user with a list of tracks to pick}
VAR
Top, Bottom : Byte;
change : Boolean; {scroller vi op/ned?}
slut : Boolean;
i : Byte;
c : Byte;
curr : Byte;
index : Byte;
s: String;
topl: Byte;
BEGIN
topl := wherey-1; {topline}
pickatrack := 0;
s := ' ';
change := FALSE;
curr := 1;
slut := FALSE;
Top := 1;
index := endtrack;
TextColor (lightgray);
gotoxy(32,topl+1);
write('Select ');
gotoxy(42,topl+1);
write( ' ³ ');
curr:=track;
REPEAT
BEGIN
TextBackground (Black);
TextColor (lightgray);
FOR i := Top TO Bottom DO
BEGIN
GotoXY (43, topl + 1);
Write (' ');
IF i = track THEN
BEGIN
TextColor (lightgray+ Blink);
Write (leadingzero (i) );
TextColor (lightgray);
Write ('³');
TextColor (lightgray+ Blink);
Write (leadingzero (trackinfo [i]^. playmin) );
TextColor (lightgray);
Write (':');
TextColor (lightgray+ Blink);
Write (leadingzero (trackinfo [i]^. playsec) );
END
ELSE
BEGIN
Write (leadingzero (i) );
Write ('³');
Write (leadingzero (trackinfo [i]^. playmin) );
Write (':');
Write (leadingzero (trackinfo [i]^. playsec) );
END;
END;
IF curr = track THEN
BEGIN
TextColor (lightgray);
GotoXY (44, topl + 1);
Write (leadingzero (curr) );
TextColor (lightgray);
Write ('³');
TextColor (lightgray);
Write (leadingzero (trackinfo [curr]^. playmin) );
TextColor (lightgray);
Write (':');
TextColor (lightgray);
Write (leadingzero (trackinfo [curr]^. playsec) );
END
ELSE
BEGIN
TextColor (lightgray);
GotoXY (44, topl + 1);
Write (leadingzero (curr) );
Write ('³');
Write (leadingzero (trackinfo [curr]^. playmin) );
Write (':');
Write (leadingzero (trackinfo [curr]^. playsec) );
END;
textbackground(black);
textcolor(lightgray);
gotoxy(39,topl+1);
if curr=1 then write('( )');
if curr=index then write('( )');
if ((curr<index) and (Curr>1)) then write('( )');
repeat
calctrack;
q_channel_info;
textcolor(yellow);
gotoxy(18,wherey);
write(leadingzero(track));
gotoxy(21,wherey);
textcolor(white);
write(leadingzero(endtrack));
textcolor(yellow);
gotoxy(24,wherey);
write(leadingzero(qchannelinfo.minutes));
gotoxy(27,wherey);
write(leadingzero(qchannelinfo.seconds));
until keypressed;
c := get_Svar;
IF (c = uparrow) THEN
BEGIN
IF (curr = Top) AND (Top > 1) THEN
BEGIN
Dec (Top);
Dec (curr);
change := TRUE;
END;
IF (curr > Top) THEN Dec (curr);
END;
IF (c = dnarrow) THEN
BEGIN
IF (curr < index)THEN
begin
Inc (curr);
inc(top);
end;
END;
IF c = 100 THEN
BEGIN
pickatrack := curr;
slut := TRUE;
END;
IF c = 27 THEN
BEGIN
TextBackground (Black);
gotoxy(32,topl+1);write(' ');
Exit;
END;
END; {while}
UNTIL slut;
TextBackground (Black);
gotoxy(32,topl+1);write(' ');
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE colwrite (col, startline: Byte; s: String);
{Writes a given line downwards from the given column and the given startline}
VAR
i, j: Byte;
BEGIN
j := 1;
FOR i := startline TO startline+ Length (s) - 1 DO
BEGIN
GotoXY (col, i);
Write (s [j] );
Inc (j);
END;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE stuffthebuff;
{Empties the buffer}
VAR
chartoskip: Char;
BEGIN
WHILE KeyPressed DO
chartoskip := ReadKey;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
FUNCTION Get_Scan_Code : Word;
VAR
HTregs : Registers;
BEGIN
HTregs. AH := $01;
Intr ($16, HTregs);
Get_Scan_Code := HTregs. AX;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
PROCEDURE fuckthebuff;
{Flushes the keyboard-buffer}
BEGIN
ASM
Mov AX, $0C00;
Int 21h;
END;
END;
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
{ÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜ}
VAR
currtrack : Byte;
ieren : LongInt;
slut : Boolean;
newtrack : Byte;
xkor,
ykor : Byte;
timepassed:longint;
BEGIN
origmode := LastMode;
cursoff;
soundport;
port [$224] := 48;
lvolume := port [$225];
port [$224] := 49;
rvolume := port [$225];
port [$224] := 65;
xkor := WhereX;
ykor := WhereY;
TextColor (LightGray);
TextBackground (Black);
gotoxy(1,wherey-1);
textcolor(white);
write('(\/)ini');
textcolor(lightgray);
writeln(' v.1 Checking CD-ROM ... ');
gotoxy(1,wherey);
Audio_Disk_Info;
Setup;
IF AudioDiskInfo. HighestTrack < 1 THEN
BEGIN
delay(200);
Audio_Disk_Info;
Setup;
WriteLn ('Not an audio-CD!');
curson;
Exit;
END;
gotoxy(1,wherey-1);
gotoxy(01,wherey);
write('(\/)ini v.1 xx/xx xx:XX L/th 1996');
gotoxy(1,wherey-1);
gotoxy(18,wherey);
slut := FALSE;
textcolor(white);
audio_status_info;
q_channel_info;
audio_status_info;
audio_disk_info;
Play_Audio (trackinfo [starttrack]^. startpoint, trackinfo [endtrack]^. endpoint);
REPEAT
REPEAT
if toslet then
begin
if elapsedtime(vol_time,readtimer)>700 then
begin
gotoxy(33,wherey);
write(' ');
toslet:=false;
end;
end;
fuckthebuff;
calctrack;
q_channel_info;
gotoxy(18,wherey);
write(leadingzero(track));
gotoxy(21,wherey);
textcolor(white);
write(leadingzero(endtrack));
textcolor(yellow);
gotoxy(24,wherey);
write(leadingzero(qchannelinfo.minutes));
gotoxy(27,wherey);
write(leadingzero(qchannelinfo.seconds));
UNTIL InKey (Hi, Hi2);
{ESC (EXIT AUDIO)}
IF ( (Hi = 1) AND (Hi2 = 27) ) THEN slut := TRUE;
{Page Up (UP ONE TRACK)}
IF ( (Hi = 73) AND ( (Hi2 = 0) OR (Hi2 = 224) ) AND (playing) AND (track < endtrack) ) THEN
BEGIN
pause_audio;
play_audio (trackinfo [track + 1]^. startpoint, trackinfo [endtrack]^. endpoint);
END;
{Page Down (DOWN ONE TRACK)}
IF ( (Hi = 81) AND ( (Hi2 = 0) OR (Hi2 = 224) ) AND (playing) AND (track > starttrack) ) THEN
BEGIN
IF ( (place < (trackinfo [track]^. startpoint + 3000) ) ) THEN
BEGIN
pause_audio;
play_audio (trackinfo [track - 1]^. startpoint, trackinfo [endtrack]^. endpoint);
END;
IF ( (place > (trackinfo [track]^. startpoint + 3000) ) ) THEN
BEGIN
pause_audio;
play_audio (trackinfo [track]^. startpoint, trackinfo [endtrack]^. endpoint);
END;
END;
{Right Arrow (SKIP 3-4 SECS)}
IF ( (Hi = 77) AND ( (Hi2 = 0) OR (Hi2 = 224) ) AND (playing) AND ( (place+ (3000) ) <
trackinfo [endtrack]^. endpoint) )
THEN
BEGIN
pause_audio;
play_audio (place+1000, trackinfo [endtrack]^. endpoint);
END;
{Left Arrow (SKIP 3-4 SECS)}
IF ( (Hi = 75) AND ( (Hi2 = 0) OR (Hi2 = 224) ) AND (playing) AND ( (place- (3000 * 4) ) >
trackinfo [starttrack]^. startpoint) )
THEN
BEGIN
pause_audio;
play_audio ((place- 1000), trackinfo [endtrack]^. endpoint);
delay(20);
END;
{Middle key (PAUSE/RESUME)}
IF ( (Hi = 76) AND (Hi2 = 0) ) THEN
BEGIN
IF playing THEN
BEGIN
io_control (stopplay);
audio_status_info;
END
ELSE
BEGIN
resume_play;
END;
END;
IF ( (Hi = 52) AND (Hi2 = 46) ) THEN
BEGIN
newtrack := pickatrack;
IF newtrack > 0 THEN
BEGIN
pause_audio;
play_audio (trackinfo [newtrack]^. startpoint, trackinfo [endtrack]^. endpoint);
END;
END;
{HELP MENU!}
IF ( (Hi = 59) AND (Hi2 = 0) ) THEN
BEGIN
fuckthebuff;
help;
gotoxy(01,wherey-1);
write('(\/)ini v.1 xx/xx xx:XX L/th 1996');
gotoxy(1,wherey-1);
END;
{ VOLUME-CONTROL!}
{'-' (Reduce BOTH volumes)}
IF ( (Hi = 74) AND (Hi2 = 45) AND NOT ( (left_shift) OR (right_shift) ) ) THEN
BEGIN
if sbfound then
begin
IF rvolume > 04 THEN
BEGIN
DEC (rvolume, 4);
port [$224] := 49;
port [$225] := rvolume;
END;
IF lvolume > 04 THEN
BEGIN
DEC (lvolume, 4);
port [$224] := 48;
port [$225] := lvolume;
END;
showvolume;
end;
END;
{'+' (Increase BOTH volumes)}
IF ( (Hi = 78) AND (Hi2 = 43) AND NOT ( (left_shift) OR (right_shift) ) ) THEN
BEGIN
if sbfound then
begin
IF rvolume < 252 THEN
BEGIN
INC (rvolume, 4);
port [$224] := 49;
port [$225] := rvolume;
END;
IF lvolume < 252 THEN
BEGIN
INC (lvolume, 4);
port [$224] := 48;
port [$225] := lvolume;
END;
showvolume;
end;
END;
{ VOLUME-CONTROL!}
stuffthebuff;
UNTIL slut;
gotoxy(1,wherey);
textcolor(lightgray);
writeln('(\/)ini v.1 Mini-CD-ROM-player L/th 1996');
curson;
END.
{CUT OFF ...}
{CUT ... Save this as CD_UNIT.PAS}
UNIT CD_Unit;
INTERFACE
USES DOS, CD_Vars;
VAR
Drive : Integer; { Must set drive before all operations }
SubUnit : Integer;
PROCEDURE IO_Control (Command : Byte);
FUNCTION File_Name (VAR Code : Integer) : String;
FUNCTION Read_VTOC (VAR VTOC : VTOCArray;
VAR Index : Integer) : Boolean;
PROCEDURE CD_Check (VAR Code : Integer);
PROCEDURE Vol_Desc (VAR Code : Integer;
VAR ErrCode : Integer);
PROCEDURE CD_Dev_Req (DevPointer : Pointer);
PROCEDURE Get_Dir_Entry (PathName : String;
VAR Format, ErrCode : Integer);
PROCEDURE DeviceStatus;
PROCEDURE Audio_Channel_Info;
PROCEDURE Audio_Disk_Info;
PROCEDURE Audio_Track_Info (VAR StartPoint : LongInt;
VAR TrackControl : Byte);
PROCEDURE Audio_Status_Info;
PROCEDURE Q_Channel_Info;
PROCEDURE Lock (LockDrive : Boolean);
PROCEDURE Resetcd;
PROCEDURE Eject;
PROCEDURE CloseTray;
PROCEDURE Resume_Play;
PROCEDURE Pause_Audio;
PROCEDURE Play_Audio (StartSec, EndSec : LongInt);
FUNCTION Sector_Size (ReadMode : Integer) : Word;
FUNCTION Volume_Size : LongInt;
FUNCTION Media_Changed : Boolean;
FUNCTION Head_Location (AddrMode : Byte) : LongInt;
PROCEDURE Read_Drive_Bytes (VAR ReadBytes : DriveByteArray);
PROCEDURE Read_Long (TransAddr : Pointer; StartSec : LongInt);
PROCEDURE SeekSec (StartSec : LongInt);
PROCEDURE DevClose;
PROCEDURE DevOpen;
PROCEDURE OutputFlush;
PROCEDURE InputFlush;
FUNCTION UPC_Code : String;
IMPLEMENTATION
CONST
CarryFlag = $0001;
TYPE
PointerHalf = RECORD
LoHalf, HiHalf : Word;
END;
VAR
Regs : Registers;
IOBlock : IOControl;
DriveBytes : ARRAY [1..130] OF Byte;
PROCEDURE Clear_Regs;
BEGIN
FillChar (Regs, SizeOf (Regs), #0);
END;
PROCEDURE CD_Intr;
BEGIN
Regs. AH := $15;
Intr ($2F, Regs);
END;
PROCEDURE MSCDEX_Ver;
BEGIN
Clear_Regs;
Regs. AL := $0C;
Regs. BX := $0000;
CD_Intr;
MSCDEX_Version. Minor := 0;
IF Regs. BX = 0 THEN
MSCDEX_Version. Major := 1
ELSE
BEGIN
MSCDEX_Version. Major := Regs. BH;
MSCDEX_Version. Minor := Regs. BL;
END;
END;
PROCEDURE Initialize;
BEGIN
NumberOfCD := 0;
Clear_Regs;
Regs. AL := $00;
Regs. BX := $0000;
CD_Intr;
IF Regs. BX <> 0 THEN
BEGIN
NumberOfCD := Regs. BX;
FirstCD := Regs. CX;
Clear_Regs;
FillChar (DriverList, SizeOf (DriverList), #0);
FillChar (UnitList, SizeOf (UnitList), #0);
Regs. AL := $01; { Get List of Driver Header Addresses }
Regs. ES := Seg (DriverList);
Regs. BX := Ofs (DriverList);
CD_Intr;
Clear_Regs;
Regs. AL := $0D; { Get List of CD-ROM Units }
Regs. ES := Seg (UnitList);
Regs. BX := Ofs (UnitList);
CD_Intr;
MSCDEX_Ver;
END;
END;
FUNCTION File_Name (VAR Code : Integer) : String;
VAR
FN : String [38];
BEGIN
Clear_Regs;
Regs. AL := Code + 1;
{
Copyright Filename = 1
Abstract Filename = 2
Bibliographic Filename = 3
}
Regs. CX := Drive;
Regs. ES := Seg (FN);
Regs. BX := Ofs (FN);
CD_Intr;
Code := Regs. AX;
IF (Regs. Flags AND CarryFlag) = 0 THEN
File_Name := FN
ELSE
File_Name := '';
END;
FUNCTION Read_VTOC (VAR VTOC : VTOCArray;
VAR Index : Integer) : Boolean;
{ On entry -
Index = Vol Desc Number to read from 0 to ?
On return
Case Index of
1 : Standard Volume Descriptor
$FF : Volume Descriptor Terminator
0 : All others
}
BEGIN
Clear_Regs;
Regs. AL := $05;
Regs. CX := Drive;
Regs. DX := Index;
Regs. ES := Seg (VTOC);
Regs. BX := Ofs (VTOC);
CD_Intr;
Index := Regs. AX;
IF (Regs. Flags AND CarryFlag) = 0 THEN
Read_VTOC := TRUE
ELSE
Read_VTOC := FALSE;
END;
PROCEDURE CD_Check (VAR Code : Integer);
BEGIN
Clear_Regs;
Regs. AL := $0B;
Regs. BX := $0000;
Regs. CX := Drive;
CD_Intr;
IF Regs. BX <> $ADAD THEN
Code := 2
ELSE
BEGIN
IF Regs. AX <> 0 THEN
Code := 0
ELSE
Code := 1;
END;
END;
PROCEDURE Vol_Desc (VAR Code : Integer;
VAR ErrCode : Integer);
FUNCTION Get_Vol_Desc : Byte;
BEGIN
Clear_Regs;
Regs. CX := Drive;
Regs. AL := $0E;
Regs. BX := $0000;
CD_Intr;
Code := Regs. AX;
IF (Regs. Flags AND CarryFlag) <> 0 THEN
ErrCode := $FF;
Get_Vol_Desc := Regs. DH;
END;
BEGIN
Clear_Regs;
ErrCode := 0;
IF Code <> 0 THEN
BEGIN
Regs. DH := Code;
Regs. DL := 0;
Regs. BX := $0001;
Regs. AL := $0E;
Regs. CX := Drive;
CD_Intr;
Code := Regs. AX;
IF (Regs. Flags AND CarryFlag) <> 0 THEN
ErrCode := $FF;
END;
IF ErrCode = 0 THEN
Code := Get_Vol_Desc;
END;
PROCEDURE Get_Dir_Entry (PathName : String;
VAR Format, ErrCode : Integer);
BEGIN
FillChar (DirBuf, SizeOf (DirBuf), #0);
PathName := PathName + #0;
Clear_Regs;
Regs. AL := $0F;
Regs. CL := Drive;
Regs. CH := 1;
Regs. ES := Seg (PathName);
Regs. BX := Ofs (PathName);
Regs. SI := Seg (DirBuf);
Regs. DI := Ofs (DirBuf);
CD_Intr;
ErrCode := Regs. AX;
IF (Regs. Flags AND CarryFlag) = 0 THEN
BEGIN
Move (DirBuf. NameArray [1], DirBuf. FileName [1], 38);
DirBuf. FileName [0] := #12; { File names are only 8.3 }
Format := Regs. AX
END
ELSE
Format := $FF;
END;
PROCEDURE CD_Dev_Req (DevPointer : Pointer);
BEGIN
Clear_Regs;
Regs. AL := $10;
Regs. CX := Drive;
Regs. ES := PointerHalf (DevPointer).HiHalf;
Regs. BX := PointerHalf (DevPointer).LoHalf;
CD_Intr;
END;
PROCEDURE IO_Control (Command : Byte);
BEGIN
IOBlock. IOReq_Hdr. Len := 26;
IOBlock. IOReq_Hdr. SubUnit := SubUnit;
IOBlock. IOReq_Hdr. Status := 0;
IOBlock. TransAddr := @DriveBytes;
IOBlock. IOReq_Hdr. Command := Command;
FillChar (IOBlock. IOReq_Hdr. Reserved, 8, #0);
CD_Dev_Req (@IOBlock);
Busy := (IOBlock. IOReq_Hdr. Status AND 512) <> 0;
END;
PROCEDURE Audio_Channel_Info;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 4;
IOBlock. NumBytes := 9;
IO_Control (IOCtlInput);
Move (DriveBytes, AudioChannel, 9);
END;
PROCEDURE DeviceStatus;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 6;
IOBlock. NumBytes := 5;
IO_Control (IOCtlInput);
DoorOpen := DriveBytes [2] AND 1 <> 0;
DoorLocked := DriveBytes [2] AND 2 <> 0;
AudioManip := DriveBytes [3] AND 1 <> 0;
DiscInDrive := DriveBytes [3] AND 8 <> 0;
END;
PROCEDURE Audio_Disk_Info;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 10;
IOBlock. NumBytes := 7;
IO_Control (IOCtlInput);
Move (DriveBytes [2], AudioDiskInfo, 6);
Playing := Busy;
END;
PROCEDURE Audio_Track_Info (VAR StartPoint : LongInt;
VAR TrackControl : Byte);
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 11;
DriveBytes [2] := TrackControl; { Track number }
IOBlock. NumBytes := 7;
IO_Control (IOCtlInput);
Move (DriveBytes [3], StartPoint, 4);
TrackControl := DriveBytes [7];
Playing := Busy;
END;
PROCEDURE Q_Channel_Info;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 12;
IOBlock. NumBytes := 11;
IO_Control (IOCtlInput);
Move (DriveBytes [2], QChannelInfo, 11);
END;
PROCEDURE Audio_Status_Info;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 15;
IOBlock. NumBytes := 11;
IO_Control (IOCtlInput);
Paused := (Word (DriveBytes [2] ) AND 1) <> 0;
Move (DriveBytes [4], Last_Start, 4);
Move (DriveBytes [8], Last_End, 4);
Playing := Busy;
END;
PROCEDURE Eject;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 0;
IOBlock. NumBytes := 1;
IO_Control (IOCtlOutput);
END;
PROCEDURE Resetcd;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 2;
IOBlock. NumBytes := 1;
IO_Control (IOCtlOutput);
Busy := TRUE;
END;
PROCEDURE Lock (LockDrive : Boolean);
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 1;
IF LockDrive THEN
DriveBytes [2] := 1
ELSE
DriveBytes [2] := 0;
IOBlock. NumBytes := 2;
IO_Control (IOCtlOutput);
END;
PROCEDURE CloseTray;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 5;
IOBlock. NumBytes := 1;
IO_Control (IOCtlOutput);
END;
VAR
AudioPlay : Audio_Play;
FUNCTION Play (StartLoc, NumSec : LongInt) : Boolean;
BEGIN
FillChar (AudioPlay, SizeOf (AudioPlay), #0);
AudioPlay. APReq. Command := PlayCD;
AudioPlay. APReq. Len := 22;
AudioPlay. APReq. SubUnit := SubUnit;
AudioPlay. Start := StartLoc;
AudioPlay. NumSecs := NumSec;
AudioPlay. AddrMode := 1;
CD_Dev_Req (@AudioPlay);
Play := ( (AudioPlay. APReq. Status AND 32768) = 0);
END;
PROCEDURE Play_Audio (StartSec, EndSec : LongInt);
VAR
SP,
EP : LongInt;
SArray : ARRAY [1..4] OF Byte;
EArray : ARRAY [1..4] OF Byte;
BEGIN
Move (StartSec, SArray [1], 4);
Move (EndSec, EArray [1], 4);
SP := SArray [3]; { Must use longint or get negative result }
SP := (SP * 75 * 60) + (SArray [2] * 75) + SArray [1];
EP := EArray [3];
EP := (EP * 75 * 60) + (EArray [2] * 75) + EArray [1];
EP := EP - SP;
Playing := Play (StartSec, EP);
Audio_Status_Info;
END;
PROCEDURE Pause_Audio;
BEGIN
IF Playing THEN
BEGIN
FillChar (AudioPlay, SizeOf (AudioPlay), #0);
AudioPlay. APReq. Command := stopplay; {stopplay}
AudioPlay. APReq. Len := 13;
AudioPlay. APReq. SubUnit := SubUnit;
CD_Dev_Req (@AudioPlay);
END;
Audio_Status_Info;
Playing := FALSE;
END;
PROCEDURE Resume_Play;
BEGIN
FillChar (AudioPlay, SizeOf (AudioPlay), #0);
AudioPlay. APReq. Command := ResumePlay;
AudioPlay. APReq. Len := 13;
AudioPlay. APReq. SubUnit := SubUnit;
CD_Dev_Req (@AudioPlay);
Audio_Status_Info;
END;
FUNCTION Sector_Size (ReadMode : Integer) : Word;
VAR SecSize : Word;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 7;
DriveBytes [2] := ReadMode;
IOBlock. NumBytes := 4;
IO_Control (IOCtlInput);
Move (DriveBytes [3], SecSize, 2);
Sector_Size := SecSize;
END;
(*Function CD_GetVol:Boolean;
begin
CtlBlk[0] := 4; { die Lautstaerke lesen }
CD_GetVol := CD_IOCtl(IoCtlRead, 8);
if ((R.Flags and FCARRY) = 0)
then Move(CtlBlk[1], CD.VolInfo, 8)
else FillChar( CD.VolInfo, 8, 0)
end;
Function CD_SetVol:Boolean;
begin
CtlBlk[0] := 3; { die Lautstaerke setzen }
CD_SetVol := CD_IOCtl( IoCtlWrite, 8);
end;
*)
FUNCTION Volume_Size : LongInt;
VAR VolSize : LongInt;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 8;
IOBlock. NumBytes := 5;
IO_Control (IOCtlInput);
Move (DriveBytes [2], VolSize, 4);
Volume_Size := VolSize;
END;
FUNCTION Media_Changed : Boolean;
VAR MedChng : Byte;
{ 1 : Media not changed
0 : Don't Know
-1 : Media changed
}
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 9;
IOBlock. NumBytes := 2;
IO_Control (IOCtlInput);
Move (DriveBytes [2], MedChng, 4);
Inc (MedChng);
CASE MedChng OF
2 : Media_Changed := FALSE;
1, 0 : Media_Changed := TRUE;
END;
END;
FUNCTION Head_Location (AddrMode : Byte) : LongInt;
VAR
HeadLoc : LongInt;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 1;
DriveBytes [2] := AddrMode;
IOBlock. NumBytes := 6;
IO_Control (IOCtlInput);
Move (DriveBytes [3], HeadLoc, 4);
Head_Location := HeadLoc;
END;
PROCEDURE Read_Drive_Bytes (VAR ReadBytes : DriveByteArray);
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
DriveBytes [1] := 5;
IOBlock. NumBytes := 130;
IO_Control (IOCtlInput);
Move (DriveBytes [3], ReadBytes, 128);
END;
FUNCTION UPC_Code : String;
VAR
I, J, K : Integer;
TempStr : String;
BEGIN
FillChar (DriveBytes, SizeOf (DriveBytes), #0);
TempStr := '';
DriveBytes [1] := 14;
IOBlock. NumBytes := 11;
IO_Control (IOCtlInput);
IF ( (IOBlock. IOReq_Hdr. Status AND 32768) = 0) THEN;
FOR I := 3 TO 9 DO
BEGIN
J := DriveBytes [I] AND $0F;
K := DriveBytes [I] AND $F0;
TempStr := TempStr + Chr (J + 48);
TempStr := TempStr + Chr (K + 48);
END;
IF Length (TempStr) > 13 THEN
TempStr [0] := Chr (Ord (TempStr [0] ) - 1);
UPC_Code := TempStr;
END;
PROCEDURE Read_Long (TransAddr : Pointer; StartSec : LongInt);
VAR
RL : ReadControl;
{
ReadControl = Record
IOReq_Hdr : Req_Hdr;
AddrMode : Byte;
TransAddr : Pointer;
NumSecs : Word;
StartSec : LongInt;
ReadMode : Byte;
IL_Size,
IL_Skip : Byte;
End;
}
BEGIN
FillChar (RL, SizeOf (RL), #0);
RL. IOReq_Hdr. Len := 27;
RL. IOReq_Hdr. SubUnit := SubUnit;
RL. IOReq_Hdr. Command := ReadLong;
RL. AddrMode := 1;
RL. TransAddr := TransAddr;
RL. NumSecs := 1;
RL. StartSec := StartSec;
RL. ReadMode := 0;
CD_Dev_Req (@RL);
END;
PROCEDURE SeekSec (StartSec : LongInt);
VAR
RL : ReadControl;
BEGIN
FillChar (RL, SizeOf (RL), #0);
RL. IOReq_Hdr. Len := 24;
RL. IOReq_Hdr. SubUnit := SubUnit;
RL. IOReq_Hdr. Command := SeekCmd;
RL. AddrMode := 1;
RL. StartSec := StartSec;
RL. ReadMode := 0;
CD_Dev_Req (@RL);
END;
PROCEDURE InputFlush;
VAR
IOReq : Req_Hdr;
BEGIN
FillChar (IOReq, SizeOf (IOReq), #0);
WITH IOReq DO
BEGIN
Len := 13;
SubUnit := SubUnit;
Command := 7;
Status := 0;
END;
CD_Dev_Req (@IOReq);
END;
PROCEDURE OutputFlush;
VAR
IOReq : Req_Hdr;
BEGIN
FillChar (IOReq, SizeOf (IOReq), #0);
WITH IOReq DO
BEGIN
Len := 13;
SubUnit := SubUnit;
Command := 11;
Status := 0;
END;
CD_Dev_Req (@IOReq);
END;
PROCEDURE DevOpen;
VAR
IOReq : Req_Hdr;
BEGIN
FillChar (IOReq, SizeOf (IOReq), #0);
WITH IOReq DO
BEGIN
Len := 13;
SubUnit := SubUnit;
Command := 13;
Status := 0;
END;
CD_Dev_Req (@IOReq);
END;
PROCEDURE DevClose;
VAR
IOReq : Req_Hdr;
BEGIN
FillChar (IOReq, SizeOf (IOReq), #0);
WITH IOReq DO
BEGIN
Len := 13;
SubUnit := SubUnit;
Command := 14;
Status := 0;
END;
CD_Dev_Req (@IOReq);
END;
{************************************************************}
BEGIN
NumberOfCD := 0;
FirstCD := 0;
FillChar (MSCDEX_Version, SizeOf (MSCDEX_Version), #0);
Initialize;
Drive := FirstCD;
SubUnit := 0;
END.
{CUT OFF ...}
{CUT ... Save this as CD_VARS.PAS}
UNIT CD_Vars;
INTERFACE
TYPE
ListBuf = RECORD
UnitCode : Byte;
UnitSeg,
UnitOfs : Word;
END;
VTOCArray = ARRAY [1..2048] OF Byte;
DriveByteArray = ARRAY [1..128] OF Byte;
Req_Hdr = RECORD
Len : Byte;
SubUnit : Byte;
Command : Byte;
Status : Word;
Reserved: ARRAY [1..8] OF Byte;
END;
CONST
Init = 0;
IoCtlInput = 3;
InputFlush = 7;
IOCtlOutput = 12;
DevOpen = 13;
DevClose = 14;
ReadLong = 128;
ReadLongP = 130;
SeekCmd = 131;
PlayCD = 132;
StopPlay = 133;
ResumePlay = 136;
TYPE
Audio_Play = RECORD
APReq : Req_Hdr;
AddrMode : Byte;
Start : LongInt;
NumSecs : LongInt;
END;
IOControl = RECORD
IOReq_Hdr : Req_Hdr;
MediaDesc : Byte;
TransAddr : Pointer;
NumBytes : Word;
StartSec : Word;
ReqVol : Pointer;
END;
ReadControl = RECORD
IOReq_Hdr : Req_Hdr;
AddrMode : Byte;
TransAddr : Pointer;
NumSecs : Word;
StartSec : LongInt;
ReadMode : Byte;
IL_Size,
IL_Skip : Byte;
END;
AudioDiskInfoRec = RECORD
LowestTrack : Byte;
HighestTrack : Byte;
LeadOutTrack : LongInt;
{new!}
VolInfo: ARRAY [1..8] OF Byte; { Lautst.-Einstellungen }
END;
PAudioTrackInfo = ^AudioTrackInfoRec;
AudioTrackInfoRec = RECORD
Track : Integer;
StartPoint : LongInt;
EndPoint : LongInt;
Frames,
Seconds,
Minutes,
PlayMin,
PlaySec,
TrackControl : Byte;
END;
MSCDEX_Ver_Rec = RECORD
Major,
Minor : Integer;
END;
DirBufRec = RECORD
XAR_Len : Byte;
FileStart : LongInt;
BlockSize : Integer;
FileLen : LongInt;
DT : Byte;
Flags : Byte;
InterSize : Byte;
InterSkip : Byte;
VSSN : Integer;
NameLen : Byte;
NameArray : ARRAY [1..38] OF Char;
FileVer : Integer;
SysUseLen : Byte;
SysUseData: ARRAY [1..220] OF Byte;
FileName : String [38];
END;
Q_Channel_Rec = RECORD
Control : Byte;
Track : Byte;
Index : Byte;
Minutes : Byte;
Seconds : Byte;
Frame : Byte;
Zero : Byte;
AMinutes : Byte;
ASeconds : Byte;
AFrame : Byte;
END;
VAR
AudioChannel : ARRAY [1..9] OF Byte;
DoorOpen,
DoorLocked,
AudioManip,
DiscInDrive : Boolean;
AudioDiskInfo : AudioDiskInfoRec;
DriverList : ARRAY [1..26] OF ListBuf;
NumberOfCD : Integer;
FirstCD : Integer;
UnitList : ARRAY [1..26] OF Byte;
MSCDEX_Version : MSCDEX_Ver_Rec;
QChannelInfo : Q_Channel_Rec;
Busy,
Playing,
Paused : Boolean;
Last_Start,
Last_End : LongInt;
DirBuf : DirBufRec;
IMPLEMENTATION
BEGIN
FillChar (DriverList, SizeOf (DriverList), #0);
FillChar (UnitList, SizeOf (UnitList), #0);
NumberOfCD := 0;
FirstCD := 0;
MSCDEX_Version. Major := 0;
MSCDEX_Version. Minor := 0;
END.
{CUT OFF ...}
{CUT ... Save this as TPTIMER.PAS}
{$S-,R-,I-,V-,B-}
{*********************************************************}
{* TPTIMER.PAS 2.00 *}
{* by TurboPower Software *}
{*********************************************************}
UNIT TpTimer;
{-Allows events to be timed with 1 microsecond resolution}
INTERFACE
PROCEDURE InitializeTimer;
{-Reprogram the timer chip to allow 1 microsecond resolution}
PROCEDURE RestoreTimer;
{-Restore the timer chip to its normal state}
FUNCTION ReadTimer : LongInt;
{-Read the timer with 1 microsecond resolution}
FUNCTION ElapsedTime (Start, Stop : LongInt) : Real;
{-Calculate time elapsed (in milliseconds) between Start and Stop}
FUNCTION ElapsedTimeString (Start, Stop : LongInt) : String;
{-Return time elapsed (in milliseconds) between Start and Stop as a string}
{==========================================================================}
IMPLEMENTATION
CONST
TimerResolution = 1193181.667;
VAR
SaveExitProc : Pointer;
Delta : LongInt;
FUNCTION Cardinal (L : LongInt) : Real;
{-Return the unsigned equivalent of L as a real}
BEGIN {Cardinal}
IF L < 0 THEN
Cardinal := 4294967296.0 + L
ELSE
Cardinal := L;
END; {Cardinal}
FUNCTION ElapsedTime (Start, Stop : LongInt) : Real;
{-Calculate time elapsed (in milliseconds) between Start and Stop}
BEGIN {ElapsedTime}
ElapsedTime := 1000.0 * Cardinal (Stop - (Start + Delta) ) / TimerResolution;
END; {ElapsedTime}
FUNCTION ElapsedTimeString (Start, Stop : LongInt) : String;
{-Return time elapsed (in milliseconds) between Start and Stop as a string}
VAR
R : Real;
S : String;
BEGIN {ElapsedTimeString}
R := ElapsedTime (Start, Stop);
Str (R: 0: 3, S);
ElapsedTimeString := S;
END; {ElapsedTimeString}
PROCEDURE InitializeTimer;
{-Reprogram the timer chip to allow 1 microsecond resolution}
BEGIN {InitializeTimer}
{select timer mode 2, read/write channel 0}
Port [$43] := $34; {00110100b}
INLINE ($EB / $00); {jmp short $+2 ;delay}
Port [$40] := $00; {LSB = 0}
INLINE ($EB / $00); {jmp short $+2 ;delay}
Port [$40] := $00; {MSB = 0}
END; {InitializeTimer}
PROCEDURE RestoreTimer;
{-Restore the timer chip to its normal state}
BEGIN {RestoreTimer}
{select timer mode 3, read/write channel 0}
Port [$43] := $36; {00110110b}
INLINE ($EB / $00); {jmp short $+2 ;delay}
Port [$40] := $00; {LSB = 0}
INLINE ($EB / $00); {jmp short $+2 ;delay}
Port [$40] := $00; {MSB = 0}
END; {RestoreTimer}
FUNCTION ReadTimer : LongInt;
{-Read the timer with 1 microsecond resolution}
BEGIN {ReadTimer}
INLINE (
$FA / {cli ;Disable interrupts}
$BA / $20 / $00 / {mov dx,$20 ;Address PIC ocw3}
$B0 / $0A / {mov al,$0A ;Ask to read irr}
$EE / {out dx,al}
$B0 / $00 / {mov al,$00 ;Latch timer 0}
$E6 / $43 / {out $43,al}
$EC / {in al,dx ;Read irr}
$89 / $C7 / {mov di,ax ;Save it in DI}
$E4 / $40 / {in al,$40 ;Counter --> bx}
$88 / $C3 / {mov bl,al ;LSB in BL}
$E4 / $40 / {in al,$40}
$88 / $C7 / {mov bh,al ;MSB in BH}
$F7 / $D3 / {not bx ;Need ascending counter}
$E4 / $21 / {in al,$21 ;Read PIC imr}
$89 / $C6 / {mov si,ax ;Save it in SI}
$B0 / $FF / {mov al,$0FF ;Mask all interrupts}
$E6 / $21 / {out $21,al}
$B8 / $40 / $00 / {mov ax,$40 ;read low word of time}
$8E / $C0 / {mov es,ax ;from BIOS data area}
$26 / $8B / $16 / $6C / $00 / {mov dx,es:[$6C]}
$89 / $F0 / {mov ax,si ;Restore imr from SI}
$E6 / $21 / {out $21,al}
$FB / {sti ;Enable interrupts}
$89 / $F8 / {mov ax,di ;Retrieve old irr}
$A8 / $01 / {test al,$01 ;Counter hit 0?}
$74 / $07 / {jz done ;Jump if not}
$81 / $FB / $FF / $00 / {cmp bx,$FF ;Counter > $FF?}
$77 / $01 / {ja done ;Done if so}
$42 / {inc dx ;Else count int req.}
{done:}
$89 / $5E / $FC / {mov [bp-4],bx ;set function result}
$89 / $56 / $FE); {mov [bp-2],dx}
END; {ReadTimer}
PROCEDURE Calibrate;
{-Calibrate the timer}
CONST
Reps = 1000;
VAR
I : Word;
L1, L2, Diff : LongInt;
BEGIN {Calibrate}
Delta := MaxInt;
FOR I := 1 TO Reps DO BEGIN
L1 := ReadTimer;
L2 := ReadTimer;
{use the minimum difference}
Diff := L2 - L1;
IF Diff < Delta THEN
Delta := Diff;
END;
END; {Calibrate}
{$F+}
PROCEDURE OurExitProc;
{-Restore timer chip to its original state}
BEGIN {OurExitProc}
ExitProc := SaveExitProc;
RestoreTimer;
END; {OurExitProc}
{$F-}
BEGIN
{set up our exit handler}
SaveExitProc := ExitProc;
ExitProc := @OurExitProc;
{reprogram the timer chip}
InitializeTimer;
{adjust for speed of machine}
Calibrate;
END.
{CUT OFF...}
{CUT ... Save this as TCTIMER.PAS}
UNIT tctimer;
INTERFACE
USES tptimer;
VAR
start : LongInt;
PROCEDURE StartTimer;
PROCEDURE WriteElapsedTime;
IMPLEMENTATION
PROCEDURE StartTimer;
BEGIN
start := ReadTimer;
END;
PROCEDURE WriteElapsedTime;
VAR stop : LongInt;
BEGIN
stop := ReadTimer;
WriteLn ('calc = ', (ElapsedTime (start, stop) / 1000): 10: 6, ' sec');
END;
END.
{CUT OFF...}
{CUT ... Save this as TPBUFFER.PAS}
UNIT TPbuffer;
(* TP-Buffer unit version 1.1 /Update *)
(* Using the keyboard's buffer in Turbo Pascal *)
(* This unit is released to the public domain *)
(* by Lavi Tidhar on 5-10-1992 *)
(* This unit adds three special functions not *)
(* incuded in the Turbo Pascal regular package *)
(* You may alter this source code, move the *)
(* procedures to your own programs. Please do *)
(* NOT change these lines of documentation *)
(* This source might teach you about how to *)
(* use interrupts in pascal, and the keyboard's *)
(* buffer. from the other hand, it might not :-) *)
(* Used: INT 16, functions 0 and 1 *)
(* INT 21, function 0Ch *)
(* INT 16 - KEYBOARD - READ CHAR FROM BUFFER, WAIT IF EMPTY
AH = 00h
Return: AH = scan code
AL = character *)
(* INT 16 - KEYBOARD - CHECK BUFFER, DO NOT CLEAR
AH = 01h
Return: ZF = 0 character in buffer
AH = scan code
AL = character
ZF = 1 no character in buffer *)
(* INT 21 - DOS - CLEAR KEYBOARD BUFFER
AH = 0Ch
AL must be 1, 6, 7, 8, or 0Ah.
Notes: Flushes all typeahead input, then executes function specified by AL
(effectively moving it to AH and repeating the INT 21 call).
If AL contains a value not in the list above, the keyboard buffer is
flushed and no other action is taken. *)
(* For more details/help etc, you can contact me on: *)
(* Mail: Lavi Tidhar
46 Bantam Dr.
Blairgowrie
2194
South Africa
*)
(* Phone:
International: +27-11-787-8093
South Africa: (011)-787-8093
*)
(* Netmail: The Catacomb BBS 5:7101/45 (fidonet)
The Catacomb BBS 80:80/100 (pipemail)
*)
INTERFACE
USES DOS;
FUNCTION GetScanCode: Byte; (* Get SCAN CODE from buffer, wait if empty *)
FUNCTION GetKey: Char; (* Get Char from buffer, do NOT wait *)
PROCEDURE FlushKB;
IMPLEMENTATION
FUNCTION GetKey: Char;
VAR Regs: Registers;
BEGIN
Regs. AH := 1; (* Int 16 function 1 *)
Intr ($16, Regs); (* Read a charecter from the keyboard buffer *)
GetKey := Chr (Regs. AL); (* do not wait. If no char was found, CHR(0) *)
END; (* (nul) is returned *)
FUNCTION GetScanCode: Byte; (* Int 16 function 0 *)
VAR Regs: Registers; (* The same as CRT's Readkey, but gives you *)
BEGIN (* the scan code. Esp usefull when you want to *)
Regs. AH := 1; (* use special keys as the arrows, there will *)
Intr ($16, Regs); (* be a conflict when using ReadKey *)
GetScanCode := Regs. AH;
END;
PROCEDURE FlushKB; (* INT 21 function 0C *)
VAR Regs: Registers; (* Flushes (erase) the keyboard buffer *)
BEGIN (* ONLY. No other function is executed *)
Regs. AH := $0C;
Regs. AL := 2;
Intr ($21, Regs);
END;
END.
{CUT OFF...}
{CUT... Save this as SCANCODE.PAS}
UNIT ScanCode;
{ This UNIT is created by Wayne Boyd, aka Vipramukhya Swami, BBS phone
(604)431-6260, Fidonet node 1:153/763. It's function is to facilitate
the use of Function keys and Alt keys in a program. It includes F1
through F10, Shift-F1 through Shift-F10, Ctrl-F1 through Ctrl-F10,
and Alt-F1 through Alt-F10. It also includes all of the alt keys, all
of the Ctrl keys and many other keys as well. This UNIT and source code
are copyrighted material and may not be used for commercial use
without express written permission from the author. Use at your own
risk. I take absolutely no responsibility for it, and there are no
guarantees that it will do anything more than take up space on your
disk. }
INTERFACE
CONST
F1 = 59; CtrlF1 = 94; AltF1 = 104; Homekey = 71;
F2 = 60; CtrlF2 = 95; AltF2 = 105; Endkey = 79;
F3 = 61; CtrlF3 = 96; AltF3 = 106; PgUp = 73;
F4 = 62; CtrlF4 = 97; AltF4 = 107; PgDn = 81;
F5 = 63; CtrlF5 = 98; AltF5 = 108; UpArrow = 72;
F6 = 64; CtrlF6 = 99; AltF6 = 109; RtArrow = 77;
F7 = 65; CtrlF7 = 100; AltF7 = 110; DnArrow = 80;
F8 = 66; CtrlF8 = 101; AltF8 = 111; LfArrow = 75;
F9 = 67; CtrlF9 = 102; AltF9 = 112; InsertKey = 82;
F10 = 68; CtrlF10 = 103; AltF10 = 113; DeleteKey = 83;
AltQ = 16; AltA = 30; AltZ = 44; Alt1 = 120; ShftF1 = 84;
AltW = 17; AltS = 31; AltX = 45; Alt2 = 121; ShftF2 = 85;
AltE = 18; AltD = 32; AltC = 46; Alt3 = 122; ShftF3 = 86;
AltR = 19; AltF = 33; AltV = 47; Alt4 = 123; ShftF4 = 87;
AltT = 20; AltG = 34; AltB = 48; Alt5 = 124; ShftF5 = 88;
AltY = 21; AltH = 35; AltN = 49; Alt6 = 125; ShftF6 = 89;
AltU = 22; AltJ = 36; AltM = 50; Alt7 = 126; ShftF7 = 90;
AltI = 23; AltK = 37; Alt8 = 127; ShftF8 = 91;
AltO = 24; AltL = 38; Alt9 = 128; ShftF9 = 92;
AltP = 25; CtrlLf = 115; Alt0 = 129; ShftF10 = 93;
CtrlRt = 116;
CtrlA = #1; CtrlK = #11; CtrlU = #21; CtrlB = #2; CtrlL = #12;
CtrlV = #22; CtrlC = #3; CtrlM = #13; CtrlW = #23; CtrlD = #4;
CtrlN = #14; CtrlX = #24; CtrlE = #5; CtrlO = #15; CtrlY = #25;
CtrlF = #6; CtrlP = #16; CtrlZ = #26; CtrlG = #7; CtrlQ = #17;
CtrlS = #19; CtrlH = #8; CtrlR = #18; CtrlI = #9; CtrlJ = #10;
CtrlT = #20; BSpace = #8; EscapeKey = #27; EnterKey = #13; NullKey = #0;
IMPLEMENTATION
END.
{CUT OFF...}
[Back to DELPHI SWAG index] [Back to Main SWAG index] [Original]