unicommx.pas

很好用的串口通信工具软件。Comport目录下是用到的通信控件。

    FDefaultProtocolType: Integer;      // 默认协议类型
    FDefaultProtocolVersion: Integer;   // 默认协议版本
    FDefaultTransferMode: TUniTransferMode; // 默认的通信模式
    FOutBuff: Pointer;                  // 发送数据缓冲区
    FOutBuffSize: Cardinal;             // 发送数据缓冲区大小
    FOptimize: FOptimizeMode;           // 优化模式

    function GetDataCount: Integer;     // 取得数据总量
    function GetData(Index: Integer): string; // 取得数据
    procedure SetParameters(value: TStringList); // 设定参数
    procedure CommWndProc(var msg: TMessage); virtual; // 消息处理程序
    procedure KillCommDevice;           // 释放当前的通信设备
    procedure KillCommThread;           // 释放当前的通信线程
    procedure SetDeviceType(value: TUniDeviceType); // 设定通信设备类型
    function GetDeviceType: TUniDeviceType; // 取得通信设备类型
    procedure SetActived(value: Boolean); // 设定是否激活
    procedure ResetComPort(DeviceType: TUniDeviceType = dtUnknown); // 初始化通信设备
    procedure SaveCommDatas;            // 保存通信数据
    procedure SetDeviceName(value: string); // 设定通信设备名称
    function GetDeviceName: string;     // 取得通信设备名称
    procedure OnParametersChange(Sender: TObject); // 参数改变事件
    function GetBusy: Boolean;          // 通信是否忙
    function GetTransferMode: TUniTransferMode; // 取得默认传输模式
    function GetCurrentTransferMode: TUniTransferMode; // 取得当前的传输模式
    procedure SetTransferMode(value: TUniTransferMode); // 设定默认传输模式
    function GetDefaultProtocolType: Integer; // 取得默认协议类型
    function GetDefaultProtocolVersion: Integer; // 取得默认协议版本
    procedure SetDefaultProtocolType(value: Integer); // 设定默认协议类型
    procedure SetDefaultProtocolVersion(value: Integer); // 设定默认协议版本
    function GetCurrentData: string;    // 取得当前数据
    function GetOutBuff: Pointer;       // 取得输出缓冲区
    procedure SetOutBuff(value: Pointer); // 设定输出缓冲区
    function GetOutBuffSize: Cardinal;  // 取得输出缓冲区大小
    procedure SetOutBuffSize(value: Cardinal); // 设定输出缓冲区大小
    function GetOptimizeMode: FOptimizeMode; // 取得优化模式
    procedure SetOptimizeMode(value: FOptimizeMode); // 设定优化模式

  public
    constructor Create(AOwner: TComponent); override; // 建构式
    destructor Destroy; override;       // 析构式
    procedure DiscardData(Index: Integer); // 删除数据
    property Data[Index: Integer]: string read GetData; // 取得数据
    property OutBuff: Pointer read GetOutBuff write SetOutBuff; // 输出缓冲区

    function InitiativelyConnect(Params: string): Boolean; // 主动连接
    procedure SetBaudRate(value: TUniBaudRate); // 设定通信速率
    function GetBaudRate: TUniBaudRate; // 取得通信速率
    class procedure EnumDevice(DeviceType: TUniDeviceType; Device: TStrings); // 取得所有可用设备名称
  published
    property Parameters: TStringList read FParameters write SetParameters; // 通信参数
    property CurrentData: string read GetCurrentData; // 当前数据
    property DataCount: Integer read GetDataCount; // 数据总量
    property Actived: Boolean read FActived write SetActived; // 是否激活
    property DeviceType: TUniDeviceType read GetDeviceType write SetDeviceType; // 设备类型
    property DeviceName: string read GetDeviceName write SetDeviceName; // 设备名称
    property BaudRate: TUniBaudRate read GetBaudRate write SetBaudRate; // 通信速率
    property DefaultTransferMode: TUniTransferMode read GetTransferMode write SetTransferMode; // 默认通信模式
    property CurrentTransferMode: TUniTransferMode read GetCurrentTransferMode; //当前通信模式
    property DefaultProtocolType: Integer read GetDefaultProtocolType write SetDefaultProtocolType; //默认协议类型
    property DefaultProtocolVersion: Integer read GetDefaultProtocolVersion write SetDefaultProtocolVersion; //默认协议版本
    property OutBuffSize: Cardinal read GetOutBuffSize write SetOutBuffSize; // 输出缓冲区大小
    property Busy: Boolean read GetBusy; // 是否通信忙
    property OptimizeMode: FOptimizeMode read GetOptimizeMode write SetOptimizeMode; // 优化模式
    property OnInitCompleted: TInitCompletedEvent read FInitCompletedEvent write FInitCompletedEvent; // 事件：初始化完成
    property OnConnectState: TConnectStateEvent read FConnectStateEvent write FConnectStateEvent; // 事件：连接状态改变
    property OnProgress: TProgressEvent read FProgressEvent write FProgressEvent; // 事件：通信进度改变
    property OnDealData: TDealDataEvent read FDealDataEvent write FDealDataEvent; // 事件：需要处理数据
    property OnCommCompleted: TCommCompletedEvent read FCommCompletedEvent write FCommCompletedEvent; // 事件：通信完毕
  end;

function UniCreateGUID: string;         // 生成一个GUID字符串，16字节长
function DeleteLeadBracket(Text: string): string; // 删除前导括号 如 (1)abc 转换为 abc
function ConvBCDToHex(BCD: Byte): Byte; // 将BCD码转换为实际值，如 $51 转换为 51
function GenerateCRC(const buff; count: Integer): Byte; // 生成一个缓冲区数据的CRC校验值
function CrcOfString(str: string): Byte; // 生成一个字符串的CRC校验
function ConvHexStrToBinary(BCDStr: string): string; // 将十六进制字符串转换为二进制字符串。如：'55AA' 转换为 #$55#$AA
function AddressToStr(Address: Integer): string; // 将给定的地址值(整形)转换为3字节字符串
procedure Debug(Owner, msg: string);    // 增加调试信息
function GetAndClearDebugMsg: string;   // 取得调试信息并删除调试缓冲区
function ConvBinaryToHexStr(data: string): string; // 将二进制字符串转换为16进制字符串。如 #$AA#$55 转化为 'AA55'
function WaitFor_Any_Events(Handles: array of THandle; dwMilliseconds: DWORD): DWORD; // 等待任意一个Handle变为有信号状态
procedure RegisterDeviceClass(AClass: TCustomDeviceClass); // 注册通信设备类型
procedure RegisterExecutorClass(AClass: TCustomProtocolExecutorClass); // 注册协议处理类型
function GetProtocolClass(const SenderID: Integer; const ProtocolVersion: Integer; isCommander: Boolean): TCustomProtocolExecutorClass; overload; // 根据给定的协议种类以及版本查找合适的协议处理类
function GetDeviceClass(const DeviceType: TUniDeviceType): TCustomDeviceClass; overload; // 根据给定的通信设备类型查找合适的通信设备
function GetCompatibleCommand(cmdBuffer: string; cmdArray: array of TCommandTag; var curPos: Integer): Integer; // 根据给定的数据缓冲区查找其中是否含有某个命令
procedure SafePostMessage(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM); // 安全发送消息，确保消息发送到
function MakeLanID(P, S: Word): Word;   // 生成语言代码
function IntToChar4B(IntVal: Cardinal): string; // 将地址转换为4字节的字符串
function Char4BToInt(CharVal: string): Cardinal; // 将4字节的字符串转换为地址

procedure Register;

implementation

uses UniDevice_BuiltIn;

const
  Max_Idle_Time = 20000;                // Responder 的最长线路静默时间。如果超过此时间没有收到命令，则挂机

var
  ClassCommDeviceList: TThreadList;     // 保存所有通信设备类
  ClassProtocolList: TThreadList;       // 保存所有协议处理类
  HSem: Thandle;                        // 信号量，用于调试消息生成
{$IFDEF DEBUG_FILE}
  SystemStartupTime: TDateTime;         // 系统启动时间，用于调试
  DebugFiles: TStrings;                 // 所有的调试文件名称，如果指定 DEBUG_FILE 会生成调试文件
  DebugFileStream: TFileStream;         // 调试文件，如果指定 DEBUG_FILE 会生成调试文件
{$ENDIF}

{$IFDEF DEBUG_MSG}
  DebugStrings: TStrings;               // 调试消息缓冲区，只有指定 DEBUG_MSG 才会生成调试消息
{$ENDIF}


procedure DebugMsg_Lock;                // 锁住调试信息，防止冲突
begin
  WaitForSingleObject(HSem, INFINITE);
end;

procedure DebugMsg_UnLock;              // 解锁调试信息
begin
  ReleaseSemaphore(hSem, 1, nil);
end;


{$IFDEF DEBUG_FILE}

function GenerateDebugFileName(Owner: string): string; // 生成调试文件名称
begin
  Result := FormatDateTime('yyyy-mm-dd hh-nn-ss', SystemStartupTime) + '(' +
    Owner + ').Log';
end;
{$ENDIF}

{---------------------- TCustomCommDevice -------------------------}

{--------------------------------------------------------------------------
constructor TCustomCommDevice.Create
功能： TCustomCommDevice 建构式
输入： OwnerHandle: THandle 拥有者的handle。此Handle用来接收消息。
输出： 无
---------------------------------------------------------------------------}

