delphi如何操作opc

jupiterhunter 2006-11-26 06:14:03
小弟,初次使用opc,知道opc是基于com的技术,请问各位大侠使用opc还需要特殊操作吗?
这是我在网上下 载的例子,这段代码有什么问题?我总是运行不成功。
在HR := GroupAddItem(GroupIf, Item0Name, 0, VT_EMPTY, Item0Handle
ItemType);一句中,hr总是返回负值,请问为什么,另外在
HR := GroupAdviseTime(GroupIf, AdviseSink, AsyncConnection);这一句总是提示 异常 接口不支持 interface not supportd,就是DataIf := GroupIf as IDataObject;groupif 是 IOPCItemMgt类型的
源代码:
// among other things, this call makes sure that COM is initialized
Application.Initialize;
Writeln('========================================================');
Writeln('Simple OPC client program, by Mike Dillamore, 1998-2006.');
Writeln('Tested for compatibility with Delphi 3-7 and 2005, 2006 ');
Writeln('Requires Simulation OPC server from Matrikon, ');
Writeln('but easily modified for use with other servers. ');
Writeln('========================================================');
Writeln;

// this is for DCOM:
// without this, callbacks from the server may get blocked, depending on
// DCOM configuration settings
HR := CoInitializeSecurity(
nil, // points to security descriptor
-1, // count of entries in asAuthSvc
nil, // array of names to register
nil, // reserved for future use
RPC_C_AUTHN_LEVEL_NONE, // the default authentication level for proxies
RPC_C_IMP_LEVEL_IMPERSONATE,// the default impersonation level for proxies
nil, // used only on Windows 2000
EOAC_NONE, // additional client or server-side capabilities
nil // reserved for future use
);
if Failed(HR) then
begin
Writeln('Failed to initialize DCOM security');
end;

try
// we will use the custom OPC interfaces, and OPCProxy.dll will handle
// marshaling for us automatically (if registered)
ServerIf := CreateComObject(ProgIDToClassID(ServerProgID)) as IOPCServer;
except
ServerIf := nil;
end;
if ServerIf <> nil then
begin
Writeln('Connected to OPC server');
end
else begin
Writeln('Unable to connect to OPC server');
Exit;
end;

// now add a group
HR := ServerAddGroup(ServerIf, 'MyGroup', True, 500, 0, GroupIf, GroupHandle);
if Succeeded(HR) then
begin
Writeln('Added group to server');
end
else begin
Writeln('Unable to add group to server');
Exit;
end;

// now add an item to the group
HR := GroupAddItem(GroupIf, Item0Name, 0, VT_EMPTY, Item0Handle,
ItemType);
if Succeeded(HR) then
begin
Writeln('Added item 0 to group');
end
else begin
Writeln('Unable to add item 0 to group');
ServerIf.RemoveGroup(GroupHandle, False);
Exit;
end;
// now add a second item to the group
HR := GroupAddItem(GroupIf, Item1Name, 1, VT_EMPTY, Item1Handle,
ItemType);
if Succeeded(HR) then
begin
Writeln('Added item 1 to group');
end
else begin
Writeln('Unable to add item 1 to group');
ServerIf.RemoveGroup(GroupHandle, False);
Exit;
end;

// set up an IDataObject advise callback for the group
AdviseSink := TOPCAdviseSink.Create;
HR := GroupAdviseTime(GroupIf, AdviseSink, AsyncConnection);
if Failed(HR) then
begin
Writeln('Failed to set up IDataObject advise callback');
end
else begin
Writeln('IDataObject advise callback established');
// continue waiting for callbacks for 10 seconds
StartTime := Now;
while (Now - StartTime) < (10 * OneSecond) do
begin
Application.ProcessMessages;
end;
// end the IDataObject advise callback
GroupUnadvise(GroupIf, AsyncConnection);
end;

