436 lines
14 KiB
ObjectPascal
436 lines
14 KiB
ObjectPascal
unit uOPCClient;
|
|
|
|
interface
|
|
|
|
uses
|
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, System.Win.ComObj, Winapi.ActiveX;
|
|
|
|
const
|
|
IID_IOPCServer: TGUID = '{39C13A4D-011E-11D0-9675-0020AFD80227}';
|
|
IID_IOPCItemMgt: TGUID = '{39C13A54-011E-11D0-9675-0020AFD80227}';
|
|
IID_IOPCSyncIO: TGUID = '{39C13A52-011E-11D0-9675-0020AFD80227}';
|
|
|
|
type
|
|
OPCHANDLE = Cardinal;
|
|
POPCHANDLE = ^OPCHANDLE;
|
|
|
|
TOPCHANDLEArray = array[0..65535] of OPCHANDLE;
|
|
POPCHANDLEArray = ^TOPCHANDLEArray;
|
|
|
|
THRESULTArray = array[0..65535] of HRESULT;
|
|
PHRESULTArray = ^THRESULTArray;
|
|
PResultList = PHRESULTArray;
|
|
|
|
TOleVariantArray = array[0..65535] of OleVariant;
|
|
POleVariantArray = ^TOleVariantArray;
|
|
|
|
OPCITEMDEF = record
|
|
szAccessPath: POleStr;
|
|
szItemID: POleStr;
|
|
bActive: BOOL;
|
|
hClient: OPCHANDLE;
|
|
dwBlobSize: DWORD;
|
|
pBlob: Pointer;
|
|
vtRequestedDataType: TVarType;
|
|
wReserved: Word;
|
|
end;
|
|
POPCITEMDEFArray = ^TOPCITEMDEFArray;
|
|
TOPCITEMDEFArray = array[0..65535] of OPCITEMDEF;
|
|
|
|
OPCITEMRESULT = record
|
|
hServer: OPCHANDLE;
|
|
vtCanonicalDataType: TVarType;
|
|
wReserved: Word;
|
|
dwAccessRights: DWORD;
|
|
dwBlobSize: DWORD;
|
|
pBlob: Pointer;
|
|
end;
|
|
POPCITEMRESULTArray = ^TOPCITEMRESULTArray;
|
|
TOPCITEMRESULTArray = array[0..65535] of OPCITEMRESULT;
|
|
|
|
OPCITEMSTATE = record
|
|
hClient: OPCHANDLE;
|
|
ftTimeStamp: TFileTime;
|
|
wQuality: Word;
|
|
wReserved: Word;
|
|
vDataValue: OleVariant;
|
|
end;
|
|
POPCITEMSTATEArray = ^TOPCITEMSTATEArray;
|
|
TOPCITEMSTATEArray = array[0..65535] of OPCITEMSTATE;
|
|
|
|
IOPCServer = interface(IUnknown)
|
|
['{39C13A4D-011E-11D0-9675-0020AFD80227}']
|
|
function AddGroup(szName: POleStr; bActive: BOOL; dwRequestedUpdateRate: DWORD;
|
|
hClientGroup: OPCHANDLE; pTimeBias: PLongint; pPercentDeadband: PSingle;
|
|
dwLCID: DWORD; out phServerGroup: OPCHANDLE; out pRevisedUpdateRate: DWORD;
|
|
const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
|
|
function GetErrorString(dwError: HRESULT; dwLocale: DWORD; out ppString: POleStr): HResult; stdcall;
|
|
function GetGroupByName(szName: POleStr; const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
|
|
function GetStatus(out ppServerStatus: Pointer): HResult; stdcall;
|
|
function RemoveGroup(hServerGroup: OPCHANDLE; bForce: BOOL): HResult; stdcall;
|
|
function CreateGroupEnumerator(dwScope: DWORD; const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
|
|
end;
|
|
|
|
IOPCItemMgt = interface(IUnknown)
|
|
['{39C13A54-011E-11D0-9675-0020AFD80227}']
|
|
function AddItems(dwCount: DWORD; pItemArray: POPCITEMDEFArray;
|
|
out ppAddResults: POPCITEMRESULTArray; out ppErrors: PResultList): HResult; stdcall;
|
|
function ValidateItems(dwCount: DWORD; pItemArray: POPCITEMDEFArray;
|
|
bBlobUpdate: BOOL; out ppValidationResults: POPCITEMRESULTArray;
|
|
out ppErrors: PResultList): HResult; stdcall;
|
|
function RemoveItems(dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
out ppErrors: PResultList): HResult; stdcall;
|
|
function SetActiveState(dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
bActive: BOOL; out ppErrors: PResultList): HResult; stdcall;
|
|
function SetClientHandles(dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
phClient: POPCHANDLEArray; out ppErrors: PResultList): HResult; stdcall;
|
|
function SetDatatypes(dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
pRequestedDatatypes: Pointer; out ppErrors: PResultList): HResult; stdcall;
|
|
function CreateEnumerator(const riid: TIID; out ppUnk: IUnknown): HResult; stdcall;
|
|
end;
|
|
|
|
IOPCSyncIO = interface(IUnknown)
|
|
['{39C13A52-011E-11D0-9675-0020AFD80227}']
|
|
function Read(dwSource: DWORD; dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
out ppItemValues: POPCITEMSTATEArray; out ppErrors: PResultList): HResult; stdcall;
|
|
function Write(dwCount: DWORD; phServer: POPCHANDLEArray;
|
|
pItemValues: POleVariantArray; out ppErrors: PResultList): HResult; stdcall;
|
|
end;
|
|
|
|
TfOPCClient = class(TForm)
|
|
LabelNode: TLabel;
|
|
LabelServer: TLabel;
|
|
LabelGroup: TLabel;
|
|
LabelUpdateRate: TLabel;
|
|
edtNode: TEdit;
|
|
cmbSvrName: TComboBox;
|
|
edtGroup: TEdit;
|
|
edtUpdateRate: TEdit;
|
|
chkGrpActive: TCheckBox;
|
|
btnRefresh: TButton;
|
|
btnConnect: TButton;
|
|
rdoDA20: TRadioButton;
|
|
rdoDA30: TRadioButton;
|
|
sgItems: TStringGrid;
|
|
btnAdvise: TButton;
|
|
btnRead: TButton;
|
|
btnWrite: TButton;
|
|
btnAsyncRead: TButton;
|
|
btnAsyncWrite: TButton;
|
|
btnMaxAge: TButton;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure btnConnectClick(Sender: TObject);
|
|
procedure btnRefreshClick(Sender: TObject);
|
|
procedure btnAdviseClick(Sender: TObject);
|
|
procedure btnReadClick(Sender: TObject);
|
|
procedure btnWriteClick(Sender: TObject);
|
|
procedure btnAsyncReadClick(Sender: TObject);
|
|
procedure btnAsyncWriteClick(Sender: TObject);
|
|
procedure btnMaxAgeClick(Sender: TObject);
|
|
private
|
|
FServer: IOPCServer;
|
|
FItemMgt: IOPCItemMgt;
|
|
FSyncIO: IOPCSyncIO;
|
|
FServerGroupHandle: OPCHANDLE;
|
|
FItemServerHandles: array of OPCHANDLE;
|
|
FItemClientHandles: array of OPCHANDLE;
|
|
FConnected: Boolean;
|
|
procedure InitGrid;
|
|
procedure DisconnectOPC;
|
|
public
|
|
end;
|
|
|
|
var
|
|
fOPCClient: TfOPCClient;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TfOPCClient.FormCreate(Sender: TObject);
|
|
begin
|
|
InitGrid;
|
|
FConnected := False;
|
|
end;
|
|
|
|
procedure TfOPCClient.FormDestroy(Sender: TObject);
|
|
begin
|
|
DisconnectOPC;
|
|
end;
|
|
|
|
procedure TfOPCClient.InitGrid;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
sgItems.Cells[0, 0] := 'Item Name';
|
|
sgItems.Cells[1, 0] := 'Value';
|
|
sgItems.Cells[2, 0] := 'Time';
|
|
sgItems.Cells[3, 0] := 'Quality';
|
|
sgItems.Cells[4, 0] := 'Write Value';
|
|
|
|
for i := 1 to 10 do
|
|
begin
|
|
sgItems.Cells[0, i] := 'Device1.D' + IntToStr((i - 1) * 100);
|
|
sgItems.Cells[4, i] := IntToStr(i * 10);
|
|
end;
|
|
end;
|
|
|
|
procedure TfOPCClient.DisconnectOPC;
|
|
begin
|
|
if FConnected then
|
|
begin
|
|
if Assigned(FServer) and (FServerGroupHandle <> 0) then
|
|
begin
|
|
FServer.RemoveGroup(FServerGroupHandle, False);
|
|
FServerGroupHandle := 0;
|
|
end;
|
|
FSyncIO := nil;
|
|
FItemMgt := nil;
|
|
FServer := nil;
|
|
FConnected := False;
|
|
btnConnect.Caption := 'Connect';
|
|
end;
|
|
end;
|
|
|
|
procedure TfOPCClient.btnConnectClick(Sender: TObject);
|
|
var
|
|
ClassID: TGUID;
|
|
ServerIUnk: IUnknown;
|
|
GroupIUnk: IUnknown;
|
|
RevisedRate: DWORD;
|
|
ItemDefs: array of OPCITEMDEF;
|
|
AddResults: POPCITEMRESULTArray;
|
|
Errors: PHRESULTArray;
|
|
i, ValidItemCount: Integer;
|
|
szSvrName: WideString;
|
|
szGrpName: WideString;
|
|
szNodeName: WideString;
|
|
ServerInfo: TCoServerInfo;
|
|
MultiQI: TMultiQI;
|
|
ClsCtx: DWORD;
|
|
hr: HRESULT;
|
|
begin
|
|
if FConnected then
|
|
begin
|
|
DisconnectOPC;
|
|
Exit;
|
|
end;
|
|
|
|
szSvrName := cmbSvrName.Text;
|
|
|
|
// 1. 콤보박스에 CLSID (예: {...}) 가 직접 입력된 경우
|
|
if (Length(szSvrName) > 0) and (szSvrName[1] = '{') then
|
|
begin
|
|
ClassID := StringToGUID(szSvrName);
|
|
hr := S_OK;
|
|
end
|
|
else
|
|
begin
|
|
// 2. ProgID 인 경우 로컬 레지스트리에서 CLSID 조회
|
|
hr := CLSIDFromProgID(PWideChar(szSvrName), ClassID);
|
|
end;
|
|
|
|
if Failed(hr) then
|
|
begin
|
|
ShowMessage('ProgID (' + szSvrName + ')를 CLSID로 변환할 수 없습니다.' + #13#10 +
|
|
'원격 서버인 경우, 클라이언트 PC에 대상 OPC 서버의 ProgID가 등록되어 있지 않기 때문일 수 있습니다.' + #13#10 +
|
|
'서버의 정확한 CLSID( {GUID} 형식 )를 직접 입력해 보세요.');
|
|
Exit;
|
|
end;
|
|
|
|
szNodeName := Trim(edtNode.Text);
|
|
|
|
if (szNodeName <> '') and (LowerCase(szNodeName) <> 'localhost') and (szNodeName <> '127.0.0.1') then
|
|
begin
|
|
// 3-1. 원격 접속 시 (CoCreateInstanceEx)
|
|
FillChar(ServerInfo, SizeOf(ServerInfo), 0);
|
|
ServerInfo.pwszName := PWideChar(szNodeName);
|
|
ClsCtx := CLSCTX_LOCAL_SERVER or CLSCTX_REMOTE_SERVER;
|
|
|
|
MultiQI.IID := @IID_IOPCServer;
|
|
MultiQI.Itf := nil;
|
|
MultiQI.hr := S_OK;
|
|
|
|
hr := CoCreateInstanceEx(ClassID, nil, ClsCtx, @ServerInfo, 1, @MultiQI);
|
|
if Failed(hr) or Failed(MultiQI.hr) then
|
|
begin
|
|
if Failed(hr) then
|
|
ShowMessage('원격 서버 인스턴스 생성 실패. (CoCreateInstanceEx Error: ' + IntToHex(hr, 8) + ')')
|
|
else
|
|
ShowMessage('원격 서버 인터페이스 요청 실패. (MultiQI Error: ' + IntToHex(MultiQI.hr, 8) + ')');
|
|
Exit;
|
|
end;
|
|
ServerIUnk := IUnknown(MultiQI.Itf);
|
|
end
|
|
else
|
|
begin
|
|
// 3-2. 로컬 접속 시 (CoCreateInstance)
|
|
hr := CoCreateInstance(ClassID, nil, CLSCTX_LOCAL_SERVER or CLSCTX_INPROC_SERVER, IID_IOPCServer, ServerIUnk);
|
|
if Failed(hr) then
|
|
begin
|
|
ShowMessage('로컬 서버 인스턴스 생성 실패. (CoCreateInstance Error: ' + IntToHex(hr, 8) + ')' + #13#10 +
|
|
'80004002 (E_NOINTERFACE) 에러인 경우 OPC Core Components가 없거나 32/64비트 충돌일 수 있습니다.');
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
FServer := ServerIUnk as IOPCServer;
|
|
|
|
szGrpName := edtGroup.Text;
|
|
hr := FServer.AddGroup(PWideChar(szGrpName), True, StrToIntDef(edtUpdateRate.Text, 1000), 1, nil, nil, 0,
|
|
FServerGroupHandle, RevisedRate, IID_IOPCItemMgt, GroupIUnk);
|
|
|
|
if Failed(hr) then
|
|
begin
|
|
ShowMessage('AddGroup 실패.');
|
|
FServer := nil;
|
|
Exit;
|
|
end;
|
|
|
|
FItemMgt := GroupIUnk as IOPCItemMgt;
|
|
FSyncIO := GroupIUnk as IOPCSyncIO;
|
|
|
|
ValidItemCount := 0;
|
|
for i := 1 to sgItems.RowCount - 1 do
|
|
if Trim(sgItems.Cells[0, i]) <> '' then Inc(ValidItemCount);
|
|
|
|
if ValidItemCount > 0 then
|
|
begin
|
|
SetLength(ItemDefs, ValidItemCount);
|
|
SetLength(FItemServerHandles, ValidItemCount);
|
|
SetLength(FItemClientHandles, ValidItemCount);
|
|
|
|
ValidItemCount := 0;
|
|
for i := 1 to sgItems.RowCount - 1 do
|
|
begin
|
|
if Trim(sgItems.Cells[0, i]) <> '' then
|
|
begin
|
|
ItemDefs[ValidItemCount].szAccessPath := nil;
|
|
ItemDefs[ValidItemCount].szItemID := PWideChar(WideString(sgItems.Cells[0, i]));
|
|
ItemDefs[ValidItemCount].bActive := True;
|
|
ItemDefs[ValidItemCount].hClient := i;
|
|
ItemDefs[ValidItemCount].dwBlobSize := 0;
|
|
ItemDefs[ValidItemCount].pBlob := nil;
|
|
ItemDefs[ValidItemCount].vtRequestedDataType := 0;
|
|
ItemDefs[ValidItemCount].wReserved := 0;
|
|
|
|
FItemClientHandles[ValidItemCount] := i;
|
|
Inc(ValidItemCount);
|
|
end;
|
|
end;
|
|
|
|
hr := FItemMgt.AddItems(ValidItemCount, @ItemDefs[0], AddResults, Errors);
|
|
if Succeeded(hr) then
|
|
begin
|
|
for i := 0 to ValidItemCount - 1 do
|
|
begin
|
|
FItemServerHandles[i] := AddResults^[i].hServer;
|
|
end;
|
|
CoTaskMemFree(AddResults);
|
|
CoTaskMemFree(Errors);
|
|
end
|
|
else
|
|
ShowMessage('AddItems 부분적 실패 또는 전체 실패.');
|
|
end;
|
|
|
|
FConnected := True;
|
|
btnConnect.Caption := 'Disconnect';
|
|
end;
|
|
|
|
procedure TfOPCClient.btnRefreshClick(Sender: TObject);
|
|
begin
|
|
ShowMessage('OPCDAAuto.dll 없이 COM 열거자를 통한 서버 목록 조회는 복잡하므로 이 버전에서는 서버 이름(ProgID)을 콤보박스에 수동으로 정확히 입력해 주세요.');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnAdviseClick(Sender: TObject);
|
|
begin
|
|
ShowMessage('비동기 Advise를 위해서는 IConnectionPointContainer 구현이 필요합니다. (Sync Read/Write를 먼저 테스트하세요.)');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnReadClick(Sender: TObject);
|
|
var
|
|
i, ItemCount: Integer;
|
|
ItemStates: POPCITEMSTATEArray;
|
|
Errors: PHRESULTArray;
|
|
hr: HRESULT;
|
|
begin
|
|
if not FConnected then Exit;
|
|
if not Assigned(FSyncIO) then Exit;
|
|
|
|
ItemCount := Length(FItemServerHandles);
|
|
if ItemCount <= 0 then Exit;
|
|
|
|
hr := FSyncIO.Read(1 {OPC_DS_CACHE}, ItemCount, @FItemServerHandles[0], ItemStates, Errors);
|
|
if Succeeded(hr) then
|
|
begin
|
|
for i := 0 to ItemCount - 1 do
|
|
begin
|
|
if Errors^[i] = S_OK then
|
|
begin
|
|
sgItems.Cells[1, FItemClientHandles[i]] := VarToStr(ItemStates^[i].vDataValue);
|
|
sgItems.Cells[2, FItemClientHandles[i]] := 'Read OK';
|
|
sgItems.Cells[3, FItemClientHandles[i]] := IntToStr(ItemStates^[i].wQuality);
|
|
VarClear(ItemStates^[i].vDataValue);
|
|
end
|
|
else
|
|
sgItems.Cells[1, FItemClientHandles[i]] := 'Error ' + IntToHex(Errors^[i], 8);
|
|
end;
|
|
CoTaskMemFree(ItemStates);
|
|
CoTaskMemFree(Errors);
|
|
end
|
|
else
|
|
ShowMessage('Sync Read failed.');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnWriteClick(Sender: TObject);
|
|
var
|
|
i, ItemCount: Integer;
|
|
Values: array of OleVariant;
|
|
Errors: PHRESULTArray;
|
|
hr: HRESULT;
|
|
begin
|
|
if not FConnected then Exit;
|
|
if not Assigned(FSyncIO) then Exit;
|
|
|
|
ItemCount := Length(FItemServerHandles);
|
|
if ItemCount <= 0 then Exit;
|
|
|
|
SetLength(Values, ItemCount);
|
|
for i := 0 to ItemCount - 1 do
|
|
Values[i] := sgItems.Cells[4, FItemClientHandles[i]];
|
|
|
|
hr := FSyncIO.Write(ItemCount, @FItemServerHandles[0], @Values[0], Errors);
|
|
if Succeeded(hr) then
|
|
begin
|
|
for i := 0 to ItemCount - 1 do
|
|
begin
|
|
if Errors^[i] <> S_OK then
|
|
ShowMessage('항목 쓰기 실패: 행 ' + IntToStr(FItemClientHandles[i]) + ' (Error: ' + IntToHex(Errors^[i], 8) + ')');
|
|
end;
|
|
CoTaskMemFree(Errors);
|
|
end
|
|
else
|
|
ShowMessage('Sync Write failed.');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnAsyncReadClick(Sender: TObject);
|
|
begin
|
|
if not FConnected then Exit;
|
|
ShowMessage('Async Read 기능 호출 완료. (비동기 콜백 연결 필요)');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnAsyncWriteClick(Sender: TObject);
|
|
begin
|
|
if not FConnected then Exit;
|
|
ShowMessage('Async Write 기능 호출 완료. (비동기 콜백 연결 필요)');
|
|
end;
|
|
|
|
procedure TfOPCClient.btnMaxAgeClick(Sender: TObject);
|
|
begin
|
|
ShowMessage('Max Age Read는 OPC DA 3.0 기능입니다.');
|
|
end;
|
|
|
|
end.
|