main.~pas

DELPHI编写OPC(一)： 编写OPC客户端程序

end; 

function TOPCDataCallback.OnDataChange(dwTransid: DWORD; hGroup: OPCHANDLE;
  hrMasterquality: HResult; hrMastererror: HResult; dwCount: DWORD;
  phClientItems: POPCHANDLEARRAY; pvValues: POleVariantArray;
  pwQualities: PWordArray; pftTimeStamps: PFileTimeArray;
  pErrors: PResultList): HResult;
var
  ClientItems: POPCHANDLEARRAY;
  Values: POleVariantArray;
  Qualities: PWORDARRAY;
  I: Integer;
  NewValue: string;
begin
  Result := S_OK;
  ClientItems := POPCHANDLEARRAY(phClientItems);
  Values := POleVariantArray(pvValues);
  Qualities := PWORDARRAY(pwQualities);
  for I := 0 to dwCount - 1 do
  begin  
    if Qualities[I] = OPC_QUALITY_GOOD then
    begin
      NewValue := VarToStr(Values[I]);
      LogActivity(PChar('ClientItems: '),pchar(POPCHANDLEARRAY(ClientItems[i])));
    end
    else begin   
    end;
  end;
end;

function TOPCDataCallback.OnReadComplete(dwTransid: DWORD; hGroup: OPCHANDLE;
  hrMasterquality: HResult; hrMastererror: HResult; dwCount: DWORD;
  phClientItems: POPCHANDLEARRAY; pvValues: POleVariantArray;
  pwQualities: PWordArray; pftTimeStamps: PFileTimeArray;
  pErrors: PResultList): HResult;
begin
  Result := OnDataChange(dwTransid, hGroup, hrMasterquality, hrMastererror,
    dwCount, phClientItems, pvValues, pwQualities, pftTimeStamps, pErrors);
end;

function TOPCDataCallback.OnWriteComplete(dwTransid: DWORD; hGroup: OPCHANDLE;
  hrMastererr: HResult; dwCount: DWORD; pClienthandles: POPCHANDLEARRAY;
  pErrors: PResultList): HResult;
begin
  Result := S_OK;
end;

function TOPCDataCallback.OnCancelComplete(dwTransid: DWORD;
  hGroup: OPCHANDLE): HResult;
begin  
  Result := S_OK;
end;
procedure TFMain.EditValue(var An,Value:string;Aj:Integer);
begin
   if An='fifth' then
   begin
          case Aj of
          2:begin Edit1.Color:=clWindow;Edit1.Text:=Value;end;
          3:begin Edit2.Color:=clWindow;Edit2.Text:=Value;end;
          4:begin Edit3.Color:=clWindow;Edit3.Text:=Value;end;
          5:begin Edit4.Color:=clWindow;Edit4.Text:=Value;end;
          6:begin Edit5.Color:=clWindow;Edit5.Text:=Value;end;
          7:begin Edit6.Color:=clWindow;Edit6.Text:=Value;end;
          end;
   end;
   if An='forth' then
   begin
          case Aj of
          2:begin Edit7.Color:=clWindow;Edit7.Text:=Value;end;
          3:begin Edit8.Color:=clWindow;Edit8.Text:=Value;end;
          4:begin Edit9.Color:=clWindow;Edit9.Text:=Value;end;
          5:begin Edit10.Color:=clWindow;Edit10.Text:=Value;end;
          6:begin Edit11.Color:=clWindow;Edit11.Text:=Value;end;
          7:begin Edit12.Color:=clWindow;Edit12.Text:=Value;end;
          end;
   end;
   if An='third' then
   begin
          case Aj of
          2:begin Edit13.Color:=clWindow;Edit13.Text:=Value;end;
          3:begin Edit14.Color:=clWindow;Edit14.Text:=Value;end;
          4:begin Edit15.Color:=clWindow;Edit15.Text:=Value;end;
          5:begin Edit16.Color:=clWindow;Edit16.Text:=Value;end;
          6:begin Edit17.Color:=clWindow;Edit17.Text:=Value;end;
          7:begin Edit18.Color:=clWindow;Edit18.Text:=Value;end;
          end;
   end;
   if An='second' then
   begin
         case Aj of
          2:begin Edit19.Color:=clWindow;Edit19.Text:=Value;end;
          3:begin Edit20.Color:=clWindow;Edit20.Text:=Value;end;
          4:begin Edit21.Color:=clWindow;Edit21.Text:=Value;end;
          5:begin Edit22.Color:=clWindow;Edit22.Text:=Value;end;
          6:begin Edit23.Color:=clWindow;Edit23.Text:=Value;end;
          7:begin Edit24.Color:=clWindow;Edit24.Text:=Value;end;
          end;
   end;
