driveru.pas

omroln OPC 用delphi描述了同OMROLnOPC通讯的过程

    FPortInfo: TCommPortInfo; //通信设备属性
    FOPCComm: TOPCComm; //通讯操作对象
    FDriveStatus: Integer; //通信设备状态
    FRefreshDataPnt: DWord; //查询数据
    FCommStateChkPnt: DWord; //通讯状态检查
    FCommAddress: string; //通讯端口的

    //用于后台调度的事件
    FInputHandler: TInputHandler; //接收端口数据到达事件通知对象
    FSendHandler: TInputHandler; //接收下发数据事件通知对象
    FSendEvent: THandle; //发送数据事件通知对象
    FLoopTimer: TTimerHandler; //轮询检测的定时器
    FWaitTimer: TTimerHandler; //等待应答的定时器
    FWaitCount: Integer; //等待应答次数
    FScheduler: TScheduler; //调度事件对象

    //发送数据缓冲区
    FWindow: TSlidingWindow; //发送数据滑动窗口
    FAddressParse: TAddressParse; //设备变量的寻址对象

    function GetPortId: DWord;
    function SendPktToComm(WriteData: Variant; Address: string): Boolean;
    procedure SetDriveStatus(Value: Integer);
    procedure CheckReSendTime;
    procedure NotifyToSendPkt;
    function SendApplicationFrm(Frm: TFrame): Boolean;
    function GeneralWriteData(const LocalIndex: Integer; Value: Variant;
      var Info: TAppDataInfo): Boolean;
  protected
    function SendNextDataPacket: Boolean;
    procedure ReceiveCommData;
    procedure QueryCommData;

    //有关事件调度的函数
    procedure StartInputHandler;
    procedure StartSendHandler;
    procedure StartLoopTimer;
    procedure StartWaitTimer;

    procedure StopInputHandler;
    procedure StopSendHandler;
    procedure StopLoopTimer;
    procedure StopWaitTimer;
  public
    constructor Create(PortInfo: TCommPortInfo);
    destructor Destroy; override;
    procedure EventCallback(EventId: Integer); override;
    procedure StartDriver; //启动驱动
    procedure StopDriver; //停止驱动
    function SendData(const LocalIndex: Integer; Value: Variant): Boolean;
  published
    property PortId: DWord read GetPortId;
    property Status: Integer read FDriveStatus;
    property CommAddress: string read FCommAddress;
  end;

  //通信设备列表类
  TDriverList = class(TObjectList)
  private
    FEvent: THandle;
    procedure FreeResource;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(const Driver: TDriver);
    procedure Delete(const Driver: TDriver);
    function GetDriver(const ID: DWord): TDriver;
    procedure StartDrivers;
    procedure StopDrivers;
    procedure SetTrgEvent;
    class function GetDriverList: TDriverList;
  published
    property Event: THandle read FEvent;
  end;

  function GetJobNo: Byte;

var
  gDriverList: TDriverList;
  gDeviceVarList: TDeviceVarList;
  gJobNo: Byte; //SCMS发送的任务号

implementation
{$IFDEF DEBUG}
uses
  OPC;
{$ENDIF}

//**************************************************************************
//                  类名：TAddressParse
//                  功能：设备变量地址解析
//**************************************************************************

{*
 *                函数名称：ItemIsNull
 *                函数功能：判断OPCITEM的名称是否为空
 *                入口参数：1、ItemName: string。 OPCITEM名称
 *                出口参数：无
 *                  返回值：True -- 该变量为空
 *}

function TAddressParse.ItemIsNull(ItemName: string): Boolean;
begin
  Result := False;
  if (Length(ItemName) = 0) or
    (AnsiPos(CONST_NULL_ITEMNAME, UpperCase(ItemName)) <> 0) then
    Result := True;
end;

{*
 *                函数名称：SplitValue
 *                函数功能：根据地址信息拆分出指定设备变量的数据
 *                入口参数：1、DeviceVar: TDeviceVar。设备变量
 *                          2、DataPkt: TDataPacket。数据
 *                出口参数：1、Value: Variant。拆分出的数据
 *                  返回值：True -- 该变量有数据
 *}

function TAddressParse.SplitValue(const DeviceVar: TDeviceVar; DataPkt: Variant;
  var Value: Variant): Boolean;
