//自己解决，原马供他人参考
implementation
const
LedON = True;
LedOFF = False;
var
lpDevFeatures : DEVFEATURES;
gnNumOfSubdevices : Smallint;
Response : Integer;
DoValue : integer=0 ;
DiValue : Smallint=0;
Function DoBit(bit : Integer) : Integer;
var
temp, i : Integer;
begin
temp := 1;
If bit >= 1 Then
For i := 1 To bit do
temp := temp * 2;
DoBit := temp;
end;
function UpdateBitUsed(iPort,iBits:integer):boolean;
begin
BitUsedArray[iPort,iBits]:= not BitUsedArray[iPort,iBits];
end;
Function Init(szReplay:String):integer;//SzReplay:错误描述//返回值：0成功，1失败
var
MaxEntries, OutEntries : Smallint;
NumOfDevice : Smallint;
i, ii : Integer;
tempStr : String;
testRes : boolean;
dwDeviceNum : Longint;
tempNum : integer;
begin
Result:=1;
try
{ Add type of PC Laboratory Card }
ErrCde := DRV_DeviceGetList(DeviceList[0], MaxEntries, OutEntries);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pchar(pszErrMsg+' ：读取设备列表失败 '), 'Error!!', MB_OK);
Exit;
end;
{ Here NumOfDevice = OutEntries }
ErrCde := DRV_DeviceGetNumOfList(MaxEntries);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pchar(pszErrMsg+ 'Error!! ：取设备输入引脚数失败'),'Error!!', MB_OK);
Exit;
end;
//-------------------------
gnNumOfSubdevices := DeviceList[0].nNumOfSubdevices; //取得子设备
if (gnNumOfSubdevices > MaxDev) then
gnNumOfSubdevices := MaxDev;
dwDeviceNum := DeviceList[0].dwDeviceNum; //取得设备的编号
if (gnNumOfSubdevices = 0) then
begin
dwDeviceNum := DeviceList[0].dwDeviceNum;
ErrCde := DRV_DeviceOpen(dwDeviceNum, DeviceHandle); //取得设备的句柄
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
ptDevGetFeatures.buffer := @lpDevFeatures; //取得设备的各属性
ErrCde := DRV_DeviceGetFeatures(DeviceHandle, ptDevGetFeatures);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
tempNum := Trunc(lpDevFeatures.usMaxDOChl / 8); { Max. number of digital out channel }
end;
//-----------------------
ReadFromIni;
if not IsInitArray then InitBitUsedArray;
Result:=0;
except
Raise;
end;
end;
function ReadPortByte:boolean;
begin
lpDioReadPort.port := lpDioPortMode.port;
lpDioReadPort.value := @DiValue;
ErrCde := DRV_DioReadPortByte(DeviceHandle, lpDioReadPort);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
//Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
end;
function UpdateTopLampValue(Port,Bit,Value : Integer;IsUsed:Boolean):Boolean;
begin
//iTmp:=1;
//iTmp:=iTmp and TpLmpOpenValue ;
//iTmp:=iTmp shl ((TpLmpOpenPort*8)+TpLmpOpenBits);
//iTmp:= TpLmpOpenValue+ DoBit(TpLmpOpenBits) ;
if not IsUsed then
begin
if Value>0 then
begin
DoValue := DoValue +DoBit(Bit);
UpdateBitUsed( Port,Bit);
end;
end
else
begin
if Value=0 then
begin
DoValue := DoValue - DoBit(Bit);
UpdateBitUsed( Port,Bit);
end;
end;
lpDioWritePort.port := Port;
lpDioWritePort.mask := 255;
lpDioWritePort.state := DoValue;
ErrCde := DRV_DioWritePortByte(DeviceHandle, lpDioWritePort);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
end;
function ReadDevSetPortMode(iPort:integer):Boolean;
begin
lpDioPortMode.port := iPort;
lpDioPortMode.dir := INPORT;
{ not every digital I/O card could use DRV_DioSetPortMode function }
if lpDevFeatures.usDIOPort > 0 then
begin
ErrCde := DRV_DioSetPortMode(DeviceHandle, lpDioPortMode);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
end;
Result:=true;
end;
function WriteDevSetPortMode(iPort:integer):Boolean;
begin
lpDioPortMode.port := iPort;
lpDioPortMode.dir := OUTPORT;
{ not every digital I/O card could use DRV_DioSetPortMode function }
if lpDevFeatures.usDIOPort > 0 then
begin
ErrCde := DRV_DioSetPortMode(DeviceHandle, lpDioPortMode);
If (ErrCde <> 0) Then
begin
DRV_GetErrorMessage(ErrCde, pszErrMsg);
Response := Application.MessageBox(pszErrMsg, 'Error!!', MB_OK);
Exit;
end;
end;
Result:=true;
end;
Function OpenPassLampGreen( szReplay:string):integer;stdcall;//通行灯置绿色
begin
if Init('')=0 then
begin
WriteDevSetPortMode( PsLmpOpenPort);
UpdateTopLampValue(PsLmpOpenPort,PsLmpOpenBits,PsLmpOpenValue,BitUsedArray[PsLmpOpenPort,PsLmpOpenBits] );
end
else
application.MessageBox(' OpenPassLampGreen 错误 ','错误',mb_OK+mb_IconError);
end;