end;
procedure TFMain.EditBadValue(var An:string);
begin
   if An='fifth' then
   begin
      Edit1.Text:='BAD';Edit1.Color:=$00BFBFFF;Edit2.Text:='BAD';Edit2.Color:=$00BFBFFF;
      Edit3.Text:='BAD';Edit3.Color:=$00BFBFFF;Edit4.Text:='BAD';Edit4.Color:=$00BFBFFF;
      Edit5.Text:='BAD';Edit5.Color:=$00BFBFFF;Edit6.Text:='BAD';Edit6.Color:=$00BFBFFF;
   end;
   if An='forth' then
   begin
      Edit7.Text:='BAD';Edit7.Color:=$00BFBFFF;Edit8.Text:='BAD';Edit8.Color:=$00BFBFFF;
      Edit9.Text:='BAD';Edit9.Color:=$00BFBFFF;Edit10.Text:='BAD';Edit10.Color:=$00BFBFFF;
      Edit11.Text:='BAD';Edit11.Color:=$00BFBFFF;Edit12.Text:='BAD';Edit12.Color:=$00BFBFFF;
   end;
   if An='third' then
   begin
      Edit13.Text:='BAD';Edit13.Color:=$00BFBFFF;Edit14.Text:='BAD';Edit14.Color:=$00BFBFFF;
      Edit15.Text:='BAD';Edit15.Color:=$00BFBFFF;Edit16.Text:='BAD';Edit16.Color:=$00BFBFFF;
      Edit17.Text:='BAD';Edit17.Color:=$00BFBFFF;Edit18.Text:='BAD';Edit18.Color:=$00BFBFFF;
   end;
   if An='second' then
   begin
      Edit19.Text:='BAD';Edit19.Color:=$00BFBFFF;Edit20.Text:='BAD';Edit20.Color:=$00BFBFFF;
      Edit21.Text:='BAD';Edit21.Color:=$00BFBFFF;Edit22.Text:='BAD';Edit22.Color:=$00BFBFFF;
      Edit23.Text:='BAD';Edit23.Color:=$00BFBFFF;Edit24.Text:='BAD';Edit24.Color:=$00BFBFFF;
   end;
