Sample with extended functions (for multithreaded applications)

The application is a simple Delphi-MDI application. Each Child window (GUI) has its own ADS thread (ADS port for data communication) in which the extended ADS functions are called. The application demonstrates how ADS function calls (longer actions) can be outsourced to a separate thread without blocking the main thread. The application can be used as a starting point for your own implementations.

The ADS thread functions were implemented in a separate unit: AdsThread.pas. The Child window functions were similarly implemented in a separate unit: CHILDWIN.PAS / CHILDWIN.DFM.

Communication between the GUI (Child window) and the ADS thread was realized with the aid of WM messages (PostThreadMessage/SendMessage functions). As a result, the main thread was decoupled from the ADS threads. However, other synchronization mechanisms can also be used.

Requirements:

Delphi 7.0 + update 7.1 or higher;
TcAdsDLL.DLL;
TcAdsDEF.pas and TcAdsAPI.pas, contained in the file delphi_adsdll_api_units.zip, if you want to compile the source code yourself;

Sample with extended functions (for multithreaded applications) 1:

Description

Start the associated PLC project Sample.pro and MDIAPP.exe. Using File -> New, a new ADS-Client connection and the associated GUI windows can be created. Create several Child windows.

PROGRAM MAIN
VAR
    vUINT AT%MB0 :UINT;
END_VAR

vUINT := vUINT +1;

The following actions are started with a mouse click on the corresponding buttons:

Start read loop...: reads the vUINT variable synchronously (by address) in a For loop (duration approx. 10 seconds).
Start write loop...: writes the vUINT variable synchronously (by address) in a For loop (duration approx. 10 seconds).
Start read by name loop...: reads the vUINT variable synchronously (by variable name) in a For loop (duration approx. 10 seconds).
Add notification: adds a notification. Whenever the value of the vUINT variable changes, it is transmitted to the Client application and displayed in Memo Control (notification messages).
Delete notification: deletes the notification.
Start PLC: starts the PLC.
Stop PLC: stops the PLC.
Exit thread: exits the ADS thread (exits the TThread-Execute call).

In order to test, select for example the Start read loop... button in one window and the Start write loop... button in another window.

Delphi 7 program

Main.pas:

unit MAIN;
interface
                    
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, CHILDWIN, TcAdsDef, TcAdsAPI, AdsThread;
const
  DEFAULT_SERVERADDR : TAmsAddr =    ( netID : ( b : (0,0,0,0,0,0 ) );
//  DEFAULT_SERVERADDR : TAmsAddr =    ( netID : ( b : (172,16,7,53,1,1 ) );
                      port : 801);
  DEFAULT_ADSTIMEOUT : Longint = 5000;  {default ads timeout = 5 seconds}
  DEFAULT_IG  : Longint = $00004020;    {memory range}
  DEFAULT_IO  : Longint = $00000000;    {byte offset of the PLC variable}
type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    StatusBar: TStatusBar;
    ImageList1: TImageList;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileCloseItem: TMenuItem;
    FileExitItem: TMenuItem;
    FileExit1: TAction;
    FileClose1: TWindowClose;
    Window1: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowTileItem2: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowTileVertical1: TWindowTileVertical;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowArrangeAll1: TWindowArrange;
    ToolBar2: TToolBar;
    ToolButton9: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    procedure FileNew1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
  private
    { Private declarations }
    procedure CreateMDIChild(const Name: string);
  public
    { Public declarations }
  end;
var
  MainForm: TMainForm;
implementation
{$R *.dfm}
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.CreateMDIChild(const Name: string);
var
  Child: TMDIChild;
  params : TAdsParams;
begin
  params.hOwner := 0;
  params.server := DEFAULT_SERVERADDR;
  params.timeout := DEFAULT_ADSTIMEOUT;
  params.varIG   := DEFAULT_IG;
  params.varIO := DEFAULT_IO;
  params.length := 2; // INT
  params.name := 'MAIN.VUINT';
  { create a new MDI child window }
  Child := TMDIChild.Create(Application, params );
  Child.Caption := Name;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FileNew1Execute(Sender: TObject);
begin
  CreateMDIChild('TwinCAT TcAdsDll Client ' + IntToStr(MDIChildCount + 1));
