Monday, February 05, 2007


TAtCommands

Aquest component gestiona els SMS mitjançant les comandes AT del modem.

unit AtCommands;

interface

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

const
  SIZEBUFFER_RX=1024;
  SIZEBUFFER_TX=1024;
  CR=$0D;
  LF=$0A;
  CTRLZ=26;

type TPortsAt = (COM1,COM2,COM3,COM4,COM5,COM6,COM7,COM8,COM9,COM10);
type TParity = (pNONE,pODD,pEVEN,pMARK,pSPACE);
type TStopBit = (sbONE,sbONE5,sbTWO);

type TPortConfig = class(TPersistent)
  private
    FBaudRate: integer;
    FBitsNumber: integer;
    FParity: TParity;
    FParityN: integer;
    FStopBit: TStopBit;
    FStopBitN: integer;
    procedure SetParity(AParity: TParity);
    procedure SetStopBit(AStopBit: TStopBit);
  public
    constructor Create;
  published
    property BaudRate: integer read FBaudRate write FBaudRate;
    property BitsNumber: integer read FBitsNumber write FBitsNumber;
    property Parity: TParity read FParity write SetParity;
    property StopBit: TStopBit read FStopBit write SetStopBit;
  end;

type
  TAtCommands = class(TComponent)
  private
    { Private declarations }
    FPortName: TPortsAt;
    FPortNumber: integer;
    HandlePort: Array[0..6] of THANDLE;
    FConfiguration: TPortConfig;
    FEnabled: boolean;
    FPhoneNumber: string;
    FDelayTime: DWORD;
    procedure SetPortName(APort: TPortsAt);
  protected
    { Protected declarations }
    function ReadByteSerialChannel(var b: BYTE): Integer;
    function WriteByteSerialChannel(b: BYTE): Integer;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function OpenSerialChannel: Integer;
    procedure CloseSerialChannel;
    procedure ClearInBuffer;
    procedure ClearOutBuffer;
    procedure SendAtCommand(AtComm: string);
    procedure ReadAnswer(var Ans: string);
    procedure SendCRLF;
    procedure SendCtrlZ;
    procedure SendMessage(msgtxt: string; var msgerr: string);
    procedure Delay(Ms: DWORD);
    procedure ReadMessage(index: integer; var msgtxt: string; var msgerr: string);
    procedure DeleteMessage(index: integer; var msgerr: string);
  published
    { Published declarations }
    property Configuration: TPortConfig read FConfiguration write FConfiguration;
    property PortName: TPortsAt read FPortName write SetPortName;
    property Enabled: boolean read FEnabled write FEnabled;
    property PhoneNumber: string read FPhoneNumber write FPhoneNumber;
    property DelayTime: DWORD read FDelayTime write FDelayTime;
  end;

procedure Register;

implementation

var
  cPortName: Array[0..10] of PChar=('COM1','COM2','COM3','COM4','COM5','COM6','COM7','COM8','COM9','COM10','');

constructor TPortConfig.Create;
begin
  FBaudRate := 9600;
  FBitsNumber := 8;
  FParity := pEVEN;
  FParityN := EVENPARITY;
  FStopBit := sbONE;
  FStopBitN := ONESTOPBIT;
end;

procedure TPortConfig.SetParity(AParity: TParity);
begin
  FParity := AParity;
  case FParity of
    pNONE: FParityN := NOPARITY;
    pODD: FParityN := ODDPARITY;
    pEVEN: FParityN := EVENPARITY;
    pMARK: FParityN := MARKPARITY;
    pSPACE: FParityN := SPACEPARITY;
  end;
end;

procedure TPortConfig.SetStopBit(AStopBit: TStopBit);
begin
  FStopBit := AStopBit;
  case FStopBit of
    sbONE: FStopBitN := ONESTOPBIT;
    sbONE5: FStopBitN := ONE5STOPBITS;
    sbTWO: FStopBitN := TWOSTOPBITS;
  end;
end;

constructor TAtCommands.Create(AOwner: TComponent);
begin
  FConfiguration := TPortConfig.Create;
  FEnabled := True;
  inherited Create(AOwner);
end;

destructor TAtCommands.Destroy;
begin
  FConfiguration.Free;
  inherited Destroy;
end;