end;
procedure TFMain.EditNotGood(var An:string;value:string;Aj:Integer);
begin
  if An='fifth' then
   begin
          case Aj of
          2:begin Edit1.Color:=$00BFBFFF;Edit1.Text:='';end;
          3:begin Edit2.Color:=$00BFBFFF;Edit2.Text:='';end;
          4:begin Edit3.Color:=$00BFBFFF;Edit3.Text:='';end;
          5:begin Edit4.Color:=$00BFBFFF;Edit4.Text:='';end;
          6:begin Edit5.Color:=$00BFBFFF;Edit5.Text:='';end;
          7:begin Edit6.Color:=$00BFBFFF;Edit6.Text:='';end;
          end;
   end;
   if An='forth' then
   begin
          case Aj of
          2:begin Edit7.Color:=$00BFBFFF;Edit7.Text:='';end;
          3:begin Edit8.Color:=$00BFBFFF;Edit8.Text:='';end;
          4:begin Edit9.Color:=$00BFBFFF;Edit9.Text:='';end;
          5:begin Edit10.Color:=$00BFBFFF;Edit10.Text:='';end;
          6:begin Edit11.Color:=$00BFBFFF;Edit11.Text:='';end;
          7:begin Edit12.Color:=$00BFBFFF;Edit12.Text:='';end;
          end;
   end;
   if An='third' then
   begin
          case Aj of
          2:begin Edit13.Color:=$00BFBFFF;Edit13.Text:='';end;
          3:begin Edit14.Color:=$00BFBFFF;Edit14.Text:='';end;
          4:begin Edit15.Color:=$00BFBFFF;Edit15.Text:='';end;
          5:begin Edit16.Color:=$00BFBFFF;Edit16.Text:='';end;
          6:begin Edit17.Color:=$00BFBFFF;Edit17.Text:='';end;
          7:begin Edit18.Color:=$00BFBFFF;Edit18.Text:='';end;
          end;
   end;
   if An='second' then
   begin
         case Aj of
          2:begin Edit19.Color:=$00BFBFFF;Edit19.Text:='';end;
          3:begin Edit20.Color:=$00BFBFFF;Edit20.Text:='';end;
          4:begin Edit21.Color:=$00BFBFFF;Edit21.Text:='';end;
          5:begin Edit22.Color:=$00BFBFFF;Edit22.Text:='';end;
          6:begin Edit23.Color:=$00BFBFFF;Edit23.Text:='';end;
          7:begin Edit24.Color:=$00BFBFFF;Edit24.Text:='';end;
          end;
   end;
end;
procedure TFMain.FormCreate(Sender: TObject);
var
   i,j:Integer;
   iniF:TIniFile;
   GList:TStrings;
   tmp,tname:string;
begin  
  iniF:=TIniFile.Create(ExtractFilePath(ParamStr(0))+'Setup.ini');
  GList:=TStringList.Create;
  iniF.ReadSection('group',GList);
   ServerNames := TStringList.Create;
  try
    SetLength(CATIDs, 0);
    OPCServerList := TOPCServerList.Create('', True, CATIDs);
    try
      OPCServerList.Update;
      ServerNames.AddStrings(OPCServerList.Items);
    finally
      OPCServerList.Free;
    end;
    for I := 0 to ServerNames.Count - 1 do
    begin
      RzComboBox1.Items.Add(ServerNames[I]);
    end;
    RzComboBox1.ItemIndex:=0;  
  finally
    ServerNames.Free;
  end;sGroupCount:=GList.Count;
  RzListView1.Items.Clear; GroupCount:=GList.Count;
  for i:=0 to GList.Count-1 do
  begin
     With   RzListView1.Items.Add do
     begin
         Caption:=GList.Strings[i];
     end;tmp:='';tname:='';
     tmp:=iniF.ReadString(GList.Strings[i],'LineCount','0');
     tname:=iniF.ReadString(GList.Strings[i],'name','vb');
     LList[i+1,1]:=GList.Strings[i];
     for j:=1 to StrToInt(tmp) do
     begin
         LList[i+1,J+1]:='MicroWin.'+GList.Strings[i]+'.'+tname+inttostr(j-1);
        // ItemHandle[i+1,j+1]:= OPCHANDLE(StrToInt(IntToStr(i+1)+inttostr(j+1)));
        ItemHandle[i+1,j+1]:=J;
     end;
  end;
  Label16.Caption:='ぃ硄';Label17.Caption:='ぃ硄';Label18.Caption:='ぃ硄';
  Label19.Caption:='ぃ硄';
end;

