(*=============================================================================| | PROJECT SNAP7 1.4.0 | |==============================================================================| | Copyright (C) 2013, 2014 Davide Nardella | | All rights reserved. | |==============================================================================| | SNAP7 is free software: you can redistribute it and/or modify | | it under the terms of the Lesser GNU General Public License as published by | | the Free Software Foundation, either version 3 of the License, or | | (at your option) any later version. | | | | It means that you can distribute your commercial software linked with | | SNAP7 without the requirement to distribute the source code of your | | application and without the requirement that your application be itself | | distributed under LGPL. | | | | SNAP7 is distributed in the hope that it will be useful, | | but WITHOUT ANY WARRANTY; without even the implied warranty of | | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | | Lesser GNU General Public License for more details. | | | | You should have received a copy of the GNU General Public License and a | | copy of Lesser GNU General Public License along with Snap7. | | If not, see http://www.gnu.org/licenses/ | |==============================================================================| | | | Object PASCAL Interface Classes | | | | Compatibility : | | Delphi/Embarcadero RAD : All 32/64 bit releases (Windows) | | FreePascal (1) : 2.4.0+ 32/64 bit (Windows/Unix) | | | |=============================================================================*) unit snap7; interface {$IFDEF FPC} {$MODE DELPHI} {$ENDIF} // Old compilers don't define MSWINDOWS {$IFDEF WIN32} {$IFNDEF MSWINDOWS} {$DEFINE MSWINDOWS} {$ENDIF} {$ENDIF} Const // Library name {$IFDEF MSWINDOWS} snaplib = 'snap7.dll'; {$ELSE} snaplib = 'libsnap7.so'; // valid for all Unix platforms {$ENDIF} // Native integrals {$IFNDEF FPC} {$IF CompilerVersion<21} // below Delphi 7 Type NativeUint = LongWord; NativeInt = LongInt; {$IFEND} {$ENDIF} Type S7Object = NativeUint; // Platform independent Object reference // DON'T CONFUSE IT WITH AN OLE OBJECT, IT'S SIMPLY // AN INTEGER (32 OR 64 BIT) VALUE USED AS HANDLE. //****************************************************************************** // COMMON //****************************************************************************** Const errLibInvalidParam = -1; errLibInvalidObject = -2; // CPU status S7CpuStatusUnknown = $00; S7CpuStatusRun = $08; S7CpuStatusStop = $04; // ISO Errors errIsoConnect = $00010000; // Connection error errIsoDisconnect = $00020000; // Disconnect error errIsoInvalidPDU = $00030000; // Bad format errIsoInvalidDataSize = $00040000; // Bad Datasize passed to send/recv buffer is invalid errIsoNullPointer = $00050000; // Null passed as pointer errIsoShortPacket = $00060000; // A short packet received errIsoTooManyFragments = $00070000; // Too many packets without EoT flag errIsoPduOverflow = $00080000; // The sum of fragments data exceded maximum packet size errIsoSendPacket = $00090000; // An error occurred during send errIsoRecvPacket = $000A0000; // An error occurred during recv errIsoInvalidParams = $000B0000; // Invalid TSAP params errIsoResvd_1 = $000C0000; // Unassigned errIsoResvd_2 = $000D0000; // Unassigned errIsoResvd_3 = $000E0000; // Unassigned errIsoResvd_4 = $000F0000; // Unassigned // Jobs JobComplete = 0; JobPending = 1; Type TS7Tag = packed record Area : integer; DBNumber : integer; Start : integer; Size : integer; WordLen : integer; end; PS7Tag = ^TS7Tag; //------------------------------------------------------------------------------ // PARAMS LIST //------------------------------------------------------------------------------ Const p_u16_LocalPort = 1; p_u16_RemotePort = 2; p_i32_PingTimeout = 3; p_i32_SendTimeout = 4; p_i32_RecvTimeout = 5; p_i32_WorkInterval = 6; p_u16_SrcRef = 7; p_u16_DstRef = 8; p_u16_SrcTSap = 9; p_i32_PDURequest = 10; p_i32_MaxClients = 11; p_i32_BSendTimeout = 12; p_i32_BRecvTimeout = 13; p_u32_RecoveryTime = 14; p_u32_KeepAliveTime = 15; //****************************************************************************** // CLIENT //****************************************************************************** // Error codes errNegotiatingPDU = $00100000; errCliInvalidParams = $00200000; errCliJobPending = $00300000; errCliTooManyItems = $00400000; errCliInvalidWordLen = $00500000; errCliPartialDataWritten = $00600000; errCliSizeOverPDU = $00700000; errCliInvalidPlcAnswer = $00800000; errCliAddressOutOfRange = $00900000; errCliInvalidTransportSize = $00A00000; errCliWriteDataSizeMismatch = $00B00000; errCliItemNotAvailable = $00C00000; errCliInvalidValue = $00D00000; errCliCannotStartPLC = $00E00000; errCliAlreadyRun = $00F00000; errCliCannotStopPLC = $01000000; errCliCannotCopyRamToRom = $01100000; errCliCannotCompress = $01200000; errCliAlreadyStop = $01300000; errCliFunNotAvailable = $01400000; errCliUploadSequenceFailed = $01500000; errCliInvalidDataSizeRecvd = $01600000; errCliInvalidBlockType = $01700000; errCliInvalidBlockNumber = $01800000; errCliInvalidBlockSize = $01900000; errCliDownloadSequenceFailed = $01A00000; errCliInsertRefused = $01B00000; errCliDeleteRefused = $01C00000; errCliNeedPassword = $01D00000; errCliInvalidPassword = $01E00000; errCliNoPasswordToSetOrClear = $01F00000; errCliJobTimeout = $02000000; errCliPartialDataRead = $02100000; errCliBufferTooSmall = $02200000; errCliFunctionRefused = $02300000; errCliDestroying = $02400000; errCliInvalidParamNumber = $02500000; errCliCannotChangeParam = $02600000; MaxVars = 20; // Max vars that can be transferred with MultiRead/MultiWrite // Client Connection Type CONNTYPE_PG = $01; // Connect to the PLC as a PG CONNTYPE_OP = $02; // Connect to the PLC as an OP CONNTYPE_BASIC = $03; // Basic connection // Area ID S7AreaPE = $81; S7AreaPA = $82; S7AreaMK = $83; S7AreaDB = $84; S7AreaCT = $1C; S7AreaTM = $1D; // Word Length S7WLBit = $01; S7WLByte = $02; S7WLChar = $03; S7WLWord = $04; S7WLInt = $05; S7WLDWord = $06; S7WLDInt = $07; S7WLReal = $08; S7WLDate = $09; S7WLTOD = $0A; S7WLTime = $0B; S7WLS5Time = $0C; S7WLDT = $0F; S7WLCounter = $1C; S7WLTimer = $1D; // Block type Block_OB = $38; Block_DB = $41; Block_SDB = $42; Block_FC = $43; Block_SFC = $44; Block_FB = $45; Block_SFB = $46; // Sub Block Type SubBlk_OB = $08; SubBlk_DB = $0A; SubBlk_SDB = $0B; SubBlk_FC = $0C; SubBlk_SFC = $0D; SubBlk_FB = $0E; SubBlk_SFB = $0F; // Block languages BlockLangAWL = $01; BlockLangKOP = $02; BlockLangFUP = $03; BlockLangSCL = $04; BlockLangDB = $05; BlockLangGRAPH = $06; Type TS7Buffer = packed array[0..$FFFF] of byte; PS7Buffer = ^TS7Buffer; TS7DataItem = packed record Area : integer; WordLen : integer; Result : integer; DBNumber : integer; Start : integer; Amount : integer; pdata : pbyte; end; PS7DataItem = ^TS7DataItem; TS7DataItems = packed array[0..MaxVars-1] of TS7DataItem; PS7DataItems = ^TS7DataItems; TS7BlocksList = packed record OBCount : integer; FBCount : integer; FCCount : integer; SFBCount : integer; SFCCount : integer; DBCount : integer; SDBCount : integer; end; PS7BlocksList = ^TS7BlocksList; TS7BlockInfo = packed record BlkType : integer; BlkNumber : integer; BlkLang : integer; BlkFlags : integer; MC7Size : integer; // The real size in bytes LoadSize : integer; LocalData : integer; SBBLength : integer; CheckSum : integer; Version : integer; // Chars info CodeDate : packed array[0..10] of AnsiChar; IntfDate : packed array[0..10] of AnsiChar; Author : packed array[0..8] of AnsiChar; Family : packed array[0..8] of AnsiChar; Header : packed array[0..8] of AnsiChar; end; PS7BlockInfo = ^TS7BlockInfo; TS7BlocksOfType = packed array[0..$1FFF] of word; PS7BlocksOfType = ^TS7BlocksOfType; TS7OrderCode = packed record Code : packed array[0..20] of AnsiChar; V1 : byte; V2 : byte; V3 : byte; end; PS7OrderCode = ^TS7OrderCode; TS7CpuInfo = packed record ModuleTypeName : packed array[0..32] of AnsiChar; SerialNumber : packed array[0..24] of AnsiChar; ASName : packed array[0..24] of AnsiChar; Copyright : packed array[0..26] of AnsiChar; ModuleName : packed array[0..24] of AnsiChar; end; PS7CpuInfo = ^TS7CpuInfo; TS7CpInfo = packed record MaxPduLengt : integer; MaxConnections : integer; MaxMpiRate : integer; MaxBusRate : integer; end; PS7CpInfo = ^TS7CpInfo; // See §33.1 of "System Software for S7-300/400 System and Standard Functions" // and see SFC51 description too SZL_HEADER = packed record LENTHDR : word; N_DR : word; end; PSZL_HEADER = ^SZL_HEADER; // SZL Record TS7SZL = packed record Header : SZL_HEADER; Data : packed array[0..$3FFF-4] of byte; end; PS7SZL = ^TS7SZL; // List of available SZL IDs : same as SZL but List items are big-endian adjusted TS7SZLList = packed record Header : SZL_HEADER; List : packed array[0..$1FFF-2] of word; end; PS7SZLList = ^TS7SZLList; // See §33.19 of "System Software for S7-300/400 System and Standard Functions" TS7Protection = packed record sch_schal : word; sch_par : word; sch_rel : word; bart_sch : word; anl_sch : word; end; PS7Protection = ^TS7Protection; // C++ time record, functions to convert it from/to TDateTime are provided ;-) TCPP_tm = packed record tm_sec : integer; tm_min : integer; tm_hour : integer; tm_mday : integer; tm_mon : integer; tm_year : integer; tm_wday : integer; tm_yday : integer; tm_isdst : integer; end; PCPP_tm = ^TCPP_tm; // Client completion callback TS7CliCompletion = procedure(usrPtr : Pointer; opCode, opResult : integer); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Control functions function Cli_Create : S7Object; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} procedure Cli_Destroy(var Client : S7Object); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ConnectTo(Client : S7Object; Address : PAnsiChar; Rack, Slot : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetConnectionParams(Client : S7Object; Address : PAnsiChar; LocalTSAP, RemoteTSAP : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetConnectionType(Client : S7Object; ConnectionType : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_Connect(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_Disconnect(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetParam(Client : S7Object; ParamNumber : integer; pValue : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetParam(Client : S7Object; ParamNumber : integer; pValue : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetAsCallback(Client : S7Object; pCompletion, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Data I/O functions function Cli_ReadArea(Client : S7Object; Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_WriteArea(Client : S7Object; Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ReadMultiVars(Client : S7Object; Items : PS7DataItems; ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_WriteMultiVars(Client : S7Object; Items : PS7DataItems; ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Data I/O Lean functions function Cli_DBRead(Client : S7Object; DBNumber, Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_DBWrite(Client : S7Object; DBNumber, Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_MBRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_MBWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_EBRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_EBWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ABRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ABWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_TMRead(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_TMWrite(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_CTRead(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_CTWrite(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Directory functions function Cli_ListBlocks(Client : S7Object; pUsrData : PS7BlocksList) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetAgBlockInfo(Client : S7Object; BlockType, BlockNum : integer; pUsrData : PS7BlockInfo) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetPgBlockInfo(Client : S7Object; pBlock : pointer; pUsrData : PS7BlockInfo; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ListBlocksOfType(Client : S7Object; BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Blocks functions function Cli_Upload(Client : S7Object; BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_FullUpload(Client : S7Object; BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_Download(Client : S7Object; BlockNum : integer; pUsrData : pointer; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_Delete(Client : S7Object; BlockType, BlockNum : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_DBGet(Client : S7Object; DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_DBFill(Client : S7Object; DBNumber : integer; FillChar : byte) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Date/Time functions function Cli_GetPlcDateTime(Client : S7Object; var DateTime : TCPP_tm) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetPlcDateTime(Client : S7Object; var DateTime : TCPP_tm) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetPlcSystemDateTime(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // System Info functions function Cli_GetOrderCode(Client : S7Object; pUsrData : PS7OrderCode) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetCpuInfo(Client : S7Object; pUsrData : PS7CpuInfo) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetCPInfo(Client : S7Object; pUsrData : PS7CpInfo) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ReadSZL(Client : S7Object; ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ReadSZLList(Client : S7Object; pUsrData : PS7SZLList; var ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Control functions function Cli_PlcHotStart(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_PlcColdStart(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_PlcStop(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_CopyRamToRom(Client : S7Object; Timeout : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_Compress(Client : S7Object; Timeout : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetPlcStatus(Client : S7Object; var Status : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Security functions function Cli_GetProtection(Client : S7Object; pUsrData : PS7Protection) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_SetSessionPassword(Client : S7Object; Password : PAnsiChar) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ClearSessionPassword(Client : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Async functions function Cli_AsReadArea(Client : S7Object; Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsWriteArea(Client : S7Object; Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsDBRead(Client : S7Object; DBNumber, Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsDBWrite(Client : S7Object; DBNumber, Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsMBRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsMBWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsEBRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsEBWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsABRead(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsABWrite(Client : S7Object; Start, Size : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsTMRead(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsTMWrite(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsCTRead(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsCTWrite(Client : S7Object; Start, Amount : integer; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsListBlocksOfType(Client : S7Object; BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsReadSZL(Client : S7Object; ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsReadSZLList(Client : S7Object; pUsrData : PS7SZLList; var ItemsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsUpload(Client : S7Object; BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsFullUpload(Client : S7Object; BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsDownload(Client : S7Object; BlockNum : integer; pUsrData : pointer; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsCopyRamToRom(Client : S7Object; Timeout : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsCompress(Client : S7Object; Timeout : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsDBGet(Client : S7Object; DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_AsDBFill(Client : S7Object; DBNumber : integer; FillChar : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_CheckAsCompletion(Client : S7Object; var opResult : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_WaitAsCompletion(Client : S7Object; Timeout : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Low level function Cli_IsoExchangeBuffer(Client : S7Object; pUsrData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Utility/Misc functions function Cli_GetExecTime(Client : S7Object; var Time : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetLastError(Client : S7Object; var LastError : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetPduLength(Client : S7Object; Var Requested, Negotiated : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_ErrorText(Error : integer; Text : PAnsiChar; TextLen : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Cli_GetConnected(Client : S7Object; var IsConnected : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} //****************************************************************************** // SERVER //****************************************************************************** Const mkEvent = 0; mkLog = 1; OperationRead = 0; OperationWrite = 1; // Server Area ID (use with Register/unregister - Lock/unlock Area) srvAreaPE = 0; srvAreaPA = 1; srvAreaMK = 2; srvAreaCT = 3; srvAreaTM = 4; srvAreaDB = 5; // Errors errSrvCannotStart = $00100000; // Server cannot start errSrvDBNullPointer = $00200000; // Passed null as PData errSrvAreaAlreadyExists = $00300000; // Area Re-registration errSrvUnknownArea = $00400000; // Unknown area errSrvInvalidParams = $00500000; // Invalid param(s) supplied errSrvTooManyDB = $00600000; // Cannot register DB errSrvInvalidParamNumber = $00700000; // Invalid param (srv_get/set_param) errSrvCannotChangeParam = $00800000; // Cannot change because running // TCP Server Event codes evcServerStarted = $00000001; evcServerStopped = $00000002; evcListenerCannotStart = $00000004; evcClientAdded = $00000008; evcClientRejected = $00000010; evcClientNoRoom = $00000020; evcClientException = $00000040; evcClientDisconnected = $00000080; evcClientTerminated = $00000100; evcClientsDropped = $00000200; evcReserved_00000400 = $00000400; // currently unused evcReserved_00000800 = $00000800; // currently unused evcReserved_00001000 = $00001000; // currently unused evcReserved_00002000 = $00002000; // currently unused evcReserved_00004000 = $00004000; // currently unused evcReserved_00008000 = $00008000; // currently unused // S7 Server Event Code evcPDUincoming = $00010000; evcDataRead = $00020000; evcDataWrite = $00040000; evcNegotiatePDU = $00080000; evcReadSZL = $00100000; evcClock = $00200000; evcUpload = $00400000; evcDownload = $00800000; evcDirectory = $01000000; evcSecurity = $02000000; evcControl = $04000000; evcReserved_08000000 = $08000000; // currently unused evcReserved_10000000 = $10000000; // currently unused evcReserved_20000000 = $20000000; // currently unused evcReserved_40000000 = $40000000; // currently unused evcReserved_80000000 = $80000000; // currently unused // Masks to enable/disable all evcAll = $FFFFFFFF; evcNone = $00000000; // Event SubCodes evsUnknown = $0000; evsStartUpload = $0001; evsStartDownload = $0001; evsGetBlockList = $0001; evsStartListBoT = $0002; evsListBoT = $0003; evsGetBlockInfo = $0004; evsGetClock = $0001; evsSetClock = $0002; evsSetPassword = $0001; evsClrPassword = $0002; // Event Params : functions group grProgrammer = $0041; grCyclicData = $0042; grBlocksInfo = $0043; grSZL = $0044; grPassword = $0045; grBSend = $0046; grClock = $0047; grSecurity = $0045; // Event Params : control codes CodeControlUnknown = $0000; CodeControlColdStart = $0001; CodeControlWarmStart = $0002; CodeControlStop = $0003; CodeControlCompress = $0004; CodeControlCpyRamRom = $0005; CodeControlInsDel = $0006; // Event Result evrNoError = $0000; evrFragmentRejected = $0001; evrMalformedPDU = $0002; evrSparseBytes = $0003; evrCannotHandlePDU = $0004; evrNotImplemented = $0005; evrErrException = $0006; evrErrAreaNotFound = $0007; evrErrOutOfRange = $0008; evrErrOverPDU = $0009; evrErrTransportSize = $000A; evrInvalidGroupUData = $000B; evrInvalidSZL = $000C; evrDataSizeMismatch = $000D; evrCannotUpload = $000E; evrCannotDownload = $000F; evrUploadInvalidID = $0010; evrResNotFound = $0011; type // Unix Timestamp, the best compact way to store date/time if we don't need // millisecond resolution. time_t = NativeInt; Type TSrvEvent = packed record EvtTime : time_t; // Timestamp EvtSender : integer; // Sender EvtCode : longword; // Event code EvtRetCode : word; // Event result EvtParam1 : word; // Param 1 EvtParam2 : word; // Param 2 EvtParam3 : word; // Param 3 EvtParam4 : word; // Param 4 end; PSrvEvent = ^TSrvEvent; TSrvCallBack = procedure(usrPtr : pointer; PEvent : PSrvEvent; Size : integer); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} TSrvRWAreaCallBack = function(usrPtr : pointer; Sender, Operation : integer; PTag : PS7Tag; pUsrData : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} Const // Server status SrvStopped = 0; SrvRunning = 1; SrvError = 2; function Srv_Create : S7Object; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} procedure Srv_Destroy(var Server : S7Object); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_GetParam(Server : S7Object; ParamNumber : integer; pValue : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetParam(Server : S7Object; ParamNumber : integer; pValue : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_Start(Server : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_StartTo(Server : S7Object; Address : PAnsiChar) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_Stop(Server : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_RegisterArea(Server : S7Object; AreaCode : integer; Index : word; pUsrData : pointer; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_UnregisterArea(Server : S7Object; AreaCode : integer; Index : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_LockArea(Server : S7Object; AreaCode : integer; Index : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_UnlockArea(Server : S7Object; AreaCode : integer; Index : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_GetStatus(Server : S7Object; Var ServerStatus, CpuStatus, ClientsCount : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetCpuStatus(Server : S7Object; CpuStatus : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_PickEvent(Server : S7Object; var Event : TSrvEvent; var EvtReady : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_ClearEvents(Server : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_GetMask(Server : S7Object; MaskKind : integer; Var Mask : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetMask(Server : S7Object; MaskKind : integer; Mask : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetEventsCallback(Server : S7Object; CallBack, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetReadEventsCallback(Server : S7Object; CallBack, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_SetRWAreaCallback(Server : S7Object; CallBack, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_ErrorText(Error : integer; Text : PAnsiChar; TextLen : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Srv_EventText(var Event : TSrvEvent; Text : PAnsiChar; TextLen : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} //****************************************************************************** // PARTNER //****************************************************************************** Const // Partner status par_stopped = 0; // stopped par_connecting = 1; // running and active, connecting par_waiting = 2; // running and waiting for a connection par_linked = 3; // running and connected : linked par_sending = 4; // sending data par_receiving = 5; // receiving data par_binderror = 6; // error starting passive server // Errors errParAddressInUse = $00200000; errParNoRoom = $00300000; errServerNoRoom = $00400000; errParInvalidParams = $00500000; errParNotLinked = $00600000; errParBusy = $00700000; errParFrameTimeout = $00800000; errParInvalidPDU = $00900000; errParSendTimeout = $00A00000; errParRecvTimeout = $00B00000; errParSendRefused = $00C00000; errParNegotiatingPDU = $00D00000; errParSendingBlock = $00E00000; errParRecvingBlock = $00F00000; errBindError = $01000000; errParDestroying = $01100000; errParInvalidParamNumber = $01200000; errParCannotChangeParam = $01300000; errParBufferTooSmall = $01400000; Type TParBRecvEvent = procedure(usrPtr : pointer; opResult : integer; R_ID : longword; pdata : pointer; size : integer); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} TParBSendCompletion = procedure(usrPtr : pointer; opResult : integer); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Control function Par_Create(Active : longbool) : S7Object; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} procedure Par_Destroy(var Partner : S7Object); {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_GetParam(Partner : S7Object; ParamNumber : integer; pValue : Pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_SetParam(Partner : S7Object; ParamNumber : integer; pValue : Pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_Start(Partner : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_StartTo(Partner : S7Object; LocalAddress : PAnsiChar; RemoteAddress : PAnsiChar; LocalTSAP : word; RemoteTSAP : word) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_Stop(Partner : S7Object) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Data I/O functions : BSend function Par_BSend(Partner : S7Object; R_ID : longword; pUsrData : pointer; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_AsBSend(Partner : S7Object;R_ID : longword; pUsrData : pointer; Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_CheckAsBSendCompletion(Partner : S7Object; var opResult : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_WaitAsBSendCompletion(Partner : S7Object; Timeout : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_SetSendCallback(Partner : S7Object; pCompletion, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Data I/O functions : BRecv function Par_BRecv(Partner : S7Object; var R_ID : longword; pData : pointer; var Size : integer; Timeout : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_CheckAsBRecvCompletion(Partner : S7Object; var opResult : integer; var R_ID : longword; pData : pointer; var Size : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_SetRecvCallback(Partner : S7Object; pCompletion, usrPtr : pointer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} // Utility functions function Par_GetTimes(Partner : S7Object; var SendTime : longword; var RecvTime : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_GetLastError(Partner : S7Object; var LastError : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_GetStatus(Partner : S7Object; Var Status : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_GetStats(Partner : S7Object; Var BytesSent, BytesRecv, SendErrors, RecvErrors : longword) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} function Par_ErrorText(Error : integer; Text : PAnsiChar; TextLen : integer) : integer; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} //****************************************************************************** // S7CLIENT CLASS //****************************************************************************** Type { TS7Client } TS7Client = class private HC : S7Object; public constructor Create; destructor Destroy; override; // Control functions function ConnectTo(Address : AnsiString; Rack, Slot : integer) : integer; function SetConnectionParams(Address : AnsiString; LocalTSAP, RemoteTSAP : word) : integer; function SetConnectionType(ConnectionType : word) : integer; function Connect : integer; function Disconnect : integer; function GetParam(ParamNumber : integer; pValue : pointer) : integer; function SetParam(ParamNumber : integer; pValue : pointer) : integer; function SetAsCallback(pCompletion, usrPtr : pointer) : integer; // Data I/O Main functions function ReadArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; function WriteArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; function ReadMultiVars(Items : PS7DataItems; ItemsCount : integer) : integer; function WriteMultiVars(Items : PS7DataItems; ItemsCount : integer) : integer; // Data I/O Lean functions function DBRead(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; function DBWrite(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; function MBRead(Start, Size : integer; pUsrData : pointer) : integer; function MBWrite(Start, Size : integer; pUsrData : pointer) : integer; function EBRead(Start, Size : integer; pUsrData : pointer) : integer; function EBWrite(Start, Size : integer; pUsrData : pointer) : integer; function ABRead(Start, Size : integer; pUsrData : pointer) : integer; function ABWrite(Start, Size : integer; pUsrData : pointer) : integer; function TMRead(Start, Amount : integer; pUsrData : pointer) : integer; function TMWrite(Start, Amount : integer; pUsrData : pointer) : integer; function CTRead(Start, Amount : integer; pUsrData : pointer) : integer; function CTWrite(Start, Amount : integer; pUsrData : pointer) : integer; // Directory functions function ListBlocks(pUsrData : PS7BlocksList) : integer; function GetAgBlockInfo(BlockType, BlockNum : integer; pUsrData : PS7BlockInfo) : integer; function GetPgBlockInfo(pBlock : pointer; pUsrData : PS7BlockInfo; Size : integer) : integer; function ListBlocksOfType(BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; // Blocks functions function Upload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; function FullUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; function Download(BlockNum : integer; pUsrData : pointer; Size : integer) : integer; function Delete(BlockType, BlockNum : integer) : integer; function DBGet(DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; function DBFill(DBNumber : integer; FillChar : integer) : integer; // Date/Time functions function GetPlcDateTime(Var DateTime : TDateTime) : integer; function SetPlcDateTime(Var DateTime : TDateTime) : integer; function SetPlcSystemDateTime : integer; // System Info functions function GetOrderCode(pUsrData : PS7OrderCode) : integer; function GetCpuInfo(pUsrData : PS7CpuInfo) : integer; function GetCPInfo(pUsrData : PS7CpInfo) : integer; function ReadSZL(ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; function ReadSZLList(pUsrData : PS7SZLList; var ItemsCount : integer) : integer; // Control functions function PlcHotStart : integer; function PlcColdStart : integer; function PlcStop : integer; function CopyRamToRom(Timeout : integer) : integer; function Compress(Timeout : integer) : integer; function GetPlcStatus(var Status : integer) : integer; // Security functions function GetProtection(pUsrData : PS7Protection) : integer; function SetSessionPassword(Password : AnsiString) : integer; function ClearSessionPassword : integer; // Async functions function AsReadArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; function AsWriteArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; function AsDBRead(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; function AsDBWrite(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; function AsMBRead(Start, Size : integer; pUsrData : pointer) : integer; function AsMBWrite(Start, Size : integer; pUsrData : pointer) : integer; function AsEBRead(Start, Size : integer; pUsrData : pointer) : integer; function AsEBWrite(Start, Size : integer; pUsrData : pointer) : integer; function AsABRead(Start, Size : integer; pUsrData : pointer) : integer; function AsABWrite(Start, Size : integer; pUsrData : pointer) : integer; function AsTMRead(Start, Amount : integer; pUsrData : pointer) : integer; function AsTMWrite(Start, Amount : integer; pUsrData : pointer) : integer; function AsCTRead(Start, Amount : integer; pUsrData : pointer) : integer; function AsCTWrite(Start, Amount : integer; pUsrData : pointer) : integer; function AsListBlocksOfType(BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; function AsReadSZL(ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; function AsReadSZLList(pUsrData : PS7SZLList; var ItemsCount : integer) : integer; function AsUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; function AsFullUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; function AsDownload(BlockNum : integer; pUsrData : pointer; Size : integer) : integer; function AsCopyRamToRom(Timeout : integer) : integer; function AsCompress(Timeout : integer) : integer; function AsDBGet(DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; function AsDBFill(DBNumber : integer; FillChar : integer) : integer; function CheckAsCompletion(var opResult : integer) : boolean; function WaitAsCompletion(Timeout : longword) : integer; // Low level function IsoExchangeBuffer(pUsrData : pointer; var Size : integer) : integer; // Utility/Misc functions function Time : longword; function LastError : integer; function PduLength : integer; function PduRequested : integer; function PlcStatus : integer; function Connected : boolean; end; //****************************************************************************** // SNAP7SERVER CLASS //****************************************************************************** TS7Server = class private HS : S7Object; function GetEventsMask: longword; function GetLogMask: longword; procedure SetEventsMask(const Value: longword); procedure SetLogMask(const Value: longword); function GetStatus(Var ServerStatus, CpuStatus, ClientsCount : integer) : integer; function GetClientsCount: integer; function GetCpuStatus: integer; function GetServerStatus: integer; procedure SetCpuStatus(const Value: integer); public constructor Create; destructor Destroy; override; // Control function Start : integer; function StartTo(Address : String) : integer; function Stop : integer; function GetParam(ParamNumber : integer; pValue : pointer) : integer; function SetParam(ParamNumber : integer; pValue : pointer) : integer; // Resources function RegisterArea(AreaCode : integer; Index : integer; pUsrData : pointer; Size : integer) : integer; function UnregisterArea(AreaCode : integer; Index : integer) : integer; function LockArea(AreaCode : integer; Index : integer) : integer; function UnlockArea(AreaCode : integer; Index : integer) : integer; // Events function PickEvent(var Event : TSrvEvent) : boolean; function ClearEvents : integer; function SetEventsCallback(CallBack, usrPtr : pointer) : integer; function SetReadEventsCallback(CallBack, usrPtr : pointer) : integer; function SetRWAreaCallback(CallBack, usrPtr : pointer) : integer; // Properties property EventsMask : longword read GetEventsMask write SetEventsMask; property LogMask : longword read GetLogMask write SetLogMask; property ServerStatus : integer read GetServerStatus; property CpuStatus : integer read GetCpuStatus write SetCpuStatus; property ClientsCount : integer read GetClientsCount; end; //****************************************************************************** // SNAP7PARTNER CLASS //****************************************************************************** TS7Partner = class private HP : S7Object; FBytesSent : longword; FBytesRecv : longword; FSendErrors : longword; FRecvErrors : longword; FActive: boolean; procedure GetStatistics; function GetLastError : integer; function GetBytesRecv: integer; function GetBytesSent: integer; function GetRecvErrors: integer; function GetRecvTime: longword; function GetSendErrors: integer; function GetSendTime: longword; function GetStatus: integer; function GetLinked: boolean; public constructor Create(AsActive : boolean); destructor Destroy; override; function GetParam(ParamNumber : integer; pValue : Pointer) : integer; function SetParam(ParamNumber : integer; pValue : Pointer) : integer; function Start : integer; function StartTo(LocalAddress, RemoteAddress : AnsiString; LocalTSAP, RemoteTSAP : word ) : integer; function Stop : integer; // Block send function BSend(R_ID : longword; pUsrData : pointer; size : integer) : integer; function AsBSend(R_ID : longword; pUsrData : pointer; size : integer) : integer; function CheckAsBSendCompletion(var opResult : integer) : boolean; function WaitAsBSendCompletion(Timeout : longword) : integer; function SetSendCallback(pSendCompletion, usrPtr : pointer) : integer; // Block recv function BRecv(Timeout : longword; var R_ID : longword; pUsrData : pointer; var Size : integer) : integer; function CheckAsBRecvCompletion(var opResult : integer; var R_ID : longword; pUsrData : pointer; var Size : integer) : boolean; function SetRecvCallback(pRecvCompletion, usrPtr : pointer) : integer; // Read only properties property Active : boolean read FActive; property Status : integer read GetStatus; property Linked : boolean read GetLinked; property BytesSent : integer read GetBytesSent; property BytesRecv : integer read GetBytesRecv; property SendErrors : integer read GetSendErrors; property RecvErrors : integer read GetRecvErrors; property LastError : integer read GetLastError; property SendTime : longword read GetSendTime; property RecvTime : longword read GetRecvTime; end; //****************************************************************************** // S7 CONVERSION CLASS //****************************************************************************** TS7Type = (S7Int, S7DInt, S7Word, S7DWord, S7Real, S7DT_To_DateTime, DateTime_To_S7DT); TS7Helper = class private function GetInt(pval: pointer): smallint; procedure SetInt(pval: pointer; const Value: smallint); function GetWord(pval: pointer): word; procedure SetWord(pval: pointer; const Value: word); function GetDInt(pval: pointer): longint; procedure SetDInt(pval: pointer; const Value: longint); function GetDWord(pval: pointer): longword; procedure SetDWord(pval: pointer; const Value: longword); function GetDateTime(pval: pointer): TDateTime; procedure SetDateTime(pval: pointer; const Value: TDateTime); function GetReal(pval: pointer): single; procedure SetReal(pval: pointer; const Value: single); function GetBit(pval: pointer; BitIndex: integer): boolean; procedure SetBit(pval: pointer; BitIndex: integer; const Value: boolean); public procedure Reverse(pval : pointer; const S7Type : TS7Type); property ValBit[pval : pointer; BitIndex : integer] : boolean read GetBit write SetBit; property ValInt[pval : pointer] : smallint read GetInt write SetInt; property ValDInt[pval : pointer] : longint read GetDInt write SetDInt; property ValWord[pval : pointer] : word read GetWord write SetWord; property ValDWord[pval : pointer] : longword read GetDWord write SetDWord; property ValReal[pval : pointer] : single read GetReal write SetReal; property ValDateTime[pval : pointer] : TDateTime read GetDateTime write SetDateTime; end; // Error text function CliErrorText(Error : integer) : string; function SrvErrorText(Error : integer) : string; function ParErrorText(Error : integer) : string; function SrvEventText(var Event : TSrvEvent) : string; Var S7 : TS7Helper; implementation Uses DateUtils, SysUtils; Const TextLen = 1024; //------------------------------------------------------------------------------ // C++ Datatime conversion helpers //------------------------------------------------------------------------------ function DateTimeToCPP_tm(T : TDateTime) : TCPP_tm; Var YY,MM,DD,HH,NN,SS,DOW,MS : word; begin DecodeDateFully(T,YY,MM,DD,DOW); DecodeTime(T,HH,NN,SS,MS); with Result do begin tm_year :=YY-1900; tm_mon :=MM-1; tm_mday :=DD; tm_hour :=HH; tm_min :=NN; tm_sec :=SS; tm_wday :=DOW-1; tm_isdst:=-1; // Info not available end; end; //------------------------------------------------------------------------------ function CPP_tmToDateTime(var T : TCPP_tm) : TDateTime; Var Date, Time : TDateTime; begin with T do begin if TryEncodeDate(tm_year+1900,tm_mon+1,tm_mday,Date) then begin if TryEncodeTime(tm_hour,tm_min,tm_sec,0,Time) then Result:=Date+Time else Result:=0; end else Result:=0; end; end; //****************************************************************************** // CLIENT FORWARDS //****************************************************************************** function Cli_Create; external snaplib name 'Cli_Create'; procedure Cli_Destroy; external snaplib name 'Cli_Destroy'; function Cli_ConnectTo; external snaplib name 'Cli_ConnectTo'; function Cli_SetConnectionParams; external snaplib name 'Cli_SetConnectionParams'; function Cli_SetConnectionType; external snaplib name 'Cli_SetConnectionType'; function Cli_Disconnect; external snaplib name 'Cli_Disconnect'; function Cli_Connect; external snaplib name 'Cli_Connect'; function Cli_GetParam; external snaplib name 'Cli_GetParam'; function Cli_SetParam; external snaplib name 'Cli_SetParam'; function Cli_SetAsCallback; external snaplib name 'Cli_SetAsCallback'; function Cli_ReadArea; external snaplib name 'Cli_ReadArea'; function Cli_WriteArea; external snaplib name 'Cli_WriteArea'; function Cli_ReadMultiVars; external snaplib name 'Cli_ReadMultiVars'; function Cli_WriteMultiVars; external snaplib name 'Cli_WriteMultiVars'; function Cli_DBRead; external snaplib name 'Cli_DBRead'; function Cli_DBWrite; external snaplib name 'Cli_DBWrite'; function Cli_MBRead; external snaplib name 'Cli_MBRead'; function Cli_MBWrite; external snaplib name 'Cli_MBWrite'; function Cli_EBRead; external snaplib name 'Cli_EBRead'; function Cli_EBWrite; external snaplib name 'Cli_EBWrite'; function Cli_ABRead; external snaplib name 'Cli_ABRead'; function Cli_ABWrite; external snaplib name 'Cli_ABWrite'; function Cli_TMRead; external snaplib name 'Cli_TMRead'; function Cli_TMWrite; external snaplib name 'Cli_TMWrite'; function Cli_CTRead; external snaplib name 'Cli_CTRead'; function Cli_CTWrite; external snaplib name 'Cli_CTWrite'; function Cli_ListBlocks; external snaplib name 'Cli_ListBlocks'; function Cli_GetAgBlockInfo; external snaplib name 'Cli_GetAgBlockInfo'; function Cli_GetPgBlockInfo; external snaplib name 'Cli_GetPgBlockInfo'; function Cli_ListBlocksOfType; external snaplib name 'Cli_ListBlocksOfType'; function Cli_Upload; external snaplib name 'Cli_Upload'; function Cli_FullUpload; external snaplib name 'Cli_FullUpload'; function Cli_Download; external snaplib name 'Cli_Download'; function Cli_Delete; external snaplib name 'Cli_Delete'; function Cli_GetPlcDateTime; external snaplib name 'Cli_GetPlcDateTime'; function Cli_SetPlcDateTime; external snaplib name 'Cli_SetPlcDateTime'; function Cli_SetPlcSystemDateTime; external snaplib name 'Cli_SetPlcSystemDateTime'; function Cli_GetOrderCode; external snaplib name 'Cli_GetOrderCode'; function Cli_GetCpuInfo; external snaplib name 'Cli_GetCpuInfo'; function Cli_GetCPInfo; external snaplib name 'Cli_GetCpInfo'; function Cli_ReadSZL; external snaplib name 'Cli_ReadSZL'; function Cli_ReadSZLList; external snaplib name 'Cli_ReadSZLList'; function Cli_PlcHotStart; external snaplib name 'Cli_PlcHotStart'; function Cli_PlcColdStart; external snaplib name 'Cli_PlcColdStart'; function Cli_PlcStop; external snaplib name 'Cli_PlcStop'; function Cli_CopyRamToRom; external snaplib name 'Cli_CopyRamToRom'; function Cli_Compress; external snaplib name 'Cli_Compress'; function Cli_GetPlcStatus; external snaplib name 'Cli_GetPlcStatus'; function Cli_GetProtection; external snaplib name 'Cli_GetProtection'; function Cli_SetSessionPassword; external snaplib name 'Cli_SetSessionPassword'; function Cli_ClearSessionPassword; external snaplib name 'Cli_ClearSessionPassword'; function Cli_DBGet; external snaplib name 'Cli_DBGet'; function Cli_DBFill; external snaplib name 'Cli_DBFill'; function Cli_GetExecTime; external snaplib name 'Cli_GetExecTime'; function Cli_GetPduLength; external snaplib name 'Cli_GetPduLength'; function Cli_GetLastError; external snaplib name 'Cli_GetLastError'; function Cli_AsReadArea; external snaplib name 'Cli_AsReadArea'; function Cli_AsWriteArea; external snaplib name 'Cli_AsWriteArea'; function Cli_AsDBRead; external snaplib name 'Cli_AsDBRead'; function Cli_AsDBWrite; external snaplib name 'Cli_AsDBWrite'; function Cli_AsMBRead; external snaplib name 'Cli_AsMBRead'; function Cli_AsMBWrite; external snaplib name 'Cli_AsMBWrite'; function Cli_AsEBRead; external snaplib name 'Cli_AsEBRead'; function Cli_AsEBWrite; external snaplib name 'Cli_AsEBWrite'; function Cli_AsABRead; external snaplib name 'Cli_AsABRead'; function Cli_AsABWrite; external snaplib name 'Cli_AsABWrite'; function Cli_AsTMRead; external snaplib name 'Cli_AsTMRead'; function Cli_AsTMWrite; external snaplib name 'Cli_AsTMWrite'; function Cli_AsCTRead; external snaplib name 'Cli_AsCTRead'; function Cli_AsCTWrite; external snaplib name 'Cli_AsCTWrite'; function Cli_AsListBlocksOfType; external snaplib name 'Cli_AsListBlocksOfType'; function Cli_AsReadSZL; external snaplib name 'Cli_AsReadSZL'; function Cli_AsReadSZLList; external snaplib name 'Cli_AsReadSZLList'; function Cli_AsUpload; external snaplib name 'Cli_AsUpload'; function Cli_AsFullUpload; external snaplib name 'Cli_AsFullUpload'; function Cli_AsDownload; external snaplib name 'Cli_AsDownload'; function Cli_AsCopyRamToRom; external snaplib name 'Cli_AsCopyRamToRom'; function Cli_AsCompress; external snaplib name 'Cli_AsCompress'; function Cli_AsDBGet; external snaplib name 'Cli_AsDBGet'; function Cli_AsDBFill; external snaplib name 'Cli_AsDBFill'; function Cli_CheckAsCompletion; external snaplib name 'Cli_CheckAsCompletion'; function Cli_WaitAsCompletion; external snaplib name 'Cli_WaitAsCompletion'; function Cli_IsoExchangeBuffer; external snaplib name 'Cli_IsoExchangeBuffer'; function Cli_ErrorText; external snaplib name 'Cli_ErrorText'; function Cli_GetConnected; external snaplib name 'Cli_GetConnected'; //****************************************************************************** // SERVER FORWARDS //****************************************************************************** function Srv_Create; external snaplib name 'Srv_Create'; procedure Srv_Destroy; external snaplib name 'Srv_Destroy'; function Srv_GetParam; external snaplib name 'Srv_GetParam'; function Srv_SetParam; external snaplib name 'Srv_SetParam'; function Srv_Start; external snaplib name 'Srv_Start'; function Srv_StartTo; external snaplib name 'Srv_StartTo'; function Srv_Stop; external snaplib name 'Srv_Stop'; function Srv_RegisterArea; external snaplib name 'Srv_RegisterArea'; function Srv_UnregisterArea; external snaplib name 'Srv_UnregisterArea'; function Srv_LockArea; external snaplib name 'Srv_LockArea'; function Srv_UnlockArea; external snaplib name 'Srv_UnlockArea'; function Srv_GetStatus; external snaplib name 'Srv_GetStatus'; function Srv_SetCpuStatus; external snaplib name 'Srv_SetCpuStatus'; function Srv_PickEvent; external snaplib name 'Srv_PickEvent'; function Srv_ClearEvents; external snaplib name 'Srv_ClearEvents'; function Srv_GetMask; external snaplib name 'Srv_GetMask'; function Srv_SetMask; external snaplib name 'Srv_SetMask'; function Srv_SetEventsCallback; external snaplib name 'Srv_SetEventsCallback'; function Srv_SetReadEventsCallback; external snaplib name 'Srv_SetReadEventsCallback'; function Srv_SetRWAreaCallback; external snaplib name 'Srv_SetRWAreaCallback'; function Srv_ErrorText; external snaplib name 'Srv_ErrorText'; function Srv_EventText; external snaplib name 'Srv_EventText'; //****************************************************************************** // PARTNER FORWARDS //****************************************************************************** function Par_Create; external snaplib name 'Par_Create'; procedure Par_Destroy; external snaplib name 'Par_Destroy'; function Par_GetParam; external snaplib name 'Par_GetParam'; function Par_SetParam; external snaplib name 'Par_SetParam'; function Par_Start; external snaplib name 'Par_Start'; function Par_StartTo; external snaplib name 'Par_StartTo'; function Par_Stop; external snaplib name 'Par_Stop'; function Par_BSend; external snaplib name 'Par_BSend'; function Par_AsBSend; external snaplib name 'Par_AsBSend'; function Par_CheckAsBSendCompletion; external snaplib name 'Par_CheckAsBSendCompletion'; function Par_WaitAsBSendCompletion; external snaplib name 'Par_WaitAsBSendCompletion'; function Par_SetSendCallback; external snaplib name 'Par_SetSendCallback'; function Par_BRecv; external snaplib name 'Par_BRecv'; function Par_CheckAsBRecvCompletion; external snaplib name 'Par_CheckAsBRecvCompletion'; function Par_SetRecvCallback; external snaplib name 'Par_SetRecvCallback'; function Par_GetTimes; external snaplib name 'Par_GetTimes'; function Par_GetLastError; external snaplib name 'Par_GetLastError'; function Par_GetStatus; external snaplib name 'Par_GetStatus'; function Par_GetStats; external snaplib name 'Par_GetStats'; function Par_ErrorText; external snaplib name 'Par_ErrorText'; //****************************************************************************** // TS7Client CLASS IMPLEMENTATION //****************************************************************************** constructor TS7Client.Create; begin inherited; HC:=Cli_Create; end; //------------------------------------------------------------------------------ destructor TS7Client.Destroy; begin Cli_Destroy(HC); inherited; end; //------------------------------------------------------------------------------ function TS7Client.ConnectTo(Address : AnsiString; Rack,Slot : integer) : integer; begin Result:=Cli_ConnectTo(HC,PAnsiChar(Address), Rack, Slot) end; //------------------------------------------------------------------------------ function TS7Client.SetConnectionParams(Address: AnsiString; LocalTSAP, RemoteTSAP: word ) : integer; begin Result:=Cli_SetConnectionParams(HC,PAnsiChar(Address), LocalTSAP, RemoteTSAP) end; //------------------------------------------------------------------------------ function TS7Client.SetConnectionType(ConnectionType : word ) : integer; begin Result:=Cli_SetConnectionType(HC, ConnectionType) end; //------------------------------------------------------------------------------ function TS7Client.Connect : integer; begin Result:=Cli_Connect(HC) end; //------------------------------------------------------------------------------ function TS7Client.Disconnect : integer; begin Result:=Cli_Disconnect(HC) end; //------------------------------------------------------------------------------ function TS7Client.SetAsCallback(pCompletion, usrPtr : pointer) : integer; begin Result:=Cli_SetAsCallback(HC,pCompletion,usrPtr) end; //------------------------------------------------------------------------------ function TS7Client.ReadArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; begin Result:=Cli_ReadArea(HC,Area,DBNumber,Start,Amount,WordLen,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.WaitAsCompletion(Timeout: longword): integer; begin Result:=Cli_WaitAsCompletion(HC,Timeout) end; //------------------------------------------------------------------------------ function TS7Client.WriteArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; begin Result:=Cli_WriteArea(HC,Area,DBNumber,Start,Amount,WordLen,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.ReadMultiVars(Items : PS7DataItems; ItemsCount : integer) : integer; begin Result:=Cli_ReadMultiVars(HC,Items,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.WriteMultiVars(Items : PS7DataItems; ItemsCount : integer) : integer; begin Result:=Cli_WriteMultiVars(HC,Items,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.DBRead(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_DBRead(HC,DBNumber,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.DBWrite(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_DBWrite(HC,DBNumber,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.MBRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_MBRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.MBWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_MBWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.EBRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_EBRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.EBWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_EBWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.ABRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_ABRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.ABWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_ABWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.TMRead(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_TMRead(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.TMWrite(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_TMWrite(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.CTRead(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_CTRead(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.CTWrite(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_CTWrite(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.ListBlocks(pUsrData : PS7BlocksList) : integer; begin Result:=Cli_ListBlocks(HC,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.GetAgBlockInfo(BlockType, BlockNum : integer; pUsrData : PS7BlockInfo) : integer; begin Result:=Cli_GetAgBlockInfo(HC,BlockType,BlockNum,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.GetPgBlockInfo(pBlock : pointer; pUsrData : PS7BlockInfo; Size : integer) : integer; begin Result:=Cli_GetPgBlockInfo(HC,pBlock,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.ListBlocksOfType(BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; begin Result:=Cli_ListBlocksOfType(HC,BlockType,pUsrData,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.Upload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_Upload(HC,BlockType,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.FullUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_FullUpload(HC,BlockType,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.Download(BlockNum : integer; pUsrData : pointer; Size : integer) : integer; begin Result:=Cli_Download(HC,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.Delete(BlockType, BlockNum : integer) : integer; begin Result:=Cli_Delete(HC,BlockType,BlockNum) end; //------------------------------------------------------------------------------ function TS7Client.DBGet(DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_DBGet(HC,DBNumber,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.DBFill(DBNumber : integer; FillChar : integer) : integer; begin Result:=Cli_DBFill(HC,DBNumber,FillChar) end; //------------------------------------------------------------------------------ function TS7Client.GetPlcDateTime(Var DateTime : TDateTime) : integer; Var CPP_tm : TCPP_tm; begin Result:=Cli_GetPlcDateTime(HC,CPP_tm); if Result=0 then DateTime:=CPP_tmToDateTime(CPP_tm); end; //------------------------------------------------------------------------------ function TS7Client.GetParam(ParamNumber : integer; pValue: pointer): integer; begin Result:=Cli_GetParam(HC, ParamNumber, pValue); end; //------------------------------------------------------------------------------ function TS7Client.SetParam(ParamNumber : integer; pValue: pointer): integer; begin Result:=Cli_SetParam(HC, ParamNumber, pValue); end; //------------------------------------------------------------------------------ function TS7Client.SetPlcDateTime(Var DateTime : TDateTime) : integer; Var CPP_tm : TCPP_tm; begin CPP_tm:=DateTimeToCPP_tm(DateTime); Result:=Cli_SetPlcDateTime(HC,CPP_tm); end; //------------------------------------------------------------------------------ function TS7Client.SetPlcSystemDateTime : integer; begin Result:=Cli_SetPlcSystemDateTime(HC) end; //------------------------------------------------------------------------------ function TS7Client.GetOrderCode(pUsrData : PS7OrderCode) : integer; begin Result:=Cli_GetOrderCode(HC,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.GetCpuInfo(pUsrData : PS7CpuInfo) : integer; begin Result:=Cli_GetCpuInfo(HC,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.GetCPInfo(pUsrData : PS7CpInfo) : integer; begin Result:=Cli_GetCPInfo(HC,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.ReadSZL(ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; begin Result:=Cli_ReadSZL(HC,ID,Index,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.ReadSZLList(pUsrData : PS7SZLList; var ItemsCount : integer) : integer; begin Result:=Cli_ReadSZLList(HC,pUsrData,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.PlcHotStart : integer; begin Result:=Cli_PlcHotStart(HC) end; //------------------------------------------------------------------------------ function TS7Client.PlcColdStart : integer; begin Result:=Cli_PlcColdStart(HC) end; //------------------------------------------------------------------------------ function TS7Client.PlcStatus: integer; Var Return : integer; begin Return:=Cli_GetPlcStatus(HC, Result); if (Return<>0) then Result:=Return; end; //------------------------------------------------------------------------------ function TS7Client.Connected: boolean; Var IsConnected : integer; begin if Cli_GetConnected(HC, IsConnected)=0 then Result:=IsConnected<>0 else Result:=false; end; //------------------------------------------------------------------------------ function TS7Client.PlcStop : integer; begin Result:=Cli_PlcStop(HC) end; //------------------------------------------------------------------------------ function TS7Client.CopyRamToRom(Timeout : integer) : integer; begin Result:=Cli_CopyRamToRom(HC,Timeout) end; //------------------------------------------------------------------------------ function TS7Client.Compress(Timeout : integer) : integer; begin Result:=Cli_Compress(HC,Timeout) end; //------------------------------------------------------------------------------ function TS7Client.GetPlcStatus(var Status : integer) : integer; begin Result:=Cli_GetPlcStatus(HC,Status) end; //------------------------------------------------------------------------------ function TS7Client.GetProtection(pUsrData : PS7Protection) : integer; begin Result:=Cli_GetProtection(HC,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.SetSessionPassword(Password : AnsiString) : integer; begin Result:=Cli_SetSessionPassword(HC,PAnsiChar(Password)) end; //------------------------------------------------------------------------------ function TS7Client.ClearSessionPassword : integer; begin Result:=Cli_ClearSessionPassword(HC) end; //------------------------------------------------------------------------------ function TS7Client.AsReadArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsReadArea(HC,Area,DBNumber,Start,Amount,WordLen,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsWriteArea(Area, DBNumber, Start, Amount, WordLen : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsWriteArea(HC,Area,DBNumber,Start,Amount,WordLen,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsDBRead(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsDBRead(HC,DBNumber,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsDBWrite(DBNumber, Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsDBWrite(HC,DBNumber,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsMBRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsMBRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsMBWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsMBWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsEBRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsEBRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsEBWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsEBWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsABRead(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsABRead(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsABWrite(Start, Size : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsABWrite(HC,Start,Size,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsTMRead(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsTMRead(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsTMWrite(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsTMWrite(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsCTRead(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsCTRead(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsCTWrite(Start, Amount : integer; pUsrData : pointer) : integer; begin Result:=Cli_AsCTWrite(HC,Start,Amount,pUsrData) end; //------------------------------------------------------------------------------ function TS7Client.AsListBlocksOfType(BlockType : integer; pUsrData : PS7BlocksOfType; var ItemsCount : integer) : integer; begin Result:=Cli_AsListBlocksOfType(HC,BlockType,pUsrData,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.AsReadSZL(ID, Index : integer; pUsrData : PS7SZL; var Size : integer) : integer; begin Result:=Cli_AsReadSZL(HC,ID,Index,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.AsReadSZLList(pUsrData: PS7SZLList; var ItemsCount: integer): integer; begin Result:=Cli_AsReadSZLList(HC,pUsrData,ItemsCount) end; //------------------------------------------------------------------------------ function TS7Client.AsUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_AsUpload(HC,BlockType,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.AsFullUpload(BlockType, BlockNum : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_AsFullUpload(HC,BlockType,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.AsDownload(BlockNum : integer; pUsrData : pointer; Size : integer) : integer; begin Result:=Cli_AsDownload(HC,BlockNum,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.AsCopyRamToRom(Timeout : integer) : integer; begin Result:=Cli_AsCopyRamToRom(HC,Timeout) end; //------------------------------------------------------------------------------ function TS7Client.AsCompress(Timeout : integer) : integer; begin Result:=Cli_AsCompress(HC,Timeout) end; //------------------------------------------------------------------------------ function TS7Client.AsDBGet(DBNumber : integer; pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_AsDBGet(HC,DBNumber,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.AsDBFill(DBNumber : integer; FillChar : integer) : integer; begin Result:=Cli_AsDBFill(HC,DBNumber,FillChar) end; //------------------------------------------------------------------------------ function TS7Client.CheckAsCompletion(var opResult : integer) : boolean; begin Result:=Cli_CheckAsCompletion(HC,opResult)=JobComplete; end; //------------------------------------------------------------------------------ function TS7Client.IsoExchangeBuffer(pUsrData : pointer; var Size : integer) : integer; begin Result:=Cli_IsoExchangeBuffer(HC,pUsrData,Size) end; //------------------------------------------------------------------------------ function TS7Client.Time : longword; Var Return : integer; begin Return:=Cli_GetExecTime(HC,Result); if Return<>0 then Result:=longword(-1); end; //------------------------------------------------------------------------------ function TS7Client.LastError : integer; begin Cli_GetLastError(HC,Result); end; //------------------------------------------------------------------------------ function TS7Client.PduLength : integer; Var Requested : integer; begin Cli_GetPduLength(HC, Requested, Result); end; //------------------------------------------------------------------------------ function TS7Client.PduRequested: integer; Var PduLength : integer; begin Cli_GetPduLength(HC, Result, PduLength); end; //****************************************************************************** // TS7Server CLASS IMPLEMENTATION //****************************************************************************** constructor TS7Server.Create; begin inherited Create; HS:=Srv_Create; end; //------------------------------------------------------------------------------ destructor TS7Server.Destroy; begin if HS<>0 then Srv_Destroy(HS); inherited; end; //------------------------------------------------------------------------------ function TS7Server.ClearEvents: integer; begin Result:=Srv_ClearEvents(HS) end; //------------------------------------------------------------------------------ function TS7Server.PickEvent(var Event: TSrvEvent) : boolean; Var EvtReady : integer; begin if Srv_PickEvent(HS, Event, EvtReady)=0 then Result := EvtReady<>0 else Result:=False; end; //------------------------------------------------------------------------------ function TS7Server.GetClientsCount: integer; Var ServerStatus, CpuStatus : integer; begin if GetStatus(ServerStatus, CpuStatus, Result)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Server.GetCpuStatus: integer; Var ServerStatus, ClientsCount : integer; begin if GetStatus(ServerStatus, Result, ClientsCount)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Server.GetEventsMask: longword; begin if Srv_GetMask(HS, mkEvent, Result)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Server.GetLogMask: longword; begin if Srv_GetMask(HS, mkLog, Result)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Server.GetServerStatus: integer; Var CpuStatus, ClientsCount : integer; begin if GetStatus(Result, CpuStatus, ClientsCount)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Server.GetStatus(var ServerStatus, CpuStatus, ClientsCount: integer): integer; begin Result:=Srv_GetStatus(HS, ServerStatus, CpuStatus, ClientsCount); end; //------------------------------------------------------------------------------ function TS7Server.LockArea(AreaCode, Index: integer): integer; begin Result:=Srv_LockArea(HS, AreaCode, Index); end; //------------------------------------------------------------------------------ function TS7Server.RegisterArea(AreaCode, Index: integer; pUsrData: pointer; Size: integer): integer; begin Result:=Srv_RegisterArea(HS,AreaCode,Index,pUsrData,Size); end; //------------------------------------------------------------------------------ procedure TS7Server.SetCpuStatus(const Value: integer); begin Srv_SetCpuStatus(HS, Value); end; //------------------------------------------------------------------------------ function TS7Server.SetEventsCallback(CallBack, usrPtr: pointer): integer; begin Result:=Srv_SetEventsCallback(HS,CallBack,usrPtr); end; //------------------------------------------------------------------------------ function TS7Server.SetReadEventsCallback(CallBack, usrPtr: pointer): integer; begin Result:=Srv_SetReadEventsCallback(HS,CallBack,usrPtr); end; //------------------------------------------------------------------------------ function TS7Server.SetRWAreaCallback(CallBack, usrPtr : pointer) : integer; begin Result:=Srv_SetRWAreaCallback(HS,CallBack,usrPtr); end; //------------------------------------------------------------------------------ procedure TS7Server.SetEventsMask(const Value: longword); begin Srv_SetMask(HS, mkEvent, Value); end; //------------------------------------------------------------------------------ procedure TS7Server.SetLogMask(const Value: longword); begin Srv_SetMask(HS, mkLog, Value); end; //------------------------------------------------------------------------------ function TS7Server.GetParam(ParamNumber : integer; pValue: pointer): integer; begin Result:=Srv_GetParam(HS, ParamNumber ,pValue) end; //------------------------------------------------------------------------------ function TS7Server.SetParam(ParamNumber : integer; pValue: pointer): integer; begin Result:=Srv_SetParam(HS, ParamNumber ,pValue) end; //------------------------------------------------------------------------------ function TS7Server.Start: integer; begin Result:=Srv_Start(HS) end; //------------------------------------------------------------------------------ function TS7Server.StartTo(Address: String): integer; begin Result:=Srv_StartTo(HS, PAnsiChar(AnsiString(Address))); end; //------------------------------------------------------------------------------ function TS7Server.Stop: integer; begin Result:=Srv_Stop(HS) end; //------------------------------------------------------------------------------ function TS7Server.UnlockArea(AreaCode, Index: integer): integer; begin Result:=Srv_UnlockArea(HS,AreaCode,Index) end; //------------------------------------------------------------------------------ function TS7Server.UnregisterArea(AreaCode, Index: integer): integer; begin Result:=Srv_UnregisterArea(HS,AreaCode, Index) end; //****************************************************************************** // TS7Partner CLASS IMPLEMENTATION //****************************************************************************** function TS7Partner.AsBSend(R_ID: longword; pUsrData: pointer; size: integer): integer; begin Result:=Par_AsBSend(HP, R_ID, pUsrData, Size); end; //------------------------------------------------------------------------------ function TS7Partner.BRecv(Timeout: longword; var R_ID: longword; pUsrData: pointer; var Size: integer): integer; begin Result:=Par_BRecv(HP, R_ID, pUsrData, Size, Timeout); end; //------------------------------------------------------------------------------ function TS7Partner.BSend(R_ID: longword; pUsrData: pointer; size: integer): integer; begin Result:=Par_BSend(HP, R_ID, pUsrData, Size); end; //------------------------------------------------------------------------------ function TS7Partner.CheckAsBRecvCompletion(var opResult: integer; var R_ID: longword; pUsrData: pointer; var Size: integer): boolean; begin Result:=Par_CheckAsBRecvCompletion(HP, opResult, R_ID, pUsrData, Size)=JobComplete; end; //------------------------------------------------------------------------------ function TS7Partner.CheckAsBSendCompletion(var opResult: integer): boolean; begin Result:=Par_CheckAsBSendCompletion(HP, opResult)=JobComplete; end; //------------------------------------------------------------------------------ constructor TS7Partner.Create(AsActive: boolean); begin HP := Par_Create(AsActive); end; //------------------------------------------------------------------------------ destructor TS7Partner.Destroy; begin Par_Destroy(HP); inherited; end; //------------------------------------------------------------------------------ function TS7Partner.GetBytesRecv: integer; begin GetStatistics; Result:=FBytesRecv; end; //------------------------------------------------------------------------------ function TS7Partner.GetBytesSent: integer; begin GetStatistics; Result:=FBytesSent; end; //------------------------------------------------------------------------------ function TS7Partner.GetLastError: integer; begin if Par_GetLastError(HP, Result)<>0 then Result:=errLibInvalidObject; end; //------------------------------------------------------------------------------ function TS7Partner.GetLinked: boolean; begin Result:=Status=par_linked; end; //------------------------------------------------------------------------------ function TS7Partner.GetRecvErrors: integer; begin GetStatistics; Result:=FRecvErrors; end; //------------------------------------------------------------------------------ function TS7Partner.GetRecvTime: longword; Var FSendTime : longword; begin if Par_GetTimes(HP, FSendTime, Result)<>0 then Result:=0; end; //------------------------------------------------------------------------------ function TS7Partner.GetSendErrors: integer; begin GetStatistics; Result:=FSendErrors; end; //------------------------------------------------------------------------------ function TS7Partner.GetSendTime: longword; Var FRecvTime : longword; begin if Par_GetTimes(HP, Result, FRecvTime)<>0 then Result:=0; end; //------------------------------------------------------------------------------ procedure TS7Partner.GetStatistics; begin if Par_GetStats(HP, FBytesSent, FBytesRecv, FSendErrors, FRecvErrors)<>0 then begin FBytesSent :=0; FBytesRecv :=0; FSendErrors:=0; FRecvErrors:=0; end; end; //------------------------------------------------------------------------------ function TS7Partner.GetStatus: integer; begin if Par_GetStatus(HP, Result)<>0 then Result:=errLibInvalidObject; end; //------------------------------------------------------------------------------ function TS7Partner.GetParam(ParamNumber: integer; pValue: Pointer): integer; begin Result:=Par_SetParam(HP, ParamNumber, pValue); end; //------------------------------------------------------------------------------ function TS7Partner.SetParam(ParamNumber: integer; pValue: Pointer): integer; begin Result:=Par_SetParam(HP, ParamNumber, pValue); end; //------------------------------------------------------------------------------ function TS7Partner.SetRecvCallback(pRecvCompletion, usrPtr: pointer): integer; begin Result:=Par_SetRecvCallback(HP, pRecvCompletion, usrPtr); end; //------------------------------------------------------------------------------ function TS7Partner.SetSendCallback(pSendCompletion, usrPtr: pointer): integer; begin Result:=Par_SetSendCallback(HP, pSendCompletion, usrPtr); end; //------------------------------------------------------------------------------ function TS7Partner.Start: integer; begin Result:=Par_Start(HP); end; //------------------------------------------------------------------------------ function TS7Partner.StartTo(LocalAddress, RemoteAddress: AnsiString; LocalTSAP, RemoteTSAP: word): integer; begin Result:=Par_StartTo(HP, PAnsiChar(LocalAddress), PAnsiChar(RemoteAddress), LocalTSAP, RemoteTSAP); end; //------------------------------------------------------------------------------ function TS7Partner.Stop: integer; begin Result:=Par_Stop(HP); end; //------------------------------------------------------------------------------ function TS7Partner.WaitAsBSendCompletion(Timeout: longword): integer; begin Result:=Par_WaitAsBSendCompletion(HP, Timeout); end; //****************************************************************************** // S7 CLASS IMPLEMENTATION //****************************************************************************** function TS7Helper.GetBit(pval: pointer; BitIndex: integer): boolean; Const Mask : array[0..7] of byte = ($01,$02,$04,$08,$10,$20,$40,$80); begin if BitIndex<0 then BitIndex:=0; if BitIndex>7 then BitIndex:=7; Result:=pbyte(pval)^ and Mask[BitIndex] <> 0; end; //------------------------------------------------------------------------------ function TS7Helper.GetDateTime(pval: pointer): TDateTime; Type S7DT = packed array[0..7] of byte; Var Buffer : ^S7DT; YY,MM,DD,HH,NN,SS,MS : word; C,D,U : integer; function BCD(const B: byte): word; begin Result:=(B and $0F) + ((B shr 4) * 10); end; begin Buffer:=pval; YY:= Buffer^[0]; if YY>137 then // 137 dec = 89 BCD YY:=1900+BCD(YY) else YY:=2000+BCD(YY); MM:=BCD(Buffer^[1]); DD:=BCD(Buffer^[2]); HH:=BCD(Buffer^[3]); NN:=BCD(Buffer^[4]); SS:=BCD(Buffer^[5]); // Millisec MS:=Buffer^[6]; MS:=(MS shl 8)+Buffer^[7]; // Last 4 bit are Day of Week MS:=MS shr 4; // Hex to Int C:=((MS and $0F00) shr 8) * 100; D:=((MS and $00F0) shr 4) * 10; U:= (MS and $000F); MS:=C+D+U; TryEncodeDateTime(YY,MM,DD,HH,NN,SS,MS,Result); end; //------------------------------------------------------------------------------ function TS7Helper.GetDInt(pval: pointer): longint; Var DW : packed array[0..3] of byte absolute Result; begin DW[0]:=pbyte(NativeInt(pval)+3)^; DW[1]:=pbyte(NativeInt(pval)+2)^; DW[2]:=pbyte(NativeInt(pval)+1)^; DW[3]:=pbyte(pval)^; end; //------------------------------------------------------------------------------ function TS7Helper.GetDWord(pval: pointer): longword; Var DW : packed array[0..3] of byte absolute Result; begin DW[0]:=pbyte(NativeInt(pval)+3)^; DW[1]:=pbyte(NativeInt(pval)+2)^; DW[2]:=pbyte(NativeInt(pval)+1)^; DW[3]:=pbyte(pval)^; end; //------------------------------------------------------------------------------ function TS7Helper.GetInt(pval: pointer): smallint; Var BW : packed array[0..1] of byte absolute Result; begin BW[0]:=pbyte(NativeInt(pval)+1)^; BW[1]:=pbyte(pval)^; end; //------------------------------------------------------------------------------ function TS7Helper.GetReal(pval: pointer): single; Var DW : packed array[0..3] of byte absolute Result; begin DW[0]:=pbyte(NativeInt(pval)+3)^; DW[1]:=pbyte(NativeInt(pval)+2)^; DW[2]:=pbyte(NativeInt(pval)+1)^; DW[3]:=pbyte(pval)^; end; //------------------------------------------------------------------------------ function TS7Helper.GetWord(pval: pointer): word; Var BW : packed array[0..1] of byte absolute Result; begin BW[0]:=pbyte(NativeInt(pval)+1)^; BW[1]:=pbyte(pval)^; end; //------------------------------------------------------------------------------ procedure TS7Helper.Reverse(pval: pointer; const S7Type: TS7Type); Var DT : TDateTime; begin case S7Type of S7Int, S7Word: SetWord(pval, pword(pval)^); S7DInt, S7DWord, S7Real: SetDWord(pval, plongword(pval)^); S7DT_To_DateTime: pDateTime(pval)^:=GetDateTime(pval); DateTime_To_S7DT: begin DT:=pdateTime(pval)^; SetDateTime(pval, DT); end; end; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetBit(pval: pointer; BitIndex: integer; const Value: boolean); Const Mask : array[0..7] of byte = ($01,$02,$04,$08,$10,$20,$40,$80); begin if BitIndex<0 then BitIndex:=0; if BitIndex>7 then BitIndex:=7; if Value then pbyte(pval)^ := pbyte(pval)^ or Mask[BitIndex] else pbyte(pval)^ := pbyte(pval)^ and not Mask[BitIndex]; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetDateTime(pval: pointer; const Value: TDateTime); Type DATE_AND_TIME = packed array[1..8] of byte; pDT = ^DATE_AND_TIME; function BCD(Value : word) : byte; begin Result:=((Value div 10) shl 4) OR (Value mod 10); end; function BCDW(Value : word) : word; Var AppC, AppD : word; begin AppC :=(Value div 100); Dec(Value,AppC * 100); AppD :=(Value div 10); Dec(Value,AppD * 10); Result:=(AppC shl 8) + (AppD shl 4) + Value; end; Var DT : pDT; MsDOW, AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word; begin DT:=pval; DecodeDateTime(Value,AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond); if AYear>1999 then AYear:=AYear-2000 else AYear:=AYear-1900; DT^[1]:=BCD(AYear); DT^[2]:=BCD(AMonth); DT^[3]:=BCD(ADay); DT^[4]:=BCD(AHour); DT^[5]:=BCD(AMinute); DT^[6]:=BCD(ASecond); MsDOW:=(BCDW(AMillisecond) shl 4) + DayOfWeek(Value)+1; DT^[7]:=HI(MsDOW); DT^[8]:=LO(MsDOW); end; //------------------------------------------------------------------------------ procedure TS7Helper.SetDInt(pval: pointer; const Value: longint); Var DW : packed array[0..3] of byte absolute value; begin pbyte(pval)^:=DW[3]; pbyte(NativeInt(pval)+1)^:=DW[2]; pbyte(NativeInt(pval)+2)^:=DW[1]; pbyte(NativeInt(pval)+3)^:=DW[0]; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetDWord(pval: pointer; const Value: longword); Var DW : packed array[0..3] of byte absolute value; begin pbyte(pval)^:=DW[3]; pbyte(NativeInt(pval)+1)^:=DW[2]; pbyte(NativeInt(pval)+2)^:=DW[1]; pbyte(NativeInt(pval)+3)^:=DW[0]; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetInt(pval: pointer; const Value: smallint); Var BW : packed array[0..1] of byte absolute value; begin pbyte(NativeInt(pval)+1)^:=BW[0]; pbyte(pval)^:=BW[1]; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetReal(pval: pointer; const Value: single); Var DW : packed array[0..3] of byte absolute value; begin pbyte(pval)^:=DW[3]; pbyte(NativeInt(pval)+1)^:=DW[2]; pbyte(NativeInt(pval)+2)^:=DW[1]; pbyte(NativeInt(pval)+3)^:=DW[0]; end; //------------------------------------------------------------------------------ procedure TS7Helper.SetWord(pval: pointer; const Value: word); Var BW : packed array[0..1] of byte absolute value; begin pbyte(NativeInt(pval)+1)^:=BW[0]; pbyte(pval)^:=BW[1]; end; //****************************************************************************** // TEXT ROUTINES //****************************************************************************** function CliErrorText(Error : integer) : string; Var Text : packed array[0..TextLen-1] of AnsiChar; begin if Cli_ErrorText(Error, @Text, TextLen)=0 then Result:=String(Text) else Result:='LIB : Error getting text'; end; //--------------------------------------------------------------------------- function SrvErrorText(Error : integer) : string; Var Text : packed array[0..TextLen-1] of AnsiChar; begin if Srv_ErrorText(Error, @Text, TextLen)=0 then Result:=String(Text) else Result:='LIB : Error getting text'; end; //--------------------------------------------------------------------------- function ParErrorText(Error : integer) : string; Var Text : packed array[0..TextLen-1] of AnsiChar; begin if Par_ErrorText(Error, @Text, TextLen)=0 then Result:=String(Text) else Result:='LIB : Error getting text'; end; //--------------------------------------------------------------------------- function SrvEventText(var Event : TSrvEvent) : string; Var Text : packed array[0..TextLen-1] of AnsiChar; begin if Srv_EventText(Event, @Text, TextLen)=0 then Result:=String(Text) else Result:='LIB : Error getting text'; end; initialization S7 := TS7Helper.Create; finalization S7.Free; end.