unitdm.pas

串口短信猫收发软件。支持西门子TC35i设备

      else if DQ.FieldByName('para_name').AsString='autoreply' then
        FbAutoReply := DQ.FieldByName('para_value').AsString = '1'
      else if DQ.FieldByName('para_name').AsString='limitfee' then
        FbLimitFee := DQ.FieldByName('para_value').AsString = '1'
      else if DQ.FieldByName('para_name').AsString='autostopoverfee' then
        FbAutoStopOverFee := DQ.FieldByName('para_value').AsString = '1';
      DQ.Next;
    end;
  finally
    DQ.Close;
  end;
end;

function TDM.AddRequest(req_time, send_mobile, send_data: string): boolean;
var
  sql: string;
begin
  Result := False;
  try
    //send_result: 0-未发 1-已发 2-失败
    sql := ' insert into Tab_request(req_time, send_num, send_mobile, send_data, send_result) '
         + ' values(:req_time, 0, :send_mobile, :send_data, 0) ';
    Con.BeginTrans;
    DQ.Close;
    DQ.SQL.Text := sql;
    DQ.Parameters.ParamByName('req_time').value := req_time;
    DQ.Parameters.ParamByName('send_mobile').value := send_mobile;
    DQ.Parameters.ParamByName('send_data').value := send_data;
    DQ.ExecSQL;
    Con.CommitTrans;
    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.AddAutoReply(req_time, send_mobile, send_data: string): boolean;
var
  sOriginSend_data: string;
  sReci_prefix, sSend_prefix, sSend_SQL, sSend_params, sSend_suffix, sSend_data: string;
  reply_data, tmpStr: widestring;
  i, j: integer;
  sql1, sql2: string;
begin
  Result := False;
  sql1 := ' select * from Tab_autoreply ';
  sql2 := ' insert into Tab_request(req_time, send_num, send_mobile, send_data, send_result) '
        + ' values(:req_time, 0, :send_mobile, :send_data, 0) ';
  sOriginSend_data := Trim(send_data);
  sSend_prefix := '';
  sSend_SQL := '';
  sSend_params := '';
  sSend_suffix := '';
  try
    //查找规则
    DQ.Close;
    DQ.SQL.Text := sql1;
    DQ.Open;
    if DQ.RecordCount<=0 then//没有合适规则，退出
    begin
      Result := True;
      Exit;
    end;
    DQ.First;
    while not DQ.Eof do
    begin
      sReci_prefix := UpperCase(Trim(DQ.FieldByName('reci_prefix').AsString));
      if (sReci_prefix='*')or(sReci_prefix='＊') then sReci_prefix := sOriginSend_data;//如果是*则所有均回复
      while pos('*', sReci_prefix)>0 do delete(sReci_prefix, pos('*', sReci_prefix), 1);
      while pos('＊', sReci_prefix)>0 do delete(sReci_prefix, pos('＊', sReci_prefix), 1);
      if sReci_prefix<>'' then
      begin
        if copy(UpperCase(sOriginSend_data),1,Length(sReci_prefix))=sReci_prefix then
        begin
          sSend_prefix := Trim(DQ.FieldByName('send_prefix').AsString);
          sSend_SQL := Trim(DQ.FieldByName('send_sql').AsString);
          sSend_params := Trim(DQ.FieldByName('send_params').AsString);
          sSend_suffix := Trim(DQ.FieldByName('send_suffix').AsString);
          Break;
        end;
      end;
      DQ.Next;
    end;
    DQ.Close;
    
    if (sSend_prefix='')and(sSend_SQL='')and(sSend_params='')and(sSend_suffix='') then//没有合适规则，正常退出
    begin
      Result := True;
      Exit;
    end;

    //根据动态SQL查询出结果
    sSend_data := '';
    if sSend_SQL<>'' then
    begin
      DQ.Close;
      DQ.SQL.Text := sSend_SQL;
      //参数赋值
      DQ.Parameters.Items[0].Value := copy(sOriginSend_data, Length(sReci_prefix)+1, Length(sOriginSend_data));//第一个固定参数
      for i:=0 to GetParamNum(';', sSend_params)-1 do
        DQ.Parameters.Items[i+1].Value := GetIndexParam(i, ';', sSend_params);

      try
        DQ.Open;
        DQ.First;
        while not DQ.Eof do
        begin
          tmpStr := '';
          for j:=0 to DQ.Fields.Count-1 do tmpStr := tmpStr + DQ.Fields.Fields[j].AsString + ',';
          tmpStr := Trim(tmpStr);
          if copy(tmpStr, Length(tmpStr), 1)=',' then delete(tmpStr, Length(tmpStr), 1);

          sSend_data := sSend_data + tmpStr + ';';
          DQ.Next;
        end;
        //去掉尾部;
        sSend_data := Trim(sSend_data);
        if copy(sSend_data, Length(sSend_data), 1)=';' then delete(sSend_data, Length(sSend_data), 1);
      except
        DQ.Close;
        Exit;
      end;
    end;
    
    if sSend_data='' then sSend_data := AUTOREPLY_NO_INFO;
    reply_data := Trim(sSend_prefix + sSend_data + sSend_suffix);
    tmpStr := reply_data;

    Con.BeginTrans;
    //按每条短信最大长度自动拆分成多条短信发送
    for i:=0 to (Round(Ceil(Length(reply_data)/70)))-1 do
    begin
      tmpStr := copy(reply_data, i*70+1, 70);
      DQ.Close;
      DQ.SQL.Text := sql2;
      DQ.Parameters.ParamByName('req_time').value := req_time;
      DQ.Parameters.ParamByName('send_mobile').value := send_mobile;
      DQ.Parameters.ParamByName('send_data').value := tmpStr;
      DQ.ExecSQL;
    end;
    Con.CommitTrans;

    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.AddResponse(res_time, reci_mobile, reci_data, reci_time: string): boolean;