procedure TFMain.FlatButton2Click(Sender: TObject);
var i,j,k:Integer;
begin
  DeleteFile(ExtractFilePath(ParamStr(0))+'debug.txt');
  HR := CoInitializeSecurity( nil,-1,nil,nil,RPC_C_AUTHN_LEVEL_NONE,RPC_C_IMP_LEVEL_IMPERSONATE,nil,EOAC_NONE,nil);
  if Failed(HR) then
  begin
     ShowMessage('Failed to initialize DCOM security');
  end;
  try
    ServerIf := CreateComObject(ProgIDToClassID(RzComboBox1.Text)) as IOPCServer;
  except
    ServerIf := nil;
  end;
  if ServerIf <> nil then
  begin
  end
  else begin
    ShowMessage('Unable to connect to OPC server');  Exit;
  end;
  for i:=1 to GroupCount do
  begin
      if LList[i,1]<>'' then
      begin
           HR := ServerAddGroup(ServerIf,  LList[i,1], true, 500, 0, GroupIf[i], GroupHandle[i]);
           if Succeeded(HR) then
           begin
               LogActivity('ServerAddGroup',PChar('Sessus add group to server for '+LList[i,1]));
           end
           else begin
               LogActivity('ServerAddGroup',PChar('Unable to add group to server for '+RzListView1.Items[0].Caption));
           end; 
           for j:=2 to 15 do
           begin
                if LList[i,j]<>'' then
                begin 
                   LogActivity(PChar('ItemHandle['+inttostr(i)+','+inttostr(j)+']:'),PChar(inttostr(OPCHANDLE(ItemHandle[i,j]))));
                   HR := GroupAddItem(GroupIf[i],LList[i,j], 0, VT_EMPTY, ItemHandle[i,j],ItemType);
                   if Succeeded(HR) then
                   begin
                        LogActivity('ItemHandle[i,j]',PChar(IntToStr(OPCHANDLE(ItemHandle[i,j]))));
                   end
                   else begin
                      LogActivity('ServerAddGroup',PChar('Unable to add Item to Group for '+ LList[i,j]));
                   end;
                    AdviseSink := TOPCAdviseSink.Create;
                   HR := GroupAdviseTime(GroupIf[i], AdviseSink, AsyncConnection);
                  { if Failed(HR) then
                   begin
                      LogActivity('AdviseSink',PChar('Failed AdviseSink for '+LList[i,1]));
                   end
                   else begin
                      LogActivity('AdviseSink',PChar('success AdviseSink for '+LList[i,1]));
                   end;
                   OPCDataCallback := TOPCDataCallback.Create;
                   HR := GroupAdvise2(GroupIf[i], OPCDataCallback, AsyncConnection);
                   if Failed(HR) then
                   begin
                      LogActivity('OPCDataCallback',PChar('Failed OPCDataCallback for '+LList[i,1]));
                   end
                   else begin
                     LogActivity('AdviseSink',PChar('success OPCDataCallback for '+LList[i,1]));
                   end;  }
                   HR := ReadOPCGroupItemValue(GroupIf[i],ItemHandle[i,j], ItemValue, ItemQuality);
                   if Succeeded(HR) then
                   begin     
                      if (ItemQuality and OPC_QUALITY_MASK) = OPC_QUALITY_GOOD then
                      begin 
                          EditValue(LList[i,1],ItemValue,J);
                      end
                      else begin
                         EditNotGood(LList[i,1],'NotGood',j);
                      end;
                      Label16.Caption:='タ盽';Label17.Caption:='タ盽';Label18.Caption:='タ盽';
                      Label19.Caption:='タ盽';
                  end
                  else begin
                        EditBadValue(LList[i,1]);
                        Label16.Caption:='ぃ硄';Label17.Caption:='ぃ硄';Label18.Caption:='ぃ硄';
                        Label19.Caption:='ぃ硄';
                  end;

            end;
           end; 
      end;      
  end;
  FlatButton2.Enabled:=False;FlatButton3.Enabled:=True;
end;

procedure TFMain.FlatButton1Click(Sender: TObject);
begin
close;
end;

procedure TFMain.FlatPanel2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
ReleaseCapture; Perform(WM_syscommand, $F012, 0);
end;

procedure TFMain.Panel5MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ReleaseCapture; Perform(WM_syscommand, $F012, 0); 
end;

procedure TFMain.RzGroupBox1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
ReleaseCapture; Perform(WM_syscommand, $F012, 0); 
end;

procedure TFMain.tippanelMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
ReleaseCapture; Perform(WM_syscommand, $F012, 0);
end;

procedure TFMain.FormShow(Sender: TObject);
begin
Label37.Caption:='さぱ琌'+copy(FormatDateTime('YYYY/MM/DD',Now),1,4)+
                  '