delphi 开发台达PLC

【例子介绍】

【相关图片】

【源码结构】

unit uPublic;

interface
    uses SysUtils,Dialogs,Types,Graphics,forms,Windows,  Classes,Variants;

      type
        TPortInfo=record //串口信息
            iPort:Integer;
            iBaud:Integer;
            iDataBit:Integer;
            sParity:String;
            iStopBit:Integer;
        end;

        Function HexToInt(Hex : string) : Integer;
        Function LRC(str :String) :String;
        procedure OpenPort(rPort:TPortInfo);   //打开串口
        procedure SendData(iPort:Integer;sData:String);
        Function ReadFromPort(iPort:integer):String;
        Function ReadResFromPort(iPort:integer):String;

implementation

uses PComm;

procedure OpenPort(rPort:TPortInfo);   //打开串口
var
    ret:Integer;
    _iBaud,_iStop,_iData:Integer;
    _iPort,_iParity:Integer;
begin
        _iPort:=rPort.iPort;
        sio_close(_iPort);     //打开之前先关闭
        ret := sio_open(_iPort);
        if ( ret <> SIO_OK ) then
        begin
            //MessageBox(Handle, PChar('打开端口失败！'), PChar('警告'), MB_ICONERROR or MB_OK);
            MessageDlg(#13#10'打开端口失败！', mtWarning,[mbOK], 0);
        end;

        case rPort.iBaud of
            921600: _iBaud:=B921600;
            460800: _iBaud:=B460800;
            230400: _iBaud:=B230400;
            115200: _iBaud:=B115200;
            57600: _iBaud:=B57600;
            38400: _iBaud:=B38400;
            19200: _iBaud:=B19200;
            9600: _iBaud:=B9600;
            4800: _iBaud:=B4800;
            2400: _iBaud:=B2400;
            1800: _iBaud:=B1800;
            1200: _iBaud:=B1200;
            600: _iBaud:=B600;
            300: _iBaud:=B300;
        end;

        case rPort.iDataBit of
            8: _iData:=BIT_8;
            7: _iData:=BIT_7;
            6: _iData:=BIT_6;
            5: _iData:=BIT_5;
        end;

        case rPort.iStopBit of
            1: _iStop:=STOP_1;
            2: _iStop:=STOP_2;
        end;
        _iParity:=0;
        if(rPort.sParity = '偶校验') then _iParity := 24;
        if(rPort.sParity = '奇校验') then _iParity := 8;
        if(rPort.sParity = '无')     then _iParity := 0;
        if(rPort.sParity = '标记')   then _iParity := 40;
        if(rPort.sParity = '空')     then _iParity := 56;
        ret := sio_ioctl ( _iPort, _iBaud, _iParity or _iData or _iStop );
        if (ret <> SIO_OK) then
            //MessageBox(Handle, PChar('串口设置参数失败！'), PChar('警告'),  MB_ICONERROR or MB_OK);
            MessageDlg(#13#10'串口设置参数失败！', mtWarning,[mbOK], 0);
end;

Function HexToInt(Hex : string) : Integer;
const cHex = '0123456789ABCDEF';
    var mult,i,loop : integer;
begin
    result := 0;
    mult := 1;
    for loop := length(Hex) downto 1 do
    begin
        i := pos(Hex[loop],cHex)-1;
        if (i < 0) then i := 0;
            inc(result,(i*mult));
        mult := mult * 16;
    end;
end;

Function LRC(str :String) :String;
var
	c,l:Integer;
	c_Data:String;
    d_lrc:integer;
    h_lrc:String;
Begin
    c := 0;
    l := Length(str) div 2 ;
    d_lrc:=0;
    For c := 1 To l  do
	Begin
         c_data := Copy(str, c*2-1, 2)   ;
         d_lrc := d_lrc   HexToInt(c_data);
    End;
    If d_lrc > 255 Then
	Begin
        d_lrc := d_lrc Mod 256;
    End;
    h_lrc := IntToHex(256 - d_lrc,4);
    If Length(h_lrc) > 2 Then
	Begin
        h_lrc := Copy(h_lrc, Length(h_lrc) - 1, 2)
    End;
    LRC := h_lrc;
end;

procedure SendData(iPort:Integer;sData:String);
var
    buffer : Array[1..255] of char;
    i,iLen:Integer;
    sStr,sLRC:String;
begin
    sLRC:=LRC(sData);
    sStr:=':' sData sLRC #13 #10;
    iLen:=length(sStr);
    if iLen>255 then Exit;
    for i:=1 to iLen do
        buffer[i]:=sStr[i];
    sio_write(iPort,@buffer,iLen);
end;


Function ReadFromPort(iPort:integer):String;
var
    iLen:integer;
	sSave:String;
Begin
    sSave:='';
    iLen:=sio_getch(iPort);
    while iLen>=0 do  //包含Asc为０的字符
    begin
        if iLen>=0 then
        begin
            sSave:=sSave Chr(iLen);
        end
        else
        Begin
            break;
        End;
        //sleep(50);
        iLen:=sio_getch(iPort);
    end;
    Result:=sSave;
End;


Function ReadResFromPort(iPort:integer):String;
var
    iLen:integer;
	sSave:String;
Begin
    sSave:='';

    repeat
         iLen:=sio_getch(iPort);
         if iLen>=0 then
         begin
            sSave:=sSave Chr(iLen);
         end;
         if Length(sSave)>3 then
         Begin
            if Copy(sSave,length(sSave)-1,2)=#13#10 then
            Begin
                break;
            End;
         End;
    until false;

    Result:=sSave;
End;

end.