Beispiel mit erweiterten Funktionen (für Multithreaded-Applikationen)

Bei der Applikation handelt es sich um eine einfache Delphi-MDI-Applikation. Jedes Child-Fenster (GUI) besitzt einen eigenen Ads-Thread (ADS-Port für die Datenkommunikation) in dem die erweiterten Ads-Funktionen aufgerufen werden. Die Applikation demonstriert wie ADS-Funktionsaufrufe (längere Aktionen) in einen separaten Thread ausgelagert werden können ohne den Main-Thread zu blokieren. Die Applikation kann als Startpunkt für eigene Implementierungen benutzt werden.

Die Ads-Thread-Funktionen wurden in einer separaten Unit: AdsThread.pas implementiert. Die Child-Fensterfunktionen wurden ebenfalls in einer separaten Unit: CHILDWIN.PAS / CHILDWIN.DFM implementiert.

Die Kommunikation zwischen der GUI (Child-Fenster) und dem Ads-Thread wurde mit Hilfe der WM-Messages realisiert ( PostThreadMessage-/SendMessage-Funktionen ). Dadurch wurde der Main-Thread von den Ads-Threads entkoppelt. Es können aber auch andere Synchronisierungsmechanismen benutzt werden.

Voraussetzungen:

Delphi 7.0 + Update 7.1 oder höher;
TcAdsDLL.DLL;
TcAdsDEF.pas und TcAdsAPI.pas, enthalten in der Datei delphi_adsdll_api_units.zip, falls Sie den Quelltext selber übersetzen möchten;

Beispiel mit erweiterten Funktionen (für Multithreaded-Applikationen) 1:

Beschreibung

Starten sie das dazugehörige SPS-Projekt Sample.pro und die MDIAPP.exe. Mit File->New kann eine neue Ads-Client-Verbindung und das dazugehörige GUI-Fenster erzeugt werden. Erzeugen sie mehrere Child-Fenster.

PROGRAM MAIN
VAR
    vUINT AT%MB0 :UINT;
END_VAR

vUINT := vUINT +1;

Bei einem Mausklick auf die entsprechenden Buttons werden folgende Aktionen gestartet:

Start read loop...: Liest synchron (by address) in einer For-Schleife die vUINT-Variable (Dauer ca. 10 Sekunden).
Start write loop...: Schreibt synchron (by address) in einer For-Schleife die vUINT-Variable (Dauer ca. 10 Sekunden).
Start read by name loop...: Liest synchron (by variable name) in einer For-Schleife die vUINT-Variable (Dauer ca. 10 Sekunden).
Add notification: Meldet eine Notification an. Immer wenn sich der Wert der vUINT-Variablen ändert wird er an die Client-Applikation übertragen un im (Notification mesages) Memo-Control angezeigt.
Delete notification: Deaktiviert die Notification.
Start PLC: Startet die SPS.
Stop PLC: Stoppt die SPS.
Exit thread: Beendet den Ads-Thread (verlässt den TThread-Execute-Aufruf).

Zum Test wählen Sie z. B. in einem Fenster den Start read loop...-Button und in einem anderem Fenster Start write loop...-Button.

Delphi 7 Programm

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.

Sprache / IDE	Beispielprogram auspacken
Delphi XE2	delphixe2_api_ADS-DLL Sample06.exe
Delphi 7 oder höher (classic)	Sample06.exe

Dokumente hierzu

delphi_adsdll_api_units.zip