AdsSyncAddDeviceNotificationReq/AdsSyncDelDeviceNotificationReq

Delphi 5 Programm

unit frmAdsSyncAddDeviceNotificationReqUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, TcAdsDef, TcAdsApi, Buttons, ExtCtrls, Math;

//define your own message ids
const WM_ADSDEVICENOTIFICATION = WM_APP + 400;

type
  TfrmAdsSyncAddDeviceNotificationReq = class(TForm)
    BitBtn1: TBitBtn;
    Bevel1: TBevel;
    Button1: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    Button2: TButton;
    Label2: TLabel;
    Bevel2: TBevel;
    Button3: TButton;
    Button4: TButton;
    Memo2: TMemo;
    Label3: TLabel;
    Label4: TLabel;
    Edit1: TEdit;
    Label5: TLabel;
    Edit2: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  protected
    procedure WMAdsDeviceNotification( var Message: TMessage ); message WM_ADSDEVICENOTIFICATION;
  private
    { Private-Deklarationen }
    serverAddr : TAmsAddr;
    hDevNotification : Longword;
    hSymValNotification : Longword;
  public
    { Public-Deklarationen }
    procedure InitData( addr : TAmsAddr);
    destructor Destroy; override;
  end;

{$ALIGN OFF}
type TThreadListItem = record
     netId       : TAmsNetId;
     port        : Word;
       hNotify     : Longword;
       stamp       : TDateTime;
       cbSize      : Longword;
     destObj     : ^TStrings;
     data        : Byte;    //Array[1..ANYSIZE_ARRAY] of Byte;
end;
PThreadListItem = ^TThreadListItem;
{$ALIGN ON}

var
    DevThreadList : TThreadList;
    wndHandle :HWND;

implementation
{$R *.DFM}

//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.InitData( addr : TAmsAddr);
begin
     DevThreadList := TThreadList.Create();
     serverAddr := addr;
     wndHandle := Handle;
end;
//////////////////////////////////////////////////////////////////////////////
destructor TfrmAdsSyncAddDeviceNotificationReq.Destroy();
var X : integer;
begin
     //delete notifications on exit
     if hDevNotification <> 0 then
      Button2Click( self );
     if hSymValNotification <> 0 then
      Button4Click( self );

     With DevThreadList.LockList do
     try
    for X := 0 to Count-1 do
        FreeMem( Items[X], sizeof(TThreadListItem) + PThreadListItem(Items[X])^.cbSize - 1 );
     finally
    DevThreadList.UnlockList;
    DevThreadList.Destroy;
     end;

     inherited Destroy;
end;
//////////////////////////////////////////////////////////////////////////////
Procedure Callback(     pAddr:PAmsAddr; pNotification:PAdsNotificationHeader;   hUser:Longword ); stdcall;
var pItem : PThreadListItem;
    FileTime        : _FILETIME;
    SystemTime, LocalTime   : _SYSTEMTIME;
    TimeZoneInformation     : _TIME_ZONE_INFORMATION;
begin
    GetMem( pItem, sizeof(TThreadListItem) + pNotification^.cbSampleSize - 1 );
    pItem^.netId := pAddr^.netId;
    pItem^.port := pAddr^.port;
    pItem^.hNotify := pNotification^.hNotification;
    pItem^.cbSize := pNotification^.cbSampleSize;

    FileTime:=pNotification^.nTimeStamp;
    FileTimeToSystemTime(FileTime, SystemTime);
    GetTimeZoneInformation(TimeZoneInformation);
    SystemTimeToTzSpecificLocalTime(@TimeZoneInformation, SystemTime, LocalTime);
    pItem^.stamp := SystemTimeToDateTime(LocalTime);

    pItem^.destObj := Ptr(hUser);
    //copy the notification data
    Move( pNotification^.data, pItem^.data, pNotification^.cbSampleSize);
    with DevThreadList.LockList do
    try
       Add( pItem );
    finally
       DevThreadList.UnlockList;
       PostMessage( wndHandle, WM_ADSDEVICENOTIFICATION, 0, 0);
    end;
end;
//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.WMAdsDeviceNotification( var Message: TMessage );
var pItem           : PThreadListItem;
    X,i             : integer;
    dataAsStr           : String;
