unit1.~pas

RS232串口通讯随书源码

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    rdCOM: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    btnOpenPort: TButton;
    btnEnd: TButton;
    spCD: TShape;
    spDSR: TShape;
    spCTS: TShape;
    Label3: TLabel;
    Label4: TLabel;
    spRI: TShape;
    Timer1: TTimer;
    spDTR: TShape;
    Label5: TLabel;
    Label6: TLabel;
    spRTS: TShape;
    btnDTR: TButton;
    btnRTS: TButton;
    procedure btnOpenPortClick(Sender: TObject);
    procedure btnEndClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure btnDTRClick(Sender: TObject);
    procedure btnRTSClick(Sender: TObject);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DTRMode,RTSMode,Port:Integer;
  Function PortSet():Boolean;
implementation
 uses PComm,MxTool,EXGLOBAL; //PCOmm引用声明放于此
{$R *.DFM}

//以下是打开通信端口的程序
procedure TForm1.btnOpenPortClick(Sender: TObject);
var
 Ret:Integer;
begin
 //打开通信端口
 Port := rdCom.ItemIndex+1;  //指定通信端口
 Ret := sio_Open(Port);
  If ret <> SIO_OK Then
   begin
     ShowMessage('打开通信端口错误');
     sio_close (Port);
     Exit;
   end;
   If Not PortSet() Then   //参数设置
   begin
     sio_close(Port);
     ShowMessage('通信端口参数设置发生错误');
     Exit;
   End;
    //降低DTR及RTS的电压
    ret := sio_DTR(Port, 0);
    ret := sio_RTS(Port, 0);
    //激活定时器
    Timer1.Enabled := True;
end;


//以下是结束按钮的动作
procedure TForm1.btnEndClick(Sender: TObject);
begin
   //关闭通信端口
   sio_Close(Port);
   //结束程序
   close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Ret:Integer;
begin
  ret := sio_lstatus(Port);//读取状态
  If ret < 0 Then
   begin
    ShowMessage('状态错误');
    Timer1.Enabled := False;
   end 
  Else
    begin
     //各线路状态检查
      If (ret And S_DSR) > 0 Then
        spDSR.Brush.Color := clRed
      Else
       spDSR.Brush.Color := clWhite;

      If (ret And S_CD) > 0 Then
        spCD.Brush.Color := clRed
      Else
       spCD.Brush.Color := clWhite;

      If (ret And S_RI) > 0 Then
        spRI.Brush.Color := clRed
      Else
        spRI.Brush.Color := clWhite;

      If (ret And S_CTS) > 0 Then
        spCTS.Brush.Color := clRed
      Else
       spCTS.Brush.Color := clWhite;
    End;

end;

procedure TForm1.btnDTRClick(Sender: TObject);
var
  ret:Integer;
begin
  //计算DTR线路状态
  DTRMode := (DTRMode + 1) Mod 2 ;
  If DTRMode = 1 Then
    spDTR.Brush.Color:=clRed
  Else
    spDTR.Brush.Color:=clWhite;
  //控制DTR线路状态
  ret := sio_DTR(Port, DTRMode);
  If ret <> SIO_OK Then
   begin
    ShowMessage('DTR控制错误');
    Exit;
   end;
end;

procedure TForm1.btnRTSClick(Sender: TObject);
var
  ret:Integer;
begin
  //计算RTS状态
  RTSMode := (RTSMode + 1) Mod 2 ;
  If RTSMode = 1 Then
    spRTS.Brush.Color:=clRed
  Else
    spRTS.Brush.Color:=clWhite;
  //控制RTS状态
  ret := sio_RTS(Port, RTSMode);
  If ret <> SIO_OK Then
   begin
    ShowMessage('RTS控制错误');
    Exit;
   end;
end;

//以下是通信参数的函数实现
Function PortSet():Boolean;
var
   mode,Hw,Sw,ret,tout:LongInt;
begin
//参数设置子程序
    mode := P_NONE Or BIT_8 Or STOP_1;
    Hw := 0 ;   //没有硬件流量控制
    Sw := 0 ;  //没有软件流量控制
    Result := False ;
    ret := sio_ioctl(Port, B38400, mode); //Setting
    If ret <> SIO_OK Then
     begin
        ShowMessage('设置时发生错误');
        Exit;
     end;
    ret := sio_flowctrl(Port, Hw or Sw); //Flow Control
    If ret <> SIO_OK Then
      begin
        ShowMessage('流量设置时发生错误');
        Exit;
      end;
    Result := True;
End;
end.