var
  sql: string;
begin
  Result := False;
  try
    //res_time接收时间 reci_time来信时间
    //do_result 0-未处理 1-已处理
    sql := ' insert into Tab_response(res_time, reci_mobile, reci_data, reci_time, do_result) '
         + ' values(:res_time, :reci_mobile, :reci_data, :reci_time, 0) ';
    Con.BeginTrans;
    DQ.Close;
    DQ.SQL.Text := sql;
    DQ.Parameters.ParamByName('res_time').value := res_time;
    DQ.Parameters.ParamByName('reci_mobile').value := reci_mobile;
    DQ.Parameters.ParamByName('reci_data').value := reci_data;
    DQ.Parameters.ParamByName('reci_time').value := reci_time;
    DQ.ExecSQL;
    Con.CommitTrans;
    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;  
end;

function TDM.UpdateRequest(req_id, send_mobile, send_result, send_time, netdefine: string): boolean;
var
  sql1, sql2, sql3, sql4: string;
  iLocalNet, iSend_result: integer;
  feebalance, SMSFee: real;
  send_remark: string;
begin
  Result := False;
  try
    iSend_result := StrToInt(send_result);
    send_remark := '无';
    
    sql1 := ' select send_num from Tab_request where req_id=:req_id ';
    sql2 := ' update Tab_request set localnet=:localnet, send_result=:send_result, send_time=:send_time, send_num=send_num+1, send_remark=:send_remark '
          + ' where req_id=:req_id ';
    sql3 := 'select para_value from Tab_basepara where para_name=''feebalance'' ';
    sql4 := ' update Tab_basepara set para_value=:para_value where para_name=''feebalance'' ';

    if iSend_result=0 then
    begin
      //如果超过最大发送次数，则置send_result为2-失败标志
      DQ.Close;
      DQ.SQL.Text := sql1;
      DQ.Parameters.ParamByName('req_id').value := req_id;
      DQ.Open;
      if DQ.FieldByName('send_num').AsInteger > PublicFun.FiTrySendCount-1 then
      begin
        iSend_result := 2;
        send_remark := '第' + IntToStr(PublicFun.FiTrySendCount) + '次尝试重新发送失败';
      end;
    end;
    
    Con.BeginTrans;
    //扣费
    if iSend_result=1 then
    begin
      feebalance := 0.0;
      DQ.Close;
      DQ.SQL.Text := sql3;
      DQ.Open;
      feebalance := DQ.FieldByName('para_value').AsFloat;//总结余费用
      
      SMSFee := GetSMSFee(send_mobile, netdefine);//本次短信费用

      DQ.Close;
      DQ.SQL.Text := sql4;
      DQ.Parameters.ParamByName('para_value').value := FloatToStr(feebalance - SMSFee);
      DQ.ExecSQL;
    end;

    iLocalNet := GetLocalNetDefine(send_mobile, netdefine);//获取网络标识，0-网内, 1-网外

    //更改发送标志
    DQ.Close;
    DQ.SQL.Text := sql2;
    DQ.Parameters.ParamByName('localnet').value := iLocalNet;
    DQ.Parameters.ParamByName('send_result').value := iSend_result;
    DQ.Parameters.ParamByName('send_time').value := send_time;
    DQ.Parameters.ParamByName('send_remark').value := send_remark;
    DQ.Parameters.ParamByName('req_id').value := req_id;
    DQ.ExecSQL;
    
    Con.CommitTrans;
    DQ.Close;

  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.QueryRequest(var MsgNum: integer; var MsgArray: array of TRecieveSMS): boolean;
var
  i: integer;
  sql: string;
begin
  Result := False;
  MsgNum := 0;

  if not HasFee then Exit;                                                      //如果费用超额则退出

  try
    sql := ' select req_id, send_mobile, send_data, req_time from Tab_request where send_result=0 order by req_time,send_num ';
    DQ.Close;
    DQ.SQL.Text := sql;
    DQ.Open;
    MsgNum := DQ.RecordCount;
    if MsgNum>MAX_PER_DO_NUM then MsgNum := MAX_PER_DO_NUM;
    for i:=0 to MsgNum-1 do
    begin
      MsgArray[i].MsgIndex := DQ.FieldByName('req_id').AsString;
      MsgArray[i].MsgDate := DQ.FieldByName('req_time').AsString;
      MsgArray[i].MsgMobile := DQ.FieldByName('send_mobile').AsString;
      MsgArray[i].MsgData := DQ.FieldByName('send_data').AsString;
    end;
    Result := True;    
    DQ.Close;
  except
    DQ.Close;
  end;
end;

procedure TDM.DSet_RequestCalcFields(DataSet: TDataSet);
begin
  case DSet_Requestsend_result.AsInteger of
    0: DSet_Requestresult.Text := '未发';
    1: DSet_Requestresult.Text := '已发';
    2: DSet_Requestresult.Text := '失败';
  else
    DSet_Requestresult.Text := '不详';
  end;
end;

procedure TDM.DSet_RequestNewRecord(DataSet: TDataSet);
begin
  DSet_Requestreq_time.AsString := FormatDateTime(FORMATDATETIME_DEF, Now);
  DSet_Requestsend_result.AsInteger := 0;
end;

procedure TDM.DSet_AddrNewRecord(DataSet: TDataSet);
begin
  if (DSet_AddrGroup.RecordCount<=0)
   or(DSet_AddrGroup.FieldByName('addrgroup_id').AsString='') then
  begin
    Application.MessageBox('请先在通讯群组显示列表中右键选择创建通讯群组！','提示',MB_OK + MB_ICONWARNING);
    Abort;
  end;
  DSet_Addr.FieldByName('addrgroup_id').Value := DSet_AddrGroup.FieldByName('addrgroup_id').AsString;
end;

procedure TDM.DSet_TextNewRecord(DataSet: TDataSet);
begin
  if (DSet_TextGroup.RecordCount<=0)
   or(DSet_TextGroup.FieldByName('textgroup_id').AsString='') then
  begin
    Application.MessageBox('请先在常用短语显示列表中右键选择创建常用短语类别！','提示',MB_OK + MB_ICONWARNING);
    Abort;
  end;
  DSet_Text.FieldByName('textgroup_id').Value := DSet_TextGroup.FieldByName('textgroup_id').AsString;
end;

function TDM.AddAddrGroup(addrgroup_name: string): boolean;
var
  sql: string;
begin
  Result := False;
  try
    sql := ' insert into Tab_addrgroup(addrgroup_name)values(:addrgroup_name) ';
    Con.BeginTrans;
    DQ.Close;
    DQ.SQL.Text := sql;
    DQ.Parameters.ParamByName('addrgroup_name').value := addrgroup_name;
    DQ.ExecSQL;
    Con.CommitTrans;
    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.UpdateAddrGroup(addrgroup_id, addrgroup_name: string): boolean;
var
  sql: string;
begin
  Result := False;
  try
    sql := ' update Tab_addrgroup set addrgroup_name=:addrgroup_name where addrgroup_id=:addrgroup_id ';
    Con.BeginTrans;
    DQ.Close;
    DQ.SQL.Text := sql;
    DQ.Parameters.ParamByName('addrgroup_name').value := addrgroup_name;
    DQ.Parameters.ParamByName('addrgroup_id').value := addrgroup_id;
    DQ.ExecSQL;
    Con.CommitTrans;
    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.DelAddrGroup(addrgroup_id: string): boolean;
var
  sql1, sql2: string;
begin
  Result := False;
  try
    sql1 := ' delete from Tab_addrgroup where addrgroup_id=:addrgroup_id ';
    sql2 := ' delete from Tab_addr where addrgroup_id=:addrgroup_id ';
    Con.BeginTrans;

    DQ.Close;
    DQ.SQL.Text := sql1;
    DQ.Parameters.ParamByName('addrgroup_id').value := addrgroup_id;
    DQ.ExecSQL;

    DQ.Close;
    DQ.SQL.Text := sql2;
    DQ.Parameters.ParamByName('addrgroup_id').value := addrgroup_id;
    DQ.ExecSQL;

    Con.CommitTrans;
    DQ.Close;
  except
    Con.RollbackTrans;
    DQ.Close;
  end;
  Result := True;
end;

function TDM.AddTextGroup(textgroup_name: string): boolean;
var
  sql: string;
begin
  Result := False;
  try
    sql := ' insert into Tab_textgroup(textgroup_name)values(:textgroup_name) ';