ufmain.~pas

这个是DELPHI环境下的收发短信程序的源代码。目前发送短信已经做的很完美了

unit UFMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Menus, ExtCtrls, ComCtrls, ToolWin;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    StatusBar1: TStatusBar;
    GroupBox2: TGroupBox;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Memo1: TMemo;
    Edit1: TEdit;
    Memo2: TMemo;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Timer1: TTimer;
    procedure N4Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Form1: TForm1;



implementation

uses
  UFHelp, UFConfig, USMS;



{$R *.dfm}

procedure TForm1.N4Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.N2Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = Word(#13) then
  begin
    BitBtn1.Click;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption := Application.Title;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  if Timer1.Interval <> (SMS.SMSSet.ChkMsgDelay*1000) then
  begin
    Timer1.Interval := SMS.SMSSet.ChkMsgDelay*1000;
  end;
  if not SMS.SComm.m_Opened then
  begin
    Memo1.Lines.Add('初始化失败,程序无法运行！');
    Memo1.Enabled := FALSE;
    Memo2.Enabled := FALSE;
    Edit1.Enabled := FALSE;
    BitBtn1.Enabled := FALSE;
    BitBtn2.Enabled := FALSE;
  end else
  begin
    Memo1.Lines.Clear;
    Memo1.Enabled := TRUE;
    Memo2.Enabled := TRUE;
    Edit1.Enabled := TRUE;
    BitBtn1.Enabled := TRUE;
    BitBtn2.Enabled := TRUE;
  end;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Memo1.Lines.Clear;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  smsBuf:string;
  Mobile:string;
begin
  BitBtn1.Enabled := FALSE;
  if SMS.SComm.m_Opened then
  begin
    Mobile := '86'+Edit1.Text;
    if length(Mobile) <> 13 then
    begin
      if Mobile = '86' then
        MessageDlg('请输入手机号码！',mtInformation,[mbOk],0)
      else
        MessageDlg('手机号码不正确！',mtInformation,[mbOk],0);
      BitBtn1.Enabled := TRUE;
      exit;
    end;

    smsBuf := Memo1.Lines.GetText;
    if (length(smsBuf) > 70) and (SMS.SMSSet.SMSMode = 'PDU')
    or (length(smsBuf) >140) and (SMS.SMSSet.SMSMode ='Text') then
    begin
      MessageDlg('短消息内容太长！',mtInformation,[mbOk],0);
      BitBtn1.Enabled := TRUE;
      exit;
    end;
    if smsBuf = '' then
    begin
      MessageDlg('请输入发送内容！',mtInformation,[mbOk],0);
      Memo1.Lines.Clear;
      BitBtn1.Enabled := TRUE;
      exit;
    end;

    while SMS.Busy do;
    SMS.Busy := TRUE;
    if SMS.SendSMS(smsBuf,Mobile) then
    begin
      MessageDlg('短消息发送成功！',mtInformation,[mbOk],0);
      Memo1.Lines.Clear;
    end else
    begin
     MessageDlg('短消息发送失败！',mtWarning,[mbOk],0);
     Memo1.Lines.Text := smsBuf;
    end;
    SMS.Busy := FALSE;
  end else
  begin
    MessageDlg('串口初始化失败！不能发送短消息。',mtError,[mbOk],0);
  end;
  BitBtn1.Enabled := TRUE;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  CheckResult:boolean;
  strTmp:string;
begin
  CheckResult := TRUE;
  if not SMS.SComm.m_Opened or not SMS.SMSSet.ChkNewMsg then exit;

  if SMS.Busy then exit;
  SMS.Busy := TRUE;
  while CheckResult do
  begin
    CheckResult := SMS.CheckNewSMS;
    if CheckResult then
    begin
      strTmp := '20'+copy(SMS.RxMsg.Date,1,2)+'-'+copy(SMS.RxMsg.Date,3,2)
                +'-'+copy(SMS.RxMsg.Date,5,2)+'      '+copy(SMS.RxMsg.Date,7,2)
                +':'+copy(SMS.RxMsg.Date,9,2)+':'+copy(SMS.RxMsg.Date,11,2);
      Memo2.Lines.Append('时间：'+strTmp);
      Memo2.Lines.Append('号码：'+copy(SMS.RxMsg.Mobile,3,11));
      Memo2.Lines.Append('内容：'+SMS.RxMsg.SMSMsg);
      Memo2.Lines.Append('');
    end;
    sleep(300);
  end;
  SMS.Busy := FALSE;
end;

initialization
begin
  SMS := TSMSControl.Create;                                                    //注意先后顺序
  if SMS.SComm.SComInit then
  begin
    SMS.ErrMsg := SMS.IniSMS;
    if SMS.ErrMsg < 0 then
    begin
      SMS.SComm.CloseSerial;
      case SMS.ErrMsg of
      -1:
        begin
          if MessageDlg('　　没有检测到短消息模块,如果模块已与计算机连接，'
               +chr(13)+'请检查端口参数设置。要继续吗？',mtError,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -4:
        begin
          if MessageDlg('设置GSM字符集错误,请检查您的短消息模块。',mtError,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -5:
        begin
          if MessageDlg('短消息中心没有配置或配置置错误,请检查SIM卡和短消息参数设置。要继续吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -6:
        begin
          if MessageDlg('短消息模块不支持文本方式(Text)发送,请重新配置短消息参数。要继续吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -7:
        begin
          if MessageDlg('短消息模块不支持PDU方式,请重新配置短消息参数。要继续吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
          Application.Terminate;
        end;
      -8:
        begin
          if MessageDlg('设置PDU-UCS2字符集错误,请确认您的模块是否支持。要继续吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
          begin
            Application.Terminate;
          end;
        end;
      else
        begin
          Application.Terminate;
        end;
      end;
    end;
  end else
  begin
    if MessageDlg('串口初始化失败！要继续吗？',mtWarning,[mbYes,mbNo],0) = mrNo then
    begin
      Application.Terminate;
    end;
  end;
end;

finalization
begin
  SMS.SComm.CloseSerial;
end;

end.