end;
///////////////////////////////////////////////////////////////////////////////
procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end;
end.

ChildWin.pas

unit CHILDWIN;
interface
uses Windows, Classes, Messages, Graphics, Forms, Controls, StdCtrls, TcAdsDef, TcAdsApi, AdsThread,
  ComCtrls;
type
  TMDIChild = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Memo2: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Memo3: TMemo;
    Label3: TLabel;
    Button7: TButton;
    Button8: TButton;
    ProgressBar1: TProgressBar;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    adsThread : TAdsThread;
    procedure OnNotification(var Message: TMessage); message WM_NOTIFICATION;
    procedure OnReadWrite(var Message: TMessage); message WM_READWRITE;
    procedure OnLog(var Message: TMessage); message WM_LOG;
    procedure OnProgress(var Message: TMessage); message WM_PROGRESS;
  public
    { Public declarations }
    constructor Create( AOwner: TComponent; params : TAdsParams );
  end;
implementation
{$R *.dfm}
//////////////////////////////////////////////////////////////////
constructor TMDIChild.Create(AOwner: TComponent; params : TAdsParams );
begin
  inherited Create(AOwner);   // create child window
  params.hOwner := self.Handle; // set owner window handle
  adsThread := TAdsThread.Create(params ); // create ads thread  (open ads connection)
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.FormDestroy(Sender: TObject);
begin
  adsThread.Free();// release thread resources (close ads connection)
  inherited;
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.OnLog(var Message: TMessage);
begin
 Memo1.Lines.Add(String(Message.WParam));
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.OnReadWrite(var Message: TMessage);
begin
  Memo3.Lines.Add(String(Message.WParam));
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.OnNotification(var Message: TMessage);
begin
  Memo2.Lines.Add(String(Message.WParam));
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.OnProgress(var Message: TMessage);
begin
  if Message.LParam = 0 then
    Progressbar1.Position := Message.WParam
  else
  begin
    Progressbar1.Min := Message.WParam;
    Progressbar1.Max := Message.LParam;
  end;
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button1Click(Sender: TObject);
begin
  Memo3.Lines.Clear();
  PostThreadMessage( adsThread.ThreadID, WM_READLOOP, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button2Click(Sender: TObject);
begin
  Memo3.Lines.Clear();
  PostThreadMessage( adsThread.ThreadID, WM_WRITELOOP, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button3Click(Sender: TObject);
begin
  Memo2.Lines.Clear();
  PostThreadMessage( adsThread.ThreadID, WM_ADDNOTIFICATION, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button4Click(Sender: TObject);
begin
  PostThreadMessage( adsThread.ThreadID, WM_DELNOTIFICATION, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button5Click(Sender: TObject);
begin
  PostThreadMessage( adsThread.ThreadID, WM_STARTPLC, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button6Click(Sender: TObject);
begin
  PostThreadMessage( adsThread.ThreadID, WM_STOPPLC, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button8Click(Sender: TObject);
begin
  PostThreadMessage( adsThread.ThreadID, WM_READBYNAME, 0, 0 );
end;
//////////////////////////////////////////////////////////////////
procedure TMDIChild.Button7Click(Sender: TObject);
begin
 adsThread.Terminate();
 Button1.Enabled := false;
 Button2.Enabled := false;
 Button3.Enabled := false;
 Button4.Enabled := false;
 Button5.Enabled := false;
 Button6.Enabled := false;
 Button7.Enabled := false;
 Button8.Enabled := false;
end;
end.

AdsThread.pas:

unit AdsThread;
interface
uses
  Messages, Windows, Classes, SysUtils, TcAdsDef, TcAdsApi;
const
  // messages send from form to ads thread
  WM_READLOOP       = WM_APP + $0001;
  WM_WRITELOOP      = WM_APP + $0002;
  WM_ADDNOTIFICATION = WM_APP + $0003;
  WM_DELNOTIFICATION = WM_APP + $0004;
  WM_STARTPLC       = WM_APP + $0005;
  WM_STOPPLC    = WM_APP + $0006;
  WM_READBYNAME     = WM_APP + $0007;
  // messages send from ads thread to form
  WM_LOG        = WM_APP + $1001;
  WM_NOTIFICATION   = WM_APP + $1002;
  WM_READWRITE      = WM_APP + $1003;
  WM_PROGRESS       = WM_APP + $1004;
  MAX_TEST_LOOPS  : Longint = 100;
type
  TAdsParams = record
      hOwner : HWND;
      server  : TAmsAddr;  // TwincAT ADS server network address
      timeout : Longint;  // ads communication timeout
      varIG   : Longint;  // index offset of the plc variable
      varIO   : Longint;  // index group of the plc variable
      length  : Longint; // byte size of the plc variable
      name    : String; // plc variable symbol name
  end;
type
  TAdsThread = class(TThread)
  private
    { Private declarations }
    port    : Longint;
    params   : TAdsParams;
    hNotification : Longint;  // notification handle
    procedure LogMessage( msg : String );
    procedure LogReadWrite( msg : String );
    procedure StartProgress( min : Longint; max: Longint );
    procedure DoProgress( position : Longint );
    function ReadByName( port : Longint; pAddr:PAmsAddr; sName : String; pReadData:Pointer; cbReadLength : Longword; pcbReturn :PLONGWORD ): Longint;
    procedure OnReadLoop(var Message: TMessage); message WM_READLOOP;
    procedure OnWriteLoop(var Message: TMessage); message WM_WRITELOOP;
    procedure OnAddNotification(var Message: TMessage); message WM_ADDNOTIFICATION;
    procedure OnDelNotification(var Message: TMessage); message WM_DELNOTIFICATION;
    procedure OnStartPlc(var Message: TMessage); message WM_STARTPLC;
    procedure OnStopPlc(var Message: TMessage); message WM_STOPPLC;
    procedure OnReadByName(var Message: TMessage); message WM_READBYNAME;
  protected
    procedure Execute; override;
  public
    constructor Create( params : TAdsParams );
  end;
implementation

//////////////////////////////////////////////////////////////////////////////
// Notification callback
Procedure Callback( pAddr:PAmsAddr; pNotification:PAdsNotificationHeader; hUser:Longword ); stdcall;
var sValue : String;
    nValue : Word;
begin
  // only to test
  if pNotification^.cbSampleSize = sizeof(nValue) then
  begin
    nValue := (PWORD(@pNotification^.data))^;
    sValue := Format('Value: %d', [ nValue ] );
    SendMessage( HWND(hUser), WM_NOTIFICATION, Integer(sValue), 0 );
  end;
end;

//////////////////////////////////////////////////////////////////////////////
constructor TAdsThread.Create( params : TAdsParams );
begin
  hNotification := 0;
  port := 0;
  self.params := params; // save parameter for later use
  inherited Create(false);
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.Execute();
var result      : Longint;
    client      : TAmsAddr;
    oldTimeout  : Longint;
    enabled     : LongBool;
    adsState, deviceState : Word;
    adsVersion: TAdsVersion;
    szDevName : AnsiString;
    pDllVersion : PAdsVersion;
    Msg: TMsg;
    DMsg: TMessage;
begin
  LogMessage( 'Ads thread started!' );
  result := AdsGetDllVersion();
  if result <> 0 then
  begin
    pDllVersion := PAdsVersion(@result);
    LogMessage( Format('---- TcAdsDll.dll version:%d, revision:%d, build:%d ----',
        [pDllVersion^.version, pDllVersion^.revision, pDllVersion^.build]));
  end;
  port := 0;
  port := AdsPortOpenEx();
  if port <> 0 then
  begin
    result := AdsGetLocalAddressEx( port, @client );
    LogMessage(Format('AdsGetLocalAddressEx() result: %d [0x%x]', [result, result]));
    if result = 0 then
    begin
    
      if (params.server.netId.b[0] = 0)
      And (params.server.netId.b[1] = 0)
      And (params.server.netId.b[2] = 0)
      And (params.server.netId.b[3] = 0)
      And (params.server.netId.b[4] = 0)
      And (params.server.netId.b[5] = 0)then
      begin
    params.server.netId := client.netId;
      end;
      // show client address
      LogMessage(Format('Client port:%d [0x%x], netID:%d.%d.%d.%d.%d.%d',
              [client.port, client.port,
              client.netid.b[0],client.netid.b[1],client.netid.b[2],
              client.netid.b[3],client.netid.b[4],client.netid.b[5]]));
      // show server address
      LogMessage(Format('Server port:%d [0x%x], netID:%d.%d.%d.%d.%d.%d',
              [params.server.port, params.server.port,
              params.server.netid.b[0],params.server.netid.b[1],params.server.netid.b[2],
              params.server.netid.b[3],params.server.netid.b[4],params.server.netid.b[5]]));
      // read current ads timeout
      oldTimeout := 0;
      result := AdsSyncGetTimeoutEx( port, @oldTimeout );
      LogMessage(Format('AdsSyncGetTimeoutEx() result: %d [0x%x], timeout: %d', [result, result, oldTimeout]));
      if oldTimeout <> params.timeout then
      begin
    // set new ads timeout
    result := AdsSyncSetTimeoutEx( port, params.timeout );
    LogMessage(Format('AdsSyncSetTimeoutEx() result: %d [0x%x], timeout: %d', [result, result, params.timeout]));
      end;
      result := AdsAmsPortEnabledEx( port, @enabled );
      LogMessage(Format('AdsAmsPortEnabledEx() result: %d [0x%x], enabled: %d', [result, result, Ord(enabled)]));
      if enabled then
      begin
    result := AdsSyncReadStateReqEx( port, @params.server, @adsState, @deviceState );
    LogMessage(Format('AdsSyncReadStateReqEx() result: %d [0x%x], adsState: %d, deviceState: %d',
          [result, result, adsState, deviceState]));
    SetLength( szDevName, ADS_FIXEDNAMESIZE + 1 );
    result := AdsSyncReadDeviceInfoReqEx( port, @params.server, @szDevName[1], @adsVersion );
    LogMessage(Format('AdsSyncReadDeviceInfoReqEx() result: %d [0x%x], name: %s, version:%d, revision:%d, build:%d',
          [result, result, szDevName, adsVersion.version, adsVersion.revision, adsVersion.build]));
      end;
      /////////////////////////////////////////////////
      PeekMessage(Msg,0,0,0,PM_NOREMOVE); // Create Message Queue
      repeat
    if PeekMessage(Msg,0,0,0,PM_REMOVE) then
    begin
      DMsg.Msg:=Msg.message;
      DMsg.wParam:=Msg.wParam;
      DMsg.lParam:=Msg.lParam;
      DMsg.Result:=0;
      Dispatch(DMsg);
    end;
    Sleep(10);
      until Terminated;
      if hNotification <> 0 then
      begin
     result := AdsSyncDelDeviceNotificationReqEx( port, @params.server, hNotification );
     hNotification := 0;
      end;
      /////////////////////////////////////////////////
      result := AdsPortcloseEx(port); // close ads port
      LogMessage(Format('AdsPortcloseEx() result: %d [0x%x]', [result, result]));
    end
  end
  else
    LogMessage('AdsPortOpenEx() failed!');
  LogMessage( 'Ads thread stopped!' );
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnReadLoop(var Message: TMessage);
var i, error : Longint;
    varValue    : Word;
    cbReturned    : Longint;
begin
  StartProgress( 0, MAX_TEST_LOOPS);
  for i:= 1 to MAX_TEST_LOOPS  do
  begin
    cbReturned := 0;
    varValue := 0;
    error := AdsSyncReadReqEx2( port, @params.server, params.varIG, params.varIO, sizeof(varValue), @varValue, @cbReturned );
    LogReadWrite( Format('AdsSyncReadReqEx2() result: %d [0x%x], value:0x%x, length: %d', [error, error, varValue, cbReturned]));
    if Terminated then break;
    DoProgress(i);
    Sleep(100);
  end;
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnWriteLoop(var Message: TMessage);
var i, error : Longint;
    varValue    : Word;
begin
  StartProgress( 0, MAX_TEST_LOOPS);
  varValue := 1;
  for i:= 1 to MAX_TEST_LOOPS  do
  begin
    varValue := i; // write some test value
    error := AdsSyncWriteReqEx( port, @params.server, params.varIG, params.varIO, sizeof(varValue), @varValue );
    LogReadWrite( Format('AdsSyncWriteReqEx() result:%d [0x%x], value:0x%x', [error, error, varValue]));
    if Terminated then break;
    DoProgress(i);
    Sleep(100);
  end;
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnReadByName(var Message: TMessage);
var i, cbReturned, error : Longint;
    varValue : Word;
begin
  StartProgress( 0, MAX_TEST_LOOPS);
  for i:= 1 to MAX_TEST_LOOPS  do
  begin
    cbReturned := 0;
    varValue := 0;
    error := ReadByName( port, @params.server, params.name, @varValue, sizeof(varValue), @cbReturned);
    LogReadWrite( Format('Ads read value by name result:%d [0x%x], value: 0x%x, length: %d', [error, error, varValue, cbReturned]));
    if Terminated then break;
    DoProgress(i);
    Sleep(100);
  end;
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnAddNotification(var Message: TMessage);
var error : Longword;
    adsNotificationAttrib : TAdsNotificationAttrib;
begin
     adsNotificationAttrib.cbLength := params.length;
     adsNotificationAttrib.nTransMode := ADSTRANS_SERVERONCHA;
     adsNotificationAttrib.nMaxDelay := 10000000;//1 second
     adsNotificationAttrib.nCycleTime := 0;
     error := AdsSyncAddDeviceNotificationReqEx( port, @params.server,
                        params.varIG,
                        params.varIO,
                        @adsNotificationAttrib,
                        @Callback,
                        params.hOwner, // send window handle as user data
                        @hNotification  );
    LogMessage( Format('AdsSyncAddDeviceNotificationReqEx() result:%d [0x%x], hNotification:0x%x', [error, error, hNotification]));
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnDelNotification(var Message: TMessage);
var error : Longint;
begin
  if hNotification <> 0 then
  begin
    error := AdsSyncDelDeviceNotificationReqEx( port, @params.server, hNotification );
    hNotification := 0;
    LogMessage( Format('AdsSyncDelDeviceNotificationReqEx() result:%d [0x%x], hNotification:0x%x', [error, error, hNotification]));
  end;
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnStartPlc(var Message: TMessage);
var error : Longint;
begin
  error:=AdsSyncWriteControlReqEx( port, @params.server, ADSSTATE_RUN, 0, 0, Nil );
  LogMessage( Format('AdsSyncWriteControlReqEx() result: %d [0x%x]', [error, error]));
end;

//////////////////////////////////////////////////////////////////////////////
procedure TAdsThread.OnStopPlc(var Message: TMessage);
var error : Longint;
begin
  error:=AdsSyncWriteControlReqEx( port, @params.server, ADSSTATE_STOP, 0, 0, Nil );
  LogMessage( Format('AdsSyncWriteControlReqEx() result: %d [0x%x]', [error, error]));
end;

//////////////////////////////////////////////////////////////////////////////
function TAdsThread.ReadByName( port : Longint; pAddr:PAmsAddr; sName : String; pReadData:Pointer; cbReadLength : Longword; pcbReturn :PLONGWORD ) : Longint;
var hSymbol : Longword;
    error : Longint;
    varName : AnsiString;
begin
  {get handle}
  hSymbol := 0;
  varName := AnsiString(sName);
  error := AdsSyncReadWriteReqEx2( port, pAddr, ADSIGRP_SYM_HNDBYNAME, 0, sizeof(hSymbol), @hSymbol, Length(varName)+1, @varName[1], pcbReturn );
  if error = 0 then
  begin
    {get value}
    error := AdsSyncReadReqEx2( port, pAddr, ADSIGRP_SYM_VALBYHND, hSymbol, cbReadLength, pReadData, pcbReturn );
    {release handle}
    error := AdsSyncWriteReqEx( port, pAddr, ADSIGRP_RELEASE_SYMHND, 0, sizeof(hSymbol), @hSymbol );
  end;
  result := error;
end;
end.

Language / IDE	Unpack sample program
Delphi XE2	delphixe2_api_ADS-DLL Sample06.exe
Delphi 7 or higher (classic)	Sample06.exe