unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TfrmMain = class(TForm)
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Function GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
function PDUSMSC(Tel:String;var TelLen:Byte):String;
Function PDUTel(Tel:String;var TelLen:Byte):String;
Function PDUFmtStr(Val:string):string;
procedure opencomm;
Function readcom:string;
Function sendmessage(var smsc,smsbody,telno:string):boolean;
{ Private declarations }
public
{ Public declarations }
end;var
frmMain: TfrmMain;
Data:string;
hcomm:thandle;implementation{$R *.dfm}
procedure tfrmMain.opencomm;
var cc:tcommconfig;
temp:string;
begin
temp:='COM1';
hcomm:=createfile(pchar(temp),generic_read or generic_write,0,nil,open_existing,0,0);
if (hcomm=invalid_handle_value) then
begin
messagebox(0,'打开通信端口失败!!','',mb_ok);
exit;
end; getcommstate(hcomm,cc.dcb);
cc.dcb.BaudRate:=cbr_9600;
cc.dcb.ByteSize:=8;
cc.dcb.Parity:=noparity;
cc.dcb.StopBits:=onestopbit; if not setcommstate(hcomm,cc.dcb) then
begin
messagebox(0,'通讯端口设置错误!!','',mb_ok);
closehandle(hcomm);
exit;
end;
end;Function TfrmMain.GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
var
i:Byte;
Data:String;
SMSC_Len,DATel_Len:Byte;
begin
SMSC:=PDUSMSC(SMSC,SMSC_Len);
DATel:=PDUTel('86'+DATel,DATel_Len);
SDU:=PDUFmtStr(SDU);
i:=Length(SDU) div 2;
Data:='';
Data:=Data+'3100';
Data:=Data+DATel;
Data:=Data+'00';
Data:=Data+'08';
Data:=Data+'A7';
Data:=Data+IntToHex(i,2);
Data:=Data+SDU;
len:=IntToStr(2+DATel_Len+4+i);
Result:=SMSC+Data;
end;function TfrmMain.PDUSMSC(Tel:String;var TelLen:Byte):String;
var
i,j:integer;
str:string;
s1,s2:String;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
j:=Length(Str) div 2+1;
str:=inttohex(j,2)+'91'+str;
TelLen:=j+1;
Result:=str;
except
result:='';
end;
end;Function TfrmMain.PDUTel(Tel:String;var TelLen:Byte):String;
var
i,j:integer;
str:string;
s1,s2:String;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
str:=inttohex(TelLen,2)+'91'+str;
TelLen:=j+2;
Result:=str;
except
result:='';
end;
end;Function TfrmMain.PDUFmtStr(Val:string):string;
var
i,j,len:Integer;
cur:Integer;
t:String;
ws:WideString;
begin
Result:='';
ws := Val;
len := Length(ws);
i := 1;
j := 0;
while i <= len do
begin
cur := ord(ws[i]);
FmtStr(t,'%4.4X',[cur]);
Result := Result+t;
inc(i);
j := (j+1) mod 7;
end;
end;
Function TfrmMain.sendmessage(var smsc,smsbody,telno:string):boolean;
var
temp,len,ret:string;
lrc:longword;
begin
Data:=GetPDUData(SMSC,telno,smsbody,Len);
temp:='AT+CSMS=1'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:='';
memo1.Text:=readcom;
frmMain.Refresh; temp:='AT+CNMI=2,2,0,1,1'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:='AT+CMGF=0'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:='AT+CMGS='+Len+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:=Data+#26;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(200);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; {Result:=false;
ret:=readcom;
Edit1.Text:=Edit1.Text+ret;
frmMain.Refresh;
if (pos('ERROR',ret)=0)
then Result:=true; }
sleep(10000);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh;
end;
Function TfrmMain.readcom:string;
var temp:string;
inbuff:array[0..10240] of char;
nbytesread,dwerror:longword;
cs:tcomstat;
begin
clearcommerror(hcomm,dwerror,@cs);
if cs.cbInQue>sizeof(inbuff) then
begin
purgecomm(hcomm,purge_rxclear);
exit;
end;
readfile(hcomm,inbuff,cs.cbInQue,nbytesread,nil);
temp:=copy(inbuff,1,cs.cbInQue);
result:=temp;
end;procedure TfrmMain.Button1Click(Sender: TObject);
var
smsc,tel,str:string;
begin
smsc:='8613800591500';
tel:=trim(edit2.Text);
str:=trim(edit3.Text); if (sendmessage(smsc,str,tel)=true)
then
if (Application.Messagebox('短信息发送成功!',
'系统提示',MB_OK+MB_DEFBUTTON1+MB_ICONQUESTION)=IDok)
then abort;end;procedure TfrmMain.FormCreate(Sender: TObject);
begin
opencomm;end;end.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TfrmMain = class(TForm)
Button1: TButton;
Edit2: TEdit;
Edit3: TEdit;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Function GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
function PDUSMSC(Tel:String;var TelLen:Byte):String;
Function PDUTel(Tel:String;var TelLen:Byte):String;
Function PDUFmtStr(Val:string):string;
procedure opencomm;
Function readcom:string;
Function sendmessage(var smsc,smsbody,telno:string):boolean;
{ Private declarations }
public
{ Public declarations }
end;var
frmMain: TfrmMain;
Data:string;
hcomm:thandle;implementation{$R *.dfm}
procedure tfrmMain.opencomm;
var cc:tcommconfig;
temp:string;
begin
temp:='COM1';
hcomm:=createfile(pchar(temp),generic_read or generic_write,0,nil,open_existing,0,0);
if (hcomm=invalid_handle_value) then
begin
messagebox(0,'打开通信端口失败!!','',mb_ok);
exit;
end; getcommstate(hcomm,cc.dcb);
cc.dcb.BaudRate:=cbr_9600;
cc.dcb.ByteSize:=8;
cc.dcb.Parity:=noparity;
cc.dcb.StopBits:=onestopbit; if not setcommstate(hcomm,cc.dcb) then
begin
messagebox(0,'通讯端口设置错误!!','',mb_ok);
closehandle(hcomm);
exit;
end;
end;Function TfrmMain.GetPDUData(SMSC,DATel,SDU:String;var len:String):String;
var
i:Byte;
Data:String;
SMSC_Len,DATel_Len:Byte;
begin
SMSC:=PDUSMSC(SMSC,SMSC_Len);
DATel:=PDUTel('86'+DATel,DATel_Len);
SDU:=PDUFmtStr(SDU);
i:=Length(SDU) div 2;
Data:='';
Data:=Data+'3100';
Data:=Data+DATel;
Data:=Data+'00';
Data:=Data+'08';
Data:=Data+'A7';
Data:=Data+IntToHex(i,2);
Data:=Data+SDU;
len:=IntToStr(2+DATel_Len+4+i);
Result:=SMSC+Data;
end;function TfrmMain.PDUSMSC(Tel:String;var TelLen:Byte):String;
var
i,j:integer;
str:string;
s1,s2:String;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
j:=Length(Str) div 2+1;
str:=inttohex(j,2)+'91'+str;
TelLen:=j+1;
Result:=str;
except
result:='';
end;
end;Function TfrmMain.PDUTel(Tel:String;var TelLen:Byte):String;
var
i,j:integer;
str:string;
s1,s2:String;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
str:=inttohex(TelLen,2)+'91'+str;
TelLen:=j+2;
Result:=str;
except
result:='';
end;
end;Function TfrmMain.PDUFmtStr(Val:string):string;
var
i,j,len:Integer;
cur:Integer;
t:String;
ws:WideString;
begin
Result:='';
ws := Val;
len := Length(ws);
i := 1;
j := 0;
while i <= len do
begin
cur := ord(ws[i]);
FmtStr(t,'%4.4X',[cur]);
Result := Result+t;
inc(i);
j := (j+1) mod 7;
end;
end;
Function TfrmMain.sendmessage(var smsc,smsbody,telno:string):boolean;
var
temp,len,ret:string;
lrc:longword;
begin
Data:=GetPDUData(SMSC,telno,smsbody,Len);
temp:='AT+CSMS=1'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:='';
memo1.Text:=readcom;
frmMain.Refresh; temp:='AT+CNMI=2,2,0,1,1'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:='AT+CMGF=0'+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:='AT+CMGS='+Len+#13;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(100);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; temp:=Data+#26;
writefile(hcomm,pchar(temp)^,length(temp),lrc,nil);
sleep(200);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh; {Result:=false;
ret:=readcom;
Edit1.Text:=Edit1.Text+ret;
frmMain.Refresh;
if (pos('ERROR',ret)=0)
then Result:=true; }
sleep(10000);
memo1.Text:=memo1.Text+readcom;
frmMain.Refresh;
end;
Function TfrmMain.readcom:string;
var temp:string;
inbuff:array[0..10240] of char;
nbytesread,dwerror:longword;
cs:tcomstat;
begin
clearcommerror(hcomm,dwerror,@cs);
if cs.cbInQue>sizeof(inbuff) then
begin
purgecomm(hcomm,purge_rxclear);
exit;
end;
readfile(hcomm,inbuff,cs.cbInQue,nbytesread,nil);
temp:=copy(inbuff,1,cs.cbInQue);
result:=temp;
end;procedure TfrmMain.Button1Click(Sender: TObject);
var
smsc,tel,str:string;
begin
smsc:='8613800591500';
tel:=trim(edit2.Text);
str:=trim(edit3.Text); if (sendmessage(smsc,str,tel)=true)
then
if (Application.Messagebox('短信息发送成功!',
'系统提示',MB_OK+MB_DEFBUTTON1+MB_ICONQUESTION)=IDok)
then abort;end;procedure TfrmMain.FormCreate(Sender: TObject);
begin
opencomm;end;end.
解决方案 »
免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货