opcmodule.pas

OPCserver OPCserver.rar

unit opcmodule;

interface
uses Windows,ActiveX,forms,Sysutils,opcdefine;
var
    m_Tags : TagList;

    function OnRegister () :BOOL;
    function OnUnRegister () :BOOL;
    function OnInitOpcServer():BOOL;
    procedure OnUnInitOpcServer();
    procedure OnAddItem();
    procedure OnDeleteItem();
    procedure  OnUpdateData();
    procedure  OnRandomData();
implementation
    function OnRegister () :BOOL;
    var
       sAppExeName:string ;
    begin
       sAppExeName:=Application.ExeName ;
       sOpcExeName:=sAppExeName;
       result :=TL_RegistryS(PChar(lpOPCClsID),PChar(lpOPCProgID),PChar(lpOPCDescr),PChar(sOpcExeName));
    end;
    function OnUnRegister () :BOOL;
    begin
    	result := TL_UnregisterS (PChar(lpOPCClsID), PChar(lpOPCProgID));
    end;
    function OnInitOpcServer():BOOL;
    begin
        //设定服务器的分隔符
        TL_SetQualifier ('.');
        result :=//TL_SetupRegCode('"TUOLIN20030713NOTAGCOUNTS');
                  TL_SetupRegCode('Z9J8-PUTLN-C6GZQ-RW2-7JW');
	result :=TL_InitOpcServerS(PChar(lpOPCClsID),500);
        TL_EnableWriteNotification (@WriteNotifyCallback);
        TL_EnableDisconnectNotification (@DisconnectProcCallback);
        TL_EnableDeviceRead (@DeviceReadProcCallback);
   end;
   procedure OnUnInitOpcServer();
   begin
	//结束OPC Server
  TL_RequestAllDisconnect;
	TL_UnInitOpcServer ();
   end;


  procedure OnAddItem();
  var
    i : integer;
  begin
   //建立点数组
    for i:=0 to MaxCounts do
    begin
        m_Tags[i].m_sTagName := 'TAG' + Format('%d',[i]);
        m_Tags[i].m_sDescr := 'm_sDescr tag' + Format('%d',[i]);
        m_Tags[i].m_hHWND  :=INVALID_HANDLE_VALUE ;

//        GetSystemTime(st);
//        SystemTimeToFileTime(st,ft);

        GetSystemTimeAsFileTime (m_Tags[i].m_ft);
        m_Tags[i].m_lQuality := OPC_QUALITY_BAD ;

        case (i mod 4) of
        0:
           begin
             m_Tags[i].m_vType := varBoolean;
             m_Tags[i].m_vValue := false;
           end;
        1:
           begin
            m_Tags[i].m_vType := varInteger;
            m_Tags[i].m_vValue := 0        ;
            end;
        2:
           begin
            m_Tags[i].m_vType := varSingle  ;
            m_Tags[i].m_vValue := 0        ;
           end;
        3:
           begin
            m_Tags[i].m_vType := varString  ;
            m_Tags[i].m_vValue := 'vbString';
           end;
        else
            beep;
        end;
    end;
//加入opc server
     for i:=0 to MaxCounts do
     begin
        m_Tags[i].m_hHWND := TL_CreateTag(PChar(m_Tags[i].m_sTagName),
            m_Tags[i].m_vValue, m_Tags[i].m_lQuality, True)  ;
        //pTagName->m_sDescr
        // 101 详见DA 2.04 中的 41页 4.4.6 节
        TL_SetTagProperties(m_Tags[i].m_hHWND, 101, 'tem Description', m_Tags[i].m_sDescr) ;
    end;

end;

    procedure OnDeleteItem()  ;
    var i : Integer;
    begin
   //删除所有点opc server
     for i:=0 to MaxCounts do
     begin
        TL_RemoveTag (m_Tags[i].m_hHWND)  ;
     end;
    end;

     procedure  OnUpdateData()   ;
     var i : Integer;
     begin
     //修改所有点opc server
      for i:=0 to MaxCounts do
       begin
         TL_UpdateTag(m_Tags[i].m_hHWND, m_Tags[i].m_vValue, m_Tags[i].m_lQuality);
       end;
    end;

  procedure  OnRandomData()  ;
//产生随机数据
var
   i : Integer   ;
   iRand : Single;
 begin
     Randomize;
     for i:=0 to MaxCounts do
     begin
        iRand :=  Random(1000);
{        If (iRand > 400) Then
          begin
            m_Tags[i].m_lQuality := OPC_QUALITY_UNCERTAIN;
            If (iRand > 800) Then
              m_Tags[i].m_lQuality := OPC_QUALITY_GOOD;

          end
          else
            m_Tags[i].m_lQuality := OPC_QUALITY_BAD;
 }
        m_Tags[i].m_lQuality := OPC_QUALITY_GOOD;
        Case (i mod 4) of
        0:
          begin
            If (iRand > 500) Then
               m_Tags[i].m_vValue := False
               else
               m_Tags[i].m_vValue := true;
          end;
        1:
            m_Tags[i].m_vValue := iRand;
        2:
            m_Tags[i].m_vValue := iRand/100;
        3:
            m_Tags[i].m_vValue := Format('StrValue:%f',[iRand/100]);
        else

        end;
    end;

end;


end.