uscomm.~pas

短信发送接收网关

unit USComm;

interface

uses
  Windows,SysUtils,Forms,USControl;

type
  TSComm = Class(TSerialControl)
  published
    function  SComInit:Longbool;
    procedure SetParity;
    procedure ClrParity;
  end;


implementation

uses
  UFConfig;                                                                     //取配置文件名称


////////////////////////////////////////////////////////////////////////////////////////////////////////
function TSComm.SComInit:Longbool;
var
  parBuffer:array[1..20] of char;
  RunDir   :string;
  parString:string;
  parInteger:integer;
begin
  self.CloseSerial;
  RunDir := ExtractFileDir(Application.ExeName);
  result := true;

  GetPrivateProfileString('Serial','ComPort','COM1',PChar(@parBuffer[1]),500,Pchar(RunDir+'\'+IniPath));
  parString := Copy(parBuffer,4,1);
  if (self.OpenSerial(StrToInt(parString),FALSE) = -1) then
  begin
    result := FALSE;
    exit;
  end else
  begin
    GetPrivateProfileString('Serial','BaudRate','9600',PChar(@parBuffer[1]),500,Pchar(RunDir+'\'+IniPath));
    parString := Copy(parBuffer,1,strlen(@parBuffer[1]));
    self.m_SerialSet.BaudRate := StrToInt(parString);

    parInteger := GetPrivateProfileInt('Serial','ByteSize',8,PChar(RunDir+'\'+IniPath));
    self.m_SerialSet.ByteSize := parInteger;

    GetPrivateProfileString('Serial','Parity','NONE',PChar(@parBuffer[1]),500,Pchar(RunDir+'\'+IniPath));
    parString := Copy(parBuffer,1,strlen(@parBuffer[1]));
    parInteger := 0;
    if parString = 'MARK'  then parInteger := MARKPARITY;   //Mark(MARKPARITY:3)
    if parString = 'EVEN'  then parInteger := EVENPARITY;   //Even(EVENPARITY:2)
    if parString = 'ODD'   then parInteger := ODDPARITY;    //Odd(ODDPARITY:1)
    if parString = 'SPACE' then parInteger := SP_PARITY;    //Space(SP_PARITY:1)
    if parString = 'NONE'  then parInteger := NOPARITY;     //None(NOPARITY:0)
    self.m_SerialSet.Parity := parInteger;

    parInteger := GetPrivateProfileInt('Serial','StopBits',1,PChar(RunDir+'\'+IniPath));
    if parInteger > 1 then
      self.m_SerialSet.StopBits := TWOSTOPBITS
    else
      self.m_SerialSet.StopBits := ONESTOPBIT;

    self.setSerialStatus;
  end;
end;

procedure TSComm.SetParity;
begin
  self.m_SerialSet.StopBits := MARKPARITY;
  self.setSerialStatus;
end;

procedure TSComm.ClrParity;
begin
  self.m_SerialSet.StopBits := SP_PARITY;
  self.setSerialStatus;
end;

end.