driveru.pas

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

  FCommStateChkPnt := 0;//GetTickCount;
  FRefreshDataPnt := GetTickCount;
  FCommAddress := StrPas(PortInfo.szAddressParam);

  TDriverList.GeTDriverList.Add(Self);
  InitializeCriticalSection(FSyncObj);
  FScheduler := TScheduler.Create;

  //初始化端口信息
  FOPCComm := TOPCComm.Create;
  if DecodeCommParam(PortInfo.szCommPortParam, Param) then
  begin
    FOPCComm.MachineName := Param.rcdOPC.szMachineName;
    FOPCComm.ServerName := Param.rcdOPC.szServerName;
    FOPCComm.GroupName := Param.rcdOPC.szGroupName;
  end;

  FWindow := TSlidingWindow.Create;
  FAddressParse := TAddressParse.Create;
  FInputHandler := nil;
  FSendHandler := nil;
  FLoopTimer := nil;
  FWaitTimer := nil;
end;

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

destructor TDriver.Destroy;
begin
  FScheduler.Free;
  FOPCComm.Free;
  FWindow.Free;
  FAddressParse.Free;
  DeleteCriticalSection(FSyncObj);
  inherited;
end;

{*
 *                函数名称：EventCallBack
 *                函数功能：接收调度对象的回调函数
 *                入口参数：1、EventId: Integer。命令码
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriver.EventCallback(EventId: Integer);
begin
  case EventId of
    Const_Event_RecvDataInd //接收数据
    : ReceiveCommData;
    
    Const_Event_SendDataReq //发送数据请求
    : SendNextDataPacket;

    Const_Event_LoopCheck //轮询数据
    : QueryCommData;

    Const_Event_WaitAnswer //等待应答
    : CheckReSendTime;
  end;
end;

{*
 *                函数名称：StartDriver
 *                函数功能：开始运行
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriver.StartDriver;
var
  Items: TStringArray;
begin
  try
    SetLength(Items, 0);
    FAddressParse.FinishedAdd;
    Items := FAddressParse.GetItemNameList;
    FOPCComm.SetItems(Items);
    //if not FOPCComm.StartComm then
    //begin
    //  WriteErrorLog(Format('打开通信端口(%s)失败！', [FOPCComm.MachineName]));
    //  SetDriveStatus(COMM_STATUS_DisConnect);
    //  Exit;
    //end;
    StartInputHandler;
    StartSendHandler;
    StartLoopTimer;
    StartWaitTimer;
    FScheduler.Run;
  except
    SetDriveStatus(COMM_STATUS_DisConnect);
    WriteDebugLog(Format('打开通信端口(%s)失败.(%s)', [FOPCComm.MachineName,
      Exception(ExceptObject).message]));
  end;
end;

{*
 *                函数名称：Stop
 *                函数功能：停止运行
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriver.StopDriver;
begin
  try
    FScheduler.Stop;
    StopLoopTimer;
    StopWaitTimer;
    StopSendHandler;
    StopInputHandler;
    //FOPCComm.StopComm;
  except
    WriteDebugLog(Format('关闭通信端口(%s)失败. %s', [FOPCComm.MachineName,
      Exception(ExceptObject).message]));
  end;
end;

{*
 *                函数名称：SendData
 *                函数功能：下发数据，此接口由设备变量类调用
 *                入口参数：1、本地索引
 *                          2、下发数据内容
 *                出口参数：无
 *                  返回值：True -- 发送成功
 *                          False -- 发送失败
 *}

function TDriver.SendData(const LocalIndex: Integer; Value: Variant): Boolean;
var
  Frm: TFrame;
  Info: TAppDataInfo;
begin
  Result := False;
  //判断通讯是否正常
  if FDriveStatus <> COMM_STATUS_Connected then
  begin
    WriteDebugLog('下发数据时通讯中断');
    Exit;
  end;

  //找到地址信息并将发送任务放入发送队列中
  if not GeneralWriteData(LocalIndex, Value, Info) then
  begin
    WriteDebugLog('下发数据时，查找下发索引对应的设备变量失败');
    Exit;
  end;

  //生成下发数据
  Frm := TFrame.Create(Info.AppData, True);
  Frm.SetParams(Info.rcdAddress, Info.dwLocalIndex);
  SendApplicationFrm(Frm);
  Result := True;
end;

//**************************************************************************
//                  类名：TDriverList
//                  功能：维护所有通信设备对象
//**************************************************************************

{*
 *                函数名称：FreeResource
 *                函数功能：释放资源
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.FreeResource;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TDriver(Items[I]).DeRegister;
end;

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

constructor TDriverList.Create;
begin
  inherited Create(False);
  FEvent := CreateEvent(nil, False, False, '');
end;

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

destructor TDriverList.Destroy;
begin
  FreeResource;   
  CloseHandle(FEvent);
  inherited;
end;

{*
 *                函数名称：Add
 *                函数功能：添加成员对象
 *                入口参数：1、Driver: TDriver。成员对象实例
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.Add(const Driver: TDriver);
begin
  if not Assigned(Driver) then
    Exit;
  Driver.Register;
  inherited Add(Driver);
end;

{*
 *                函数名称：Delete
 *                函数功能：删除成员
 *                入口参数：1、Driver: TDriver。成员对象实例
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.Delete(const Driver: TDriver);
begin
  if not Assigned(Driver) then
    Exit;
  Driver.DeRegister;
  inherited Remove(Driver);
end;

{*
 *                函数名称：GetDriver
 *                函数功能：根据通信端口编号查询通信设备对象实例
 *                入口参数：1、ID: DWord。通信端口编号
 *                出口参数：无
 *                  返回值：TDriver。通信设备对象实例
 *}

function TDriverList.GetDriver(const ID: DWord): TDriver;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to Count - 1 do
  begin
    if TDriver(Items[I]).PortId = ID then
    begin
      Result := TDriver(Items[I]);
      Break;
    end;
  end;
end;

{*
 *                函数名称：StartDrivers
 *                函数功能：开始运行
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.StartDrivers;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TDriver(Items[I]).StartDriver;
end;

{*
 *                函数名称：StopDrivers
 *                函数功能：停止运行
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.StopDrivers;
var
  I: Integer;
begin
  for I := 0 to Count - 1 do
    TDriver(Items[I]).StopDriver;
end;

{*
 *                函数名称：SetEvent
 *                函数功能：置位通信端口状态改变
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TDriverList.SetTrgEvent;
begin
  SetEvent(FEvent);
end;

{*
 *                函数名称：GetDriverList
 *                函数功能：静态成员函数。用于返回唯一的列表对象实例
 *                入口参数：无
 *                出口参数：无
 *                  返回值：TDriverList。列表对象实例
 *}

class function TDriverList.GetDriverList: TDriverList;
begin
  Result := gDriverList;
end;


//**************************************************************************
//                  类名：TFrame
//                  功能：对数据报文进行打包、解析处理
//**************************************************************************

{*
 *                函数名称：Create
 *                函数功能：构造函数
 *                          1、保存数据报文
 *                          2、对数据报文进行解析
 *                入口参数：1、DataPkt: Variant。数据报文
 *                          2、Xmit: Boolean。方向。True -- 打包
 *                出口参数：无
 *                  返回值：无
 *}

constructor TFrame.Create(DataPkt: Variant; Xmit: Boolean);
begin
  FSending := False;
  FDeleted := False;
  FDataPkt := DataPkt;
end;

{*
 *                函数名称：Destroy
 *                函数功能：析构函数
 *                          1、释放数据报文
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

destructor TFrame.Destroy;
begin
  inherited Destroy;
end;

{*
 *                函数名称：SetParams
 *                函数功能：设置发送报文的控制参数信息
 *                入口参数：1、AddressInfo: TAddressInfo。数据地址信息
 *                          2、LocalIndex: Integer。设备变量索引
 *                出口参数：无
 *                  返回值：无
 *}

procedure TFrame.SetParams(const AddrInfo: TAddressInfo; LocalIndex: Integer = -1);
begin
  FLocalIndex := LocalIndex;
  FAddrInfo := AddrInfo;
  FItemName := AddrInfo.dwWriteItem;
  if FAddrInfo.dwFuncGroup = Const_FG_SCMS then
    FFrmType := Const_FrameType_SCMS
  else
    FFrmType := Const_FrameType_Normal;
end;

{*
 *                函数名称：FormFrame
 *                函数功能：对发送数据进行打包处理
 *                入口参数：无
 *                出口参数：无
 *                  返回值：无
 *}

procedure TFrame.FormFrame;
var
  JobNo, DataLen: