unmain.~pas

OPC 源程序示例

unit UnMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,comobj,OPCtypes,OPCDA, OPCutils,OPCDataCallback,OPCAdviseSink,ActiveX, StdCtrls, Buttons,
  ComCtrls, Menus, ExtCtrls, TeEngine, Series, TeeProcs, Chart, DbChart,
  DB, ADODB,ShellAPI, Grids, DBGrids, DBTables, CheckLst, GridsEh, DBGridEh,
  PrnDbgeh, DBSumLst,report1;

const
   ServerProgIDWincc = 'OPCServer.WinCC';
   RPC_C_AUTHN_LEVEL_NONE = 1;
   RPC_C_IMP_LEVEL_IMPERSONATE = 3;
   EOAC_NONE = 0;

   OneSecond = 1 / (24 * 60 * 60);
   MY_MESSAGE =WM_USER + 100;
type
  TMain = class(TForm)
    Button2: TButton;
    StatusBar1: TStatusBar;
    BExit: TButton;
    Button3: TButton;
    Label2: TLabel;
    Timer1: TTimer;
    Button4: TButton;
    DataSource1: TDataSource;
    PrintDBGridEh1: TPrintDBGridEh;
    ADOT_OneTimeDataValues: TADOTable;
    ADOT_TagName: TADOTable;
    ADOConnection1: TADOConnection;
    DBSumList1: TDBSumList;
 //   procedure Timer1Timer(Sender: TObject);
 //   procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure BExitClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    procedure OnIconNotify(var Message:TMessage);message MY_MESSAGE;
    { Private declarations }
  public
    procedure LinkOPCServer(); //连接OPC服务器函数
    procedure AddGroup();      //添加组函数
    procedure AddWinccOPCItem();       //添加项目
 //   procedure AddKepServerItem();       //添加项目
    procedure SyncreadTagValue(); //同步读取项目值函数
 //   procedure SyncWriteTagValue(); //同步寫入项目值函数
 //   procedure SyncReadTagValueSP();
    { Public declarations }
  end;

var
  Main: TMain;
  serverWinccOPC:iopcserver;

  groupNo :array of iopcitemmgt;
  grouphandleNo :array of opchandle;
  
  //groupif:iopcitemmgt;
  groupWinccOPC:iopcitemmgt;
  grouphandle:opchandle;           //添加组句柄
  // 可考虑定义为数组型变量，便于处理多个组分类

  ItemType:TVarType;
  VT_EMPTY: TVarType;               //项的类型（返回值）
  //Item0Handle:opchandle;            //添加项返回句柄 （返回值）
  Item0HandleCuteOPC_RD:opchandle;
  Item0HandleCuteOPC_WR:opchandle;


  itemvalue:string;                 //项的值  （设定或返回值）
  ItemQuality:word;                 //项质量 （返回值）

  OPCDataCallback: IOPCDataCallback;    //回调函数定义
  AsyncConnection: Longint;

  ppErrors:PResultList;               //返回结果 （返回值）
  Hr:HResult;                        //函数返回状态句柄
  //CuitOPC變量
  aRdTagItemHandle,aWrTagItemHandle :array of DWORD;
  aRdTagName,aWrTagName :array of string;    //定义读全局标签变量数组
  dRdTagNameValue,dWrTagNameValue :array of Real;
  iRdTagNumber,iWrTagNumber :Integer;
  abcflower :array of Real;

  bShowMain : boolean;  //是否显示主窗口
  iwritenumber :Integer;
implementation

{$R *.dfm}

