⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modlinkdemomain.pas

📁 ModLink VCL component 组件以及代码。版本是shareware edition of ModLink 2.10
💻 PAS
📖 第 1 页 / 共 5 页
字号:
{*****************************************************************}
{                                                                 }
{ ModLink                                                         }
{ Copyright (C) 2002 - 2007 Ing. Ivo Bauer                        }
{ All Rights Reserved.                                            }
{                                                                 }
{ Web site: http://www.ozm.cz/ivobauer/modlink/                   }
{ E-mail:   ivo.bauer@tiscali.cz | bauer@ozm.cz                   }
{                                                                 }
{ For a detailed information regarding the distribution and use   }
{ of this software product, please refer to the License Agreement }
{ embedded in the accompanying online documentation (ModLink.chm) }
{                                                                 }
{*****************************************************************}

unit ModLinkDemoMain;

{$I ModLink.inc}

interface

//--------------------------------------------------------------------------------------------------

uses
  { Windows } Windows, Messages,
  { Delphi  } SysUtils, {$IFDEF COMPILER_6_UP} Variants , {$ENDIF COMPILER_6_UP} Classes, Graphics,
              Controls, Forms, Dialogs, Menus, ComCtrls, StdCtrls, ExtCtrls, Buttons, IniFiles,
  { ModLink } ModLink,
  { Project } ServerItem, ServerItemEditor;

//--------------------------------------------------------------------------------------------------

type
  TModLinkDemoMainForm = class(TForm)
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    ToolsMenu: TMenuItem;
    HelpMenu: TMenuItem;
    FileExitItem: TMenuItem;
    ToolsConnectionOptionsItem: TMenuItem;
    ToolsClientOptionsItem: TMenuItem;
    HelpAboutItem: TMenuItem;
    ModbusConnection1: TModbusConnection;
    ModbusClient1: TModbusClient;
    StatusBar1: TStatusBar;
    PageControl1: TPageControl;
    LogMemo: TMemo;
    IntroductionTabSheet: TTabSheet;
    DiscreteAccessTabSheet: TTabSheet;
    RegisterAccessTabSheet: TTabSheet;
    DiagnosticsTabSheet: TTabSheet;
    Panel1: TPanel;
    DiagnosticActionRadioGroup: TRadioGroup;
    DiagnosticsButton: TButton;
    N2: TMenuItem;
    ToolsClearTransactionLogItem: TMenuItem;
    DiscreteReadGroupBox: TGroupBox;
    Label3: TLabel;
    Label2: TLabel;
    ReadStartBitEdit: TEdit;
    ReadBitCountEdit: TEdit;
    ReadCoilsButton: TButton;
    ReadDiscreteInputsButton: TButton;
    DiscreteWriteGroupBox: TGroupBox;
    DiscreteListView: TListView;
    WriteSingleCoilButton: TButton;
    WriteMultipleCoilsButton: TButton;
    Label1: TLabel;
    WriteStartBitEdit: TEdit;
    Label7: TLabel;
    WriteBitCountEdit: TEdit;
    RegisterReadGroupBox: TGroupBox;
    Label9: TLabel;
    Label10: TLabel;
    ReadStartRegEdit: TEdit;
    ReadRegCountEdit: TEdit;
    ReadHoldingRegistersButton: TButton;
    ReadInputRegistersButton: TButton;
    RegisterWriteGroupBox: TGroupBox;
    Label4: TLabel;
    Label5: TLabel;
    RegisterListView: TListView;
    RegisterBroadcastCheckBox: TCheckBox;
    WriteStartRegEdit: TEdit;
    WriteRegCountEdit: TEdit;
    WriteSingleRegisterButton: TButton;
    WriteMultipleRegistersButton: TButton;
    RegisterMaskWriteGroupBox: TGroupBox;
    Label11: TLabel;
    MaskWriteRegAddrEdit: TEdit;
    Label6: TLabel;
    AndMaskEdit: TEdit;
    Label8: TLabel;
    OrMaskEdit: TEdit;
    MaskWriteSingleRegisterButton: TButton;
    DiscreteBroadcastCheckBox: TCheckBox;
    IntroductionRichEdit: TRichEdit;
    Timer1: TTimer;
    ToolsDiscardPendingTransactionsItem: TMenuItem;
    ServerMapTabSheet: TTabSheet;
    ModbusServer1: TModbusServer;
    ToolsServerOptionsItem: TMenuItem;
    ServerItemsListView: TListView;
    AddButton: TBitBtn;
    RemoveButton: TButton;
    RemoveAllButton: TButton;
    PopupMenu1: TPopupMenu;
    AddCoilItem: TMenuItem;
    AddDiscreteInputItem: TMenuItem;
    AddHoldingRegisterItem: TMenuItem;
    AddInputRegisterItem: TMenuItem;
    EditButton: TButton;
    ReadExceptionStatusButton: TButton;
    ReportServerIDButton: TButton;
    Bevel1: TBevel;
    RegisterReadWriteGroupBox: TGroupBox;
    ReadWriteMultipleRegistersButton: TButton;
    ToolsLogTransactionsToFileItem: TMenuItem;
    procedure FileExitItemClick(Sender: TObject);
    procedure ToolsConnectionOptionsItemClick(Sender: TObject);
    procedure ToolsClientOptionsItemClick(Sender: TObject);
    procedure HelpAboutItemClick(Sender: TObject);
    procedure ReadCoilsButtonClick(Sender: TObject);
    procedure ReadDiscreteInputsButtonClick(Sender: TObject);
    procedure WriteSingleCoilButtonClick(Sender: TObject);
    procedure WriteMultipleCoilsButtonClick(Sender: TObject);
    procedure ModbusClient1CoilsRead(Sender: TModbusClient;
      const Info: TTransactionInfo; BitStart, BitCount: Word;
      const BitValues: TBitValues);
    procedure ModbusClient1DiscreteInputsRead(Sender: TModbusClient;
      const Info: TTransactionInfo; BitStart, BitCount: Word;
      const BitValues: TBitValues);
    procedure ModbusClient1SingleCoilWrite(Sender: TModbusClient;
      const Info: TTransactionInfo; BitAddr: Word; BitValue: Boolean);
    procedure ModbusClient1MultipleCoilsWrite(Sender: TModbusClient;
      const Info: TTransactionInfo; BitStart, BitCount: Word;
      const BitValues: TBitValues);
    procedure ModbusConnection1FrameSend(Sender: TModbusConnection;
      const Data: TFrameData);
    procedure ModbusConnection1FrameReceive(Sender: TModbusConnection;
      const Data: TFrameData);
    procedure ReadHoldingRegistersButtonClick(Sender: TObject);
    procedure ReadInputRegistersButtonClick(Sender: TObject);
    procedure WriteSingleRegisterButtonClick(Sender: TObject);
    procedure WriteMultipleRegistersButtonClick(Sender: TObject);
    procedure RegisterListViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure RegisterListViewDblClick(Sender: TObject);
    procedure ModbusClient1HoldingRegistersRead(Sender: TModbusClient;
      const Info: TTransactionInfo; StartReg, RegCount: Word;
      const RegValues: TRegValues);
    procedure ModbusClient1InputRegistersRead(Sender: TModbusClient;
      const Info: TTransactionInfo; StartReg, RegCount: Word;
      const RegValues: TRegValues);
    procedure ModbusClient1SingleRegisterWrite(Sender: TModbusClient;
      const Info: TTransactionInfo; RegAddr, RegValue: Word);
    procedure ModbusClient1MultipleRegistersWrite(Sender: TModbusClient;
      const Info: TTransactionInfo; StartReg, RegCount: Word;
      const RegValues: TRegValues);
    procedure MaskWriteSingleRegisterButtonClick(Sender: TObject);
    procedure ModbusClient1SingleRegisterMaskWrite(Sender: TModbusClient;
      const Info: TTransactionInfo; RegAddr, AndMask, OrMask: Word);
    procedure DiagnosticsButtonClick(Sender: TObject);
    procedure ModbusClient1Diagnostics(Sender: TModbusClient;
      const Info: TTransactionInfo; Action: TDiagnosticAction;
      Result: Word);
    procedure ToolsClearTransactionLogItemClick(Sender: TObject);
    procedure WriteStartBitEditExit(Sender: TObject);
    procedure WriteBitCountEditExit(Sender: TObject);
    procedure WriteStartRegEditExit(Sender: TObject);
    procedure WriteRegCountEditExit(Sender: TObject);
    procedure RegisterListViewEdited(Sender: TObject; Item: TListItem;
      var S: String);
    procedure ModbusConnection1BeforeOpen(Sender: TObject);
    procedure ModbusConnection1AfterOpen(Sender: TObject);
    procedure ModbusConnection1BeforeClose(Sender: TObject);
    procedure ModbusConnection1AfterClose(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ToolsDiscardPendingTransactionsItemClick(Sender: TObject);
    procedure ToolsServerOptionsItemClick(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure RemoveButtonClick(Sender: TObject);
    procedure RemoveAllButtonClick(Sender: TObject);
    procedure AddServerItemClick(Sender: TObject);
    procedure EditButtonClick(Sender: TObject);
    procedure ServerItemsListViewDeletion(Sender: TObject;
      Item: TListItem);
    procedure ServerItemsListViewDblClick(Sender: TObject);
    procedure ServerItemsListViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ServerItemsListViewCompare(Sender: TObject; Item1,
      Item2: TListItem; Data: Integer; var Compare: Integer);
    procedure ModbusServer1AcceptCommand(Sender: TModbusServer;
      Command: Byte; var Accept: Boolean);
    procedure ModbusServer1CanReadCoil(Sender: TModbusServer;
      BitAddr: Word; var Allow: Boolean);
    procedure ModbusServer1CanReadDiscreteInput(Sender: TModbusServer;
      BitAddr: Word; var Allow: Boolean);
    procedure ModbusServer1CanReadHoldingRegister(Sender: TModbusServer;
      RegAddr: Word; var Allow: Boolean);
    procedure ModbusServer1CanReadInputRegister(Sender: TModbusServer;
      RegAddr: Word; var Allow: Boolean);
    procedure ModbusServer1CanWriteCoil(Sender: TModbusServer;
      BitAddr: Word; BitValue: Boolean; var Status: TItemWriteStatus);
    procedure ModbusServer1CanWriteHoldingRegister(Sender: TModbusServer;
      RegAddr, RegValue: Word; var Status: TItemWriteStatus);
    procedure ModbusServer1GetCoilValue(Sender: TModbusServer;
      BitAddr: Word; var BitValue: Boolean);
    procedure ModbusServer1GetDiscreteInputValue(Sender: TModbusServer;
      BitAddr: Word; var BitValue: Boolean);
    procedure ModbusServer1GetHoldingRegisterValue(Sender: TModbusServer;
      RegAddr: Word; var RegValue: Word);
    procedure ModbusServer1GetInputRegisterValue(Sender: TModbusServer;
      RegAddr: Word; var RegValue: Word);
    procedure ModbusServer1SetCoilValue(Sender: TModbusServer;
      BitAddr: Word; BitValue: Boolean);
    procedure ModbusServer1SetHoldingRegisterValue(Sender: TModbusServer;
      RegAddr, RegValue: Word);
    procedure ReadExceptionStatusButtonClick(Sender: TObject);
    procedure ModbusClient1ExceptionStatusRead(Sender: TModbusClient;
      const Info: TTransactionInfo;
      const StatusValues: TExceptionStatusValues);
    procedure ReportServerIDButtonClick(Sender: TObject);
    procedure ModbusClient1ServerIdentificationReport(
      Sender: TModbusClient; const Info: TTransactionInfo; Count: Integer;
      const Data: TServerIdentificationData);
    procedure ReadWriteMultipleRegistersButtonClick(Sender: TObject);
    procedure ModbusClient1MultipleRegistersReadWrite(
      Sender: TModbusClient; const Info: TTransactionInfo; StartRegToRead,
      RegCountToRead: Word; const RegValuesToRead: TRegValues;
      StartRegToWrite, RegCountToWrite: Word;
      const RegValuesToWrite: TRegValues);
    procedure ToolsLogTransactionsToFileItemClick(Sender: TObject);
  private
    fLogTransactionsToFile: Boolean;
    fLogCounter: Cardinal;
    fLogFile: TFileStream;
    procedure BeginLogTransactions;
    procedure ClearTransactionLog;
    procedure ConnectionModeChanged;
    procedure EditSelectedServerItem;
    procedure EndLogTransactions;
    function FindServerItemByAddress(Address: Word; ItemKind: TItemKind): PServerItem;
    procedure LogBroadcast;
    procedure LogDone(ID: Cardinal; const CmdDesc: string);
    procedure LogExceptionStatusBit(BitIndex: Word; BitValue: Boolean);
    procedure LogFrame(const Data: TFrameData; Send: Boolean);
    procedure LogIdentificationData(const Data: TServerIdentificationData);
    procedure LogInit(ID: Cardinal; const CmdDesc: string);
    procedure LogProcessedBits(BitCount: Word; Coils: Boolean);
    procedure LogProcessedRegs(RegCount: Word; Holding: Boolean);
    procedure LogServerReadError(ItemKind: TItemKind; ItemAddr: Word);
    procedure LogServerWriteError(ItemKind: TItemKind; ItemAddr: Word;
      ItemValue: Word; Status: TItemWriteStatus);
    procedure LogSingleBit(BitIndex: Word; BitValue: Boolean; Coil: Boolean);
    procedure LogSingleRegister(RegIndex: Word; RegValue: Word; Holding: Boolean);
    procedure LogStatus(const Info: TTransactionInfo);
    procedure LogString(const S: string);
    procedure LogStringToFile(const S: string);
    procedure UpdateConnectionStatus;
    procedure UpdateDiscreteListView;
    procedure UpdateRegisterListView;
    procedure UpdateServerItem(Item: TListItem);
    procedure ValidateRegisterMaskWriteGroupBox;
    procedure ValidateDiscreteReadGroupBox;
    procedure ValidateDiscreteWriteGroupBox;
    procedure ValidateRegisterReadGroupBox;
    procedure ValidateRegisterWriteGroupBox;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadServerItems(const aFileName: string);
    procedure LoadSettings(aIniFile: TCustomIniFile);
    procedure SaveServerItems(const aFileName: string);
    procedure SaveSettings(aIniFile: TCustomIniFile);
  end;

//--------------------------------------------------------------------------------------------------

var
  ModLinkDemoMainForm: TModLinkDemoMainForm;

//--------------------------------------------------------------------------------------------------

implementation

//--------------------------------------------------------------------------------------------------

uses SysConst, Consts, Math, ModbusConnectionEditor, ModLinkAboutBox;

//--------------------------------------------------------------------------------------------------

{$R *.dfm}

//--------------------------------------------------------------------------------------------------

const
  gcGeneral               = 'General';
  gcModbusConnection1     = 'ModbusConnection1';
  gcModbusClient1         = 'ModbusClient1';
  gcModbusServer1         = 'ModbusServer1';
  // ---
  gcAddress               = 'Address';
  gcBaudRate              = 'BaudRate';
  gcConnectionMode        = 'ConnectionMode';
  gcCustomBaudRate        = 'CustomBaudRate';
  gcDataBits              = 'DataBits';
  gcDTREnabled            = 'DTREnabled';
  gcEchoQryBeforeRpy      = 'EchoQueryBeforeReply';
  gcFlowControl           = 'FlowControl';
  gcLogTransactionsToFile = 'LogTransactionsToFile';
  gcMaxRetries            = 'MaxRetries';
  gcParity                = 'Parity';
  gcPort                  = 'Port';
  gcReceiveTimeout        = 'ReceiveTimeout';
  gcRefetchDelay          = 'RefetchDelay';
  gcRTSEnabled            = 'RTSEnabled';
  gcSendTimeout           = 'SendTimeout';
  gcServerAddress         = 'ServerAddress';
  gcSilentInterval        = 'SilentInterval';
  gcStopBits              = 'StopBits';
  gcThreadPriority        = 'ThreadPriority';
  gcTransmissionMode      = 'TransmissionMode';
  gcTurnaroundDelay       = 'TurnaroundDelay';

//--------------------------------------------------------------------------------------------------

type
  TAccessSettingsProc = procedure (aIniFile: TCustomIniFile) of object;

//--------------------------------------------------------------------------------------------------

procedure AccessSettings(const IniFileName: string; AccessProc: TAccessSettingsProc);
var
  IniFile: TCustomIniFile;
begin
  IniFile := TIniFile.Create(IniFileName);
  try
    AccessProc(IniFile);
  finally
    IniFile.Free;
  end;
end;

//--------------------------------------------------------------------------------------------------

var
  SettingsFileName: TFileName = '';

//--------------------------------------------------------------------------------------------------

function GetSettingsFileName: TFileName;
begin
  if SettingsFileName = EmptyStr then
    SettingsFileName := ExtractFilePath(ParamStr(0)) + 'ModLinkDemo.dat';
  Result := SettingsFileName;
end;

//--------------------------------------------------------------------------------------------------

var
  ServerItemsFileName: TFileName = '';

//--------------------------------------------------------------------------------------------------

function GetServerItemsFileName: TFileName;
begin
  if ServerItemsFileName = EmptyStr then
    ServerItemsFileName := ExtractFilePath(ParamStr(0)) + 'ServerItems.dat';
  Result := ServerItemsFileName;
end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -