TSmsGateAway Belom Jadi … he..he..

Daripada enggak sempat-sempat nerusin.. aku coba masukin blog deh. siapa tahu ada yg mo nerusin.

Component ini menggunakan fungsi dari komponen synaser, jadi anda membutuhkannya untuk install pada delphi.

AT Command saya ambil dari document Nokia.

untuk pertanyaan silakan pake comment ajah yah.

unit smsgateaway;

(************************************************************
TSmsGateAway Component (Freeware Delphi Component)
HeruX Sms GateAway Component

created by:
(C)2008. Heru Susanto (herux delphi-id)
email: herux.igsw@yahoo.com
as THXvidfwin on HeruX palette

u can use, modified or redistribute this class... but don't
forget my name...
of course there is a lot of bug, but i don't have much time.
so may be u ...

************************************************************)

interface

uses
SysUtils, Classes, SynaSer, Windows, DesignIntf, StrUtils, TypInfo;

const
sOK = #$D#$A'OK'#$D#$A;
sERROR = #$D#$A'ERROR'#$D#$A;

Eq                      = '=';
Qask                    = '?';
ATCommand               = 'AT';
PLUS                    = '+';
//* Format message in PDU or Text if supported !!
MFormatCommandResult    = PLUS+'CMGF';
MFormatCommand          = ATCommand+MFormatCommandResult;
MFormatSupp             = MFormatCommand+Eq+Qask;
MFormatPDU              = MFormatCommand+Eq+'0';
MFormatText             = MFormatCommand+Eq+'1';
//* Write message to device memory
WriteMtoMemCommandResult= PLUS+'CMGW';
WriteMtoMemCommand      = ATCommand+WriteMtoMemCommandResult;
WriteMtoMemResp         = ATCommand+WriteMtoMemCommandResult+Eq;
WriteMtoMemText         = '';
//* List message
ListMessageCommandResult= PLUS+'CMGL';
ListMessageCommand      = ATCommand+ListMessageCommandResult;
MessageSpec             : array[0..4] of string[11] = ('REC UNREAD','REC READ','STO UNSENT','STO SENT','ALL');

type
TMessFormat  = (mfPDU, mfTEXT);
TCfgParity   = (cpNone, cpOdd, cpEven, cpMark, cpSpace);
TMessageSpec = (msRECUNREAD, msRECREAD, msSTOUNSENT, msSTOSENT, msALL);
TSmsgateaway = class(TComponent)
private
FConnected   : Boolean;
serialcomm   : TBlockSerial;
FBaud        : Integer;
FBits        : Integer;
FParity      : TCfgParity;
FSoftFlow    : Boolean;
FHardFlow    : Boolean;
FPort        : String;
FMessFormat  : TMessFormat;
FMessageSpecs: TMessageSpec;
function GetMessageSpec: TMessageSpec;
procedure SetMessageSpec(Value: TMessageSpec);
function GetConnected: Boolean;
procedure SetConnected(Value: Boolean);
procedure Connecting;
function GetMessFormat:TMessFormat;
procedure SetMessFormat(Value: TMessFormat);
procedure SetBaud(Value: Integer);
function GetBaud: Integer;
procedure SetBits(Value: Integer);
function GetBits: Integer;
Procedure SetParity(Value: TCfgParity);
function GetParity: TCfgParity;
function ParityChar: Char;
Procedure SetPort(Value: String);
function GetPort: String;
procedure EnumComPorts(Ports: TStrings);
function GetMessageSpecStr(MessSpec: TMessageSpec): String;
function GetMessageSpecInt(MessSpec: TMessageSpec): Integer;
protected
function JmlKataA(Kalimat: string; Out DaftarKata: TStringList): Longint;
procedure PreComCondition;
public
MessagesCon  : String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetSmsStr:String;
function ListWord: TStrings;
function SmsCount(MessSpec: TMessageSpec): Integer;
published
property Baud: Integer read GetBaud write SetBaud default 19200;
property Bits: Integer read GetBits write SetBits default 8;
property Parity: TCfgParity read GetParity write SetParity default cpNone;
property SoftFlow : Boolean read FSoftFlow write FSoftFlow default False;
property HardFlow : Boolean read FHardFlow write FHardFlow default True;
property Port : String read GetPort write SetPort;
property Connected : Boolean read FConnected write SetConnected default False;
property MessFormat : TMessFormat read GetMessFormat write SetMessFormat;
property MessageSpecS : TMessageSpec read GetMessageSpec write SetMessageSpec;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Herux', [TSmsgateaway]);
RegisterPropertyInCategory('Config',TSmsgateaway,'Port');
RegisterPropertyInCategory('Config',TSmsgateaway,'Baud');
RegisterPropertyInCategory('Config',TSmsgateaway,'Bits');
RegisterPropertyInCategory('Config',TSmsgateaway,'Parity');
RegisterPropertyInCategory('Config',TSmsgateaway,'SoftFlow');
RegisterPropertyInCategory('Config',TSmsgateaway,'HardFlow');
end;