// now set up an IConnectionPointContainer data callback for the group
OPCDataCallback := TOPCDataCallback.Create;
HR := GroupAdvise2(GroupIf, OPCDataCallback, AsyncConnection);
if Failed(HR) then
begin
Writeln('Failed to set up IConnectionPointContainer advise callback');
end
else begin
Writeln('IConnectionPointContainer data callback established');
// continue waiting for callbacks for 10 seconds
StartTime := Now;
while (Now - StartTime) < (10 * OneSecond) do
begin
Application.ProcessMessages;
end;
// end the IConnectionPointContainer data callback
GroupUnadvise2(GroupIf, AsyncConnection);
end;

// now try to read the item value synchronously
HR := ReadOPCGroupItemValue(GroupIf, Item0Handle, ItemValue, ItemQuality);
if Succeeded(HR) then
begin
if (ItemQuality and OPC_QUALITY_MASK) = OPC_QUALITY_GOOD then
begin
Writeln('Item 0 value read synchronously as ', ItemValue);
end
else begin
Writeln('Item 0 value was read synchronously, but quality was not good');
end;
end
else begin
Writeln('Failed to read item 0 value synchronously');
end;

// finally write the value just read from item 0 into item 1
HR := WriteOPCGroupItemValue(GroupIf, Item1Handle, ItemValue);
if Succeeded(HR) then
begin
Writeln('Item 1 value written synchronously');
end
else begin
Writeln('Failed to write item 1 value synchronously');
end;

// wait for 1 second
StartTime := Now;
while (Now - StartTime) < OneSecond do
begin
Application.ProcessMessages;
end;

// and try to read it back
HR := ReadOPCGroupItemValue(GroupIf, Item1Handle, ItemValue, ItemQuality);
if Succeeded(HR) then
begin
if (ItemQuality and OPC_QUALITY_MASK) = OPC_QUALITY_GOOD then
begin
Writeln('Item 1 value read synchronously as ', ItemValue);
end
else begin
Writeln('Item 1 value was read synchronously, but quality was not good');
end;
end
else begin
Writeln('Failed to read item 0 value synchronously');
end;

// now cleanup
HR := ServerIf.RemoveGroup(GroupHandle, False);
if Succeeded(HR) then
begin
Writeln('Removed group');
end
else begin
Writeln('Unable to remove group');
end;

// Delphi runtime library will release all interfaces automatically when
// variables go out of scope
...全文
456 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
jc9772 2007-04-09
  • 打赏
  • 举报
回复
我有源代码,发给你
shuihan20e 2007-03-23
  • 打赏
  • 举报
回复
完全看不懂
plutu 2007-03-22
  • 打赏
  • 举报
回复
应该有这方面的资料,从网上搜一下吧
ipbdq 2006-11-30
  • 打赏
  • 举报
回复
帮你顶!看花眼了!
jupiterhunter 2006-11-28
  • 打赏
  • 举报
回复
delphi怎么做opc?
jupiterhunter 2006-11-28
  • 打赏
  • 举报
回复
我把问题换换吧,怎么用delphi做opc服务器
sdzeng 2006-11-26
  • 打赏
  • 举报
回复
没看完,太长。。。。
jupiterhunter 2006-11-26
  • 打赏
  • 举报
回复
// wrapper for IOPCItemMgt.RemoveItems (single item only)
function GroupRemoveItem(GroupIf: IOPCItemMgt;
ServerHandle: OPCHANDLE): HResult;
var
Errors: PResultList;
begin
if GroupIf = nil then
begin
Result := E_FAIL;
Exit;
end;
Result := GroupIf.RemoveItems(1, @ServerHandle, Errors);
if Succeeded(Result) then
begin
Result := Errors[0];
CoTaskMemFree(Errors);
end;
end;

// wrapper for IDataObject.DAdvise on an OPC group object
function GroupAdviseTime(GroupIf: IUnknown; Sink: IAdviseSink;
var AsyncConnection: Longint): HResult;
var
DataIf: IDataObject;
Fmt: TFormatEtc;
begin
Result := E_FAIL;
try
DataIf := GroupIf as IDataObject;
except
DataIf := nil;
end;
if DataIf <> nil then
begin
with Fmt do
begin
cfFormat := OPCSTMFORMATDATATIME;
dwAspect := DVASPECT_CONTENT;
ptd := nil;
tymed := TYMED_HGLOBAL;
lindex := -1;
end;
AsyncConnection := 0;
Result := DataIf.DAdvise(Fmt, ADVF_PRIMEFIRST, Sink, AsyncConnection);
if Failed(Result) then
begin
AsyncConnection := 0;
end;
end;
end;

// wrapper for IDataObject.DUnadvise on an OPC group object
function GroupUnAdvise(GroupIf: IUnknown; AsyncConnection: Longint): HResult;
var
DataIf: IDataObject;
begin
Result := E_FAIL;
try
DataIf := GroupIf as IDataObject;
except
DataIf := nil;
end;
if DataIf <> nil then
begin
Result := DataIf.DUnadvise(AsyncConnection);
end;
end;

// wrapper for setting up an IOPCDataCallback connection
function GroupAdvise2(GroupIf: IUnknown; OPCDataCallback: IOPCDataCallback;
var AsyncConnection: Longint): HResult;
var
ConnectionPointContainer: IConnectionPointContainer;
ConnectionPoint: IConnectionPoint;
begin
Result := E_FAIL;
try
ConnectionPointContainer := GroupIf as IConnectionPointContainer;
except
ConnectionPointContainer := nil;
end;
if ConnectionPointContainer <> nil then
begin
Result := ConnectionPointContainer.FindConnectionPoint(IID_IOPCDataCallback,
ConnectionPoint);
if Succeeded(Result) and (ConnectionPoint <> nil) then
begin
Result := ConnectionPoint.Advise(OPCDataCallback as IUnknown,
AsyncConnection);
end;
end;
end;

// wrapper for cancelling up an IOPCDataCallback connection
function GroupUnadvise2(GroupIf: IUnknown;
var AsyncConnection: Longint): HResult;
var
ConnectionPointContainer: IConnectionPointContainer;
ConnectionPoint: IConnectionPoint;
begin
Result := E_FAIL;
try
ConnectionPointContainer := GroupIf as IConnectionPointContainer;
except
ConnectionPointContainer := nil;
end;
if ConnectionPointContainer <> nil then
begin
Result := ConnectionPointContainer.FindConnectionPoint(IID_IOPCDataCallback,
ConnectionPoint);
if Succeeded(Result) and (ConnectionPoint <> nil) then
begin
Result := ConnectionPoint.Unadvise(AsyncConnection);
end;
end;
end;

// wrapper for IOPCSyncIO.Read (single item only)
function ReadOPCGroupItemValue(GroupIf: IUnknown; ItemServerHandle: OPCHANDLE;
var ItemValue: string; var ItemQuality: Word): HResult;
var
SyncIOIf: IOPCSyncIO;
Errors: PResultList;
ItemValues: POPCITEMSTATEARRAY;
begin
Result := E_FAIL;
try
SyncIOIf := GroupIf as IOPCSyncIO;
except
SyncIOIf := nil;
end;
if SyncIOIf <> nil then
begin
Result := SyncIOIf.Read(OPC_DS_CACHE, 1, @ItemServerHandle, ItemValues,
Errors);
if Succeeded(Result) then
begin
Result := Errors[0];
CoTaskMemFree(Errors);
ItemValue := VarToStr(ItemValues[0].vDataValue);
ItemQuality := ItemValues[0].wQuality;
VariantClear(ItemValues[0].vDataValue);
CoTaskMemFree(ItemValues);
end;
end;
end;

// wrapper for IOPCSyncIO.Write (single item only)
function WriteOPCGroupItemValue(GroupIf: IUnknown; ItemServerHandle: OPCHANDLE;
ItemValue: OleVariant): HResult;
var
SyncIOIf: IOPCSyncIO;
Errors: PResultList;
begin
Result := E_FAIL;
try
SyncIOIf := GroupIf as IOPCSyncIO;
except
SyncIOIf := nil;
end;
if SyncIOIf <> nil then
begin
Result := SyncIOIf.Write(1, @ItemServerHandle, @ItemValue, Errors);
if Succeeded(Result) then
begin
Result := Errors[0];
CoTaskMemFree(Errors);
end;
end;
end;
jupiterhunter 2006-11-26
  • 打赏
  • 举报
