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.