begin
  try
    case DeviceVar.AddressInfo.dwDataSort of
      Const_DataSort_Sta
      : Value := Integer(DataPkt);
      Const_DataSort_Num
      : Value := Integer(DataPkt);
      Const_DataSort_Chr
      : Value := String(DataPkt);
      Const_DataSort_Bln
      : Value := Integer(StrToBool(String(DataPkt)));
      else
        Value := DataPkt;
    end;
    Result := True;
  except
    WriteDebugLog('在SplitValue函数中,根据变量的类型进行类型转换时发生错误');
    Result := False;
  end;
end;

{*
 *                函数名称：FindItems
 *                函数功能：根据地址信息查找设备变量的索引信息
 *                入口参数：1、Addr: TAddressInfo。设备变量地址信息
 *                出口参数：无
 *                  返回值：TIntegerArray。设备变量索引数组
 *}

function TAddressParse.FindItems(Addr: TAddressInfo): TIntegerArray;
var
  I, J, K: Integer;
begin
  SetLength(Result, 0);
  for I := 0 to High(FReadListInfos) do
  begin
    for J := 0 to High(FReadListInfos[I].rcdReadInfo) do
    begin
      if AnsiCompareText(Addr.dwReadItem, FReadListInfos[I].rcdReadInfo[J].szItemName) = 0 then
      begin
        SetLength(Result, Length(FReadListInfos[I].rcdReadInfo[J].arrVarList));
        for K := 0 to High(FReadListInfos[I].rcdReadInfo[J].arrVarList) do
          Result[K] := FReadListInfos[I].rcdReadInfo[J].arrVarList[K];
        Exit;
      end;
    end;
  end;
end;

{*
 *                函数名称：FindCommErrorItems
 *                函数功能：获得与指定通信端口关联的设备通信故障变量索引
 *                入口参数：无
 *                出口参数：无
 *                  返回值：TIntegerArray。设备变量索引数组
 *}

function TAddressParse.FindCommErrorItems: TIntegerArray;
var
  I, Count: Integer;
begin
  Count := Length(FCommErrorInfos);
  SetLength(Result, Count);
  for I := 0 to Count - 1 do
    Result[I] := FCommErrorInfos[I].dwLocalIndex;
end;

{*
 *                函数名称：FindRTUCommErrorItems
 *                函数功能：查找指定RTU连接设备通信故障变量索引
 *                入口参数：无
 *                出口参数：无
 *                  返回值：TIntegerArray。设备变量索引数组
 *}

function TAddressParse.FindRTUCommErrorItems(RTUNo: DWord): TIntegerArray;
var
  I, Count: Integer;
begin
  Count := Length(FCommErrorInfos);
  SetLength(Result, 0);
  for I := 0 to Count - 1 do
  begin
    if (FCommErrorInfos[I].rcdAddress.dwRTUNo = RTUNo) then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[High(Result)] := FCommErrorInfos[I].dwLocalIndex;
    end;
  end;
end;

