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.
