main.pas

OPCSERVER的例子、是很好的学习例子

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ExtCtrls, ActnList;

type
  PBranch = ^TBranch;
  TBranch = class
    Parent: TBranch;
    Name: string;
    BranchList: TList;
    TagList: TList;
    constructor Create;
    destructor Destroy; override;
    function FindBranchByName(Name: string): Boolean;
    function FindTagByName(Name: string): Boolean;
    function GetDefaultTagName: string;
  end;

  PTag = ^TTag;
  TTag = record
    Parent: TBranch;
    Name: string;
    DataType: TVarType;
    Simulate: Word;
    Description: string;
    AddrHandle: THandle; //address space handler
    ViewHandle: TListItem; //GUI handler
    Value: Variant;
    Quality: Word;
    TimeStamp: TFileTime;
  end;

type
  TfmMain = class(TForm)
    muMain: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Server1: TMenuItem;
    Register1: TMenuItem;
    Unregister1: TMenuItem;
    N1: TMenuItem;
    AddGroup1: TMenuItem;
    AddTag1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    GroupView: TTreeView;
    StatusBar: TStatusBar;
    TagView: TListView;
    tmStatus: TTimer;
    pmGroupView: TPopupMenu;
    Delete1: TMenuItem;
    Splitter1: TSplitter;
    ActionList1: TActionList;
    actAddTag: TAction;
    pmTagView: TPopupMenu;
    Delete2: TMenuItem;
    tmRun: TTimer;
    tmTagView: TTimer;
    procedure ShowHint(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Register1Click(Sender: TObject);
    procedure Unregister1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure tmStatusTimer(Sender: TObject);
    procedure AddGroup1Click(Sender: TObject);
    procedure pmGroupViewPopup(Sender: TObject);
    procedure Delete1Click(Sender: TObject);
    procedure TagViewResize(Sender: TObject);
    procedure GroupViewChange(Sender: TObject; Node: TTreeNode);
    procedure About1Click(Sender: TObject);
    procedure actAddTagExecute(Sender: TObject);
    procedure actAddTagUpdate(Sender: TObject);
    procedure pmTagViewPopup(Sender: TObject);
    procedure Delete2Click(Sender: TObject);
    procedure tmRunTimer(Sender: TObject);
    procedure tmTagViewTimer(Sender: TObject);
  private
    { Private declarations }
  public
    TopBranchList: TList;
    RunTagList: TList;
    { Public declarations }
  end;

  function Ansi2Wide(str: AnsiString): WideString;

var
  fmMain: TfmMain;

const
  CLSID_OPCServer: TGUID = '{19480518-7BD2-4dc6-8453-856CAE292260}';

implementation

{$R *.dfm}

uses OMOPCSvrAPI, BranchDlg, TagDlg, AboutDlg;

//generate ItemID
function GenerateTagID(tag: PTag): WideString;
var
  ID: string;
  parent: TBranch;
begin
  ID := tag^.Name;
  parent := tag^.Parent;
  while parent<>nil do
  begin
    ID := parent.Name+'.'+ID;
    parent := parent.Parent;
  end;
  Result := Ansi2Wide(ID);
end;

function SimuTypeAsText(Simu: Word): string;
begin
  case Simu of
    1: Result := 'Random';
    2: Result := 'Incremental';
  else
    Result := 'None';
  end;
end;

constructor TBranch.Create;
begin
  inherited;
  BranchList := TList.Create;
  TagList := TList.Create;
  Parent := nil;
end;

destructor TBranch.Destroy;
var
  tmpTag: PTag;
  tmpBranch: TBranch;
  I: Integer;
begin
//free memory created by new operation
  for I:=0 to TagList.Count-1 do
  begin
    tmpTag := TagList.Items[I];
    fmMain.RunTagList.Remove(tmpTag);
    RemoveTag(tmpTag^.AddrHandle, True);
    Dispose(tmpTag);
  end;
  for I:=0 to BranchList.Count-1 do
  begin
    tmpBranch := BranchList.Items[I];
    tmpBranch.Destroy;
  end;
  //
  TagList.Free;
  BranchList.Free;
  inherited;
end;

function TBranch.FindBranchByName(Name: string): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I:=0 to BranchList.Count-1 do
  begin
    if StrComp(PChar(Name), PChar(TBranch(BranchList.Items[I]).Name))=0 then
      exit;
  end;
  Result := False;
end;

function TBranch.FindTagByName(Name: string): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I:=0 to TagList.Count-1 do
  begin
    if StrComp(PChar(Name), PChar(PTag(TagList.Items[I])^.Name))=0 then
      exit;
  end;
  Result := False;
end;

function TBranch.GetDefaultTagName: string;
var
  I: Integer;
  Name: string;
begin
  I := TagList.Count;
  Name := Format('Tag%d', [I]);
  while FindTagByName(Name) do
  begin
    I := I+1;
    Name := Format('Tag%d', [I]);
  end;
  Result := Name;
end;

function Ansi2Wide(str: AnsiString): WideString;
var
  I: Integer;
  tmp: WideString;
begin
//string[0] stores the length of the string, which is equal to Length(s)
  for I:=1 to Length(str) do
    tmp := tmp + str[I];
  Result := tmp;
end;

procedure TfmMain.Exit1Click(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TfmMain.Register1Click(Sender: TObject);
var
  hr: HResult;
  str: WideString;
begin
  str := Ansi2Wide(Application.ExeName);
  hr := RegisterOPCServer(@CLSID_OPCServer, 'OPCMaster.DA.2', 'Delphi Demo', 'OPCMaster Studio', LPCWSTR(str));
  if SUCCEEDED(hr) then
    ShowMessage('Register OPC Server Successfully!');
end;

procedure TfmMain.Unregister1Click(Sender: TObject);
var
  hr: HResult;
begin
  hr := UnregisterOPCServer(@CLSID_OPCServer, 'OPCMaster.DA.2');
  if SUCCEEDED(hr) then
    ShowMessage('Unregister OPC Server Successfully!');
end;

procedure TfmMain.FormCreate(Sender: TObject);
var
  hr: HResult;
begin
  hr := InitOPCSvr(@CLSID_OPCServer);
  if FAILED(hr) then
  begin
    Application.Terminate;
  end;
  TopBranchList := TList.Create;
  RunTagList := TList.Create;
  Application.OnHint := ShowHint;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
var
  I: Integer;
begin
//stop all timers
  tmRun.Enabled := False;
  tmTagView.Enabled := False;
  tmStatus.Enabled := False;
//free branch data first
  for I:=0 to TopBranchList.Count-1 do
      TBranch(TopBranchList.Items[I]).Destroy;
  //
  TopBranchList.Free;
  RunTagList.Free;
  RequestDisconnect('');
  UninitOPCSvr;
end;

procedure TfmMain.FormResize(Sender: TObject);
begin
  StatusBar.Panels[0].Width := Width-StatusBar.Panels[1].Width-StatusBar.Panels[2].Width;
end;

procedure TfmMain.tmStatusTimer(Sender: TObject);
var
  tmp: TBranch;
begin
  StatusBar.Panels[1].Text := Format('Client Num: %d', [NumberOfClientConnections]);
  if Assigned(GroupView.Selected) then
  begin
    tmp := GroupView.Selected.Data;
    StatusBar.Panels[2].Text := Format('Tag Num: %d', [tmp.TagList.Count]);
  end
  else
    StatusBar.Panels[2].Text := 'Tag Num: 0';
end;

procedure TfmMain.AddGroup1Click(Sender: TObject);
var
  tmp: TBranch;
  tmpNode: TTreeNode;
begin
  with TfmBranchDlg.Create(Self) do
  try
    if ShowModal = mrOK then
    begin
    //check the group name
    if Assigned(GroupView.Selected) and TBranch(GroupView.Selected.Data).FindBranchByName(edBranchName.Text) then
    begin
      MessageBox(Self.Handle, 'This group name already exists!', 'System Message', MB_OK);
      Exit;
    end;
    //
      tmp := TBranch.Create;
      tmp.Name := edBranchName.Text;
      if Assigned(GroupView.Selected) then
      begin
        TBranch(GroupView.Selected.Data).BranchList.Add(tmp); //add this new-created branch to branchlist
        tmp.Parent := GroupView.Selected.Data;
        tmpNode := GroupView.Items.AddChild(GroupView.Selected, edBranchName.Text);
      end
      else
      begin
        TopBranchList.Add(tmp);
        tmpNode := GroupView.Items.Add(nil, edBranchName.Text);
      end;
      tmpNode.Data := tmp;
      GroupView.Select(tmpNode);
    end;
  finally
    Free();
  end;
end;

procedure TfmMain.pmGroupViewPopup(Sender: TObject);
begin
//  Delete1.Enabled := GroupView.SelectionCount>0;
end;

procedure TfmMain.Delete1Click(Sender: TObject);
var
  tmpBranch: TBranch;
begin
    if Assigned(GroupView.Selected) then
    begin
      tmpBranch := TBranch(GroupView.Selected.Data);
      if Assigned(tmpBranch.Parent) then
        tmpBranch.Parent.BranchList.Remove(tmpBranch)
      else
        TopBranchList.Remove(tmpBranch);
      tmpBranch.Destroy;  //delete data structure
      GroupView.Items.Delete(GroupView.Selected);
    end;
//update Tagview if no item shows in groupview
  if GroupView.Items.Count=0 then
    TagView.Clear;
end;

procedure TfmMain.TagViewResize(Sender: TObject);
var
  I: Integer;
begin
  I := TagView.Width-400-5; //5 one special number to fit the actual real
  if I > 150 then
    TagView.Columns[4].Width := I
  else
    TagView.Columns[4].Width := 150;
end;

function VarTypeFromInt(iType: Integer): TVarType;
begin
  case iType of
    0: Result := varSingle;
    1: Result := varBoolean;
    2: Result := varSmallint;
    3: Result := varOleStr;
  else
    Result := varEmpty;
  end;
end;

procedure TfmMain.GroupViewChange(Sender: TObject; Node: TTreeNode);
var
  I: Integer;
  tmpTag: PTag;
begin
  tmTagView.Enabled := False;
  TagView.Clear;
  if Assigned(Node) then
  begin
    for I:=0 to TBranch(Node.Data).TagList.Count-1 do
    begin
      tmpTag := TBranch(Node.Data).TagList.Items[I];
      tmpTag.ViewHandle := TagView.Items.Add;
      with tmpTag.ViewHandle do
      begin
        Caption := tmpTag^.Name;
        SubItems.Add(VarTypeAsText(tmpTag^.DataType));
        SubItems.Add(SimuTypeAsText(tmpTag^.Simulate));
        SubItems.Add(VarToStr(tmpTag^.Value));
        SubItems.Add(tmpTag^.Description);
        Data := tmpTag;
      end;
    end;
  end;
  tmTagView.Enabled := True;
end;

procedure TfmMain.About1Click(Sender: TObject);
begin
  with TfmAboutDlg.Create(Self) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TfmMain.actAddTagExecute(Sender: TObject);
var
  I, num: Integer;
  tmpTag: PTag;
  Branch: TBranch;
begin
  with TfmTagDlg.Create(Self) do
  try
    if ShowModal = mrOK then
    begin
      Branch := GroupView.Selected.Data;
      num := StrToInt(edNum.Text);
      for I:=1 to num do
      begin
        New(tmpTag);
        tmpTag.Parent := Branch;
        tmpTag.Name := Branch.GetDefaultTagName;
        tmpTag.DataType := VarTypeFromInt(cbType.ItemIndex);
        tmpTag.Simulate := cbSimu.ItemIndex;
        tmpTag.Description := edDesc.Text;
        TVarData(tmpTag.Value).VType := tmpTag.DataType;
        Branch.TagList.Add(tmpTag);
        //add tag to address
        CreateTag(LPCWSTR(GenerateTagID(tmpTag)), tmpTag.Value, $00C0, FALSE, THandle(tmpTag), tmpTag^.AddrHandle);

        tmpTag.ViewHandle := TagView.Items.Add;
        with tmpTag.ViewHandle do
        begin
          Caption := tmpTag.Name;
          SubItems.Add(VarTypeAsText(tmpTag.DataType));
          SubItems.Add(SimuTypeAsText(tmpTag.Simulate));
          SubItems.Add(VarToStr(tmpTag.Value));
          SubItems.Add(edDesc.Text);
          Data := tmpTag;
        end;

        RunTagList.Add(tmpTag);

      end;
    end;
  finally
    Free();
  end;
end;

procedure TfmMain.actAddTagUpdate(Sender: TObject);
begin
  actAddTag.Enabled := Assigned(GroupView.Selected);
end;

procedure TfmMain.ShowHint(Sender: TObject);
begin
  if Length(Application.Hint) > 0 then
    StatusBar.Panels[0].Text := Application.Hint
  else
    StatusBar.Panels[0].Text := 'Welcome to use OM_OPCSvr.dll to develop your OPC server! QQ: 250561779';
end;

procedure TfmMain.pmTagViewPopup(Sender: TObject);
begin
//    Delete2.Enabled := TagView.SelCount>0;
end;

procedure TfmMain.Delete2Click(Sender: TObject);
var
  I: Integer;
  tag: PTag;
begin
  for I:=0 to TagView.Items.Count-1 do
  begin
    if TagView.Items[I].Selected then
    begin
      tag := TagView.Items[I].Data;
      tag^.Parent.TagList.Remove(tag);
      RunTagList.Remove(tag);
      RemoveTag(tag^.AddrHandle, True);
      Dispose(tag);
    end;
  end;
  TagView.DeleteSelected;
end;

procedure Simu(tag: PTag);
begin
  case tag^.Simulate of
    1:  begin    //random
          case TVarData(tag^.Value).VType of
            varSingle: TVarData(tag^.Value).VSingle := 100*Random;
            varBoolean: TVarData(tag^.Value).VBoolean := Random(2)>0;
            varSmallint: TVarData(tag^.Value).VSmallInt := Random(100);
            varOleStr: ;
          end;
        end;
    2:  begin    //Incremental
          case TVarData(tag^.Value).VType of
            varSingle: TVarData(tag^.Value).VSingle := TVarData(tag^.Value).VSingle+1;
            varBoolean: TVarData(tag^.Value).VBoolean := not TVarData(tag^.Value).VBoolean;
            varSmallint: TVarData(tag^.Value).VSmallInt := TVarData(tag^.Value).VSmallInt+1;
            varOleStr: ;
          end;
        end;
  end;
end;

procedure TfmMain.tmRunTimer(Sender: TObject);
var
  I: Integer;
  tag: PTag;
begin
  for I:=0 to RunTagList.Count-1 do
  begin
    tag := RunTagList.Items[I];
    Simu(tag);
    UpdateTag(tag^.AddrHandle, tag^.Value, $00C0);
  end;
end;

procedure TfmMain.tmTagViewTimer(Sender: TObject);
var
  I: Integer;
begin
  for I:=0 to TagView.Items.Count-1 do
  begin
    TagView.Items[I].SubItems.Strings[2] := VarToStr(PTag(TagView.Items[I].Data).Value);
  end;
end;

end.