📄 unit1.~pas

📁 多线程发送和接收短信
💻 ~PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Buttons, StdCtrls, OleCtrls, SMSRedSky_TLB,inifiles,
  ExtCtrls;

type
  TFM_Main = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    M_SMS: TMemo;
    Label1: TLabel;
    SpeedButton1: TSpeedButton;
    Label2: TLabel;
    ComboBox_Tel: TComboBox;
    Label3: TLabel;
    ComboBox2: TComboBox;
    TabSheet2: TTabSheet;
    RedSky: TRedSky;
    Timer_Init_Gsm_Connected: TTimer;
    procedure Timer_Init_Gsm_ConnectedTimer(Sender: TObject);
    procedure RedSkySendMessageFailed(Sender: TObject; const PhoneNum,
      Mission, GBKText: WideString);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure RedSkySendMessageResult(Sender: TObject; const PhoneNum,
      Mission: WideString; Result: Integer);
    procedure RedSkyReadAll(Sender: TObject; const Index_ID, PhoneNum,
      SMS: WideString);
    procedure RedSkyDestroy(Sender: TObject);
    procedure RedSkyDeleteSucceed(Sender: TObject; Index_ID: Integer);
    procedure RedSkyDeleteError(Sender: TObject; Index_ID: Integer);
    procedure RedSkyComReceiveSMS(Sender: TObject; const PhoneNum,
      SMS: WideString);
   
  private
    { Private declarations }
  public
    { Public declarations }
    Function  OverLengthStr(var Str:string):string;
    procedure Send_SMS(Ambulet_Tel:string;SMS:string);
  end;

var
  FM_Main: TFM_Main;
  myinifile:Tinifile;
  Init_Gsm_Connected:integer;
implementation

uses U_Fm_Connected_GSM;

{$R *.dfm}

procedure TFM_Main.Timer_Init_Gsm_ConnectedTimer(Sender: TObject);
begin
   Init_Gsm_Connected:=Init_Gsm_Connected+1;
  if Init_Gsm_Connected>4 then
    begin
     Fm_Connected_GSM.Close;
     Memo1.Lines.Add('本机->'+'连接..'+'->与GSM模块建立连接失败！请重试... 【'+ComboBox2.Text+'】');
     Timer_Init_Gsm_Connected.Enabled:=false;
     Init_Gsm_Connected:=0;
     application.MessageBox('与GSM模块建立连接失败！请重新启动或者检查GSM连接情况！','系统错误！',MB_IconERROR)

    end;
end;

procedure TFM_Main.RedSkySendMessageFailed(Sender: TObject; const PhoneNum,
  Mission, GBKText: WideString);
begin
  if Mission='Init_Success' then
    begin
      Fm_Connected_GSM.Close;
      Timer_Init_Gsm_Connected.Enabled:=False;
      Init_Gsm_Connected:=0;

      Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',Now)+'初始化GSM模块成功：'+Mission);
    end
  else
    begin
       Memo1.Lines.Add('GSM->'+'发送失败'+'TO:'+PhoneNum+'>>发送失败！内容：['+Mission+']');
    end;
end;

procedure TFM_Main.FormShow(Sender: TObject);
var
 COM_Num,MessageCenter_Num:string;
 i,BaudRate_Num:integer;
 filename,S:string;
begin

  if FileExists('GPSConfig.ini') then
      begin
        filename:=ExtractFilePath(paramstr(0))+'GPSConfig.ini';
        myinifile:=TInifile.Create(filename);
        COM_Num:=myinifile.readstring('GPS_SERVER','COM',s);          //COM口设置
        ComboBox2.Text:= COM_Num;
        MessageCenter_Num:=myinifile.readstring('GPS_SERVER','MessageCenterNum',s);
        BaudRate_Num:=strtoint(myinifile.readstring('GPS_SERVER','BaudRate',s));
      end;
  Fm_Connected_GSM.Show;
  Fm_Connected_GSM.Refresh;
  i:=RedSky.Init(COM_Num,inttostr(BaudRate_Num),MessageCenter_Num) ;
  if i<>0 then
    begin
      application.MessageBox('短信模块初始化失败！请重新初始化或者重新登录！','系统错误！',MB_IconWarning);
      Fm_Connected_GSM.Close ;
    end
  else
   begin
     //调试信息
    Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',now)+'[GSM]初始化==>>短信中心号码：'+MessageCenter_Num+' ，波特率：'+inttostr(BaudRate_Num)+' ，COM口：【'+COM_Num+'】');

    Timer_Init_Gsm_Connected.Enabled:=true;
   end;

  RedSky.ReadAllSMSFromGSM;
end;
//=====(自定义函数)=====2004-09-21===by 郭秀双========================
//功能：按照一定的长度，把带汉字的字符串 分割成若干段
//参数： Str：字符串
Function  TFM_Main.OverLengthStr(var Str:string):string;
var
 bExit : boolean;
 iLen : integer;
 strSource, strTemp,Value : string;

