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.

12 thoughts on “TSmsGateAway Belom Jadi … he..he..

  1. Sufajar says:

    Wuidiiih…Oks Banget Boo..;)) Componentnya. syang belum selesai yak..:))

    Minta ya mas tak Coba Pahami dulu de..

  2. mas klo pake tOxzigen bisa ga???

    mas pna tOxzigen ga,?soalnya saya pna toxzigen pas dicompile smscomp.pas ga da..smscomp.pas not found

    mohon bantuannya mas!kirim keemail saya mas ya..
    makasi!

    • herux says:

      Toxygen ga punya. kalo emang suka pake itu yah .. beli aja ntar pasti dapat smscomp.pas
      sebenernya komponen kek gini tuh banyak yang gratis. cari aja.
      tapi lebih baik kalo u bisa buat sendiri .. kan udah tak kasih contoh tuh.

  3. Agan yg tengkiu bgt dah share.. ikutan nimbrung nih😀
    Ane kebetulan lg senggang mo cobain lengkapin bwt yg pake Delphi jaman urdu ^^ (kebetulan ane masih pake D6; krn sesuatu hal hehehe..)

    Untuk D6 fungsi pada TStringList.ValueFromIndex[index] ini tdk teridentifikasi, jadi setelah line { TSmsgateaway } ane bikin Function untuk menggantikan Fungsi yg cuma ada di D7 and later (lupa ane ngutip dari mana-nya, dah lama.. wkwkwk…) berikut Fungsinya:

    function GetValueFromIndex(S: TStrings; Index: Integer): string;
    begin
    if Index >= 0 then
    Result := Copy(S[Index], Length(S.Names[Index]) + 2, MaxInt) else
    Result := ”;
    end;

    Nah terus di Function yg Agan bikin:
    function TSmsgateaway.GetMessFormat: TMessFormat;
    ane rubah sedikit statement di dalamnya jadi:

    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
    //– D7 use this function ————————————–
    //if (StrList.ValueFromIndex[1] = ‘1’) then

    //– D6 use this function ————————————–
    if (GetValueFromIndex(StrList, 1) = ‘1’) then
    Result := mfTEXT else Result := mfPDU;
    end;

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

    Nah ada lagi nih gan yg ane rubah isi procedure-nya, yaitu:
    procedure TSmsgateaway.EnumComPorts(Ports: TStrings);
    menjadi
    procedure TSmsgateaway.EnumComPorts(Ports: TStrings);
    soalnya di Win7 yg ane coba kalo dah ane Register Unit ini jadi Component Package, terjadi error saat di embed ke Form, dikarenakan di Registry Win7 path :
    \HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMAP\SERIALCOMM kaga ada gan.. ^^
    Dari pada lama, ini Listingnya function tambahan dan perubahan isi procedure:

    function ExtComName(ComNr: DWORD): string;
    begin
    if (ComNr > 9) then
    Result := Format(‘\\\\.\\COM%d’, [ComNr])
    else
    Result := Format(‘COM%d’, [ComNr]);
    end;

    //– Cek handle atas koneksi Port
    function CheckCom(AComNumber: Integer): Integer;
    var
    FHandle: THandle;
    begin
    Result := 0;
    FHandle := CreateFile(PChar(ExtComName(AComNumber)),
    GENERIC_READ or GENERIC_WRITE,
    0, {exclusive access}
    nil, {no security attrs}
    OPEN_EXISTING,
    FILE_ATTRIBUTE_NORMAL,
    0);

    if (FHandle INVALID_HANDLE_VALUE) then
    CloseHandle(FHandle)
    else
    Result := GetLastError;
    end;

    //– Nah disini ane bikin perubahannya, sayang Hard Code dgn cara
    // tracing port number-nya.. wkwkkw.. (yg penting bisa dipake)
    procedure TSmsgateaway.EnumComPorts(Ports: TStrings);
    var
    i, Err : integer;
    PortList : TStringList;
    begin
    PortList := TStringList.Create;

    for i := 1 to 99 do
    begin
    Err := CheckCom(i);
    if (Err = 0) or (Err = ERROR_ACCESS_DENIED) then
    begin
    {the Port exists, if Err = ERROR_ACCESS_DENIED then the port is already open}
    PortList.Add(‘COM’+inttostr(i))
    end;
    end;
    Ports.Assign(PortList);
    PortList.Free;
    end;

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s