informis
/
textfiles
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
textfiles/internet/FAQ/faqpas4.txt

1003 lines
37 KiB
Plaintext
Raw Blame History

From ts@uwasa.fi Sat Mar 30 00:00:00 1996
Subject: FAQPAS4.TXT contents
Copyright (c) 1993-1996 by Timo Salmi
All rights reserved
FAQPAS4.TXT The fourth set of frequently (and not so frequently)
asked Turbo Pascal questions with Timo's answers. The items are in
no particular order.
You are free to quote brief passages from this file provided you
clearly indicate the source with a proper acknowledgment.
Comments and corrections are solicited. But if you wish to have
individual Turbo Pascal consultation, please post your questions to
a suitable Usenet newsgroup like news:comp.lang.pascal.borland. It
is much more efficient than asking me by email. I'd like to help,
but I am very pressed for time. I prefer to pick the questions I
answer from the Usenet news. Thus I can answer publicly at one go if
I happen to have an answer. Besides, newsgroups have a number of
readers who might know a better or an alternative answer. Don't be
discouraged, though, if you get a reply like this from me. I am
always glad to hear from fellow Turbo Pascal users.
....................................................................
Prof. Timo Salmi Co-moderator of news:comp.archives.msdos.announce
Moderating at ftp:// & http://garbo.uwasa.fi archives 193.166.120.5
Department of Accounting and Business Finance ; University of Vaasa
ts@uwasa.fi http://uwasa.fi/~ts BBS 961-3170972; FIN-65101, Finland
--------------------------------------------------------------------
76) What are the current Pascal newsgroups on the Usenet news?
77) How do I detect the CapsLock status, how do I turn it on/off?
78) How do I detect if the F11 or F12 key has been pressed?
79) How do I extract (parse) substrings from an input string?
80) How do I find out the size of any kind of a file?
81) How do I format graphics output like in textmode writeln?
82) How do I detect if more than one standard key is pressed down?
83) How can I read a disk's Volume Serial Number?
84) How can I disable and then enable the keyboard in my TP program?
85) How do I get the character device name of the (first) CD-ROM?
86) How do I eject a CD-ROM using a Turbo Pascal program?
87) How do I find out if the ANSI.SYS driver has been loaded?
88) Where do I find Turbo Pascal tutorials and/or good textbooks?
89) How do I make an executable of my Turbo Pascal source program?
90) How can I quickly read the last byte of a file?
91) Is 2000 a leap year? What is the leap year algorithm?
92) Does anybody have a program that gives the week number?
93) How can I use OutText to write numbers in the graphics mode?
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:16 1996
Subject: Usenet Pascal newsgroups
76. *****
Q: What are the current Pascal newsgroups on the Usenet news?
A: The following new Pascal newsgroups were created June 12, 1995
to replace the old comp.lang.pascal. The following new Delphi
newsgroups were created around July 10, 1995.
A special note about Delphi postings. Please use the new delphi
newsgroups for the Delphi related postings. In particular, don't let
the names mislead you. The newsgroup comp.lang.pascal.borland does
NOT cover Delphi.
A second special note. Please avoid crossposting between the Pascal
newsgroups. In particular do not crosspost between the old
comp.lang.pascal and the new Pascal newsgroups. It is slows the
transition to the new system. (This automatic posting breaches the
non-crossposting tenet only because it is relevant information about
the arrangements of all the Pascal newsgroups.)
NEW:
comp.lang.pascal.ansi-iso Pascal according to ANSI and ISO standards.
comp.lang.pascal.borland Borland's Pascal incl. Turbo Pascal (not Delphi!)
comp.lang.pascal.mac Macintosh based Pascals.
comp.lang.pascal.misc Pascal in general and ungrouped Pascals.
comp.lang.pascal.delphi.databases Database aspects of Borland Delphi.
comp.lang.pascal.delphi.components Writing components in Borland Delphi.
comp.lang.pascal.delphi.misc General issues with Borland Delphi.
RELATED of potential interest:
comp.os.msdos.programmer.turbovision Borland's text application libraries
OLD:
comp.lang.pascal Discussion about Pascal. (Please cease using!)
For more information about the new Pascal newsgroups please see
52703 Jun 14 21:37 ftp://garbo.uwasa.fi/pc/doc-net/pasgroup.zip
pasgroup.zip Information about the comp.lang.pascal.* newsgroups
18086 Jul 11 08:18 ftp://garbo.uwasa.fi/pc/doc-net/delphi.zip
delphi.zip Vote results of the comp.lang.pascal.delphi.* newsgroups
If your site is not getting the new Pascal newsgroups, please
contact your own site's newsmaster about the situation.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:17 1996
Subject: Capslock status and toggling
77. *****
Q: How do I detect the CapsLock status, how do I turn it on/off?
A: Here are the relevant Turbo Pascal routines in answer to these
questions.
{}
Uses Dos; { The Dos unit is needed }
{}
(* Is CapsLock on *)
function CAPSONFN : boolean;
var regs : registers;
KeyStatus : byte;
begin
FillChar (regs, SizeOf(regs), 0);
regs.ax := $0200; { Get shift flags }
Intr ($16, regs); { The keyboard interrupt }
KeyStatus := regs.al; { AL = shift status bits }
if (KeyStatus and $40) > 0 then { bit 6 }
capsonfn := true
else
capsonfn := false;
end; (* capsonfn *)
{}
(* Set CapsLock. Use true to turn on, false to turn off *)
procedure CAPS (TurnOn : boolean);
var keyboardStatus : byte absolute $0040:$0017;
regs : registers;
begin
if TurnOn then
keyboardStatus := keyboardStatus or $40
else
keyboardStatus := keyboardStatus and $BF;
{ Interrrupt "check for keystroke" to ensure the LED status }
FillChar (regs, SizeOf(regs), 0);
regs.ah := $01;
Intr ($16, regs);
end; (* caps *)
{}
As you see, CapsLock is indicated by bit 6. The other toggles can be
handled in an equivalent way using this information about the memory
location Mem[$0040:$0017]:
ScrollLock = bit 4 $10 $EF
NumLock = bit 5 $20 $DF
CapsLock = bit 6 $40 $BF
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:18 1996
Subject: Detecting F11 and F12
78. *****
Q: How do I detect if the F11 or F12 key has been pressed?
A: Here is a sample program
uses Dos;
(* Enhanced keyboard ReadKey, no Crt unit needed. Detects also F11
and F12, and distinguishes between the numeric keypad and the
gray keys. Lower part of the word returns the first scan code,
the higher part the second *)
function RDENKEFN : word;
var regs : registers;
keyboard : byte absolute $40:$96;
begin
rdenkefn := 0;
if ((keyboard shr 4) and 1) = 0 then exit;
FillChar (regs, SizeOf(regs), 0);
regs.ah := $10;
Intr ($16, regs);
rdenkefn := regs.ax;
end; (* rdenkefn *)
{}
procedure TEST;
var key : word;
begin
while Lo(key) <> 27 do { esc exits }
begin
key := RDENKEFN;
if (Lo(key) = 0) and (Hi(key) = 133) then
writeln ('F11 was pressed');
if (Lo(key) = 0) and (Hi(key) = 134) then
writeln ('F12 was pressed');
end;
end;
{}
begin TEST; end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:19 1996
Subject: Substrings from a string
79. *****
Q: How do I extract (parse) substrings from an input string?
A: Carefully study these two routines which I have included in
19593 Jun 1 12:12 ftp://garbo.uwasa.fi/pc/research/simirr10.zip
simirr10.zip Deriving IRR from ARR: A Simulation Testbench, TS+IV
They use space (and anything in ascii below it) as the separator.
Change the while tests if you wish to have a different set of
separators.
(* Number of substrings in a string *)
function PARSENFN (sj : string) : integer;
var i, n, p : integer;
begin
p := Length(sj);
n := 0;
i := 1;
repeat
while (sj[i] <= #32) and (i <= p) do Inc(i);
if i > p then begin parsenfn := n; exit; end;
while (sj[i] > #32) and (i <= p) do Inc(i);
Inc(n);
if i > p then begin parsenfn := n; exit; end;
until false;
end; (* parsenfn *)
{}
(* Get substrings from a string *)
function PARSERFN (sj : string; PartNumber : integer) : string;
var i, j, n, p : integer;
stash : string;
begin
if (PartNumber < 1) or (PartNumber > PARSENFN(sj)) then
begin PARSERFN := ''; exit; end;
p := Length(sj);
n := 0;
i := 1;
repeat
while (sj[i] <= #32) and (i <= p) do Inc(i);
Inc(n);
if n = PartNumber then
begin
j := 0;
while (sj[i] > #32) and (i <= p) do
begin
Inc(j);
stash[0] := chr(j);
stash[j] := sj[i];
Inc(i);
end;
PARSERFN := stash;
exit;
end
else
while (sj[i] > #32) and (i <= p) do Inc(i);
until false;
end; (* parserfn *)
{}
{... A separate, but useful function from the same package ...}
(* Delete trailing white spaces etc rubble from a string *)
function TRAILFN (sj : string) : string;
var i : byte;
begin
i := Length (sj);
while (i > 0) and (sj[i] <= #32) do i := i - 1;
sj[0] := chr(i); trailfn := sj;
end; (* trailfn *)
{}
{... Another separate, but useful function from the same package ...}
(* Delete leading white spaces etc subble from a string *)
function LEADFN (sj : string) : string;
var i, p : byte;
begin
p := Length (sj); i := 1;
while (i <= p) and (sj[i] <= #32) do i := i + 1;
leadfn := Copy (sj, i, p-i+1);
end; (* leadfn *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:20 1996
Subject: Size of a file
80. *****
Q: How do I find out the size of any kind of a file?
A1: Well, to begin with the FileSize keyword and an example code
are given in the manual (and help function of later TP versions) so
those, as usual, are the first places to look at. But the example
solution can be somewhat improved, and there is also an alternative
solution. The FSIZEFN should never be applied on an open file.
function FSIZEFN (filename : string) : longint;
var fle : file of byte; { declare as a file of byte }
fmSave : byte;
begin
fmSave := FileMode; { save the current filemode }
FileMode := 0; { to handle also read-only files }
assign (fle, filename);
{$I-} reset (fle); {$I+} { to do your own error detection }
if IOResult <> 0 then begin
fsizefn := -1; FileMode := fmSave; exit;
end;
fsizefn := FileSize(fle);
close (fle);
FileMode := fmSave; { restore the original filemode }
end; (* fsizefn *)
A2: The second, general alternative is
uses Dos;
function FSIZE2FN (FileName : string) : longint;
var FileInfo : SearchRec; { SearchRec is declared in the Dos unit }
begin
fsize2fn := -1; { return -1 if anything goes wrong }
FindFirst (filename, AnyFile, FileInfo);
if DosError <> 0 then exit;
if (FileInfo.Attr and VolumeId = 0) and
(FileInfo.Attr and Directory = 0) then
fsize2fn := FileInfo.Size;
end; (* fsize2fn *)
A3: The third alternative is due to a Usenet posting by Wayne
Hoxsie (hoxsiew@crl.com). This alternative is an instructive example
of using file handles.
uses dos;
var f : file;
{}
function filelength (var f : file) : longint;
var
handle : ^word;
regs : registers;
begin
handle := @f;
fillchar (regs, SizeOf(regs), 0); { just in case }
regs.ax := $4202;
regs.bx := handle^;
regs.cx := 0;
regs.dx := 0;
msdos(regs);
filelength := (longint(regs.dx) SHL 16)+regs.ax;
end;
{}
begin
assign(f,paramstr(1));
filemode := 0; { read-only files too }
reset(f);
writeln(filelength(f));
close(f);
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:21 1996
Subject: Formatting graphics output
81. *****
Q: How do I format graphics output like in textmode writeln?
A: In the graphics mode the positioned text output procedure is
OutTextXY (X ,Y : integer; TextString : string); It does not have
the same output formatting capabilities as the write procedure. It
only accepts the one TextString. Therefore all the output formatting
must be done previously on the string. The Str procedure has such
capabilities. The example below gives the rudiments.
uses Crt, Graph;
var grDriver : integer;
grMode : integer;
ErrCode : integer;
s, s1 : string;
v1 : real;
begin
grDriver := Detect;
InitGraph (grDriver, grMode, ' ');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
ClearDevice;
{}
{ Writing text in the graphics mode }
{ Set the drawing color }
SetColor (Yellow);
{ Set the current background color }
SetBkColor (Black);
{ Set style for text output in graphics mode }
SetTextStyle (DefaultFont, HorizDir, 2);
{ Preprocess the text }
v1 := 2.345;
Str (v1 : 10:2, s1);
s := 'The first value is' + s1 + '.';
{ Output the text }
OutTextXY (100, 30, s);
OutTextXY (100, 50, 'Press any key');
{}
repeat until KeyPressed;
{}
RestoreCrtMode;
writeln ('That''s all folks');
CloseGraph;
end.
Besides not having the same output formatting capabilities OutTextXY
and OutText procedures do not scroll the screen. If you wish to
achieve such an effect, you will have to code it yourself step by
step. You can see the effect in
111673 Oct 8 1993 ftp://garbo.uwasa.fi/pc/ts/tsdemo16.zip
tsdemo16.zip Assorted graphics demonstrations of functions etc
Coding the scrolling is a straight-forward but a laborious task.
Hence it is beyond this FAQ. The outline, however, is that you must
keep track where on the screen you are. When you come to the bottom
of your window you have to move the above region upwards before you
output new text. You can move graphics regions using the ImageSize,
GetImage and PutImage procedures.
As for readln-type input in a graphics mode, that is a complicated
issue. You will have to build the input routine reading a character
at a time with ReadKey. The rudiments of using ReadKey are shown in
the first question of FAQPAS.TXT. The demo, referred to a few lines
back, will show the effect.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:22 1996
Subject: Reading more than one key
82. *****
Q: How do I detect if more than one standard key is pressed down?
A: The example code below relies very heavily on a Usenet posting
by Lou Duchez ljduchez@en.com who wishes to acknowledge Bill Seiler
for the handling of ports. The KeyNrDown and TEST routines are by
myself. Besides being a demonstration the TEST procedure can be used
to get the scan codes of the different keys instead of relying on
external documentation.
Uses Dos;
{}
var keydown: array[0..127] of boolean; { status array }
oldkbdint: procedure; { points to the "normal" keyboard handler }
port60h, port61h: byte; { used within the interrupt for storage }
{}
{ The replacement keyboard handler }
procedure newkbdint; interrupt;
begin
port60h := port[$60];
keydown[port60h and $7f] := (port60h <= $7f);
port61h := port[$61];
port[$61] := port61h or $80;
port[$61] := port61h;
port[$20] := $20;
end;
{}
{ Get the scancode of the key pressed down, 128 for none }
function KeyNrDown : byte;
var i : byte;
begin
KeyNrDown := 128;
for i := 0 to 127 do if KeyDown[i] then KeyNrDown := i;
end;
{}
{ Test by displaying the scan codes of the keys pressed }
procedure TEST;
var k, k1 : byte;
begin
k1 := 128;
repeat
k := KeyNrDown;
if k <> k1 then begin
write (k, ' ');
if (k1 = 30) and (k = 31) then writeln ('Pressed A and S ');
k1 := k;
end;
until k = $01; {escape}
end; {test}
{}
begin
{ turn on the replacement keyboard handler }
fillchar(keydown, 128, #0); { sets array to all "false" }
getintvec($09, @oldkbdint); { record location of old keyboard int }
setintvec($09, @newkbdint); { this line installs the new interrupt }
{}
TEST;
{}
{ turn off the replacement keyboard handler }
setintvec($09, @oldkbdint);
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:23 1996
Subject: Volume Serial Number
83. *****
Q: How can I read a disk's Volume Serial Number?
A: The Volume Serial Number for disks was introduced in MS-DOS
version 4.0. Here is an example code
uses Dos;
{}
(* Convert a longint to a hexadecimal string *)
function LHEXFN (decimal : longint) : string;
const hexDigit : array [0..15] of char = '0123456789ABCDEF';
var i : byte;
hexString : string;
begin
FillChar (hexString, SizeOf(hexString), ' ');
hexString[0] := chr(8);
for i := 0 to 7 do
hexString[8-i] := HexDigit[(decimal shr (4*i)) and $0F];
lhexfn := hexString;
end; (* lhexfn *)
{}
(* Get disk serial number. Requires MS-DOS 4.0+.
Else, or on an error, returns an empty string.
The default drive can be pointed to by using '0' *)
function GETSERFN (drive : char) : string;
type diskInfoRecordType =
record
infoLevel : word; { zero }
serialNumber : longint; { DWORD actually }
volumeLabel : array [1..11] of char; { NO NAME if none present }
filesystemType : array [1..8] of char; { FAT12 or FAT16 }
end;
var regs : registers;
diskInfo : diskInfoRecordType;
serial : string;
begin
getserfn := '';
if swap(DosVersion) < $0400 then exit;
FillChar (regs, SizeOf(regs), 0);
drive := UpCase (drive);
if drive <> '0' then if (drive < 'A') or (drive > 'Z') then exit;
regs.ah := $69; { Interrrupt 21 function $69 }
regs.al := $00; { subfunction: get serial number }
if drive <> '0' then
regs.bl := ord(drive) - ord('A') + 1
else regs.bl := 0;
regs.ds := Seg(diskInfo); { the diskInfo address: }
regs.dx := Ofs(diskInfo); { its segment and offset }
Intr ($21, regs);
if (regs.flags and FCarry) <> 0 then exit; { CF is set on error }
serial := LHEXFN (diskInfo.serialNumber);
getserfn := Copy (serial, 1, 4) + '-' + Copy (serial, 5, 4);
end; (* getserfn *)
{}
begin
writeln ('C: ', GETSERFN('C'));
end.
A2: The second alternative has been modified from a posting by
Robert B. Clark rclark@su1.in.net. I have also utilized INTERRUP.E
from Ralf Brown's listing of interrupt calls
ftp://garbo.uwasa.fi/pc/programming/inter48b.zip
{}
uses Dos;
function GETSERFN2 (drive : char): longint;
var ParBlock : array [0..24] of char; { IOCTL parameter block Table 0785 }
regs : registers;
sernum : longint;
begin
FillChar (ParBlock, SizeOf(ParBlock), 0);
FillChar (regs, SizeOf(regs), 0);
regs.ax := $440D; { IOCTL - generic block device request }
if drive <> '0' then { '0' points to the default drive }
regs.bl := ord(UpCase(drive)) - ord('A') + 1 { drive as byte }
else regs.bl := 0;
regs.ch := $08; { block device IOCTL category code: disk drive }
regs.cl := $66; { IOCTL minor code: get volume serial number }
regs.ds := Seg(ParBlock); { Parameter block segment address }
regs.dx := Ofs(ParBlock); { Parameter block offset }
MsDos (regs); { Call interrupt $21 }
if regs.Flags and FCarry = 0 then
sernum := word(ord(ParBlock[4]) + ord(ParBlock[5]) shl 8) * 65536 +
word (ord(ParBlock[2]) + ord(ParBlock[3]) shl 8)
else sernum := 0;
getserfn2 := sernum;
end; (* getsetfn2 *)
{}
begin
writeln ('C: ', LHEXFN(GETSERFN2('0')));
end.
A3: Setting a disk's serial number, instead of just reading it, is
more complicated and will not be covered here. If you need it, the
routine without source code is available (for floppies only for
security reasons) as
"SETSER Set floppy's serial number (MsDos 4.0+)"
in TSUNTK.TPU in ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:24 1996
Subject: Disabling the keyboard
84. *****
Q: How can I disable and then enable the keyboard in my TP program?
A: Here is the code. A warning! Don't experiment with ports. You
can do real harm to your data and your computer if you do not know
exactly what you are doing.
uses Dos, Crt; { Crt only needed because of 'Delay' in the testing }
var i : byte; { only needed in the testing }
NormalKeyboard : procedure;
{}
procedure DisableKeyboard; interrupt;
var port60, port61 : byte;
begin
port60 := Port[$60]; { KeyBoard controller data output buffer }
port61 := Port[$61]; { Keyboard controller port B }
Port[$61] := Port61 or $80; { clear keyboard }
Port[$61] := Port61;
Port[$20] := $20; { Programmable Intr. Contr. initialization }
end;
{}
begin
writeln ('Testing...');
GetIntVec ($09, @NormalKeyboard);
SetIntVec ($09, @DisableKeyboard);
write ('The keyboard is now disabled..');
for i := 1 to 5 do begin
Delay (1000);
write (i:2);
end; {for}
writeln;
SetIntVec ($09, @NormalKeyboard);
write ('The keyboard is now enabled...');
for i := 1 to 5 do begin
Delay (1000);
write (i:2);
end; {for}
end.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:25 1996
Subject: CD-ROM device name
85. *****
Q: How do I get the character device name of the (first) CD-ROM?
A: First the code for a quick and dirty method to find the
character device name
function MSCDEXFN : string;
var s : string;
f : text;
i : byte;
fmSave : byte;
begin
mscdexfn := ''; { To indicate not found }
fmSave := FileMode; { Store the original file mode }
FileMode := 0; { Also if read-only }
Assign (f, 'c:\autoexec.bat'); { Browse the AUTOEXEC.BAT }
{$I-} Reset (f); {$I+}
if IOResult <> 0 then exit; { AUTOEXEC.BAT not found }
while not eof(f) do begin { Line by line }
readln (f, s);
for i := 1 to Length(s) do s[i] := Upcase(s[i]);
if Pos('MSCDEX', s) > 0 then begin { Is this the line }
if Pos ('REM', s) = 1 then continue; { Skip rem lines }
Close (f);
FileMode := fmSave; { Restore the original mode }
i := Pos('/D:', s); { Look for the switch }
if i = 0 then exit; { Nah! }
i := i + 3; { Where the name should start }
if i > Length(s) then exit; { Nothing there! }
s := Copy (s, i, 255); { Rest of the line after /D: }
mscdexfn := s;
i := Pos (' ', s);
if i = 0 then exit;
mscdexfn := Copy (s, 1, i-1);
exit; { Don't close twice }
end; {if}
end; {while}
Close (f);
FileMode := fmSave; { Restore the original mode }
end; (* mscdexfn *)
A2: There is more general and orthodox solution to finding the
character device name for the (first)m CD-ROM. This was kindly
provided to me by Chris Rankin (rankin@shfax1.shef.ac.uk).
uses Dos;
function GetCDROMDevice : string;
const driver_name_len = 8;
type
sig = array[1..6] of char;
siglet = array[1..4] of char;
signum = array[1..2] of char;
drvname = array[1..driver_name_len] of char;
driverstr = string[driver_name_len];
type
PCDROMDriver = ^TCDROMDriver;
TCDROMDriver = record
NextDriver: PCDROMDriver;
DeviceAttr: word;
StrategyEntryPoint: word;
INTEntryPoint: word;
DeviceName: drvname;
Reserved: word;
DriveLetter: byte;
Units: byte;
case byte of
0: (SigLetters: siglet;
SigNumbers: signum);
1: (Signature: sig)
end;
TDriveEntry = record
SubUnit: byte;
Driver: PCDROMDriver
end;
var
DeviceList: array[1..26] of TDriveEntry;
Regs: registers;
Name: driverstr;
begin
with Regs do
begin
ax := $1500;
bx := 0;
intr($2f,Regs); (* Ask for number of CD-ROM drives. *)
if bx = 0 then (* If none, then exit. *)
begin
Name[0] := #0;
GetCDROMDevice := Name;
exit
end;
ax := $1501; (* Put information about each CD-ROM *)
es := seg(DeviceList); (* into DeviceList[]. *)
bx := ofs(DeviceList);
intr($2f,Regs)
end; (* Below: Name of first CD-ROM driver *)
Name := DeviceList[1].Driver^.DeviceName;
while Name[length(Name)] = ' ' do (* Strip off trailing blanks.. *)
dec(Name[0]);
GetCDROMDevice := Name
end;
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:26 1996
Subject: Ejecting CD-ROM
86. *****
Q: How do I eject a CD-ROM using a Turbo Pascal program?
A: The code for the ejection is given below. Note that it needs the
MSCDEXFN function from the previous FAQ item.
uses Dos;
{}
procedure EJECT (charDev : string;
var ok : boolean;
var errCode : word);
var regs : registers;
cdrom : file;
cdCtrlBlock : byte; { CD-ROM Control Block }
handle : ^word; { Handle referencing CD-ROM driver }
begin
Assign (cdrom, charDev); { Character device for CD-ROM driver }
{$I-} Reset (cdrom); {$I+} { Tackle errors yourself }
if IOresult <> 0 then begin { Exit if file not found }
ok := false;
errCode := $FFFF; { Your own arbitrary error code }
exit;
end;
FillChar (regs, SizeOf(regs), 0); { Just to make sure }
regs.ax := $4403; { Function $44, subfunction $03 }
handle := @cdrom; { Establish the file handle }
regs.bx := handle^;
FillChar(CdCtrlBlock, SizeOf(CdCtrlBlock), 0);
CdCtrlBlock := $00; { $00 eject disk; $05 close tray }
regs.ds := Seg(CdCtrlBlock); { ds:dx CD-ROM control block }
regs.dx := Ofs(CdCtrlBlock);
MsDos (regs); { Call interrupt $21 }
{$I-} Close (cdrom); {$I+}
ok := regs.flags and FCarry = 0; { Success or not? }
errCode := regs.ax; { $01 = invalid function }
end; { $05 = access denied }
{} { $06 = invalid handle }
procedure TEST; { $0D = invalid data }
var ok : boolean;
code : word;
begin
EJECT ('K', ok, code);
if ok then writeln ('Success') else writeln ('Error ', code);
end;
{}
begin
TEST;
end.
My thanks are due to Miro Wikgren (wikgren@cc.helsinki.fi) who
pointed out that the "handle referencing character device for CD-ROM
driver" must be the name given when the CD-ROM driver is loaded in
CONFIG.SYS and AUTOEXEC.BAT. I could not solve this problem without
that help in comp.lang.pascal.borland. In fact the previous FAQ item
was tackled only after the current FAQ item had been solved first.
A slightly different approach to the file handle by Miro
var cdrom : text; { CD-ROM is a character device }
handle : word; { Handle: word, not a pointer }
:
handle := TextRec(cdrom).handle; { Use TP help for more on this }
regs.bx := handle;
:
Another solution can be found in
3427 Mar 15 18:35 ftp://garbo.uwasa.fi/pc/turbopas/cdtips01.zip
cdtips01.zip Eject/Close/Lock/Unlock CD-ROM in TP for Win95, C.Rankin
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:27 1996
Subject: Detecting ANSI.SYS
87. *****
Q: How do I find out if the ANSI.SYS driver has been loaded?
A: The source code of the relevant function is given below.
However, this is not necessarily a good solution. First, it requires
at least MS-DOS version 4.0. Second, there are other, compatible
screen drivers like ZANSI.SYS. You probably are more interested if
such a screen driver has been installed rather than if it is
ANSI.SYS in particular. To find out if any compatible screen driver
is operative use ISANSIFN from TSUNTG.TPU from
112570 Aug 16 1994 ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
tspa3470.zip Turbo Pascal 7.0 real mode units for (real:-) programmers
uses Dos;
function ANSIOKFN : boolean;
var regs : registers;
begin
if swap(DosVersion) < $0400 then begin
writeln ('Error: MS-DOS 4+ required');
ansiokfn := false;
halt;
end;
FillChar (regs, SizeOf(regs), 0);
regs.ax := $1A00;
Intr ($2F, regs);
ansiokfn := regs.al = $FF;
end; (* ansiokfn *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:28 1996
Subject: TP tutorial and books
88. *****
Q: Where do I find Turbo Pascal tutorials and/or good textbooks?
A: I'll list some useful sources. The first one (where also this
item comes from) among other things contains a slightly outdated
list of TP textbooks.
ftp://garbo.uwasa.fi/pc/ts/tsfaqp29.zip
tsfaqp29.zip Common Turbo Pascal Questions and Timo's answers
ftp://garbo.uwasa.fi/pc/turbopas/tptutrXX.zip
tptutrXX.zip Glenn Grotzinger's ascii-text Turbo Pascal Tutor
ftp://garbo.uwasa.fi/pc/turbopas/tpr-book.zip
tpr-book.zip Electronic Turbo Pascal Reference freeware book
ftp://garbo.uwasa.fi/pc/doc-net/faqclpb.zip
faqclpb.zip comp.lang.pascal.borland newsgroup Mini-FAQ
Furthermore, you should see the fine SWAG (SourceWare Archival
Group's) collection of TP sources. Available from the /pc/turbopas
directory at Garbo. For the current references to the SWAG files see
ftp://garbo.uwasa.fi/pc/INDEX.ZIP.
Yet another useful source can be the Turbo Pascal WWW pages. You
can find some of them by connecting to my WWW home page. Its address
is http://uwasa.fi/~ts. Select my collection of HTTP links and
proceed to the programming section on the link list.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:29 1996
Subject: Making an executable
89. *****
Q: How do I make an executable of my Turbo Pascal source program?
A: This is a typical beginner's frequent question which belies not
having read the manual carefully. You DO have the manual, right? If
you are using Turbo Pascal 7.0 this is explained on page 48 of the
User's Guide in the paragraph "Choosing a destination". Here, in
brief, is what you should do
Press F10 to go to the main menu (or press alt-C)
Choose Compile
Choose Destination Disk (toggle with enter)
To direct where the executable should go
Press F10 to go to the main menu (or press alt-O)
Choose Options
Choose Directories...
Edit the item EXE & TPU directory (the destination directory)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:30 1996
Subject: Last byte of a file
90. *****
Q: How can I quickly read the last byte of a file?
A: Below is the code for a relevant procedure. It has a number of
instructive details for you to look into. It is easy to expand this
procedure into showing any byte counted from the end by substituting
the 1 in Seek (f, fs-1) to the inverted position, and by taking care
that the position is not outside the file.
procedure LASTBYTE (fname : string; var lb : byte);
var f : file; { Use an untyped file designation }
fmSave : byte; { To push and pop the FileMode }
fs : longint; { For file size }
begin
fmSave := FileMode; { Push the original FileMode }
FileMode := 0; { To enable reading also read-only files }
Assign (f, fname);
{$I-} Reset (f, 1); {$I+} { Open file and set record size to 1 }
if IOResult <> 0 then begin
writeln ('Error opening file ', fname);
halt;
end;
fs := FileSize(f); { Get the size of the file }
if fs = 0 then begin
writeln ('Empty file ', fname);
halt;
end;
Seek (f, fs-1); { Position to the last byte of the file }
BlockRead (f, lb, 1); { Read the value of the position into lb }
Close (f); { Close the file }
FileMode := fmSave; { Pop the original FileMode }
end; (* lastbyte *)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:31 1996
Subject: Leap year
91. *****
Q: Is 2000 a leap year? What is the leap year algorithm?
A: With the approaching turn of the century this question is
becoming more and more common. Here is the algorithm in Turbo
Pascal.
function ISLEAP (y : integer) : boolean;
begin
isleap := (y mod 4 = 0) and not ((y mod 100 = 0) and not (y mod 400 = 0));
end; (* isleap *)
My thanks are due to Dr. John Stockton and Associate Professor Seppo
Pynnonen for confirming the result. In fact it was who John
suggested adding this question to the FAQ.
There are several equivalent formulations achieving the same
result. Also nested multi-line if statments could be used. The
boolean statements are much more concise, even if not very easy to
construct.
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:32 1996
Subject: Week number
92. *****
Q: Does anybody have a program that gives the week number?
A: This answer comes without source code just with a pointer to a
TPU including a week number algorithm. There is a function
"WEEKNRFN Returns the week number for a given date"
in the TSUNTE.TPU unit in my
112570 Aug 16 1994 ftp://garbo.uwasa.fi/pc/ts/tspa3470.zip
tspa3470.zip Turbo Pascal 7.0 real mode units for (real:-) programmers.
(The unit collection is also available for earlier TP versions.)
--------------------------------------------------------------------
From ts@uwasa.fi Sat Mar 30 00:01:33 1996
Subject: OutText, integers and reals
93. *****
Q: How can I use OutText to write numbers in the graphics mode?
A: OutText is the procedure to use for output in the graphics mode.
The syntax of the procedure is OutText(TextString: string). You'll
first have to convert a number into a string before you can output
it with OutText. The example below shows how it can be done when the
users wishes to output the integer value value of 12 and the result
of 4/7 as a real with a suitable formatting. Generalization from
thereon should be easy.
uses Crt, Graph;
var grDriver : integer;
grMode : integer;
ErrCode : integer;
const CharSize : integer = 2;
{}
function INT2STR (x : integer; ff : byte) : string;
var s : string;
begin
Str (x : ff, s);
int2str := s;
end;
{}
function REAL2STR (x : real; ff, dd : byte) : string;
var s : string;
begin
Str (x : ff : dd, s);
real2str := s;
end;
{}
begin
grDriver := Detect;
InitGraph (grDriver, grMode, ' ');
ErrCode := GraphResult;
if ErrCode <> grOk then begin
Writeln ('Graphics error:', GraphErrorMsg(ErrCode)); halt; end;
SetColor (LightCyan);
SetBkColor (Black);
SetTextStyle(DefaultFont, HorizDir, CharSize);
{}
{... this is the example's key line ...}
OutText ('The values are: ' + INT2STR(12,2) + REAL2STR(4/7,10,3));
{}
MoveTo (0, 10*CharSize);
OutText ('Press any key');
repeat until KeyPressed;
RestoreCrtMode;
CloseGraph;
end.
Naturally, the 12 in INT2STR(12,2) could as well be a variable
containing the value. Ditto for REAL2STR(4/7,10,3).
--------------------------------------------------------------------
Reference in New Issue View Git Blame Copy Permalink