begin
 //L_SendNum:integer 截取汉字的长度
 Value:=Str;
 if Length(Value) <= 100 then
    begin
       Str:=Value;
       exit;
    end;

 strSource := Value;
 Value := '';
 //防止截断汉字。
 begin
   iLen := 1;
   while iLen < 100 do
   begin
     if ord(strSource[iLen]) > 128 then
       inc(iLen, 2)
     else
       inc(iLen);
   end;
   dec(iLen); 
   strTemp := Copy(strSource, 1, iLen);
   OverLengthStr:=strTemp  ;
    strSource := Copy(strSource, iLen + 1, Length(strSource) - iLen);
   Str:=strSource;
 end;
end;
//向指定的电话号码发送短信息
procedure TFM_Main.Send_SMS(Ambulet_Tel:string;SMS:string);
var
 i:integer;
 TempStr,FirstStr,SecondStr:string;
begin
 TempStr:=SMS;
// RedSky.SendSMS(Ambulet_Tel,'',TempStr);
 Repeat
   FirstStr:=OverLengthStr(TempStr);
      if Trim(FirstStr)<>'' then
     try
       RedSky.SendSMS(Ambulet_Tel,FirstStr,'');
       //调试信息
       Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',now)+'To ['+Ambulet_Tel+'] ==(1)'+FirstStr);
       
     except
       Memo1.Lines.Add('本机->'+'发送..'+'->手机'+' 信息发送失败！');
     end ;
 Until
   length(TempStr)<= 100;
   SecondStr:=TempStr;
      if Trim(SecondStr)<>'' then
      try
        Sleep(1000);
        RedSky.SendSMS(Ambulet_Tel,SecondStr,'');
        //调试信息
        Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',now)+'To ['+Ambulet_Tel+'] ==(2)'+SecondStr);
      except
        Memo1.Lines.Add('本机->'+'发送..'+'->手机'+' 信息发送失败！');
      end ;   

end;
procedure TFM_Main.SpeedButton1Click(Sender: TObject);
begin
  if  (length(ComboBox_Tel.Text)<>0) and (length(M_SMS.Text)<>0) then
           begin
             Send_SMS(ComboBox_Tel.Text,M_SMS.Text) ; //【'+send_Tel+'】
             Memo1.Lines.Add('本机->'+'发送..'+'->手机'+' 发送短信至【'+ComboBox_Tel.Text+'】=='+M_SMS.Text);
           end
        else
           begin
             application.MessageBox('请填写完整！','填写不完整！',0);
           end;
end;

procedure TFM_Main.RedSkySendMessageResult(Sender: TObject; const PhoneNum,
  Mission: WideString; Result: Integer);
begin
 if Result=0 then //发送成功
   begin
    Memo1.Lines.Add('GSM->'+'发送成功'+'TO:'+PhoneNum+' 短信息已经发出！');
   end
 else
   begin
    Memo1.Lines.Add('GSM->'+'发送失败'+'TO:'+PhoneNum+'['+Mission+']'+' 短信息发送失败！请检查设备的连接情况！重新发送...');
   end;
end;

procedure TFM_Main.RedSkyReadAll(Sender: TObject; const Index_ID, PhoneNum,
  SMS: WideString);
begin
   Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',now)+'From ['+PhoneNum+']['+Index_ID+']'+'==信息：'+SMS);
   if strtoint(Index_ID)>0 then
    begin
      Sleep(1000);
      RedSky.DeleteSMS(strtoint(Index_ID));
      Memo1.Lines.Add('删除->'+'GSM'+' 内存ID:=【'+Index_ID+'】'+'[ ReadAll ]请求删除GSM短信息...');
    end;
end;

procedure TFM_Main.RedSkyDestroy(Sender: TObject);
begin
   RedSky.FreeOnRelease;
end;

procedure TFM_Main.RedSkyDeleteSucceed(Sender: TObject; Index_ID: Integer);
begin
   Memo1.Lines.Add('GSM->'+'删除成功'+' 清除短信息成功！内存ID:=【'+inttostr(Index_ID)+'】');
end;

procedure TFM_Main.RedSkyDeleteError(Sender: TObject; Index_ID: Integer);
begin
   Memo1.Lines.Add('GSM->'+'删除失败'+' 内存ID:=【'+inttostr(Index_ID)+'】'+'Delete模块中短信息失败！重试...');
end;

procedure TFM_Main.RedSkyComReceiveSMS(Sender: TObject; const PhoneNum,
  SMS: WideString);
begin
  //调试信息
   Memo1.Lines.Add(formatdatetime('YYYY-MM-DD HH:MM:SS',now)+'From ['+PhoneNum+']'+'==信息：'+SMS);

end;

end.
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -