sendsms.pas

一个delphi编写的收发短信源码, 使用了Cport控件,很实用

//at+cmgf=0  ---- 使用 pdu 模式
//at+cmgf=1  ---- 使用 text 模式

//00 ---- 7bit
//10 ---- 8bit
//08 ---- UNICOD

unit SendSMS;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, dfsStatusBar, ImgList, Buttons, StdCtrls, ExtCtrls, ToolWin,
  GlobePas, CPort, DataMoudal, IniFiles, DB, ADODB, Menus;

type
  TfrmSMS = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    Panel1: TPanel;
    Panel2: TPanel;
    memLogs: TMemo;
    Label1: TLabel;
    EdContent: TEdit;
    SBSend: TSpeedButton;
    TBOpen: TToolButton;
    TBClose: TToolButton;
    ToolButton3: TToolButton;
    TBSetup: TToolButton;
    ToolButton5: TToolButton;
    TBExit: TToolButton;
    ImageList1: TImageList;
    LightImg: TImageList;
    SB: TdfsStatusBar;
    Label2: TLabel;
    edPhone: TEdit;
    TBDebug: TToolButton;
    TBRead: TToolButton;
    TBInit: TToolButton;
    timTask: TTimer;
    timTransTask: TTimer;
    timData: TTimer;
    DealdataTimer: TTimer;
    TBSave: TToolButton;
    ToolButton2: TToolButton;
    SD: TSaveDialog;
    PM: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    TBSend: TToolButton;
    ToolButton4: TToolButton;
    SMSPort: TComPort;
    TBType: TToolButton;
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure SMSPortRxChar(Sender: TObject; Count: Integer);
    procedure TBSetupClick(Sender: TObject);
    procedure TBOpenClick(Sender: TObject);
    procedure TBCloseClick(Sender: TObject);
    procedure TBExitClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure SBSendClick(Sender: TObject);
    procedure TBDebugClick(Sender: TObject);
    procedure memLogsDblClick(Sender: TObject);
    procedure TBReadClick(Sender: TObject);
    procedure TBInitClick(Sender: TObject);
    procedure timTaskTimer(Sender: TObject);
    procedure timTransTaskTimer(Sender: TObject);
    procedure timDataTimer(Sender: TObject);
    procedure DealdataTimerTimer(Sender: TObject);
    procedure memLogsMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TBSendClick(Sender: TObject);
    procedure TBTypeClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure memLogsChange(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure SMSStatusChg(mStatus: integer; mtext: string);
    procedure InitCommPort;
    procedure InitSMSPort;
    function ChgCMGF(mcmgf: string): Boolean;
    procedure initTaskData;
    procedure transtask;
    procedure DealData(ST: TStringS); //　处理数据
    procedure PhaseAPureData(aPureData: string);
  public
    { Public declarations }
    procedure SendGSMMsg(sTel, sNote: string; sText: string);
    procedure DeBugMemo(mst: string; isTras: boolean = true; isType: Integer = 0);
    procedure LookType;

    function conhexstr(hexstr: string): string;  //十六进制转换ASCII码
  end;

const
  Msg: array[0..3] of string = ('ATE0V1', 'AT+CSDH=1', 'AT+CMGF=1', 'AT+CNMI=3,2,0,0,1');

var
  frmSMS: TfrmSMS;

implementation

uses SetParamFrm, SendCountFrm;

{$R *.DFM}

procedure TfrmSMS.SMSStatusChg(mStatus: integer; mtext: string);
begin
  SB.Panels[1].Text := mtext;
  case mStatus of
    0: LightImg.GetBitmap(0, SB.Panels[0].Glyph.BitMap);
    1: LightImg.GetBitmap(1, SB.Panels[0].Glyph.BitMap);
    2: LightImg.GetBitmap(2, SB.Panels[0].Glyph.BitMap);
    3: LightImg.GetBitmap(3, SB.Panels[0].Glyph.BitMap);
  end;
  SB.InvalidatePanel(0);
end;

procedure TfrmSMS.InitCommPort;
begin
  SMSPort.Close;
  if Length(CommPort.Port) < 4 then
  begin
    SMSStatusChg(0, '未打开端口');
    CommState := SNone;
    Exit;
  end;
  try
    SMSPort.Port := CommPort.Port;
    SMSPort.Open;
    CommState := SOpen;
    LookType;
    InitSMSPort;
  except
    SMSStatusChg(2, CommPort.Port + '：打开失败');
    CommState := SLost;
  end;
end;

procedure TfrmSMS.FormCreate(Sender: TObject);
begin
  LoadParam;
  InitCommPort;
  TBInitClick(nil);
end;

procedure TfrmSMS.InitSMSPort;
var
  mT: Dword;
  i: integer;
begin
  if CommState <> SOpen then
    exit;
  if not SMSPort.Connected then
  begin
    try
      SMSPort.Open;
      LookType;
    except
      SMSStatusChg(2, CommPort.Port + '：打开失败');
      CommState := SLost;
    end;
  end;
  CommState := SInit;
  if CommPort.Phone <> '' then
  begin
    if fType then
    begin
{TC35:AT+CNMI=3,1,0,0,1}
{AT+CNMI=3,2,0,0,1}
      SMSPort.WriteStr('ATE0V1+CSDH=1+CMGF=1+CNMI=3,2,0,0,1+CSCA="+86' + CommPort.Phone + '"'#13#10);
      DeBugMemo('ATE0V1+CSDH=1+CMGF=1+CNMI=3,2,0,0,1+CSCA="+86' + CommPort.Phone + '"'#13#10);
    end else
    begin
      for i := 0 to 3 do
      begin
        SMSPort.WriteStr(Msg[i] + #13#10);
        DeBugMemo(Msg[i] + #13#10);
        mt := GetTickCount;
        while (GetTickCount - mT) < 300 do
        begin
          application.ProcessMessages;
          if pos('OK', UpperCase(FRecTxt)) > 0 then
            break;
        end;
        Sleep(100);
      end;
      SMSPort.WriteStr('AT+CSCA="+86' + CommPort.Phone + '"'#13#10);
      DeBugMemo('AT+CSCA="+86' + CommPort.Phone + '"'#13#10);
      mt := GetTickCount;
      while (GetTickCount - mT) < 300 do
      begin
        application.ProcessMessages;
        if pos('OK', UpperCase(FRecTxt)) > 0 then
          break;
      end;
    end;
  end
  else
  begin
    if fType then
    begin
      SMSPort.WriteStr('ATE0V1+CSDH=1+CMGF=1+CNMI=3,2,0,0,1'#13#10);
      DeBugMemo('ATE0V1+CSDH=1+CMGF=1+CNMI=3,2,0,0,1'#13#10);
    end else
    begin
      for i := 0 to 3 do
      begin
        SMSPort.WriteStr(Msg[i] + #13#10);
        DeBugMemo(Msg[i] + #13#10);
        mt := GetTickCount;
        while (GetTickCount - mT) < 300 do
        begin
          application.ProcessMessages;
          if pos('OK', UpperCase(FRecTxt)) > 0 then
            break;
        end;
        Sleep(100);
      end;
    end;
  end;

  mt := GetTickCount;
  while ((GetTickCount - mT) < 300) do
  begin
    application.ProcessMessages;
    if pos('OK', UpperCase(FRecTxt)) > 0 then
      break;
  end;

  if pos('OK', UpperCase(FRecTxt)) > 0 then
  begin
    delete(FrecTxt, pos('OK', UpperCase(FrecTxt)), 2);
    SMSStatusChg(1, CommPort.Port + '：初始化成功');
    CommState := Sidlesse;
  end else
  begin
    SMSStatusChg(2, CommPort.Port + '：初始化失败');
    CommState := SLost;
  end;
  if pos('+', uppercase(FrecTxt)) = 0 then
    FrecTxt := '';
end;

procedure TfrmSMS.DeBugMemo(mst: string; isTras: boolean = True; isType: Integer = 0);
var
  mfile: string;
begin
  if memLogs.Lines.Count > 3000 then
  begin
    mfile := curdir + 'recdat\' + formatdatetime('yyyy-mm-dd_hh-mm-ss-zzz', now) + '.txt';
    while fileexists(mfile) do
    begin
//      application.ProcessMessages;
      mfile := curdir + 'recdat\' + formatdatetime('yyyy-mm-dd_hh-mm-ss-zzz', now) + '.txt';
    end;
    memLogs.Lines.SaveToFile(mfile);
    memLogs.Clear;
  end;
  if isType <> 0 then
    memLogs.Lines.Add(formatdatetime('yy-mm-dd hh:mm:ss ', now) + '>>' + mst)
  else
    if isTras then
      memLogs.Lines.Add(formatdatetime('yy-mm-dd hh:mm:ss ', now) + '>>发送' + #$0D#$0A + mst)
    else
      memLogs.Lines.Add(formatdatetime('yy-mm-dd hh:mm:ss ', now) + '<<收到' + #$0D#$0A + mst);
end;

procedure TfrmSMS.SMSPortRxChar(Sender: TObject; Count: Integer);
var
  mst: string;
begin
  if not (Sender is TComPort) then
    exit;
  SMSPort.ReadStr(mst, count);
  FrecTXT := FrecTXT + mst;
  if EnableOpen then
    DeBugMemo(mst, false);
end;

procedure TfrmSMS.TBSetupClick(Sender: TObject);
begin
  if Show_SetComm then
  begin
    InitCommPort;
  end;
end;

procedure TfrmSMS.TBOpenClick(Sender: TObject);
begin
  InitCommPort;
end;

procedure TfrmSMS.TBCloseClick(Sender: TObject);
begin
  SMSPort.Close;
  SMSStatusChg(0, '通信端口关闭...');
end;

procedure TfrmSMS.TBExitClick(Sender: TObject);
begin
  CLose;
end;

procedure TfrmSMS.FormDestroy(Sender: TObject);
begin
  iniF.Free;
  TaskList.Free;
  DataList.Free;
end;

procedure TfrmSMS.SBSendClick(Sender: TObject);
var
  smsCode, municode: string;
  TT: DWord;
  SMSComs: string;
  i: integer;
begin
  if edPhone.Text = '' then
  begin
    Application.MessageBox('请填写对方手机号码！', '系统提示', MB_OK + MB_ICONWARNING);
    Exit;
  end;
  if EdContent.Text = '' then
  begin
    Application.MessageBox('请填写短信内容！', '系统提示', MB_OK + MB_ICONWARNING);
    Exit;
  end;
  SendGSMMsg(edPhone.Text, CommPort.Phone, EdContent.Text);
end;

function TfrmSMS.ChgCMGF(mcmgf: string): Boolean;
var
  mT: Dword;
  i: integer;
begin
  result := false;
  if CommPort.Phone <> '' then
  begin //ATE0V1+CSDH=1+CMGF=1+CNMI=2,1,0,0,1+CSCA=
    if fType then
    begin
{TC35:AT+CNMI=3,1,0,0,1}
      SMSPort.WriteStr('ATE0V1+CSDH=1+CMGF=' + mcmgf + '+CNMI=3,2,0,0,1+CSCA="+86' + CommPort.Phone + '"'#13#10);
      DeBugMemo('ATE0V1+CSDH=1+CMGF=' + mcmgf + '+CNMI=3,2,0,0,1+CSCA="+86' + CommPort.Phone + '"'#13#10);
    end else
    begin
      for i := 0 to 3 do
      begin
        if Pos('AT+CMGF', Msg[i]) > 0 then
        begin
          SMSPort.WriteStr('AT+CMGF=' + mcmgf + #13#10);
          DeBugMemo('AT+CMGF=' + mcmgf + #13#10);
        end else
        begin
          SMSPort.WriteStr(Msg[i] + #13#10);
          DeBugMemo(Msg[i] + #13#10);
        end;
        mt := GetTickCount;
        while (GetTickCount - mT) < 300 do
        begin
          application.ProcessMessages;
          if pos('OK', UpperCase(FRecTxt)) > 0 then
            break;
        end;
        Sleep(100);
      end;
      SMSPort.WriteStr('AT+CSCA="+86' + CommPort.Phone + '"'#13#10);
      DeBugMemo('AT+CSCA="+86' + CommPort.Phone + '"'#13#10);
      mt := GetTickCount;
      while (GetTickCount - mT) < 300 do
      begin
        application.ProcessMessages;
        if pos('OK', UpperCase(FRecTxt)) > 0 then
          break;
      end;
    end;
  end
  else
  begin
    if fType then
    begin
      SMSPort.WriteStr('ATE0V1+CSDH=1+CMGF=' + mcmgf + '+CNMI=3,2,0,0,1'#13#10);
      DeBugMemo('ATE0V1+CSDH=1+CMGF=' + mcmgf + '+CNMI=3,2,0,0,1'#13#10);
    end else
    begin
      for i := 0 to 3 do
      begin
        if Pos('AT+CMGF', Msg[i]) > 0 then
        begin
          SMSPort.WriteStr('AT+CMGF=' + mcmgf + #13#10);
          DeBugMemo('AT+CMGF=' + mcmgf + #13#10);
        end else
        begin
          SMSPort.WriteStr(Msg[i] + #13#10);
          DeBugMemo(Msg[i] + #13#10);
        end;
        mt := GetTickCount;
        while (GetTickCount - mT) < 300 do
        begin
          application.ProcessMessages;
          if pos('OK', UpperCase(FRecTxt)) > 0 then
            break;
        end;
        Sleep(100);
      end;
    end;
  end;
  mt := GetTickCount;
  while (GetTickCount - mT) < 500 do
  begin
    application.ProcessMessages;
    if pos('OK', UpperCase(FRecTxt)) > 0 then
      break;
  end;

  if pos('OK', UpperCase(FRecTxt)) > 0 then
  begin
    delete(FrecTxt, pos('OK', UpperCase(FrecTxt)), 2);
    SMSStatusChg(1, CommPort.Port + '：初始化成功');
    result := true;
  end else
  begin
    result := false;
  end;
  if pos('+', uppercase(FrecTxt)) = 0 then
    FrecTxt := '';
end;

procedure TfrmSMS.TBDebugClick(Sender: TObject);
var
  Str: string;
begin
  Str := InputBox('调试命令', '请输入调试数据命令：', '');
  if Str <> '' then
  begin
    if UpperCase(Str) = '1A' then
      SMSPort.WriteStr(#$1A#13#10)
    else
      SMSPort.WriteStr(Str + #13#10);
    DeBugMemo(Str + #13#10);
  end;
end;

procedure TfrmSMS.memLogsDblClick(Sender: TObject);
begin
//  Self.memLogs.Lines.Clear;
end;

procedure TfrmSMS.TBReadClick(Sender: TObject);
begin
  if SMSPort.Connected then
  begin
    SMSPort.WriteStr('AT+CMGL="ALL"' + #13#10);
    DeBugMemo('AT+CMGL="ALL"' + #13#10);
  end;
end;

procedure TfrmSMS.SendGSMMsg(sTel, sNote, sText: string);
var
  smsCode, municode: string;
  TT: DWord;
  SMSComs: string;
  i: integer;
  s: string;
  ss: Boolean;
  fstr: string;
begin
   //短信Modem状态进入发短信状态
  if not ChgCMGF('0') then //设置为PDU格式
  begin
    CommState := SInit; // Modem要重新初始化
    InitSMSPort;
    exit;
  end;
  Sleep(100);
//  EdContent.Text := Copy(EdContent.Text, 1, 70);
  Caption := IntToStr(Length(sText));
  CommState := SSend;
  SMSComs := CommPort.Port;
  try
    municode := ansitoUnicode(sText);    //发送内容
    if Copy(sTel, 1, 3) = '106' then {小灵通}
      fstr := '11000F81'
    else
      fstr := '11000D91';
//    municode := sText;
    if length(municode) > 280 then
      municode := copy(municode, 1, 280);
//  0891 683108301705F0 11 00 0D91 683138084056F3 000800 16 5982679C6536523077ED4FE1002C8BF756DE590D002E
    if not fType then
    begin
      smsCode := '0891' + GetSMSTel(sNote) + fstr + GetSMSTel(sTel) + '000800'
        + inttohex(length(municode) div 2, 2)
        + municode;
    end else
    begin
      smsCode := '0891' + GetSMSTel(sNote) + fstr + GetSMSTel(sTel) + '000800'
        + inttohex(length(municode) div 2, 2)
        + municode;
    end;
{   smsCode := '0011000D91' + GetSMSTel(sTel) + '000801'
     + inttohex(length(municode) div 1, 2) + municode;}
//  0011000D91 683105114501F5000801044F60597D

    SMSStatusChg(3, CommPort.Port + '：正在' + sText); //正在向' + mtel + '发送短信');
    if not fType then
    begin
      SMSPort.WriteStr('AT+CMGS=' + IntToStr(Length(Copy(smsCode, 19, Length(smsCode))) div 2) + #10);
      DeBugMemo('AT+CMGS=' + IntToStr(Length(Copy(smsCode, 19, Length(smsCode))) div 2) + #10);
      Sleep(1000);
    end else
    begin