如何用Delphi 写Windows下的硬件端口
作者: Alan Young, ajtech@apc.net
编辑: Anatoly Podgoretsky, kvk@estpak.ee
修订日期:August 23, 1997
翻译整理:王甲春, wjiachun@263.net
这份文件是我在用户网新闻组、网页上发现的代码片断、FAQ等的汇集物。我将承认我所记得的一切,否则,还是万分感谢!
我把这一切收集到一起是因为我需要它,我希望它对你们也有用!
1. 简介
从 comp.lang.pascal.delphi.misc 得到的一份概要文件
Re: 端口指令和 win95 ,一份概要。
Martin Larsson(martin.larsson@delfi-data.msmail.telemax.no ) 提交于 10/08/1996 01:57:45
Eric Liptrot 写道:
过去的几个月里,关于这个主题已经有很大的一致性,所以这绝对是一个普遍的问题。有人能用逻辑方式总结一下这种情况么?
对这个问题我不是高手,但是我作出一点尝试。
1.1. 辩护
假定这是一份快速概要,它最终会很长。希望它不会令你太厌烦……
1.2. 问题
在MS-DOS模式下,一个应用程序对整个机器有控制权,这给了程序员很大的自由。为了加快执行速度,有必要的话你可以直接访问硬件。
在Windows 3.x下,这个自由在某种程度上受到了限制,尤其是不能直接写屏幕。问题很明显:用户可能运行着其他的应用程序,不能保证它们没有同时访问同一个硬件。
出现的其他问题就是你不得不对其他同时运行的应用程序友好一点。Windows 3.x 是合作式的多任务系统,这意味着每个程序决定自己何时执行而其他程序也能运行。长时间扰乱CPU被认为是不好的。
但是事实是除非我们程序员这么说程序是不会运行的,在访问硬件时这对我们是有利的。因为程序获取CPU,混乱I/O端口或内存,只要它愿意它就能保证完全控制机器,在结束前它不会放弃控制。
不幸的是,进度赶上了我们,现在出现了Win32(Windows NT和 Windows 95/98/2000)。它们是真正的操作系统,利用抢先式的多任务。每个线程(执行单元)得到处理器的一定时间。当时间结束或有更高优先权的线程执行时,系统将切换到下一个线程,尽管前一个线程还没有执行完毕。这种切换可以发生在任何两个汇编命令下,不能保证一个线程在它被清空前能够完成结束任何数量的命令,到下一个时间段可能要很长时间。
这产生一个直接访问硬件的实际问题。例如,一个典型的 I/O 读取由几个汇编命令组成:
mov dx, AddressPort
mov al, Address
out dx, al
jmp Wait
Wait:
mov dx, DataPort
in al, dx
只要所有的登记状态都在线程切换时被保护好,I/O 端口状态就不是保护好的了。因此,很可能有程序善于在上面的"out"和"in"命令间对付"你"的 I/O 端口。
1.3. 有文件证明的方法
这个问题的解决方法就是以某种方式告诉其他程序:现在我的程序使用着546端口,其他人最好靠边站。现在需要的是人工干预。不幸的是,为了使用人工干预,所有程序必须为这个人工干预使用一致的名字。但是,即使这是可能的,你还会轻易遇到一些棘手的问题。假定有两个程序App1 和 App2 App1 首先申请AddressPortMutex ,App2 首先申请DataPortMutex 。一个可悲的巧合,App1 取得AddressPortMutex ,系统切换到App2,它需要DataPortMutex ,僵持出现了。App2不能取得端口地址 ,因为App1拥有它;而App1又不能取得数据端口,因为App2拥有它。我们还在等着……
这个问题的正确解决方法就是建立一个拥有端口/内存地址的设备驱动程序,支持通过一个API访问硬件。一个典型的函数应该是:
GetIOPortData(AddressPort, DataPort : word) : Byte;
GetIOPortData 需要一个人工干预来保护这两个(有可能是全部)端口,然后访问这些端口,最后在返回调用前释放人工干预。如果有不同的线程同时调用这个函数,一个将先得到,另一个必须等着。
写一个设备驱动并不容易,它们必须由汇编或C来完成,而且很难调试。为了安全起见,一个Windows 9x 的设备驱动程序(VxD)和Windows NT的设备驱动程序(VDD,虚拟设备驱动)并不兼容。据说它们要被聚合,也许Windows NT 6.0 Windows 2000会兼容这些设备驱动,但是直到现在,我们不得不写两个独立的代码片断。
为了获取更多的信息请参考(举例):
* Microsoft's Windows 95 设备驱动程序工具
* Microsoft's Windows NT设备驱动程序工具
* 《Systems Programming for Windows 95》,作者 Walter Oney
* http://www.vireo.com/ 网站上Vireo的《 VtoolsD library for writing VxD's in C》
1.4. 无文件证明的方法
上面的问题还不是很实际。一个程序直接访问硬件通常使用一些专用硬件。一个机器配置倾向与只运行一个程序,唯一目的是问了访问这个硬件。在这种设想下,写设备驱动程序显得太麻烦了。毕竟,程序运行在Windows下,只是为了获得好的GUI界面,不是为了10个程序能同时运行。
幸运的是,Windows 95和Windows 3.x是兼容的。这意味着直接读取I/O 必须被许可,因为许多Win 3.x程序需要使用它。为了访问I/O端口,简单使用汇编就可以。下面的代码由Arthur Hoornweg (hoornweg@hannover.sgh-net.de) 提供:
function getport(p:word):byte; stdcall;
begin
asm
push edx
push eax
mov dx,p
in al,dx
mov @result,al
pop eax
pop edx
end;
end;
Procedure Setport(p:word;b:byte);Stdcall;
begin
asm
push edx
push eax
mov dx,p
mov al,b
out dx,al
pop eax
pop edx
end;
end;
Francois Piette 也提供利一些I/O直接访问的函数于http://rtfm.netline.be/fpiette/portiofr.htm (参见第三节) ,Anatoly Podgoretskt 也提供了一些 (参看第四节)。
1.5. 但是NT呢?
上面的代码在Windows NT下不能工作。NT是一个强大得多的操作系统,任何人在任何需要的时候访问硬件的许可都将认真约束稳定性。
此外,NT 是一个交叉的平台,在不同的处理器上访问 I/O 端口可能有很大的不同。
尽管如此,在NT 系统下 x86系列的处理器上访问I/O 端口还是有可能的。这是完全没有文件证明的,可能在将来版本的操作系统里消失。
对于处理器我掌握的信息不多,但是D. Roberts在1996年5月的论文提及的Dr. Dobb的日志看上去有希望��"Direct Port I/O and Windows NT"。看上去只有 DDJ 我忽略了,因此我不能证明这一点。请参看 http://www.ddj.com 来订阅背景问题。
Windows 开发者日志确实有一篇文章关于Windows下的 I/O 端口。作者为 Karen Hazzah,出现在1996年6月的问题里。
1.6. 资源
(注意:我对这些资源知之甚少,请自己检查它们。)
这里是关于写VxD和VDD 专题的有用的新闻组:
* comp.os.ms-windows.programmer.nt.kernel-mode (VDD)
* comp.os.ms-windows.programmer.vxd (VxD)
Dejanews (http://www.dejanews.com)出现了相当多的关于"device driver direct I/O access 95"的专题。
BlueWater Systems已经开发出了所有Win32 平台下直接访问 I/O 、内存和中断处理的OCX控件。他们好像也提供定制的设备驱动构造,可以参看他们的主页: http://www.bluewatersystems.com/.
我知道一些其他公司已经因为写典型VxD的能力在这里发布广告,但是我没有找到参考文献。
mailto:martin.larsson@delfi-data.msmail.telemax.no
http://www.delfidata.no/users/~martin
2.游戏操纵杆
一些代码由我在Delphi 1.0中完成,显示了如何访问硬件端口。利用游戏操纵杆作为一个例子来演示如何使用嵌入式汇编进行底层硬件访问。
PROGRAM Gameapp;
USES WINCRT,winprocs;
{======================================================}
CONST
ONN =1;
OFF=0 ;
{ must be * 256 because it is high byte }
STICK1 = 1*256; { bit 1 set for analog 1 }
STICK2 = 2*256; { bit 2 set for analog 2 }
STICK3 = 4*256; { bit 3 set for analog 3 }
STICK4 = 8*256; { bit 4 set for analog 4 }
BUTTON1 = 16; { bit 5 set for button 1 }
BUTTON2 = 32; { bit 6 set for button 2 }
BUTTON3 = 64; { bit 7 set for button 3 }
BUTTON4 = 128; { bit 8 set for button 4 }
{======================================================}
VAR
gvalue1,gvalue2 : INTEGER;
buttn1,buttn2 : BYTE;
P : PChar;
M : LongInt;
{======================================================}
function stick(joy:INTEGER):INTEGER;
{required input:
1 = analog stick 1
2 = analog stick 2
4 = analog stick 3
8 = analog stick 4
sample calls:
value=stick(1*256); reads stick 1,
value=stick(2*256); reads stick 2
value=stick(4*256); reads stick 3
value=stick(8*256); reads stick 4
(remember your binary arithmetic)
output:
unsigned int (16 bit output) as opposed to 8 bit output
for BIOS routines.
returns value = 0 if no joystick is connected
}
VAR
Value : INTEGER;
BEGIN
Value:=0;
ASM
@@START:
PUSH AX
PUSH CX
PUSH DX
{ we are really setting hi byte here }
CLI { clear interrupts }
MOV AX,joy { get stick to read }
MOV AL,0 { zero out low byte }
MOV DX,201H {; /* game port address */}
MOV AL,11111111b {; /* set bit map */}
OUT DX,AL {; /* force to unstable */}
MOV CX,0 {; /* set counter */}
@@TOP:
IN AL,DX {; /* read port */}
TEST AL,AH {; /* test selected port */}
JZ @@GOODEXIT {; /* branch when stable */}
LOOP @@TOP {; /* CX=CX-1, loop again */}
JMP @@TIMEOUT {; /* timeout when cx=65536 */}
@@GOODEXIT:
NEG CX {; /* two's complement CX */}
{ /* forces positive values */}
MOV value,CX {; /* put value into CX */}
STI { turn interrupts back on }
POP DX
POP CX
POP AX
JMP @@BYE { and get outta here }
@@TIMEOUT:
STI { turn interrupts back on }
POP DX
POP CX
POP AX
MOV value,0; {; /* function is zero if timeout */}
@@BYE:
END; {basm}
stick:=value;
END;
{==============================================================}
function push_button(button:BYTE):BYTE;
var
value:BYTE;
BEGIN
asm
PUSH AX
PUSH DX
CLI { clear interrupts }
MOV DX, 201H {; /* game port address */}
IN AL, DX {; /* read state of buttons */}
NOT AL {; /* invert so that 1 = on */}
TEST AL, button {; /* compare */}
JNZ @@PRESSED {; /* if pressed return ON */}
STI { turn interrupts back on}
POP DX {; /* BUTTON IS OFF */}
POP AX {; /* if got to here */}
mov value, 0; { 0=OFF}
jmp @@QUIT
@@PRESSED:
STI { interrupts back on!}
POP DX { BUTTON IS ON if got to here */}
POP AX
mov value, 1 { on}
@@QUIT:
END;
push_button:=value;
END;
{======================================================}
BEGIN {main}
gotoxy(18,2);
write('Game Port Test Program by Alan Young (c) 7/15/93');
gotoxy(25,25);
write('Press any key to exit program.');
gotoxy(28,6);
write('Game Port Button Status');
gotoxy(28,7);
write(' 1 2');
gotoxy(28,15);
write('Game Port Analog Values ');
gotoxy(28,16);
write(' 1 2');
while NOT Keypressed DO BEGIN
buttn1:=push_button(BUTTON1);
buttn2:=push_button(BUTTON2);
gotoxy(33,8);
write(buttn1,' ',buttn2);
gvalue1:=stick(STICK1);
gvalue2:=stick(STICK2);
gotoxy(30,17);
write(gvalue1:4);
gotoxy(41,17);
write(gvalue2:4);
END;
END.
3. Francois Piette
从万维网Francois Piette主页得到的一些代码,还有一些直接的 I/O 访问函数见:
http://rtfm.netline.be/fpiette/portiofr.htm
3.1. Delphi 2 直接访问 I/O 端口
function PortIn(IOAddr : WORD) : BYTE;
begin
asm
mov dx,IOAddr
in al,dx
mov result,al
end;
end;
procedure PortOut(IOAddr : WORD; Data : BYTE);
begin
asm
mov dx,IOAddr
mov al,Data
out dx,al
end;
end;
警告: 在Windows NT下,系统会拦截很多端口操作。除非系统允许,I/O 命令不会到达硬件。很多时候要有驱动程序来模拟 I/O 。基于安全考虑这是有必要的。如果你确实需要在NT下直接访问 I/O ,你需要考虑写一个驱动程序。
在 Windows 95下这段代码没有问题。
4. Anatoly Podgoretsky
4.1. Delphi 2 直接访问 I/O 端口
这里有6个Anatoly Podgoretsky写的函数,主要不同点为:这些过程使用所有Delphi 2和Delphi 3的Pascal (BASM)的能力。非常短小而有效的代码:
unit Port95;
{
**************************************************************************
* Description: Port95 - very simple unit, that lets you access port *
* under Window 95,not under Windows NT. *
* Status: Freeware *
* You can freely use or distribute this unit *
* Target: Delphi 2/3 only under Windows 95 *
* Version: 1.0 (April 27, 1997) *
* Status: Freeware *
* Author: Anatoly Podgoretsky *
* Address: kvk@estpak.ee *
* Tips: font Courier, tabs = 2 *
* Problems: Word Read/Write utulities may problems on some computers *
* or interface cards, that can't access whole word. *
* To prevent it You can use slow equivalent of these *
* procedures with suffix LS (Low Speed) *
* Copyright: Copyright (C) 1997, NPS *
**************************************************************************}
interface
function PortReadByte(Addr:Word) : Byte;
function PortReadWord(Addr:Word) : Word;
function PortReadWordLS(Addr:Word) : Word;
procedure PortWriteByte(Addr:Word; Value:Byte);
procedure PortWriteWord(Addr:Word; Value:Word);
procedure PortWriteWordLS(Addr:Word; Value:Word);
implementation
{**************************************************************
* Port Read byte function *
* Parameter: port address *
* Return: byte value from given port *
**************************************************************}
function PortReadByte(Addr:Word) : Byte; assembler; register;
asm
MOV DX,AX
IN AL,DX
end;
{**************************************************************
* HIGH SPEED Port Read Word function *
* Parameter: port address *
* Return: word value from given port *
* Comment: may problem with some cards and computers *
* that can't to access whole word, usually it work. *
**************************************************************}
function PortReadWord(Addr:Word) : Word; assembler; register;
asm
MOV DX,AX
IN AX,DX
end;
{**************************************************************
* LOW SPEED Port Read Word function *
* Parameter: port address *
* Return: word value from given port *
* Comment: work in all cases, only to adjust DELAY if need *
***************************************************************}
function PortReadWordLS(Addr:Word) : Word; assembler; register;
const
Delay = 150; // depending of CPU speed and cards speed
asm
MOV DX,AX
IN AL,DX // read LSB port
MOV ECX,Delay
@1:
LOOP @1 // delay between two reads
XCHG AH,AL
INC DX // port+1
IN AL,DX // read MSB port
XCHG AH,AL // restore bytes order
end;
{**************************************************************
* Port Write byte function *
* Parameter: port address *
**************************************************************}
procedure PortWriteByte(Addr:Word; Value:Byte); assembler; register;
asm
XCHG AX,DX
OUT DX,AL
end;
{**************************************************************
* HIGH SPEED Port Write word procedure *
* Comment: may problem with some cards and computers *
* that can't to access whole word, usually it work. *
**************************************************************}
procedure PortWriteWord(Addr:word; Value:word); assembler; register;
asm
XCHG AX,DX
OUT DX,AX
end;
{**************************************************************
* LOW SPEED Port Write Word procedure *
* Parameter: port address *
* Return: word value from given port *
* Comment: work in all cases, only to adjust DELAY if need *
**************************************************************}
procedure PortWriteWordLS(Addr:word; Value:word); assembler; register;
const
Delay = 150; // depending of CPU speed and cards speed
asm
XCHG AX,DX
OUT DX,AL // port LSB
MOV ECX,Delay
@1:
LOOP @1 // delay between two writes
XCHG AH,AL
INC DX // port+1
OUT DX,AL // port MSB
end;
end.
警告: 在Windows NT下,系统会拦截很多端口操作。除非系统允许,I/O 命令不会到达硬件。很多时候要有驱动程序来模拟 I/O 。基于安全考虑这是有必要的。如果你确实需要在NT下直接访问 I/O ,你需要考虑写一个驱动程序。
在 Windows 95下这段代码没有问题。
5. VXD
这里有一个 WIN95 下的 I/O 访问的 VXD 驱动。作者为: victor@ivi.ugatu.ac.ru
访问Victor I.Ishikeev ,它被叫做 HWPORT95.zip ,下载地址为:
ftp://sunsite.icm.edu.pl/pub/delphi/ftp/32free/hwport95.zip
我不能让它为我工作,但是我目前只有 16位的Delphi 1.0。它看上去是为 32 位的 NT端口访问使用的……一个解决方案 :-)
Andrew Clark (andyc@rmpd-ngh.demon.co.uk) 发表于 12/23/1996 16:14:17 :
你们好:
在读完许多提案求教NT下Delphi1 / TurboPascal 的等价的端口命令后,最近又被同事问起解决方案,我静下心来想想,认为我已经找到解决办法了……
由最近的Delphi FAQ R0.02(向R.E.den Braasem喝采)得到一点提示,我追查了1996年5月Dr Dobb的日志中提及的一个名为DIRECTIO.ZIP的文件(www.ddj.com,检查FTP站点ftp.ddj.com ),有一个Dale Roberts开发的名为GIVEIO.SYS的驱动程序允许访问所有的端口范围。做这些的办法就是掌握Paula Tomlinson开发的一个名为LOADDRV的小程序,这在1995年5月的Windows开发人员日志的问题里可以发现……
ftp.mfi.com/pub/windev/1995/may95.zip
这个程序将安装GIVEIO.SYS到驱动列表里,从"控制面板"里你可以启动这个程序(设置它的开始属性为"自动"可以在每次开机后启动)。
驱动程序装载并开始后,你可以从你的程序调用CreateFile 函数提供驱动程序名来授权给它(前缀一个"\\.\\ " :{ ),然后你的程序就能访问 I/O 端口而没有任何异常了 :)
为了使它对更多用户友好一些,我做了一个控件封装了端口访问,这有助于创建的驱动程序,允许端口被作为数组访问(在Delphi1中)等。
port[$378]:=10; { write }
tick := port[$40]; { read }
另外,如果你把这个控件放到窗体上而没有安装GIVEIO 驱动程序并开始运行,你将获得一个异常。
这里就是我的控件(几乎没有注释)……
unit Port;
interface
uses
Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms, Dialogs;
type
EPortError = class(Exception);
TPort = class(TComponent)
private
procedure Outport(Address,Data:Word);
function InPort(Address:Word):Word;
public
constructor Create(AOwner:TComponent);override;
property Port[index:Word]:Word
read InPort
write OutPort;
default;
end;
procedure Register;
implementation
procedure TPort.OutPort(Address,Data:Word);
asm
mov dx,Address
mov ax,Data
out dx,ax
end;
function TPort.InPort(Address:Word):Word;
asm
mov dx,Address
in ax,dx
end;
constructor TPort.Create(AOwner:TComponent);
var
h : Integer;
begin
Inherited Create(AOwner);
{ load the driver }
h:=CreateFile('\\.\\giveio',GENERIC_READ,0,nil,OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,0);
{ warn if driver not there }
if H=INVALID_HANDLE_VALUE then
raise EPortError.Create('GiveIO Driver Not Installed');
{ we don't actually need the handle, as loading the driver
enables the free port access for the period of the
program }
CloseHandle(h);
end;
procedure Register;
begin
RegisterComponents('AndyC', [TPort]);
end;
end.
注意: 这个控件应该在Windows 95 下工作而不需要驱动,只要移开Create 过程就可以。
我没有声称完全理解了这个驱动程序,实际上我还在使用 Windows 3.11,对NT的内核更是一点都不了解,但是已经为一个用NT的同事把这些标志在一起,看起来工作正常。对我来说这足够好了 :)
如果你发现上面的代码有明显的错误请告诉我,我宁愿被一耳光也不愿我的同事因为它的程序死翘翘而被周围的人咂嘴!!!
andyc@rmpd-ngh.demon.co.uk
6. 红外线接口
一个演示如何写并行端口和控制红外线遥控设备的例子。
{ A pair of diodes are necesary:
- An infra-red emmiter LED.
- A infrared receiver diode.
infrared LED must be conected to bit 5 of the parallel port (pin 7) receiver diode must be conected
o pin 12 of the parallel port of course, two diodes must be conected to ground (pin 20). With this
imple circuit you can control any infraredm device (TVs,etc)
Unit: IRU
Version: 1.0=B7
Description: This unit allows you to control infrared devices, such as TVs, videos, etc., simply
utting a pair of diodes in the parallel port.
Date: December, 1995.
Programmed by: MACRO (macro@policc.unex.es)
You can use and modify this code on your programs, but remember to give me credit :-) }
unit iru;
interface
const
IRcodeLength = 300;
{Memory in bytes for each code, can be increased to obtain more resolution}
rate = 20;
{Is a delay that defines the sample frequency, 20 value works well in a DX2, must be decreased
or slower systems}
type
Ircode = 3Darray[1..IRcodeLength] of byte;
procedure receiveIRcode(var x:IRcode);
{This procedure waits until a IR code is received, then hold it in 'x' IRcode type variable. Be sure
f put the emitter LED very close to the receiver DIODE.}
procedure sendIRcode(var x:IRcode);
{This procedure dumps the IR code specified in 'x' thru the IR LED}
implementation
procedure receiveIRcode(var x:IRcode);
var
i,j : word;
begin
for i := 1 to IRcodeLength do x[i] := 0;
repeat until (port[$379] AND 32) = 0;
asm
cli;
end;
for i := 1 to IRcodeLEngth DO begin
asm
mov cx,rate;
@1:
in al,$61
and al,0
out dx,al
loop @1
end;
x[i] := port[$379];
end;
asm
sti;
end;
j := 0;
for i := 1 to IRcodeLength do x[i] := (x[i] and 32) xor 32;
end;
procedure sendIRcode(var x:IRcode);
var
i : word;
v : byte;
begin
port[$61] := port[$61] or 1;
port[$43] := 182;
port[$42] := 30;
port[$42] := 0;
for i := 1 to IRCodeLength DO begin
v := x[i];
asm
mov dx,$378
mov cx,rate
@1:
in al,$61
and al,v
out dx,al
loop @1
end;
end;
port[$61] := port[$61] and 252;
end;
begin
end.