采用多线程的方式对GSM Modem进行发送、接收操作,并保存到数据库中。
以下为测试程序的例子,功能都有了。
unit MainForm_Pas;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB, ExtCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit1: TEdit;
Edit2: TEdit;
Memo2: TMemo;
Button6: TButton;
ADOConnection1: TADOConnection;
SP1: TADOStoredProc;
Button7: TButton;
Edit3: TEdit;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
QFindSend: TADOQuery;
QDelSend: TADOQuery;
QFindSendSendID: TStringField;
QFindSendSendPhone: TStringField;
QFindSendSendMsg: TStringField;
Label1: TLabel;
L_sms_state: TLabel;
SendPicture: TShape;
Timer1: TTimer;
RecPicture: TShape;
Button12: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button12Click(Sender: TObject);
private
{ Private declarations }
public
_ComNo:integer;
_ComName:string;
_PortNo:integer;
{ Public declarations }
procedure SaveMsg(_phone,_msg:string);
end;
TMySendThread = class(TThread)
protected
procedure Execute; override;
end;
TMyReciveThread = class(TThread)
protected
procedure Execute; override;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
//函数说明
//先初始化,然后发送或者接收,退出程序前关闭Modem
{*************************************************************}
// 参数: nComNo 0~255 代表COM编号,
// modemType 短信猫类型
// 0 - 1口短信猫,
// 1 - 2口短信猫,
// 2 - 4口短信猫,
// 3 - 8短信猫口
// 返回: 0 - 成功, -1类型错
// XXX -错误代码,参见代码表
{*************************************************************}
function fnSetModemType(ComNo:integer; modemType:Smallint) :integer;stdcall; external 'MonDem.dll';
{******************************************************}
// 获取当前短信猫类型设置
//参数: nComNo 0~255 代表COM编号。
//返回 :短信猫类型
//0 - 1口短信猫,
//1 - 2口短信猫,
//2 - 4口短信猫,
//3 - 8短信猫口
//XXX -错误代码,参见代码表
{*******************************************************}
function fnGetModemType(ComNo:integer):integer;stdcall; external 'MonDem.dll';
{***********************初始化函数***********************}
//参数: comx 0~7 代表端口号码, -1 表示所有端口
//返回: 0 - 成功 XXX -错误代码,参见代码表
{********************************************************}
function fnInitModem(comx:integer):integer;stdcall; external 'MonDem.dll';
{***********************发送函数*************************}
//参数: comx 0~7 代表端口号码, -1 表示任意一个可用端口
//receivephone 接受手机号,sendmsg表示发送信息内容
//sendmsg(应该在70个字符以内,包含标点符号,1个汉字算1个字符)
//例如: 恭喜发财,测试成功! 长度为10
//返回: 0 - 发送成功 1 - 发送失败 XXX -错误代码,参见代码表
{********************************************************}
function fnSendMsg(comx:integer;receivephone,sendmsg:pchar):integer;stdcall; external 'MonDem.dll';
{********************************************************}
// 参数: nPortNo 0~255 代表端口号码, -1 表示所有端口
//返回: 端口状态,大于等于8表示设备连接正常,可以接收和发送。
// 状态小于8,表示测试状态。小于等于1,可能连线没有接好或者电源
// 没有打开,注意复位短信猫。
// -1 端口号指定错误或者是端口未打开
{********************************************************}
function fnGetStatus(nPortNo:integer):integer;stdcall; external 'MonDem.dll';
{*************************接收函数***********************}
//参数: comx 0~7 代表端口号码,
//(-1 表示任意一个可用端口,暂时不支持)
//sendphone 发送方手机号码 receivemsg 接收信息内容
//返回: 0~7 - 成功,接收端口号码 -1 - 无信息
//XXX -错误代码,参见代码表
{********************************************************}
function fnReadMsgEx(comx:integer;szHeader,receivemsg:pchar):integer;stdcall; external 'MonDem.dll';
function fnGetSndCount(nPortNo:integer):integer;stdcall; external 'MonDem.dll';
function fnGetRecCount(nPortNo:integer):integer;stdcall; external 'MonDem.dll';
//function fnSetReceive(nType:integer):integer;stdcall; external 'MonDem.dll';
{************************关闭函数************************}
//参数: comx 0~7 代表端口号码, -1 表示所有端口
//返回: 0 - 成功 XXX -错误代码,参见代码表
{********************************************************}
function fnCloseModem(comx:integer):integer;stdcall; external 'MonDem.dll';
{*******************错误代码表:**************************}
// 100: 授权错误(检测软件狗)
// 101: 授权类型错误(检测软件狗类型)
// 102: 未初始化,请先初始化
// 200: 端口号码错
// 201: 不支持的端口
// 202: 信息超长
// 203: 不能发送空信息
// 204: 手机号码错
// 205: 设备错
//5xx: 操作xx号端口错误
{********************************************************}
procedure TMySendThread.Execute;
var
i,_ret: Integer;
_phone,_msg:string;
begin
FreeOnTerminate := True; {这可以让线程执行完毕后随即释放}
while true do
begin
_ret:= fnGetStatus(Form2._PortNo);
form2.L_sms_state.Caption:=inttostr(_ret); //显示状态
if _ret>=8 then begin
form2.QFindSend.Open;
if form2.QFindSend.RecordCount>0 then begin
form2.Memo1.Lines.Add('找到要发送信息----->'+form2.QFindSendSendID.AsString);
while not form2.QFindSend.Eof do begin
_phone:=form2.QFindSendSendPhone.AsString;
_msg:=form2.QFindSendSendMsg.AsString;
i :=fnSendMsg(-1,pchar(_phone),pchar(copy(_msg,1,120)));
if (i>=0) and (i<=255) then begin
form2.memo1.lines.add('发送成功--->'+_msg) ;
try
form2.QDelSend.Close;
form2.QDelSend.Parameters[0].Value:=form2.QFindSendSendID.AsString;
form2.QDelSend.ExecSQL;
finally
//form2.Memo1.Lines.Add('出错!');
end;
end;
form2.QFindSend.Next;
end;
end;
end;
form2.QFindSend.Close;
form2.SendPicture.brush.Color:=clLime;
Sleep(5000); //延迟5秒
end;
end;
procedure TMyReciveThread.Execute;
var
j,i,ret: Integer;
phone,msg:pchar;
begin
FreeOnTerminate := True; {这可以让线程执行完毕后随即释放}
while true do
begin
ret:=fnGetRecCount(Form2._portno);
if ret<>-1 then begin
for j:=1 to ret do begin
try
GetMem(phone,128);
GetMem(msg,500) ;
i :=fnReadMsgEx(form2._portno,phone,msg);
case i of
0..255:begin
form2.SaveMsg(StrPas(phone),StrPas(msg));
end;
end;
finally
FreeMem(phone);
FreeMem(msg);
end;
end;
end;
form2.RecPicture.brush.Color:=clLime;
Sleep(5000); //延迟5秒
end;
end;
//------------------------线程部分结束---------------------------
procedure TForm2.Button1Click(Sender: TObject);
var
i:integer;
pno:integer;
lx:integer;
st:integer;
begin
_comno:=0;
while _comno<10 do begin
pno:=-1;
for i:=0 to _comno-1 do
begin
lx:=fnGetModemType(i) ;
case lx of
0: inc(pno,1);
1: inc(pno,2);
2: inc(pno,4);
3: inc(pno,8);
end;
memo1.Lines.Add('com'+inttostr(i)+'--->'+inttostr(pno));
end;
st:=fnInitModem(pno+1);
if (st=0) then begin
_PortNo:=pno+1;
_ComName:='COM'+inttostr(_ComNo+1);
memo1.Lines.Add('找到'+_ComName+' ,端口->'+inttostr(_PortNo));
break;
end;
_comno:=_comno+1;
end;
fnSetModemType(_comno,0);
end;
procedure TForm2.Button2Click(Sender: TObject);
var
i:integer;
pno:integer;
lx:integer;
st:integer;
begin
st:=fnInitModem(_comno);
memo1.Lines.Add(inttostr(_comno)+','+inttostr(st));
end;
procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
fnCloseModem(-1);
end;
procedure TForm2.Button3Click(Sender: TObject);
var
i:integer;
begin
i:=fnCloseModem(-1);
if i=0 then
memo1.Lines.Add('释放'+inttostr(_comno)+'端口成功!')
else
memo1.Lines.Add('释放'+inttostr(_comno)+'端口失败,错误代码:'+inttostr(i));
end;
procedure TForm2.Button4Click(Sender: TObject);
var
sendstatu:integer;
begin
sendstatu:= fnGetStatus(_PortNo);
Memo1.Lines.Add('测试'+inttostr(sendstatu)) ;
end;
procedure TForm2.Button5Click(Sender: TObject);
var
i:integer;
begin
i :=fnSendMsg(-1,pchar(edit1.Text),pchar(copy(memo2.lines.Text,1,120)));
case i of
0..255:begin
memo1.lines.add('提交成功--->'+inttostr(i)) ;
//messagebox(self.Handle,'提交成功','提示',mb_ok or mb_iconinformation);
end;
-1 : begin
//StaticText1.Caption:='提交失败' ;
memo1.lines.add('发送失败 -1');
end;
else
begin
memo1.lines.add('提交出错,出错代码:'+inttostr(i));
//messagebox(self.Handle,pchar('提交出错,出错代码:'+inttostr(i)),'发送失败',mb_ok or mb_iconerror);
end;
end;
end;
procedure TForm2.Button6Click(Sender: TObject);
var
l,i,ret:integer;
phone,msg:pchar;
begin
ret:=fnGetSndCount(_portno);
if ret<>-1 then
memo1.Lines.Add('发送队列表中有:'+inttostr(ret)+'条信息')
else
memo1.lines.add('发送队列表中没有信息');
ret:=fnGetRecCount(_portno);
if ret<>-1 then begin
memo1.Lines.Add('接收队列表中有:'+inttostr(ret)+'条信息');
for l:=1 to ret do
try
GetMem(phone,128);
GetMem(msg,500) ;
i :=fnReadMsgEx(_portno,phone,msg);
case i of
0..255:begin
if StrPas(phone)[1] in ['2'..'5'] then
memo1.Lines.Add('发送失败,手机号为:'+phone+'信息为:'+msg)
else
if StrPas(phone)[1]='1' then
memo1.Lines.Add('发送成功,手机号为:'+phone+'信息为:'+msg)
ELSE
if StrPas(phone)[1]='0' THEN
memo1.Lines.Add('接收到信息,手机号为:'+phone+'信息为:'+msg)
else
if StrPas(phone)[1]='6' THEN
memo1.Lines.Add('接收到状态报告,手机号为:'+phone+'信息为:'+msg);
end;
-1 : memo1.Lines.Add('端口无信息!' );
else memo1.Lines.Add('端口读取信息错误,错误代码:'+inttostr(i));
end;
finally
FreeMem(phone);
FreeMem(msg);
end;
end;
end;
procedure TForm2.SaveMsg(_phone, _msg: string);
var
MsgStatus:string;
RecPhone:string;
RecDate:string;
RecMsg:string;
TmpStr:string;
StatuStr:string;
i,j:integer;
begin
TmpStr:=_Phone;
RecMsg:=_msg;
///返回信息字串:1,2,2012-12-07 19:05:14,13790110387,,1,-1,,0,75
memo1.Lines.Add('------start-------');
memo1.Lines.Add(tmpstr);
MsgStatus:='';
for i:=1 to 6 do begin
case i of
1:begin
StatuStr:=copy(tmpstr,1,pos(',',tmpstr)-1);
if StatuStr='1' then
MsgStatus:='发送成功'
else
if StatuStr='0' then
MsgStatus:='接到信息'
else
if StatuStr[1] in ['2'..'5'] then
MsgStatus:='发送失败';
end;
2:;
3:begin
RecDate:=copy(tmpstr,1,pos(',',tmpstr)-1);
end;
4:begin
RecPhone:=copy(tmpstr,1,pos(',',tmpstr)-1);
end;
end;
TmpStr:=copy(Tmpstr,Pos(',',Tmpstr)+1,128);
end;
memo1.lines.Add('MsgStatus--->'+MsgStatus);
memo1.Lines.add('RecDate--->'+RecDate);
memo1.lines.Add('RecPhone--->'+RecPhone);
memo1.lines.Add('RecMsg--->'+_msg);
try
sp1.Close;
sp1.Parameters[1].Value := RecDate;
sp1.Parameters[2].Value := RecPhone;
sp1.Parameters[3].Value := MsgStatus;
sp1.Parameters[4].Value := copy(RecMsg,1,150);
sp1.ExecProc;
finally
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
if not ADOConnection1.Connected then
ADOConnection1.Open;
_PortNo:=0;
_ComName:='COM0';
SendPicture.brush.Color:=clred;
RecPicture.brush.Color:=clred;
end;
procedure TForm2.Button7Click(Sender: TObject);
begin
SaveMsg(edit3.Text,'kjdjkjd');
end;
procedure TForm2.Button10Click(Sender: TObject);
begin
TMySendThread.Create(false); //false 立即调用Execute ;true- 不启动Execute
end;
procedure TForm2.Button11Click(Sender: TObject);
begin
TMyReciveThread.Create(false);
end;
procedure TForm2.Button8Click(Sender: TObject);
begin
TMySendThread.Create(false); //false 立即调用Execute ;true- 不启动Execute
end;
procedure TForm2.Button9Click(Sender: TObject);
begin
TMyReciveThread.Create(false);
end;
procedure TForm2.Timer1Timer(Sender: TObject);
begin
SendPicture.brush.Color:=clred;
RecPicture.brush.Color:=clred;
end;
procedure TForm2.Button12Click(Sender: TObject);
var
_tmpNum:integer;
begin
_tmpNum:=random(1000);
while _tmpNum<100 do begin
_tmpNum:=random(1000);
end;
memo1.Lines.Add(inttostr(_tmpNum));
end;
end.
测试效果图: