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;
    mSend: TMemo;
    mReceive: TMemo;
    Label5: TLabel;
    Label6: TLabel;
    procedure btnOpenPortClick(Sender: TObject);
    procedure btnEndClick(Sender: TObject);
    Function  PortSet():Boolean;
    Procedure ClearIrq();
    Function  InitIrq():Boolean;
    procedure mSendKeyPress(Sender: TObject; var Key: Char);
  private

  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  DTRMode,RTSMode,Port:Integer;
  Procedure CntIrq(iPort:LongInt);stdcall;
  Procedure ModemIrq(iPort:LongInt);stdcall;

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);
    //设置中断
    if  not InitIrq then
    begin
      sio_close(Port);
      ShowMessage('通信端口参数设置发生错误');
      Exit;
    end;
end;

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

//以下是通信参数的函数实现
Function TForm1.PortSet():Boolean;
var
   mode,Hw,Sw,ret: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;

//准备被调用的回调函数，此函数必须独立，不可放进窗体
//此函数用来接收它方所传送过来的数据
Procedure CntIrq(iPort:LongInt);stdcall;
var
  rLen:LongInt;
  PBuf:PChar;
  Buf:String;
begin
  //给一个空间存数据，一定要有
  PBuf := PChar(StringOfChar(' ',1024));
  rlen := sio_read(iPort,PBuf , 1024); //读取数据
  If rlen = 0 Then Exit; //若无数据则跳出
  Buf := StrPas(PBuf);
  Buf := Copy(Buf,1,rlen);
  //将数据显示在Memo中，并将光标拉至最低处
  Form1.mReceive.Text := Form1.mReceive.Text + Buf;
  Form1.mReceive.SelStart := Length(Form1.mReceive.Text);
  Form1.mReceive.SelLength := 0;
end;

//准备被调用的回调函数，此函数必须独立，不可放进窗体
//此函数用来检测硬件线路状态
Procedure ModemIrq(iPort:LongInt);stdcall;
var
  ret:integer;
begin
ret := sio_lstatus(iPort);   //读取状态
If ret < 0 Then
      ShowMessage('状态错误')
Else
 //以下依状况改变灯号的颜色
 begin
    If (ret And S_DSR) > 0 Then
      Form1.spDSR.Brush.Color := clRed
    Else
      Form1.spDSR.Brush.Color := clWhite;

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

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

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

  End ;
End ;

//中断的初始化函数
//在此指定了Count的中断及硬件线路的中断
Function TForm1.InitIrq():Boolean;
var
    ret:LongInt;
begin
    Result := False;
    ret := sio_cnt_irq(Port, CntIrq, 1);  //指定接收事件中断
    If ret <> SIO_OK Then
    begin
      ShowMessage('事件设置时发生错误-cntIrq');
      Exit;
    End;
    ret := sio_modem_irq(Port, ModemIrq); //指定硬件线路中断
    If ret <> SIO_OK Then
    begin
      ShowMessage('事件设置时发生错误-ModemIrq');
      Exit;
    End;
    Result := True
End ;

//中断的清除
//将原先设置的中断全部清除掉
Procedure TForm1.ClearIrq();
var
  ret:LongInt;
begin
  sio_cnt_irq(Port, nil, 0);
  sio_modem_irq(Port,nil);
End;


//将输入的字符送出
procedure TForm1.mSendKeyPress(Sender: TObject; var Key: Char);
begin
   //送出字符
   sio_putch(Port,Ord(Key));
end;

end.