📄 main.~pas
字号:
unit main;
interface
uses
{$IFDEF VER140}
Variants,
{$ENDIF}
{$IFDEF VER150}
Variants,
{$ENDIF}
{$IFDEF VER170}
Variants,
{$ENDIF}
{$IFDEF VER180}
Variants,
{$ENDIF}
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, RzButton, RzCmboBx, ExtCtrls, RzPanel, ComCtrls,
RzListVw,OPCDA,OPCenum,IniFiles, Grids,OPCtypes, ComObj, ActiveX,OPCutils,
IdComponent, IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP,
IdBaseComponent, IdMessage, Buttons, TFlatComboBoxUnit,
TFlatRadioButtonUnit, TFlatGroupBoxUnit, TFlatMemoUnit, TFlatButtonUnit,
TFlatPanelUnit, RzBckgnd, RzLine, RzLabel;
type
TReadThread = class(TThread)
procedure Execute; override;
//procedure EnumLocalUsersAndGroups(i:Integer);
end;
const
RPC_C_AUTHN_LEVEL_NONE = 1;
RPC_C_IMP_LEVEL_IMPERSONATE = 3;
EOAC_NONE = 0;
const
CM_RESTORE = WM_USER + $1000;
MYappname = 'splc';
type
TOPCAdviseSink = class(TInterfacedObject, IAdviseSink)
public
procedure OnDataChange(const formatetc: TFormatEtc;
const stgmed: TStgMedium); stdcall;
procedure OnViewChange(dwAspect: Longint; lindex: Longint); stdcall;
procedure OnRename(const mk: IMoniker); stdcall;
procedure OnSave; stdcall;
procedure OnClose; stdcall;
end;
TOPCDataCallback = class(TInterfacedObject, IOPCDataCallback)
public
function OnDataChange(dwTransid: DWORD; hGroup: OPCHANDLE;
hrMasterquality: HResult; hrMastererror: HResult; dwCount: DWORD;
phClientItems: POPCHANDLEARRAY; pvValues: POleVariantArray;
pwQualities: PWordArray; pftTimeStamps: PFileTimeArray;
pErrors: PResultList): HResult; stdcall;
function OnReadComplete(dwTransid: DWORD; hGroup: OPCHANDLE;
hrMasterquality: HResult; hrMastererror: HResult; dwCount: DWORD;
phClientItems: POPCHANDLEARRAY; pvValues: POleVariantArray;
pwQualities: PWordArray; pftTimeStamps: PFileTimeArray;
pErrors: PResultList): HResult; stdcall;
function OnWriteComplete(dwTransid: DWORD; hGroup: OPCHANDLE;
hrMastererr: HResult; dwCount: DWORD; pClienthandles: POPCHANDLEARRAY;
pErrors: PResultList): HResult; stdcall;
function OnCancelComplete(dwTransid: DWORD; hGroup: OPCHANDLE):
HResult; stdcall;
end;
type
TFMain = class(TForm)
Button2: TButton;
FlatPanel1: TFlatPanel;
Panel5: TFlatPanel;
Image4: TImage;
tippanel: TFlatPanel;
Label26: TLabel;
Label37: TLabel;
FlatPanel2: TFlatPanel;
FlatButton1: TFlatButton;
IdMessage1: TIdMessage;
IdSMTP1: TIdSMTP;
RzGroupBox1: TRzGroupBox;
RzComboBox1: TRzComboBox;
RzPanel1: TRzPanel;
RzPanel2: TRzPanel;
Label4: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Label5: TLabel;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Label6: TLabel;
Edit13: TEdit;
Edit14: TEdit;
Edit15: TEdit;
Edit16: TEdit;
Edit17: TEdit;
Edit18: TEdit;
Label7: TLabel;
Edit19: TEdit;
Edit20: TEdit;
Edit21: TEdit;
Edit22: TEdit;
Edit23: TEdit;
Edit24: TEdit;
FlatButton2: TFlatButton;
FlatButton3: TFlatButton;
Shape1: TShape;
RzSeparator1: TRzSeparator;
Label1: TLabel;
Shape2: TShape;
Label2: TLabel;
Shape3: TShape;
Label3: TLabel;
Shape4: TShape;
Label8: TLabel;
Shape5: TShape;
Label9: TLabel;
Shape6: TShape;
Label10: TLabel;
Shape7: TShape;
Label11: TLabel;
RzLine1: TRzLine;
RzLine2: TRzLine;
RzLine3: TRzLine;
RzLine4: TRzLine;
RzLine5: TRzLine;
RzLine6: TRzLine;
RzLine7: TRzLine;
RzLine8: TRzLine;
RzLine9: TRzLine;
RzLine10: TRzLine;
RzLine11: TRzLine;
RzLine12: TRzLine;
RzListView1: TRzListView;
RzLabel1: TRzLabel;
Image3: TImage;
RzLabel2: TRzLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
RzSeparator2: TRzSeparator;
RzLine13: TRzLine;
RzLine14: TRzLine;
RzLine15: TRzLine;
RzLine16: TRzLine;
RzLine17: TRzLine;
RzLine18: TRzLine;
RzLine19: TRzLine;
RzLine20: TRzLine;
Label16: TLabel;
Label17: TLabel;
Label18: TLabel;
Label19: TLabel;
Label20: TLabel;
procedure FormCreate(Sender: TObject);
procedure FlatButton2Click(Sender: TObject);
procedure FlatButton1Click(Sender: TObject);
procedure FlatPanel2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel5MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure RzGroupBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure tippanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormShow(Sender: TObject);
procedure FlatButton3Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Image3DblClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
sGroupCount:Integer;
OPCServerList: TOPCServerList;
CATIDs: array of TGUID;
ServerNames: TStringList;
LList:array[1..10,1..20] of string;
ServerIf: IOPCServer;
GroupIf:array[1..10] of IOPCItemMgt;
GroupIfTest:IOPCItemMgt;
GroupHandle:array[1..10] of OPCHANDLE;
GroupTestHandle :OPCHANDLE;
ItemHandle:array[1..10,2..20] of OPCHANDLE;
MyItemHandle:array[1..10,1..20] of OPCHANDLE;
ItemTestHandle:OPCHANDLE;
ItemType: TVarType;
ItemValue: string;
ItemQuality: Word;
HR: HResult;
AdviseSink: IAdviseSink;
AsyncConnection: Longint;
OPCDataCallback: IOPCDataCallback;
StartTime: TDateTime;
procedure createparams(var params: tcreateparams); override;
procedure restorerequest(var message: tmessage); message CM_RESTORE;
procedure EditValue(var An,Value:string;Aj:Integer);
procedure EditNotGood(var An:string;value:string;Aj:Integer);
procedure EditBadValue(var An:string);
end;
var
FMain: TFMain;
implementation
uses UserUnit;
{$R *.dfm}
procedure TReadThread.Execute;
var
I,J:Integer;
HR: HResult;
ItemValue: string;
ItemQuality: Word;
begin
for i:=1 to FMain.sGroupCount do
for J:=2 to 20 do
begin
if FMain.LList[i,j]<>'' then
begin
LogActivity(PChar('FMain.ItemHandle['+inttostr(i)+','+inttostr(j)+']'),PChar(IntToStr(OPCHANDLE(FMain.ItemHandle[i,j]))) );
HR := ReadOPCGroupItemValue(FMain.GroupIf[i],FMain.ItemHandle[i,j], ItemValue, ItemQuality);
if Succeeded(HR) then
begin
if (ItemQuality and OPC_QUALITY_MASK) = OPC_QUALITY_GOOD then
begin
FMain.EditValue(FMain.LList[i,1],ItemValue,J);
end
else begin
FMain.EditNotGood(FMain.LList[i,1],'NotGood',j);
end;
end
else begin
FMain.EditBadValue(FMain.LList[i,1]);
end;
end;
end;
end;
procedure TFMain.createparams(var params:tcreateparams);
begin
inherited CreateParams(Params);
params.WinClassName := MYappname;
end;
procedure TFMain.restorerequest(var message:tmessage);
begin
if isiconic(application.Handle) = true then
application.Restore
else application.BringToFront;
end;
procedure TOPCAdviseSink.OnDataChange(const formatetc: TFormatEtc;
const stgmed: TStgMedium);
var
PG: POPCGROUPHEADER;
PI1: POPCITEMHEADER1ARRAY;
PI2: POPCITEMHEADER2ARRAY;
PV: POleVariant;
I: Integer;
PStr: PWideChar;
NewValue: string;
WithTime: Boolean;
ClientHandle: OPCHANDLE;
Quality: Word;
begin
//stgmed.
if (formatetc.cfFormat <> OPCSTMFORMATDATA) and
(formatetc.cfFormat <> OPCSTMFORMATDATATIME) then Exit;
WithTime := formatetc.cfFormat = OPCSTMFORMATDATATIME;
PG := GlobalLock(stgmed.hGlobal);
if PG <> nil then
begin
PI1 := Pointer(PChar(PG) + SizeOf(OPCGROUPHEADER));
PI2 := Pointer(PI1);
if Succeeded(PG.hrStatus) then
begin
for I := 0 to PG.dwItemCount-1 do
begin
if WithTime then
begin
PV := POleVariant(PChar(PG) + PI1[I].dwValueOffset);
ClientHandle := PI1[I].hClient;
Quality := (PI1[I].wQuality and OPC_QUALITY_MASK);
end
else
begin
PV := POleVariant(PChar(PG) + PI2[I].dwValueOffset);
ClientHandle := PI2[I].hClient;
Quality := (PI2[I].wQuality and OPC_QUALITY_MASK);
end;
if Quality = OPC_QUALITY_GOOD then
begin
if TVarData(PV^).VType <> VT_BSTR then
begin
NewValue := VarToStr(PV^);
end
else
begin
PStr := PWideChar(PChar(PV) + SizeOf(OleVariant) + 4);
NewValue := WideString(PStr);
end;
if WithTime then
begin
LogActivity(PChar('ClientHandle: '+inttostr(OPCHANDLE(ClientHandle))),pchar(NewValue));
end
else
begin
LogActivity(PChar(' Test: '+inttostr(OPCHANDLE(ClientHandle))),pchar(NewValue));
end;
end
else
begin
LogActivity(PChar('Test: '),pchar('but quality not good'));
end;
end;
end;
GlobalUnlock(stgmed.hGlobal);
end;
end;
procedure TOPCAdviseSink.OnViewChange(dwAspect: Longint; lindex: Longint);
begin
end;
procedure TOPCAdviseSink.OnRename(const mk: IMoniker);
begin
end;
procedure TOPCAdviseSink.OnSave;
begin
end;
procedure TOPCAdviseSink.OnClose;
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -