delphi 短信猫GSM modem （TC35）测试开发实例

采用多线程的方式对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.

测试效果图：