sendsms.pas

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

      if Copy(sTel, 1, 3) = '106' then
      begin
        SMSPort.WriteStr('AT+CMGS=' + IntToStr(Length(Copy(smsCode, 19, Length(smsCode))) div 2) + #13#10);
        DeBugMemo('AT+CMGS=' + IntToStr(Length(Copy(smsCode, 19, Length(smsCode))) div 2) + #13#10);
      end else
      begin
        SMSPort.WriteStr('AT+CMGS=' + inttostr(length(municode) div 2 + 15) + #13#10);
        DeBugMemo('AT+CMGS=' + inttostr(length(municode) div 2 + 15) + #13#10);
      end;
    end;
    TT := GetTickCount;
    if fType then
    begin
      while (Pos('> ', UpperCase(FRecTxt)) = 0) do
      begin
        Application.ProcessMessages;
        if (GetTickCount - TT) > 2000 then
        begin
          SMSStatusChg(2, SMSComs + '：' + sText + '失败'); //正在向' + mtel + '发送短信');
          FTrasErrCount := FTrasErrCount + 1;
          CommState := SLost;
          if FTrasErrCount > 3 then
          begin
            CommState := SNone; //出错3次：500毫秒未收到发写短信内容符号'>',Modem要重新初始化
            InitSMSPort;
          end;
          exit;
        end;
      end;
    end else
    begin
      while (pos('OK', UpperCase(FRecTxt)) = 0) and (pos('> ', UpperCase(FRecTxt)) = 0)
        and (Pos(#13#10, FRecTxt) = 0) do
      begin
        Application.ProcessMessages;
        if (GetTickCount - TT) > 2000 then
        begin
          SMSStatusChg(2, SMSComs + '：' + sText + '失败'); //正在向' + mtel + '发送短信');
          FTrasErrCount := FTrasErrCount + 1;
          CommState := SLost;
          if FTrasErrCount > 3 then
          begin
            CommState := SNone; //出错3次：500毫秒未收到发写短信内容符号'>',Modem要重新初始化
            InitSMSPort;
          end;
          exit;
        end;
      end;
    end;
    delete(FrecTxt, pos('> ', FRecTxt), 2);
    if not fType then
    begin
      delete(FrecTxt, pos('OK', FRecTxt), 2);
      Delete(FRecTxt, POS(#13#10, FRecTxt), Length(#13#10));
      Sleep(100);
    end;
    SMSPort.WriteStr(smsCode + #26#13#10); //发短信内容
    DeBugMemo(smsCode + #26#13#10);

    TT := GetTickCount;
    if fType then
    begin
      while ((pos('+CMGS:', uppercase(FRecTxt)) = 0) or (pos('OK'#13#10, uppercase(FRecTxt)) = 0)) or (pos('+CMGS:', uppercase(FRecTxt)) > pos('OK'#13#10, uppercase(FRecTxt))) do
      begin
        Application.ProcessMessages;
        if (GetTickCount - TT) > 8000 then
        begin
          SMSStatusChg(2, SMSComs + '：' + sText + '失败'); //正在向' + mtel + '发送短信');
          FTrasErrCount := FTrasErrCount + 1;
          CommState := SLost;
          if FTrasErrCount > 3 then
          begin
            CommState := SNone; //出错3次：8000毫秒未收到发写短信内容符号'>',Modem要重新初始化
            InitSMSPort;
          end;
          exit;
        end;
      end;
    end else
    begin
      while (pos('+CMGS:', uppercase(FRecTxt)) = 0) or (pos('OK'#13#10, uppercase(FRecTxt)) = 0) or (pos('+CMGS:', uppercase(FRecTxt)) > pos('OK'#13#10, uppercase(FRecTxt))) do
      begin
        Application.ProcessMessages;
        if (GetTickCount - TT) > 8000 then
        begin
          SMSStatusChg(2, SMSComs + '：' + sText + '失败'); //正在向' + mtel + '发送短信');
          FTrasErrCount := FTrasErrCount + 1;
          CommState := SLost;
          if FTrasErrCount > 3 then
          begin
            CommState := SNone; //出错3次：8000毫秒未收到发写短信内容符号'>',Modem要重新初始化
            InitSMSPort;
          end;
          exit;
        end;
      end;
    end;
    delete(FRecTxt, pos('+CMGS:', uppercase(FRecTxt)), 6);
    delete(FRecTxt, pos('OK'#13#10, uppercase(FRecTxt)), 4);
    SMSStatusChg(1, SMSComs + '：' + sText + '发送成功');
    DeBugMemo(sText + #26#13#10);
    FTrasErrCount := 0;
    CommState := SLost;
  finally
    if not ChgCMGF('1') then //设置为PDU格式
    begin
      CommState := SInit; // Modem要重新初始化
      InitSMSPort;
    end;
    if pos('+', uppercase(FrecTxt)) = 0 then
      FrecTxt := '';
  end;
end;

procedure TfrmSMS.TBInitClick(Sender: TObject);
var
  ConStr: string;
  DataIni: TIniFile;
begin
  LoadParam;
{  ManagerPhone := PhoneIni.ReadString(SysName, 'ManagePhone', '');
  CotePhone := PhoneIni.ReadString(SysName, 'CotePhone', '');
  try
    DataIni := TIniFile.Create(CurDir + 'Sys\DataPath.ini');
    ConStr := DataIni.ReadString('Local', 'Constr', '');
    DM.ADOConn.Close;
    DM.ADOConn.ConnectionString := ConStr;
    try
      DM.ADOConn.Open;
      DeBugMemo('数据库初始化成功...', True, 1);
    except
      DeBugMemo('数据库初始化失败...', True, 1);
    end;
  finally
    DataIni.Free;
  end; }
end;

procedure TfrmSMS.initTaskData;
var
  fADOD: TADODataSet;
begin
  fADOD := TADODataSet.Create(nil);
  fADOD.Connection := DM.ADOConn;
  with fADOD do
  begin
    try
      Close;
      CommandText := 'Select * from TaskData where Writeback<>1';
      Open;
      while not Eof do
      begin
        Task := TTask.Create;
        Task.TaskID := FieldByName('TaskID').AsString;
        Task.TaskName := FieldByName('TaskName').AsString;
        Task.TaskData := FieldByName('TaskData').AsString;
        Task.TaskWord := FieldByName('TaskWord').AsInteger;
        Task.WriteBack := FieldByName('WriteBack').AsInteger;
        Task.WriteTime := FieldByName('Writetime').AsDateTime;
        Task.TaskPhone := FieldByName('TaskPhone').AsString;
        Task.Tasktime := GetTickCount;
        TaskList.Add(Task);
        Next;
      end;
    finally
      Free;
    end;
  end;
end;

procedure TfrmSMS.timTaskTimer(Sender: TObject);
begin
{  try
    timTask.Enabled := False;
    initTaskData;
  finally
    timTask.Enabled := True;
  end;}
end;

procedure TfrmSMS.timTransTaskTimer(Sender: TObject);
begin
{  try
    timTransTask.Enabled := False;
    transtask;
  finally
    timTransTask.Enabled := True;
  end;}
end;

procedure TfrmSMS.transtask;
var
  mTask: TTask;
  i: integer;
begin
  if CommState <> SInit then
    Exit;
  if TaskList.Count > 0 then
  begin
    for i := 0 to TaskList.Count - 1 do
    begin
      mTask := TTask(TaskList.Items[i]);
      if CotePhone <> '' then
      begin
        SendGSMMsg(mTask.TaskPhone, CotePhone, mTask.TaskData);
      end else
      begin
        Application.MessageBox('短信中心号码不能为空！', '系统提示', MB_OK + MB_ICONWARNING);
      end;
    end;
  end;
end;

procedure TfrmSMS.timDataTimer(Sender: TObject);
var
  mds, ms, mc1, mc2, mlength, mfile: string;
  mst: Tstrings;
begin
  try
    timData.Enabled := False;
{    if Pos('ERROR', UpperCase(FRecTxt)) > 0 then
    begin
      DeBugMemo(FRecTxt + '读取失败...');
      FRecTxt := '';
      Exit;
    end;}
    if (pos('+CMGL:', uppercase(FrecTxt)) = 0) and
      (pos('+CMGR:', uppercase(FrecTxt)) = 0) and
      (pos('+CMT:', uppercase(FrecTxt)) = 0) then //没接收到短信头
      exit;
    ms := FrecTxt;
    if pos('+CMT:', uppercase(FrecTxt)) > 0 then
      delete(ms, 1, pos('+CMT:', uppercase(ms)) - 1)
    else if pos('+CMGL:', uppercase(FrecTxt)) > 0 then
      delete(ms, 1, pos('+CMGL:', uppercase(ms)) - 1);
    if pos('+CMGR:', uppercase(FrecTxt)) > 0 then
      delete(ms, 1, pos('+CMGR:', uppercase(ms)) - 1);
    mds := ms;
    if pos(#13#10, ms) = 0 then //没收全
      exit;
    mc1 := copy(ms, 1, pos(#13#10, ms) - 1);
    delete(ms, 1, pos(#13#10, ms) + 1);
    if pos(#13#10, ms) = 0 then //没收全
      exit;
    mc2 := copy(ms, 1, pos(#13#10, ms) - 1);
    delete(ms, 1, pos(#13#10, ms) + 1);
    if (pos('"+', mc1) <> 0) then //text mode
    begin
      mlength := mc1;
      while pos(',', mlength) > 0 do
        delete(mlength, 1, pos(',', mlength));
      if length(mc2) < strtoint(mlength) then //没收全
        exit;
    end;
    Delete(FrecTxt, 1, pos(mds, FrecTxt) + length(mc1 + mc2) + 3);
    if pos('+', uppercase(FrecTxt)) = 0 then
      FrecTxt := '';
    mst := Tstringlist.Create;
    mst.Add('mesg=' + mc1);
    mst.Add('data=' + mc2);
    DeBugMemo(mc1 + '--' + mc2);
    DataList.Add(mst);
  finally
    timData.Enabled := True;
  end;
end;

procedure TfrmSMS.DealData(ST: TStringS);
var
  mMesg, mData: string;
  mtel, mtime: string;
  fData: string;
begin
  mMesg := st.Values['mesg'];
  mData := st.Values['data'];
  if (pos('0891', mData) = 1) and (pos('"', mMesg) = 0) then //PDU mode
  begin
      //0891 //683108301705F0 //040D91 //683137838284F7 0000 40216111623023 02 C219
    delete(mData, 1, 24);
    mtel := copy(mData, 1, 14);
    mtel := DevSMSTel(mtel);
    delete(mData, 1, 14);
    mtime := copy(mdata, 1, 4);
    if mtime <> '0008' then
    begin
//        log('接收数据出错：' + st.text);
      exit;
    end;
    delete(mData, 1, 4);
    mtime := copy(mdata, 1, 14);
    delete(mData, 1, 16);
    mtime := GetPDUSMSTime(mtime);
    mdata := unicodetoansi(mData);
  end else
  begin
    mtel := mMesg;
    if (pos('+CMGR:', uppercase(mtel)) = 0) and
      (pos('+CMT:', uppercase(mtel)) = 0) then
      Delete(mtel, 1, Pos(',', mtel));
    if (pos('+CMT:', uppercase(mtel)) > 0) then
    begin
      ; //Delete(mtel, 1, POS('+CMT:', UpperCase(mtel)));
    end
    else
      Delete(mtel, 1, Pos(',', mtel));
    mtel := copy(mtel, 1, pos(',', mtel) - 1);
    delete(mtel, 1, pos('"', mtel));
    delete(mtel, pos('"', mtel), length(mtel) + 1 - pos('"', mtel));
    if pos('+86', mtel) = 1 then
    begin
      delete(mtel, 1, 3);
    end else
      if pos('86', mtel) = 1 then
      begin
        delete(mtel, 1, 2);
      end;

    mtime := mMesg;
    delete(mtime, 1, pos(',,"', mtime) + 1);
    delete(mtime, pos('",', mtime), length(mtime) + 1 - pos('"', mtime)); //'04/11/20,15:51:30+32'
    mtime := stringreplace(mtime, '/', '-', [rfReplaceAll]);
    mtime := stringreplace(mtime, ',', ' ', [rfReplaceAll]);

    if length(mtime) - pos('+', mtime) = 0 then
      mtime := stringreplace(mtime, '+', ':000', [rfReplaceAll])
    else
      if length(mtime) - pos('+', mtime) = 1 then
        mtime := stringreplace(mtime, '+', ':00', [rfReplaceAll])
      else
        if length(mtime) - pos('+', mtime) = 2 then
          mtime := stringreplace(mtime, '+', ':0', [rfReplaceAll])
        else
          if length(mtime) - pos('+', mtime) = 3 then
            mtime := stringreplace(mtime, '+', ':', [rfReplaceAll])
          else
            if pos('+', mtime) = 0 then
              mtime := mtime + ':000'
            else
              if length(mtime) - pos('+', mtime) > 3 then
                mtime := copy(mtime, 1, pos('+', mtime) - 1) + ':000';
    delete(mtime, 1, pos('"', mtime));
    mtime := '20' + mtime;
    fData := mData;
    try
      mData := unicodetoansi(mData);
    except
      mData := mData;
    end;
    if mData = '?' then
      mData := fData;
  end;
  DeBugMemo(mData + ',' + mtel + ',' + mtime, False);
end;

procedure TfrmSMS.PhaseAPureData(aPureData: string); //分析数据分别进行处理或者入库
var
  CmmAddr, rectime: string;
  CmmData: string;
  CmmWord, CmmCrc, lnPure: Integer;
begin
  aPureData := Trim(aPureData);
  CmmAddr := Copy(aPureData, 1, Pos('^', aPureData) - 1);
  Delete(aPureData, 1, Pos('^', aPureData));
  rectime := Copy(aPureData, 1, Pos('=', aPureData) - 1);
  try StrToDateTime(rectime);
  except rectime := DateTimeToStr(Now);
  end;
  Delete(aPureData, 1, Pos('=', aPureData));
  lnPure := Length(aPureData);
  //pure protocal data layer                --CRC
  CmmWord := StrToIntDef('$' + aPureData[1] + aPureData[2], -1);
  CmmCrc := StrToIntDef('$' + Copy(aPureData, Length(aPureData) - 1, 2), -1);
  CmmData := Copy(aPureData, 3, lnPure - 4);
  //peel off typeword and crc , and deal
{  case CmmWord of
    $B1: Deal_B1(CmmAddr, CmmData, rectime);
    $B2: Deal_B2(CmmAddr, CmmData, rectime);
    $B3: Deal_B3(CmmAddr, CmmData, rectime);
    $B5: Deal_B5(CmmAddr, CmmData, rectime);
    $B6: Deal_B6(CmmAddr, CmmData, rectime);
  end; }
end;

procedure TfrmSMS.DealdataTimerTimer(Sender: TObject);
begin
  DealDataTimer.Enabled := False;
  try
    if DataList.Count > 0 then
    begin
//      StartDealData;
      try
        try
          DealData(TStrings(DataList.Items[0]));
//          Log('数据处理=======>>成功');
        except
//          Log('数据处理=======>>失败');
        end;
      finally
        TStrings(DataList.Items[0]).Free;
        DataList.Delete(0);
//        endDealData;
      end;
    end;
  finally
    DealDataTimer.Enabled := True;
  end;
end;

procedure TfrmSMS.memLogsMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssCtrl in Shift then
  begin
    TBDebug.Visible := not TBDebug.Visible;
    TBType.Visible := not TBType.Visible;
  end;
end;

procedure TfrmSMS.N1Click(Sender: TObject);
begin
  if memLogs.Lines.Count > 0 then
  begin
    if SD.Execute then
      memLogs.Lines.SaveToFile(SD.FileName + '.txt');
  end;
end;

procedure TfrmSMS.N2Click(Sender: TObject);
begin
  if memLogs.Lines.Count > 0 then
    memLogs.Clear;
end;

procedure TfrmSMS.ToolBar1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if ssctrl in Shift then
    EnableOpen := not EnableOpen;
end;

procedure TfrmSMS.TBSendClick(Sender: TObject);
var
  sPhone, sCount: string;
  tt: integer;
begin
  if Show_SendCount(sPhone, sCount) then
  begin
//    SendGSMMsg(sPhone, CommPort.Phone, sCount);
  end;
end;

procedure TfrmSMS.LookType;
var
  tt: integer;
begin
  SMSPort.WriteStr('AT+CGMI' + #13#10);
  DeBugMemo('AT+CGMI' + #13#10);
  tt := GetTickCount;
  while Pos('OK', UpperCase(FRecTxt)) = 0 do
  begin
    Application.ProcessMessages;
    if (GetTickCount - tt) > 8000 then
    begin
      DeBugMemo('No Find');
      Exit;
    end;
  end;
  if Pos('SIEMENS', UpperCase(FRecTxt)) > 0 then
  begin
    DeBugMemo('SIEMENS');
    fType := True;
  end else if Pos('WAVECOM', Uppercase(FRecTxt)) > 0 then
  begin
    fType := False;
    DeBugMemo('WAVECOM');
  end;
end;

procedure TfrmSMS.TBTypeClick(Sender: TObject);
begin
  LookType;
end;

procedure TfrmSMS.SpeedButton1Click(Sender: TObject);
begin
  Caption := IntToStr(Length('11000F8101067361869433F9000800046D4B8BD5') div 2);
  Caption := Caption + '--' + DevSMSTel('6801067361869433F9');
  Caption := Caption + '---' + inttohex(length('010673618694339'), 2) +
    '---' + inttohex(length('6831064233469'), 2)
end;

function TfrmSMS.conhexstr(hexstr: string): string;
var
  i: integer;
begin
  result := '';
  for i := 1 to length(hexstr) do
    result := result + inttohex(ord(hexstr[i]), 2);
end;

procedure TfrmSMS.memLogsChange(Sender: TObject);
begin
//  Caption := ansitoUnicode('你好') + unicodetoansi('4F60597D');
end;

procedure TfrmSMS.Button1Click(Sender: TObject);
var
  mst: TStrings;
begin
    mst := Tstringlist.Create;
    mst.Add('mesg=' + '+CMGR: 1,,24');
    mst.Add('data=' + '0891683108301705F0240D91683103839518F5000860300361941123044F60597D');
//    DeBugMemo(mc1 + '--' + mc2);
    DataList.Add(mst);
end;

end.