procedure TAtCommands.SetPortName(APort: TPortsAt);
begin
  FPortName := APort;
  case APort of
    COM1: FPortNumber := 0;
    COM2: FPortNumber := 1;
    COM3: FPortNumber := 2;
    COM4: FPortNumber := 3;
    COM5: FPortNumber := 4;
    COM6: FPortNumber := 5;
    COM7: FPortNumber := 6;
    COM8: FPortNumber := 7;
    COM9: FPortNumber := 8;
    COM10: FPortNumber := 9;
  end;
end;

function TAtCommands.OpenSerialChannel: Integer;
var
  dcb: TDCB;
  cto: TCOMMTIMEOUTS;
label
  error;

begin
  //Apertura del canal de comunicaciones
  HandlePort[FPortNumber]:=CreateFile(cPortName[FPortNumber],
                                GENERIC_READ or GENERIC_WRITE,
                                0,
                                NIL,
                                OPEN_EXISTING,
                                0,
                                0);
  if HandlePort[FPortNumber]=INVALID_HANDLE_VALUE then begin
    goto error;
  end;

  //Lectura de la configuración actual
  if not GetCommState(HandlePort[FPortNumber],dcb) then begin
    goto error;
  end;

  //Modificación de la configuración del canal
  dcb.BaudRate:=Configuration.FBaudRate;
  dcb.ByteSize:=Configuration.FBitsNumber;
  dcb.Parity:=Configuration.FParityN;
  dcb.StopBits:=Configuration.FStopBitN;
  if not SetCommState(HandlePort[FPortNumber],dcb) then begin
    goto error;
  end;

  //Asignación de buffers de entrada y salida
  SetUpComm(HandlePort[FPortNumber],SIZEBUFFER_RX,SIZEBUFFER_TX);

  //Assignación de timeouts
  GetCommTimeouts(HandlePort[FPortNumber],cto);
  cto.ReadIntervalTimeout:=0;
  cto.ReadTotalTimeoutMultiplier:=0;
  cto.ReadTotalTimeoutConstant:=300; //200
  cto.WriteTotalTimeoutMultiplier:=0;
  cto.WriteTotalTimeoutConstant:=0;
  setCommTimeouts(handlePort[FPortNumber],cto);

  //Borrado de buffers de entrada y salida
  PurgeComm(handlePort[FPortNumber],PURGE_TXCLEAR or
                              PURGE_RXCLEAR or
                              PURGE_TXABORT or
                              PURGE_RXABORT);
  Result:=0;
  Exit;

  error:
  Result:=GetLastError();
  CloseHandle(HandlePort[FPortNumber]);
end;

procedure TAtCommands.CloseSerialChannel;

begin
  PurgeComm(HandlePort[FPortNumber],PURGE_TXCLEAR or
                              PURGE_RXCLEAR or
                              PURGE_TXABORT or
                              PURGE_RXABORT);
  CloseHandle(HandlePort[FPortNumber]);
end;

procedure TAtCommands.ClearInBuffer;
begin
  PurgeComm(handlePort[FPortNumber],PURGE_RXCLEAR or
                              PURGE_RXABORT);
end;

procedure TAtCommands.ClearOutBuffer;
begin
  PurgeComm(handlePort[FPortNumber],PURGE_TXCLEAR or
                              PURGE_TXABORT);
end;

function TAtCommands.ReadByteSerialChannel(var b: BYTE): Integer;
var
  rx: Array[0..1] of BYTE;
  nBytes: DWORD;
  dwError: DWORD;
  comStat: TCOMSTAT;
label
  error;
begin
  nBytes:=0;
  ClearCommError(HandlePort[FPortNumber],dwError,@comStat);
  if dwError > 0 then begin
    goto error;
  end;
  if ReadFile(handlePort[FPortNumber],rx,1,nBytes,NIL)=False then begin
    goto error;
  end;
  if nBytes=0 then begin
    Result:=-1;
    Exit;
  end;
  b:=rx[0];
  Result:=0;
  Exit;
  error:
  Result:=GetLastError();
end;

function TAtCommands.WriteByteSerialChannel(b: BYTE): Integer;
var
  tx: Array[0..1] of BYTE;
  nB: DWORD;
  nBytes: DWORD;
  dwError: DWORD;
  comStat: TCOMSTAT;
label
  error;
begin
  nB:=1;
  tx[0]:=b;
  tx[1]:=0;
  nBytes:=0;
  repeat
    ClearCommError(HandlePort[FPortNumber],dwError,@comStat);
    if dwError > 0 then begin
      goto error;
    end;
    if (comStat.cbOutQue < nB) then begin
      if WriteFile(handlePort[FPortNumber],tx,nb,nBytes,NIL)=False then begin
        goto error;
      end;
      if nBytes=0 then begin
        goto error;
      end else begin
        dec(nB);
      end;
    end else begin
      goto error;
    end;
  until nb=0;
  Result:=0;
  Exit;
  error:
  Result:=GetLastError();
end;

procedure TAtCommands.SendAtCommand(AtComm: string);
var
  i: integer;
begin
  for i:=1 to Length(AtComm) do
  begin
    WriteByteSerialChannel(BYTE(AtComm[i]));
  end;
end;

procedure TAtCommands.SendCtrlZ;
begin
  WriteByteSerialChannel(CTRLZ);
end;

procedure TAtCommands.SendCRLF;
begin
  WriteByteSerialChannel(CR);
end;

procedure TAtCommands.ReadAnswer(var Ans: string);
var
  i: integer;
  b: byte;
  s: string;
begin
  i := 1;
  while ReadByteSerialChannel(b)=0 do
  begin
    s := s + char(b);
    Inc(i);
  end;
  ans := s;
end;

procedure TAtCommands.Delay(Ms: DWORD);
var
  StartTime: DWORD;
  Time: DWORD;
begin
  StartTime:=GetTickCount;
  while 1=1 do begin
    Time:=GetTickCount();
    if Time-StartTime > Ms then Exit;
    Application.ProcessMessages();
  end;
end;

procedure TAtCommands.SendMessage(msgtxt: string; var msgerr: string);
var
  r: integer;
  s: string;
begin
  if FEnabled then
  begin
    r := OpenSerialChannel;
    if r=0 then
    begin
      SendAtCommand('AT+CMGF=1');
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(s);
      SendAtCommand('AT+CMGS="+34'+FPhoneNumber+'"');
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(s);
      SendAtCommand(msgtxt);
      SendCtrlZ;
      Delay(FDelayTime);
      ReadAnswer(s);
      CloseSerialChannel;
    end
    else
    begin
      msgerr := Format('Error %d obrir port',[r]);
    end;
  end
  else
  begin
    msgerr := '';
  end;
end;

procedure TAtCommands.ReadMessage(index: integer; var msgtxt: string; var msgerr: string);
var
  r: integer;
  s: string;
begin
  if FEnabled then
  begin
    r := OpenSerialChannel;
    if r=0 then
    begin
      SendAtCommand('AT+CMGF=1');
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(s);
      SendAtCommand('AT+CMGR='+IntToStr(index));
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(msgtxt);
      CloseSerialChannel;
    end
    else
    begin
      msgerr := Format('Error %d obrir port',[r]);
    end;
  end
  else
  begin
    msgerr := '';
    msgtxt := 'Simulació';
  end;
end;

procedure TAtCommands.DeleteMessage(index: integer; var msgerr: string);
var
  r: integer;
  s: string;
begin
  if FEnabled then
  begin
    r := OpenSerialChannel;
    if r=0 then
    begin
      SendAtCommand('AT+CMGF=1');
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(s);
      SendAtCommand('AT+CMGD='+IntToStr(index));
      SendCRLF;
      Delay(FDelayTime);
      ReadAnswer(s);
      CloseSerialChannel;
    end
    else
    begin
      msgerr := Format('Error %d obrir port',[r]);
end;
end
else
begin
msgerr := '';
end;
end;

procedure Register;
begin
RegisterComponents('Components Delphi', [TAtCommands]);
end;

end.


Entre les propietas que cal configurar hi ha PortName, que és el port que correspon al dispositiu que empleem. A Configuration en determinen els parámetres. PhoneNumber és la destinació del missatge. Escollim un DelayTime per control.lar el correcte funcionament, si fos necessari. A partir d'aquí enviem missatges amb SendMessage, els borrem amb DeleteMessage, i els llegim amb ReadMessage.



This page is powered by Blogger. Isn't yours?