main.pas

opc client 的开发工具

unit main;

interface

uses
  ShareMem, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,
  Forms, Dialogs, Menus, ImgList, ComCtrls, ToolWin, ExtCtrls, Grids, ActiveX,
  OPCDA,ShellAPI;

const MY_MESSAGE = WM_USER + 100;
type
  TfMain = class(TForm)
    Timer1: TTimer;
    pm1: TPopupMenu;
    X1: TMenuItem;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    SvrOK: boolean;
    procedure Monitor;
    procedure InitTags;
    procedure LoadTags;
    procedure ActTags;
    procedure OnIconNotify(var Message: TMessage); message MY_MESSAGE;
    procedure AddTray;
    procedure RemoveTray;

    { Public declarations }
  end;
  procedure DisConnectServer(Numbr: DWORD); stdcall;
var
  fMain: TfMain;

implementation

uses opc;

{$R *.dfm}
procedure DisConnectServer(Numbr: DWORD); stdcall;
begin
  if Numbr = 0 then
  begin
    UninitOPCSvr;
    Application.Terminate;
  end;
end;

procedure TfMain.OnIconNotify(var Message: TMessage);
var
  p: TPoint;
begin
  if Message.LParam=WM_RBUTTONDOWN then
  begin
    SetForegroundWindow(Handle);
    GetCursorPos(p);
    pm1.Popup(p.X,p.Y);
  end;
  if Message.LParam=WM_LBUTTONDOWN then
  begin
    SetForegroundWindow(Handle);
    Show;
  end;
end;

procedure TfMain.AddTray;
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid);
  nid.Wnd := Handle;
  nid.uID := 0;
  nid.hIcon := Application.Icon.Handle;
  nid.szTip := 'OPC数据访问服务器';
  nid.uCallbackMessage := MY_MESSAGE;
  nid.uFlags := NIF_ICON or NIF_TIP or NIF_MESSAGE;
  Shell_NotifyIcon(NIM_ADD, @nid);
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
end;

procedure TfMain.RemoveTray;
var
  nid: TNotifyIconData;
begin
  nid.cbSize := sizeof(nid);
  nid.cbSize := sizeof(nid);
  nid.uID := 0;
  nid.Wnd := Handle;
  Shell_NotifyIcon(NIM_DELETE, @nid);
end;


procedure TfMain.Monitor;
var
  i: integer;
  ft: TFileTime;
  tt: TDateTime;
  lvi: TListItem;
  UpdateOK: boolean;
begin
  GetSystemTimeAsFileTime(ft);
  tt:= now;
  for i:=0 to tCount do
  begin
    case ppTags[i].TagType of
      varBoolean: if Random(3)>1 then
            ppTags[i].Value:=true
          else
            ppTags[i].Value:=false;
      varOleStr:  ppTags[i].Value:= IntToStr(Random(100));

      varDouble:  ppTags[i].Value := Random(100)/99.9*99.999;
    end ;
    ppTags[i].Quality:=192;
    ppTags[i].TagFt:= ft;
    if ppTags[i].Active then
      UpdateTagWithTimeStamp(ppTags[i].TagHandle,ppTags[i].Value,192,ppTags[i].TagFt);
  end;
end;

procedure TfMain.Timer1Timer(Sender: TObject);
begin
  Monitor;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
  if ParamCount>=1 then
  begin
    if LowerCase(ParamStr(1))='/regserver' then
    begin
      if RegServer(PChar(SvrClsID),PChar(SvrName),PChar(SvrDesc),PChar(Application.ExeName)) then
        MessageBox(handle,'OPC服务器注册成功...','提示',MB_OK)
      else
        MessageBox(handle,'OPC服务器注册失败...','提示',MB_OK);
      Application.Terminate;
    end;
    if LowerCase(ParamStr(1))='/unregserver' then
    begin
      if UnregServer(PChar(SvrClsID),PChar(SvrName)) then
        MessageBox(handle,'OPC服务器注销成功...','提示',MB_OK)
      else
        MessageBox(handle,'OPC服务器注销失败...','提示',MB_OK);
      Application.Terminate;
    end;
  end;

  if InitOPCSvr(PChar(SvrClsID),500) then
  begin
    EnableWriteNotification(@WriteTag);
    EnableDisconnectNotification(DisConnectServer);
    SetServerState(OPC_STATUS_RUNNING);
    SvrOK:= true;
    InitTags;
    LoadTags;
    ActTags;
    RunSvr;
    AddTray;
    Timer1.Enabled:=true;
  end
  else begin
    SvrOK:= false;
  end;
end;

procedure TfMain.InitTags;
var
  i: integer;
begin
  try
    for i:=0 to MaxTagCount-1 do
    begin
      ppTags[i].TagID:='';
      ppTags[i].TagHandle:=0;
      ppTags[i].TagType:=5;
      ppTags[i].Quality:=192;
      ppTags[i].lvIndex:= -1;
      VariantInit(ppTags[i].Value);
      ppTags[i].Active:=false;
    end;
    tCount:= -1;
  except
  end;
end;

procedure TfMain.ActTags;
var
  i : integer;
  H : THandle;
begin
  for i:= 0 to tCount do
  begin
    if not ppTags[i].Active then
    begin
      H:=CreateTag(PChar(ppTags[i].TagID),ppTags[i].Value,192,true);
      if H<>0 then
      begin
        SetTagProperties(H,1,'',ppTags[i].TagType);
        ppTags[i].TagHandle:=H;
        ppTags[i].Active:=true;
      end;
    end;
  end;
end;

procedure TfMain.LoadTags;
var
  ft: TFileTime;
  st : TSystemTime;
  I: integer;
begin
  GetSystemTime(st);
  SystemTimeToFileTime(st,ft);
  tCount:=-1;
  for I:=0 to MaxTagCount-1 do
  begin
    inc(tCount);
    ppTags[tCount].TagID:='TAG'+IntToStr(I);
    ppTags[tCount].TagHandle:=0;
    ppTags[tCount].Quality:=192;
    ppTags[tCount].Active := false;
    case (I mod 3) of
      0:
        begin
          ppTags[tCount].TagType := varDouble;
          ppTags[tCount].Value:=0;
        end;
      1:
        begin
          ppTags[tCount].TagType := varBoolean;
          ppTags[tCount].Value:=0;
        end;
      2:
        begin
          ppTags[tCount].TagType := varOleStr;
          ppTags[tCount].Value:=0;
        end;
    end;
  end;
end;

procedure TfMain.X1Click(Sender: TObject);
begin
  Close;
end;

procedure TfMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  RemoveTray;
end;

procedure TfMain.FormPaint(Sender: TObject);
begin
  Hide;
end;

end.