{*
 *                函数名称：Create
 *                函数功能：构造函数
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

constructor TAddressParse.Create; 
begin
  InitializeCriticalSection(FLock);
  FRTUFaultList := TList.Create;
  SetLength(FSCMSFaultList, 0);
  SetLength(FCommErrorInfos, 0);
  SetLength(FNormalInfos, 0);
end;

{*
 *                函数名称：Destroy
 *                函数功能：析构函数
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

destructor TAddressParse.Destroy;
begin
  FNormalInfos := nil;
  FCommErrorInfos := nil;
  FSCMSFaultList := nil;
  FRTUFaultList.Free;
  DeleteCriticalSection(FLock);
  inherited;
end;

{*
 *                函数名称：AddInfo
 *                函数功能：增加设备变量的寻址信息
 *                入口参数：1、Info: TAddressParseInfo。设备变量运行信息
 *                出口参数：无
 *                  返回值：无
 *}

function TAddressParse.AddInfo(Info: TAddressParseInfo): Integer;
var
  I: Integer;
  FindIt: Boolean;
  WriteInfo: TWriteInfo;
begin
  EnterCriticalSection(FLock);
  try
    Result := -1;
    if Info.rcdAddress.dwDataType = Const_Type_CommErr then //通信故障的功能组
    begin
      SetLength(FCommErrorInfos, Length(FCommErrorInfos) + 1);
      FCommErrorInfos[High(FCommErrorInfos)] := Info;
      Result := -High(FNormalInfos);
    end;
    if not ItemIsNull(Info.rcdAddress.dwReadItem) then
    begin
      //将设备变量的读地址信息添加到数组中
      SetLength(FNormalInfos, Length(FNormalInfos) + 1);
      FNormalInfos[High(FNormalInfos)] := Info;
      Result := High(FNormalInfos);
    end;
    if ItemIsNull(Info.rcdAddress.dwReadItem) then
    begin
      Result := -High(Integer);
    end;

    //将有效的OPCITEM名称加入列表中
    FindIt := False;
    if not ItemIsNull(Info.rcdAddress.dwReadItem) then
    begin
      for I := 0 to High(FItemNameList) do
      begin
        if AnsiCompareText(FItemNameList[I], Info.rcdAddress.dwReadItem) = 0 then
        begin
          FindIt := True;
          Break;
        end;
      end;

      if not FindIt then
      begin
        SetLength(FItemNameList, Length(FItemNameList) + 1);
        FItemNameList[High(FItemNameList)] := Info.rcdAddress.dwReadItem;
      end;
    end;

    //将有效的OPCITEM名称加入列表中
    FindIt := False;
    if not ItemIsNull(Info.rcdAddress.dwWriteItem) then
    begin
      for I := 0 to High(FItemNameList) do
      begin
        if AnsiCompareText(FItemNameList[I], Info.rcdAddress.dwWriteItem) = 0 then
        begin
          FindIt := True;
          Break;
        end;
      end;

      if not FindIt then
      begin
        SetLength(FItemNameList, Length(FItemNameList) + 1);
        FItemNameList[High(FItemNameList)] := Info.rcdAddress.dwWriteItem;
      end;
    end;

    //判断变量是否需要定时下发
    if (Info.rcdAddress.dwFuncGroup = Const_FG_SYSTEM) and
      (Info.rcdAddress.dwDataType = Const_Type_RTUCommCheck) then
    begin
      if ItemIsNull(Info.rcdAddress.dwWriteItem) then
        Exit;

      FindIt := False;
      for I := 0 to High(FAutoWriteInfos) do
      begin
        if AnsiCompareText(FAutoWriteInfos[I].szItemName, Info.rcdAddress.dwWriteItem) = 0 then
        begin
          FindIt := True;
          Break;
        end;
      end;

      if FindIt then
        Exit;

      WriteInfo.szItemName := Info.rcdAddress.dwWriteItem;
      WriteInfo.dwWriteSample := Info.rcdAddress.dwSampleTime * 1000;
      WriteInfo.dwPriorWrite := 0;
      WriteInfo.dwWriteValue := 0;
      SetLength(FAutoWriteInfos, Length(FAutoWriteInfos) + 1);
      FAutoWriteInfos[High(FAutoWriteInfos)] := WriteInfo;
    end;
  finally
    LeaveCriticalSection(FLock);
  end;
end;

{*
 *                函数名称：GetItemNameList
 *                函数功能：获得数据项名称的列表
 *                入口参数：无
 *                出口参数：无
 *                  返回值：数据项名称列表
 *}

function TAddressParse.GetItemNameList: TStringArray;
var
  I: Integer;
begin
  SetLength(Result, Length(FItemNameList));
  for I := 0 to High(FItemNameList) do
    Result[I] := FItemNameList[I];
end;

{*
 *                函数名称：FinishedAdd
 *                函数功能：完成添加设备变量的寻址信息
 *                          1、根据设备变量寻址信息中的读地址进行排序
 *                          2、根据设备变量的寻址信息生成采样周期判定数组
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TAddressParse.FinishedAdd;
var
  FindIt: Boolean;
  ReadInfo: TReadInfo;
  I, J, K, Idx, Count: Integer;
begin
  EnterCriticalSection(FLock);
  try
    SetLength(FReadListInfos, 0);
    Count := Length(FNormalInfos);
    if Count = 0 then
      Exit;

    for I := 0 to Count - 1 do
    begin
      //判断处理的变量是否需要主动查询
      if ItemIsNull(FNormalInfos[I].rcdAddress.dwReadItem) then