constructor TCustomCommDevice.Create;
begin
  FActived := False;
  FDeviceName := '';
  FDeviceType := dtComPort;
  FDeviceState := dsIdle;
  FBaudRate := br57600;
  FLastInitiativeTime := 0;             // 保存上一次主动连接的时间，以便作是否连接超时判断
  FDeviceValid := False;
  FEvent_DataArrive := CreateEvent(nil, False, False, nil);
  FEvent_InitState := CreateEvent(nil, False, False, nil);
  FEvent_ConnectState := CreateEvent(nil, False, False, nil);
end;

destructor TCustomCommDevice.Destroy;
begin
  CloseHandle(Event_DataArrive);
  CloseHandle(Event_InitState);
  CloseHandle(Event_ConnectState);
  inherited;
end;

{--------------------------------------------------------------------------
procedure TCustomCommDevice.NotifyInitCompleted
功能： 通知已经初始化完成。如果初始化成功将Actived标志置为True
输入： InitResult: Boolean  初始化结果
输出： 无
---------------------------------------------------------------------------}

procedure TCustomCommDevice.NotifyInitCompleted(InitResult: Boolean);
begin
  FActived := InitResult;               // 初始化结果即为激活标志
  if InitResult then
    Debug(FDeviceName, '初始化成功')
  else
    Debug(FDeviceName, '初始化失败');
  FInitSuccess := InitResult;
  FDeviceValid := InitResult;
  SetEvent(Event_InitState);            // 设定初始化完成信号
  InitiativelyConnecting := False;      // 初始化时，一定不是在主动连接
  if Assigned(FInitCompletedEvent) then
  try
    FInitCompletedEvent(self, InitResult); // 通知初始化完成，在本程序中没有使用
  except
  end;
end;

{--------------------------------------------------------------------------
procedure TCustomCommDevice.NotifyConnection
功能： 通知已经连接状态改变。
输入： Connected: Boolean 是否连接成功
输出： 无
---------------------------------------------------------------------------}

procedure TCustomCommDevice.NotifyConnection(ConnectResult: Boolean);
begin
  FConnected := ConnectResult;
  if FConnected then
  begin
    if FIsInitiative then
      Debug(FDeviceName, '主动连接成功')
    else
      Debug(FDeviceName, '连接成功')
  end
  else
  begin
    if FIsInitiative then
      Debug(FDeviceName, '主动连接失败')
    else
      Debug(FDeviceName, '连接失败')
  end;
  SetEvent(Event_ConnectState);         // 使用信号来通知连接成功
  if Assigned(FConnectedEvent) then
  try
    FConnectedEvent(self, Connected, InitiativelyConnecting); // 在本程序中没有用到
  except
  end;
  InitiativelyConnecting := False;      // 连接成功后，就不处于正在主动连接状态
end;

{--------------------------------------------------------------------------
procedure TCustomCommDevice.NotifyDataArrive
功能： 通知接收到了数据
输入： data: string 接收到的数据
输出： 无
---------------------------------------------------------------------------}

procedure TCustomCommDevice.NotifyDataArrive(data: string);
begin
  if Assigned(FDataArriveEvent) then
  try
    FDataArriveEvent(self, data);       // 为保证通信实时性，接管接收到数据的事件
  except
  end;
end;

{--------------------------------------------------------------------------
function TCustomCommDevice.GetBusy: Boolean;
功能： 指示本设备是否忙。只有在休眠或者等待连接的状态中才不忙。
输入： 无
输出： Boolean 是否忙
---------------------------------------------------------------------------}

function TCustomCommDevice.GetBusy: Boolean;
begin
  // 系统只有在初始化成功并且正在等待连接时，才是空闲可用的
  // 只有在空闲时，才可主动连接
  Result := False;
  if not DeviceValid then
    Result := True
  else if not (FDeviceState in [dsWaitForConnect]) then
    Result := True;
end;

function TCustomCommDevice.InitiativelyConnect(Params: string): Boolean;
begin
  FLastInitiativeTime := GetTickCount;  // 当主动连接时，保存本次主动连接的时间，以便作超时处理
  Result := False;
end;

procedure TCustomCommDevice.CloseDevice;
begin
  // 关闭设备时，需要初始化一些变量
  ResetEvent(Event_DataArrive);
  ResetEvent(Event_InitState);
  ResetEvent(Event_ConnectState);
  FIsInitiative := False;
  InitiativelyConnecting := False;
  FDeviceValid := False;
end;

{---------------------- TCustomProtocolExecutor ----------------------------}

{--------------------------------------------------------------------------
constructor TCustomProtocolExecutor.Create
功能： TCustomProtocolExecutor 建构式
输入： SenderID: Integer          当前的发送者标志
       ProtocolVersion: Integer   当前的协议类型
输出： 无
---------------------------------------------------------------------------}

constructor TCustomProtocolExecutor.Create(SenderID, ProtocolVersion: Integer; Hwnd: THandle);
begin
  OwnerHwnd := Hwnd;
  FSenderID := SenderID;
  FProtocolVersion := ProtocolVersion;
  FDatas := TStringList.Create;         // 使用TStringList保存通信数据
  FCommSuccess := False;
  FInBuff := nil;