//连接OPCServer//
procedure TMain.LinkOPcServer();
begin

  //*********连接CuteOPC Server***********//
  try
    serverWinccOPC :=CreateComObject(ProgIDToClassID(ServerProgIDWincc)) as IOPCServer;
    //serverWinccOPC :=CreateRemoteComObject('ZJXTZ-SGJ',ProgIDToClassID(ServerProgIDWincc)) as IOPCServer;
  except
    serverWinccOPC := nil;
  end;
  if serverWinccOPC = nil then
  begin
    showmessage(' NO!!! 不能连接WinCCOPC服务器，连接失败');
  end
  else
    //showmessage(' OK !!! 连接WinCCOPC服务器成功，连接成功');


end;


//********添加组过程********/////
procedure TMain.AddGroup();
var
  gstrCu,grtrKep :String;
begin
  gstrCu:='GRPCU'; //自己定义的组名
  grtrKep :='GRPKEP';

  /////////////////
  HR := ServerAddGroup(serverWinccOPC, gstrCu, True, 1000, 0,groupWinccOPC, GroupHandle);  //函数在OPCutils.pas中
  if not Succeeded(HR) then
  begin
    showmessage(' 添加WinCCOPC组失败！');
  end
  else
  // showmessage(' 添加WinCCOPC组成功！');
end;


//********添加CuteOPC项目过程********/////
procedure TMain.AddWinccOPCItem();
var
  sRdItemName :string;
  i :Integer;
  x :word;
begin
   ADOT_TagName.Close;
   ADOT_TagName.Open;
   ADOT_TagName.First;
   iRdTagNumber := ADOT_TagName.RecordCount;
   setLength(aRdTagName,iRdTagNumber);
   setLength(aRdTagItemHandle,iRdTagNumber);
   setLength(dRdTagNameValue,iRdTagNumber);
   for i:=0 to iRdTagNumber-1 do
   begin
     sRdItemName:=ADOT_TagName.Fields[0].AsString;
     aRdTagName[i]:=''''+sRdItemName+'''';
     x:=i;
     HR := GroupAddItem(groupWinccOPC,sRdItemName,x, VT_EMPTY,Item0HandleCuteOPC_RD,ItemType);  //函数在OPCutils.pas中
     //句柄为dword型，第一个定义的项句柄为1，依次为2，3……
     aRdTagItemHandle[i] :=Item0HandleCuteOPC_RD;

    //*******每次添加项目后返回其句柄，通过该句柄读项目值****//
     if Succeeded(HR) then
     begin
      // showmessage('ok  添加数据item成功！');
     end
     else
     begin
       showmessage('标签名" '+sRdItemName+'" 添加失败！，请检查该标签名是否正确');
       ServerWinccOPC.RemoveGroup(GroupHandle, False);
       Exit;
     end;
     ADOT_TagName.Next;
   end;
   ADOT_TagName.Close;
end;

//**** 同步读取WinCC数据项数据值同写入到Kep Server中****////
procedure TMain.SyncreadTagValue ;
Var
  ith:DWORD;
  i,n:Integer;
  dItemValue :Real;
begin
  ///读Wincc标签数据
  ADOT_OneTimeDataValues.Open;
  ADOT_OneTimeDataValues.Append;
  ADOT_OneTimeDataValues.Fields[0].AsDateTime :=now;
  for i:=0 to iRdTagNumber-1 do
  begin
     ith :=aRdTagItemHandle[i];
     HR := ReadOPCGroupItemValue(GroupWinccOPC, ith,ItemValue, ItemQuality);  //函数在OPCutils.pas中
     if  Succeeded(HR) then
     begin
       dItemValue :=strToFloat(ItemValue);
       dItemValue :=abs(round(dItemValue));
       n :=i+1;
       ADOT_OneTimeDataValues.Fields[n].AsFloat :=dItemValue;

      { case n of
          1 : Edit1.Text :=FloatToStr(dItemValue);
          2 : Edit2.Text :=FloatToStr(dItemValue);
          3 : Edit3.Text :=FloatToStr(dItemValue);
          4 : Edit4.Text :=FloatToStr(dItemValue);
          5 : Edit5.Text :=FloatToStr(dItemValue);
       end;}
     //if  Succeeded(HR) then
    // begin
       dRdTagNameValue[i]:= dItemValue;
     end
     else
    // begin
        showmessage('标签'+'sTagName[i]'+'SyncreadTagValue同步读取失败');
    // end;
  //end;
 end;
 ADOT_OneTimeDataValues.Post;
end;

procedure TMain.FormCreate(Sender: TObject);
var
   NotifyIconData :TNotifyIconData;
   sapplicationpath,MyPassW :String;
begin

   NotifyIconData.cbSize :=sizeof(NotifyIconData);
   NotifyIconData.Wnd :=Handle;
   NotifyIconData.uID :=1000;
   NotifyIconData.hIcon :=Application.Icon.Handle;
   NotifyIconData.szTip :='球团竖炉表报查询系统';
   NotifyIconData.uCallbackMessage :=MY_MESSAGE;
   NotifyIconData.uFlags :=NIF_ICON or NIF_TIP or NIF_MESSAGE;
   if not Shell_NotifyIcon(NIM_ADD,@NotifyIconData) then
   begin
      showmessage('Failed');
      Application.Terminate;
   end;

   SetWindowLong
     (
     application.Handle,
     GWL_EXSTYLE,
     WS_EX_TOOLWINDOW
     );
 
   //  Button3Click(Sender);//启动

     bShowMain :=False;
     StatusBar1.Panels[0].Text :='读取数据';
     StatusBar1.Panels[1].Text :='当前时间:'+ DateTimeToStr(now);
     sapplicationpath :=Extractfilepath(paramstr(0));
     MyPassW:='';
   {
     ADOCTagDB.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+
                                 sapplicationpath+'tagDB.mdb;Jet OLEDB:Database Password='+
                                 MyPassW+';Persist Security Info=False';
    ADOCTagDB.Connected :=true;
    }
  end;

procedure  TMain.OnIconNotify(var Message:TMessage);
const
    Busy: Boolean=False;
begin

   if not Busy then
   begin
     if Message.LParam =WM_RBUTTONDOWN then
        if Application.MessageBox('要退出系统吗？','系统提示',MB_YESNO)=IDYES then
        begin
          // Timer1.Enabled :=false;
        //   Timer2.Enabled :=false;
           Application.Terminate;
        end;
     if Message.LParam =WM_LBUTTONDOWN then
     begin
        bShowMain :=True;
        //Main.Show;
        frmreprt1.ShowModal;
     end;
   end;

end;
procedure TMain.FormPaint(Sender: TObject);
begin
  if not bShowMain then
     Hide;
end;

procedure TMain.BExitClick(Sender: TObject);
begin
 //  if Application.MessageBox('确定要退出系统吗？','系统提示',MB_YESNO)=IDYES then
      //close;
     Hide;
end;

procedure TMain.Button3Click(Sender: TObject);
begin
   LinkOPcServer();
   AddGroup();
   AddWinccOPCItem();
   SyncReadTagValue();
   iwritenumber :=0;
 //  Timer1.Enabled :=true;
  // Timer2.Enabled :=true;
end;

procedure TMain.Timer2Timer(Sender: TObject);
begin
 //  SyncReadTagValueSP();
 //  SyncWriteTagValue();
   StatusBar1.Panels[0].Text :='读取数据';
   StatusBar1.Panels[1].Text :='当前时间:'+ DateTimeToStr(now);
end;

procedure TMain.Timer1Timer(Sender: TObject);
var
  sdatetime,sreadtime :string;
  itime:Integer;
begin
  sdatetime :=timetoStr(time);
  for itime:=0 to 23 do
  begin
    sreadtime :=InttoStr(itime)+':00:00';
    if sdatetime = sreadtime then
    begin
       Button3Click(Sender);
    end;
  end;     
end;

procedure TMain.Button4Click(Sender: TObject);
begin
 frmreprt1.ShowModal;
end;

end.