回复

function ServerAddGroup(ServerIf: IOPCServer; Name: string; Active: BOOL;
UpdateRate: DWORD; ClientHandle: OPCHANDLE; var GroupIf: IOPCItemMgt;
var ServerHandle: OPCHANDLE): HResult;
function GroupAddItem(GroupIf: IOPCItemMgt; ItemID: string;
ClientHandle: OPCHANDLE; DataType: TVarType;
var ServerHandle: OPCHANDLE; var CanonicalType: TVarType): HResult;
function GroupRemoveItem(GroupIf: IOPCItemMgt;
ServerHandle: OPCHANDLE): HResult;
function GroupAdviseTime(GroupIf: IUnknown; Sink: IAdviseSink;
var AsyncConnection: Longint): HResult;
function GroupUnAdvise(GroupIf: IUnknown; AsyncConnection: Longint): HResult;
function GroupAdvise2(GroupIf: IUnknown; OPCDataCallback: IOPCDataCallback;
var AsyncConnection: Longint): HResult;
function GroupUnadvise2(GroupIf: IUnknown;
var AsyncConnection: Longint): HResult;
function ReadOPCGroupItemValue(GroupIf: IUnknown; ItemServerHandle: OPCHANDLE;
var ItemValue: string; var ItemQuality: Word): HResult;
function WriteOPCGroupItemValue(GroupIf: IUnknown; ItemServerHandle: OPCHANDLE;
ItemValue: OleVariant): HResult;

implementation

// utility functions wrapping OPC methods

// wrapper for IOPCServer.AddGroup
function ServerAddGroup(ServerIf: IOPCServer; Name: string; Active: BOOL;
UpdateRate: DWORD; ClientHandle: OPCHANDLE; var GroupIf: IOPCItemMgt;
var ServerHandle: OPCHANDLE): HResult;
var
PercentDeadBand: Single;
RevisedUpdateRate: DWORD;
begin
Result := E_FAIL;
if ServerIf <> nil then
begin
PercentDeadBand := 0.0;
Result := ServerIf.AddGroup(PWideChar(WideString(Name)), Active, UpdateRate,
ClientHandle, nil, @PercentDeadBand, 0,
ServerHandle, RevisedUpdateRate, IOPCItemMgt,
IUnknown(GroupIf));
end;
if Failed(Result) then
begin
GroupIf := nil;
end;
end;

// wrapper for IOPCItemMgt.AddItems (single item only)
function GroupAddItem(GroupIf: IOPCItemMgt; ItemID: string;
ClientHandle: OPCHANDLE; DataType: TVarType;
var ServerHandle: OPCHANDLE; var CanonicalType: TVarType): HResult;
var
ItemDef: OPCITEMDEF;
Results: POPCITEMRESULTARRAY;
Errors: PResultList;
begin
if GroupIf = nil then
begin
Result := E_FAIL;
Exit;
end;
with ItemDef do
begin
szAccessPath := '';
szItemID := PWideChar(WideString(ItemID));
bActive := True;
hClient := ClientHandle;
dwBlobSize := 0;
pBlob := nil;
vtRequestedDataType := DataType;
end;
Result := GroupIf.AddItems(1, @ItemDef, Results, Errors);
if Succeeded(Result) then
begin
//Result := Errors[0];
try
if Succeeded(Result) then
begin
ServerHandle := Results[0].hServer;
CanonicalType := Results[0].vtCanonicalDataType;
end;
finally
CoTaskMemFree(Results[0].pBlob);
CoTaskMemFree(Results);
CoTaskMemFree(Errors);
end;
end;
end;

1,593

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 网络通信/分布式开发
社区管理员
  • 网络通信/分布式开发社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