begin
    with DevThreadList.LockList do
    try
       for X := 0 to Count-1 do
       begin
      pItem := Items[X];
      { convert data to hex string }
      dataAsStr := '';
      for i:= 0 to math.Min(pItem^.cbSize-1, 20) do
          dataAsStr := dataAsStr + IntToHex( PByte(PAnsiChar(@pItem^.data)+i)^, 2 ) + ' ' ;

      pItem^.destObj^.Insert(0,Format( '%s %d.%d.%d.%d.%d.%d[%d], hNot:0x%x, size:%d, hUser:0x%x, data: %s',
                     [TimeToStr(pItem^.stamp), pItem^.netId.b[0], pItem^.netId.b[1], pItem^.netId.b[2],
                     pItem^.netId.b[3], pItem^.netId.b[4], pItem^.netId.b[5], pItem^.port,
                     pItem^.hNotify, pItem^.cbSize, Longword(pItem^.destObj),
                     dataAsStr ]));
      FreeMem( pItem, sizeof(TThreadListItem) + pItem^.cbSize - 1 ); //free item memory
       end;
       Clear();
    finally
       DevThreadList.UnlockList;
    end;
    inherited;
end;
//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.Button1Click(Sender: TObject);
var result : Longint;
    adsNotificationAttrib : TAdsNotificationAttrib;
begin
     adsNotificationAttrib.cbLength := 2;
     adsNotificationAttrib.nTransMode := ADSTRANS_SERVERONCHA;
     adsNotificationAttrib.nMaxDelay := 0;
     adsNotificationAttrib.nCycleTime := 0;

     result := AdsSyncAddDeviceNotificationReq( @serverAddr, ADSIGRP_DEVICE_DATA,
                        ADSIOFFS_DEVDATA_ADSSTATE,
                        @adsNotificationAttrib,
                        @Callback,
                        Longword(@Memo1.lines), @hDevNotification  );

     Label1.Caption := Format( 'AdsSyncAddDeviceNotificationReq() result: %d [0x%x], handle: 0x%x', [result, result, hDevNotification] );
     Memo1.Lines.Clear;
     Button1.Enabled := not(result = ADSERR_NOERR);
     Button2.Enabled := (result = ADSERR_NOERR);
end;
//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.Button2Click(  Sender: TObject);
var result : longint;
begin
     result := AdsSyncDelDeviceNotificationReq( @serverAddr, hDevNotification );
     hDevNotification := 0;
     Label1.Caption := Format( 'AdsSyncDelDeviceNotificationReq() result: %d [0x%x]', [result,result] );
     Button1.Enabled := true;
     Button2.Enabled := false;
end;

//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.Button3Click(  Sender: TObject);
var result : Longword;
    adsNotificationAttrib : TAdsNotificationAttrib;
begin
     adsNotificationAttrib.cbLength := 2; //INT
     adsNotificationAttrib.nTransMode := ADSTRANS_SERVERONCHA;
     adsNotificationAttrib.nMaxDelay := 10000000;//1 second
     adsNotificationAttrib.nCycleTime := 0;

     result := AdsSyncAddDeviceNotificationReq( @serverAddr, Longword(StrToInt(Edit1.Text)),
                        Longword(StrToInt(Edit2.Text)),
                        @adsNotificationAttrib,
                        @Callback,
                        Longword(@Memo2.lines), @hSymValNotification  );

     Label3.Caption := Format( 'AdsSyncAddDeviceNotificationReq() result: %d [0x%x], handle: 0x%x', [result, result, hSymValNotification] );
     Memo2.Lines.Clear;
     Button3.Enabled := not(result = ADSERR_NOERR);
     Button4.Enabled := (result = ADSERR_NOERR);
end;
//////////////////////////////////////////////////////////////////////////////
procedure TfrmAdsSyncAddDeviceNotificationReq.Button4Click(  Sender: TObject);
var result : Longword;
begin
     result := AdsSyncDelDeviceNotificationReq( @serverAddr, hSymValNotification );
     hSymValNotification := 0;
     Label3.Caption := Format( 'AdsSyncDelDeviceNotificationReq() result: %d [0x%x]', [result,result] );
     Button3.Enabled := true;
     Button4.Enabled := false;
end;

end.