{ TSmsgateaway }

function TSmsgateaway.GetConnected: Boolean;
begin
Result := FConnected;
end;

procedure TSmsgateaway.SetConnected(Value: Boolean);
begin
FConnected := Value;
if FConnected then
Connecting;
end;

procedure TSmsgateaway.SetMessageSpec(Value: TMessageSpec);
begin
if FMessageSpecs <> Value then
FMessageSpecs := Value;
end;

procedure TSmsgateaway.SetMessFormat(Value: TMessFormat);
var
ErrCode: String;
begin
if FConnected then
begin
try
serialcomm := TBlockSerial.Create;
serialcomm.RaiseExcept := True;
serialcomm.Connect(FPort);
serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow);
case Value of
mfPDU  : ErrCode := serialcomm.ATCommand(MFormatPDU);
mfTEXT : ErrCode := serialcomm.ATCommand(MFormatText);
end;

if ErrCode = sERROR then
raise EPropertyError.Create('Your device did not support that format');

if ErrCode = sOK then
FMessFormat := Value;

finally
serialcomm.Free;
end;
end;
end;

procedure TSmsgateaway.EnumComPorts(Ports: TStrings);
var
KeyHandle: HKEY;
ErrCode, Index: Integer;
ValueName, Data: string;
ValueLen, DataLen, ValueType: DWORD;
TmpPorts: TStringList;
begin
ErrCode := RegOpenKeyEx(
HKEY_LOCAL_MACHINE,
'HARDWARE\DEVICEMAP\SERIALCOMM',
0,
KEY_READ,
KeyHandle);

if ErrCode <> ERROR_SUCCESS then begin
Ports.Clear;
Exit;
end;

TmpPorts := TStringList.Create;
try
Index := 0;
repeat
ValueLen := 256;
DataLen := 256;
SetLength(ValueName, ValueLen);
SetLength(Data, DataLen);
ErrCode := RegEnumValue(
KeyHandle,
Index,
PChar(ValueName),
{$IFDEF DELPHI_4_OR_HIGHER}
Cardinal(ValueLen),
{$ELSE}
ValueLen,
{$ENDIF}
nil,
@ValueType,
PByte(PChar(Data)),
@DataLen);

if ErrCode = ERROR_SUCCESS then
begin
SetLength(Data, DataLen);
TmpPorts.Add(Data);
Inc(Index);
end

until (ErrCode <> ERROR_SUCCESS) ;

TmpPorts.Sort;
Ports.Assign(TmpPorts);
finally
RegCloseKey(KeyHandle);
TmpPorts.Free;
end;

end;

procedure TSmsgateaway.SetBaud(Value: Integer);
begin
FBaud := Value;
end;

procedure TSmsgateaway.SetBits(Value: Integer);
begin
FBits := Value;
end;

procedure TSmsgateaway.SetParity(Value: TCfgParity);
begin
FParity := Value;
end;

procedure TSmsgateaway.SetPort(Value: String);
begin
if Value <> FPort then
begin
if FConnected and not ((csDesigning in ComponentState) or
(csLoading in ComponentState)) then
begin
FConnected := False;
FPort := Value;
FConnected := True;
end;
end;
end;

function TSmsgateaway.SmsCount(MessSpec: TMessageSpec): Integer;
begin

end;

function TSmsgateaway.GetMessFormat: TMessFormat;
var
Res : String;
StrList: TStringList;
begin
try
serialcomm := TBlockSerial.Create;
serialcomm.RaiseExcept := True;
StrList := TStringList.Create;

serialcomm.Connect(FPort);
serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow);
Res := serialcomm.ATCommand(MFormatCommand+Qask);
if JmlKataA(Res,StrList) = 3 then
begin
if StrList.ValueFromIndex[1] = '1' then
Result := mfTEXT else Result := mfPDU;
end;

StrList.Free;
finally
serialcomm.Free;
end;
end;

function TSmsgateaway.GetParity: TCfgParity;
begin
Result := FParity;
end;

function TSmsgateaway.GetPort: String;
begin
Result := FPort;
end;

function TSmsgateaway.ParityChar: Char;
begin
Result := 'N';
case FParity of
cpNone  : Result := 'N';
cpOdd   : Result := 'O';
cpEven  : Result := 'E';
cpMark  : Result := 'M';
cpSpace : Result := 'S';
end;
end;

procedure TSmsgateaway.PreComCondition;
begin
serialcomm.Connect(FPort);
serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow);
end;

function TSmsgateaway.GetBaud: Integer;
begin
Result := FBaud;
end;

function TSmsgateaway.GetBits: Integer;
begin
Result := FBits;
end;

procedure TSmsgateaway.Connecting;
begin
try
serialcomm := TBlockSerial.Create;
serialcomm.RaiseExcept := True;
serialcomm.Connect(FPort);
serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow);
MessagesCon := serialcomm.ATCommand('AT');
if (serialcomm.LastError <> 0) or (not serialcomm.ATResult) then
begin
FConnected := False;
raise EPropertyError.Create('Communication error or modem cannot be connected '+#13
+'please.. Check the port ?');
end else FConnected := True;
finally
serialcomm.Free;
end;
end;

constructor TSmsgateaway.Create(AOwner: TComponent);
begin
inherited create(AOwner);
FBaud := 19200;
FBits := 8;
FParity := cpNone;
FSoftFlow := False;
FHardFlow := True;
FPort := 'COM5';
FConnected := False;
FMessFormat := GetMessFormat;
end;

destructor TSmsgateaway.Destroy;
begin
inherited;
end;

function TSmsgateaway.GetSmsStr: String;
begin
if FConnected = True then
begin
try
serialcomm := TBlockSerial.Create;
serialcomm.RaiseExcept := True;
serialcomm.Connect(FPort);
serialcomm.Config(FBaud,FBits,ParityChar,0,FSoftFlow,FHardFlow);
case FMessFormat of
mfTEXT :  begin
if serialcomm.ATCommand(MFormatCommand+Eq+'1') <> sERROR then
Result := serialcomm.ATCommand(ListMessageCommand+Eq+'"'+GetMessageSpecStr(FMessageSpecs)+'"')
else
Result := 'The modem is not support in TEXT mode';
end;
mfPDU  :  begin
if serialcomm.ATCommand(MFormatCommand+Eq+'0') <> sERROR then
Result := serialcomm.ATCommand(ListMessageCommand+Eq+'"'+IntToStr(GetMessageSpecInt(FMessageSpecs))+'"')
else
Result := 'The modem is not support in PDU mode';
end;
end;
finally
serialcomm.Free;
end;
end;
end;

function TSmsgateaway.GetMessageSpec: TMessageSpec;
begin
Result := FMessageSpecs;
end;

function TSmsgateaway.GetMessageSpecInt(MessSpec: TMessageSpec): Integer;
begin
Result := 0;
case MessSpec of
msRECUNREAD : Result := 0;
msRECREAD   : Result := 1;
msSTOUNSENT : Result := 2;
msSTOSENT   : Result := 3;
msALL       : Result := 4;
end;
end;

function TSmsgateaway.GetMessageSpecStr(MessSpec: TMessageSpec): String;
begin
Result := Qask;
case MessSpec of
msRECUNREAD : Result := MessageSpec[0];
msRECREAD   : Result := MessageSpec[1];
msSTOUNSENT : Result := MessageSpec[2];
msSTOSENT   : Result := MessageSpec[3];
msALL       : Result := MessageSpec[4];
end;
end;

function TSmsgateaway.JmlKataA(Kalimat: string; Out DaftarKata: TStringList): Longint;

function TandaBaca(Tanda: Char): Boolean;
begin
Result := Tanda in
[#0..#$1F, ' ', '.', ',', '?', ';','"'];
end;

var
Ix: Word;
JmlKata: Longint;
Hrf: String;
begin
JmlKata := 0;
Ix         := 1;
while Ix <= Length(Kalimat) do
begin
while (Ix <= Length(Kalimat)) and (TandaBaca(Kalimat[Ix])) do
Inc(Ix);
if Ix <= Length(Kalimat) then
begin
Inc(JmlKata);

while (Ix <= Length(Kalimat)) and (not TandaBaca(Kalimat[Ix])) do
begin
Hrf := Hrf+Kalimat[Ix];
Inc(Ix);
end;
if Hrf <> '' then DaftarKata.Add(Hrf);
Hrf := '';

end;
end;
Result := JmlKata;
end;

function TSmsgateaway.ListWord: TStrings;
begin

end;

end.