unit IOTALK;
interface
uses
SysUtils, Classes,Windows, Dialogs,WinSvc;
const
PORTTALK_TYPE = 40000; { 32768-65535是保留给用户使用的}
METHOD_BUFFERED = 0;
FILE_ANY_ACCESS = 0;
IOCTL_IOPM_RESTRICT_ALL_ACCESS = PORTTALK_TYPE shl 16 +
$900 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
IOCTL_IOPM_ALLOW_EXCUSIVE_ACCESS = PORTTALK_TYPE shl 16 +
$901 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
IOCTL_SET_IOPM = PORTTALK_TYPE shl 16 +
$902 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
IOCTL_ENABLE_IOPM_ON_PROCESSID = PORTTALK_TYPE shl 16 +
$903 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
IOCTL_READ_PORT_UCHAR = PORTTALK_TYPE shl 16 +
$904 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
IOCTL_WRITE_PORT_UCHAR = PORTTALK_TYPE shl 16 +
$905 shl 2 +
METHOD_BUFFERED +
FILE_ANY_ACCESS shl 14;
type
TIOTALK = class(TComponent)
Private
{ 私有属性定义}
FSendData:string;
FReadData :string;
{端口地址,即数据口地址}
FPortAddr:Word;
procedure WriteData;
procedure ReadData;
PROCEDURE CONNECT(sender:TObject);
protected
{ Protected declarations }
Connected:boolean;
public
{ Public declarations }
constructor Create(AOwner:TComponent);override;
destructor Destroy;override;
published
{ Published declarations }
Property Port:Word read FportAddr write FportAddr default $378;
Property SendData: string read FSendData write FSendData ;
end;
var
FPortAddr:Word;
FReadData:STRING;
procedure Register;
FUNCTION HexToInt(chr:char):integer;
function OpenPortTalk:boolean;
procedure ClosePortTalk;
procedure outportb(PortAddress:word;byte1:byte);
function inportb(PortAddress:word):byte;
function StartPortTalkDriver:boolean;
procedure InstallPortTalkDriver;
implementation
uses
UnitPortTalk;
procedure Register;
begin
{注册控件IOTALK，放在 COM+ 页}
RegisterComponents('COM+', [TIOTALK]);
end;
{-----------------------IOTALK-------------------}
constructor TIOTALK.create(AOwner:TComponent);
begin
{构造函数，进行初始化，创建所需资源}
inherited Create(AOwner);
FreadData:='';
Connected:=false;
end;
destructor TIOTALK.Destroy;
begin
{析构函数，释放IOTALK所有资源}
inherited Destroy;
end;
FUNCTION HexToInt(chr:char):integer;
var
Num:integer;
begin
{十六进制数转换成整型数函数，输入为字符，如果字符在0-9或a-f或A-F之间，
则该字符所表示的十六进制数转换成十进制，如果字符不在上述范围之内则返回-1}
case chr of
'0':Num:=0;
'1':Num:=1;
'2':Num:=2;
'3':Num:=3;
'4':Num:=4;
'5':Num:=5;
'6':Num:=6;
'7':Num:=7;
'9':Num:=9;
'a':Num:=10;
'b':Num:=11;
'c':Num:=12;
'd':Num:=13;
'e':Num:=14;
'f':Num:=15;
'A':Num:=10;
'B':Num:=11;
'C':Num:=12;
'D':Num:=13;
'E':Num:=14;
'F':Num:=15;
'8':Num:=8;
ELSE
Num:=-1;
END;
result:=Num;
end;
procedure TIOTALK.WriteData;
var
chr:byte;
s:string;
N,i,Num1,Num2,Num3: integer;
begin
{写并口数据函数}
s:=FSendData;
N:=Length(s);
i:=1;
WHILE I<=N do
begin
Num1:=HexToInt(s); {把十六进制字符串每位依次装转化成十进制数}
if i<N then begin
Num2:=HexToInt(s[i+1]); {根据字符个数是奇数还是偶数,来决定最后一个输入和处理}
Num3:=Num2+Num1*16; {偶数个字符处理方法}
end
else
begin
Num3:=Num1; {奇数个字符处理方法}
end;
I:=I+2;
chr:=InPortb(FPortAddr+2); {从控制口读控制字}
//str:=IntToHex(chr,2); {将控制字转化成十六进制字符串}
chr:=chr or $02; {将控制字第1位设置成1,通知并口准备写数据}
OutPortb($000037a,chr); {将控制字写入控制口}
Sleep(100);
chr:=lo(Num3); {将数据写入数据口}
OutPortb($000378,chr);
end;
end;
procedure ReadData;
var
chr:byte;
str:string;
begin
chr:=InPortb(FPortAddr); {从数据口8位数据}
str:=IntToHex(chr,2); {将数据转换成2字节十六进制字符串}
IOTALK.FReadData:=FReadData+' '+str;
end;
PROCEDURE CONNECT; {打开并口}
begin
if not OpenPortTalk then exit
else
[red]Connected:=true;{这里 出错 connected无法访问}[/red]
end;
end.
