Mega Code Archive
RECEIVE SMS
<![CDATA[
Title: RECEIVE SMS
Question: How to Receive SMS
Answer:
unit uTerimaSMS;
interface
uses
SysUtils,
Classes,
Math,
QDialogs,
DateUtils,
MSCommLib_TLB;
procedure CekSMS(var Memo: tMemo);
function teskoneksi(ComPort: integer; BaudRate: string): boolean;
const sOK = #13#10'OK';
sERROR = #13#10'ERROR';
var comm : TMSComm;
Konek: Boolean;
implementation
function PDU2Text(pdudata: string): string;
var
pdu,isi,hasilteks,huruf: string;
i: integer;
m,n,vgeser,sisa,
c,d,e,f,panjang: byte;
hasil,dbiner: array[1..9000] of byte;
begin
if length(pdudata)=0 then begin
Result := '';
exit;
end;
pdu := copy(pdudata,3,length(pdudata));
isi:= '';
panjang := length(pdu) div 2;
for i := 1 to panjang do begin
huruf := copy(pdu, i*2 - 1, 2);
dbiner[i] := StrToInt('$' + huruf);
end;
m := 1;
vgeser := 0;
sisa := 0;
n := 1;
while n c := dbiner[n];
d := c shl vgeser;
e := d or sisa;
f := e and $7F;
hasil[m] := f;
Inc(vgeser);
c := dbiner[n];
d := c shr (8-vgeser);
sisa := d;
inc(m);
inc(n);
if vgeser = 7 then begin
hasil[m] := sisa and $7F;
inc(m);
sisa := 0;
vgeser := 0;
end;
end;
hasilteks := '';
for i := 1 to m - 1 do
hasilteks := hasilteks + chr(hasil[i]);
Result := hasilteks;
end;
procedure ConvertMSG(var datasms,smsc,tipe,pengirim,bentuk,
skema,tanggal,batas,isi: string);
var pdu: string;
p,i: integer;
begin
pdu := datasms;
smsc := '';
p := StrToInt('$' + copy(pdu, 1, 2)) - 1;
pdu := copy(pdu,5,length(pdu)-4);
for i := 1 to p do begin
smsc := smsc + pdu[i*2];
smsc := smsc + pdu[i*2-1];
end;
if smsc[length(smsc)] = 'F' then
smsc := copy(smsc, 1, length(smsc) - 1);
pdu := copy(pdu, p*2+1,length(pdu)-p*2);
tipe := copy(pdu, 1, 2);
pdu := copy(pdu, 3, length(pdu)-2);
pengirim := '';
p := StrToInt('$'+copy(pdu,1,2));
if p mod 2 = 1 then inc(p);
pdu := copy(pdu,5,length(pdu)-4);
for i := 1 to p div 2 do begin
pengirim := pengirim + pdu[i*2];
pengirim := pengirim + pdu[i*2-1];
end;
if pengirim[length(pengirim)] = 'F' then
pengirim := copy(pengirim, 1, length(pengirim) - 1);
pdu := copy(pdu,p+1,length(pdu)-p);
bentuk := copy(pdu,1,2);
pdu := copy(pdu, 3, length(pdu)-2);
skema := copy(pdu,1,2);
pdu := copy(pdu, 3, length(pdu)-2);
tanggal := pdu[6]+pdu[5] + '-' + pdu[4]+pdu[3] + '-' +
pdu[2]+pdu[1] + ' ' +
pdu[8]+pdu[7] + ':' + pdu[10]+pdu[9] + ':' +
pdu[12]+pdu[11];
pdu := copy(pdu, 13, length(pdu)-12);
batas := copy(pdu,1,2);
pdu := copy(pdu, 3, length(pdu)-2);
isi := PDU2Text(pdu);
end;
function teskoneksi(): boolean;
var
waktu: tdatetime;
buffer: string;
begin
if comm.PortOpen then comm.PortOpen := false;
comm.CommPort := ComPort;
comm.Settings := BaudRate + ',N,8,1';
comm.InputLen := 0;
comm.PortOpen := true;
Sleep(800);
waktu := now;
repeat
comm.Output := 'ATE1'#13;
buffer := '';
repeat
buffer := buffer + comm.Input;
until (Pos(sOK, buffer) 0) or (Pos(sERROR, buffer) 0)
or (secondsbetween(waktu, now) 10);
until (Pos(sOK, buffer) 0) or (secondsbetween(waktu, now) 10);
Konek := (Pos(sOK, buffer) 0);
teskoneksi := Konek;
end;
procedure CekSMS(var Memo: tMemo);
var
smsc, tipe, pengirim, bentuk, skema, tanggal, batas,
isi,
nomer,
s : string;
n : textfile;
waktu: TDateTime;
i : integer;
begin
if not konek then
if not teskoneksi() then begin
MessageDlg('Tidak dapat melakukan koneksi ke Handphone', mtError, [mbOk], 0);
comm.PortOpen := false;
exit;
end;
assignfile(n,'temp.dat');
rewrite(n);
for i := 0 to 1 do begin
comm.Output := 'AT+CMGL=' + IntToStr(i) + #13;
waktu := now;
repeat
s := comm.Input;
write(n, s);
until (pos(sOK, s) 0) or (pos(sERROR, s) 0) or (SecondsBetween(waktu,now) 180);
end;
closefile(n);
reset(n);
readln(n, s);
while (not eof(n)) do begin
readln(n, s);
if copy(s, 1, 7) = '+CMGL: ' then begin
nomer := copy(s, 8, pos(',', s) - 8);
comm.Output := 'AT+CMGD=' + nomer + #13;
waktu := now;
repeat
s := comm.Input;
until (pos(sOK, s) 0) or (pos(sERROR, s) 0) or (SecondsBetween(waktu,now) 180);
readln(n, s);
ConvertMSG(s, smsc, tipe, pengirim, bentuk, skema, tanggal, batas, isi);
Memo.Lines.Add(pengirim + ' ' + isi);
end;
end;
closefile(n);
end;
begin
comm := TMSComm.Create(nil);
Konek := False;
end.
BY ARIO SANJANA
]]>