callerdm.pas

东进D160A板卡自动外呼程序代码

unit CallerDM;

interface

uses
  SysUtils, Classes, ImgList, Controls, DB, ADODB, ActnList, Forms, ExtCtrls;

type
  // 通道结构
  TChannel = packed record
    ChannelID: Integer;
    ChannelType: Integer;
    AttachTTS: Boolean;
    Step: Integer;
    Busying: Boolean;
    PlayingWaterfee: Boolean;
    RingdelectReset: Boolean;
    MeterID: string; // 水表编号
    Ownerdata: string;
    CallerID: Pchar;
    DtmfID: string;
  end;
  PChannel = ^TChannel;

  // 催缴状态
  TDun = (tdFree, tdDial, tdCheckSignal, tdPlayWaterfee, tdOnhook, tdConnect,
         	tdOffhook, tdBusy, tdNobody, tdNoSignal, tdNoDialtone, tdNoResult);

  TdmCaller = class(TDataModule)
    ilChannel: TImageList;
    conCaller: TADOConnection;
    qryWaterfeeQuery: TADOQuery;
    qryDunlog: TADOQuery;
    dsDunlog: TDataSource;
    qryDundetails: TADOQuery;
    dsDundetails: TDataSource;
    qryDundetailsSbbh: TStringField;
    qryDundetailsYhmc: TStringField;
    qryDundetailsYhdz: TStringField;
    qryDundetailsPhoneNumber: TStringField;
    qryDundetailsCallCount: TIntegerField;
    qryDundetailsCallDatetime: TDateTimeField;
    qryDundetailsCallStatus: TStringField;
    qryDundetailsWaterfee: TBCDField;
    qryDundetailsSewage: TBCDField;
    qryDundetailsTotalsum: TBCDField;
    qryDundetailsCbrq: TDateTimeField;
    qryDundetailsLatedays: TIntegerField;
    actlstCaller: TActionList;
    actStartDun: TAction;
    qryWaterfeedun: TADOQuery;
    actRefreshTellist: TAction;
    spDunlog: TADOStoredProc;
    spDun_Insert: TADOStoredProc;
    qryDunlogLogID: TAutoIncField;
    qryDunlogChannel: TIntegerField;
    qryDunlogChannelType: TStringField;
    qryDunlogAction: TStringField;
    qryDunlogDescription: TStringField;
    qryDunlogResult: TStringField;
    qryDunlogLogDatetime: TDateTimeField;
    tmrRefresh: TTimer;
    qryDundetailsIndexNumber: TStringField;
    procedure DataModuleCreate(Sender: TObject);
    procedure DataModuleDestroy(Sender: TObject);
    procedure actStartDunExecute(Sender: TObject);
    procedure actRefreshTellistExecute(Sender: TObject);
    procedure tmrRefreshTimer(Sender: TObject);
  private
    FStartdunflag: Boolean;
    FDuntaskCount: Integer;
    
    procedure RefreshTellist;
    procedure SetStartdunflag(const Value: Boolean);
  public
    procedure DunInsert(AmeterID, Adhhm: string; ACallCount: Integer; Astatus: string);
    procedure Dunlog(Achl: Integer; Achnltype: string; Action, Adesc, AResult: string);
    function  GetWaterfee(AmeterID: string): string;
    function  GetDunWaterfee(AmeterID: string): string;
    procedure RefreshDundetails;
    procedure RefreshDunlog;

    property Startdunflag: Boolean read FStartdunflag write SetStartdunflag default False;
    property DuntaskCount: Integer read FDuntaskCount default 0;
  end;

var
  dmCaller: TdmCaller;

implementation

uses mainform, Channels, RegExpr, DunThread;

{$R *.dfm}

procedure TdmCaller.DataModuleCreate(Sender: TObject);
begin
  FStartdunflag := False;
  conCaller.Connected := True;
end;

procedure TdmCaller.DataModuleDestroy(Sender: TObject);
begin
  conCaller.Connected := False;
end;

//------------------------------------------------------------------------------
// 获取客户当前要缴水费的总金额
//------------------------------------------------------------------------------
function TdmCaller.GetWaterfee(AmeterID: string): string;
const
  Asql = 'select Sbbh, Sum(Waterfee + Sewage) As Totalsum from VUnPaiedWaterfee where Isnull(Zzbz, '''') <> ''V'' and Sbbh = ''%s'' group by Sbbh';
var
  ATotalsum: Double;
begin
  ATotalsum := 0.00;
  with qryWaterfeeQuery do
  try
    Close;
    SQL.Clear;
    SQL.Text := Format(Asql, [AmeterID]);
    try
      Open;
      if not IsEmpty then
        ATotalsum := FieldByname('Totalsum').AsFloat
    except end;
    if ATotalsum <> 0.00 then
      Result := Format('您当前的总共有 %f 元水费未缴，请就近到自来水公司营业网点缴费。', [ATotalsum])
    else
      Result := '您当前没有未缴水费，欢迎您下次使用本系统。';
  finally
    Close;
  end;
end;

procedure TdmCaller.actStartDunExecute(Sender: TObject);
begin
  Startdunflag := not Startdunflag;
end;

//------------------------------------------------------------------------------
// 获取待催缴用户的电话列表
//------------------------------------------------------------------------------
procedure TdmCaller.RefreshTellist;

  function Getdialnumlist(Astr: string): string;
  var
    ARegex: TRegExpr; // (13\d{9}|[2-8]\d{6,7})
  begin
    Result := '';
    ARegex := TRegExpr.Create;
    try
      ARegex.Expression := '(13\d{9}|[2-8]\d{6,7})';
      if ARegex.Exec(Astr) and (ARegex.SubExprMatchCount > 0) then
        Result := ARegex.Match[0];
      if (Length(Result) = 7) then
        if Copy(Result, 1, 1) = '2' then
          Result := '2' + Result
        else
          Result := '8' + Result;
    finally
      ARegex.Free;
    end;
  end;
var
  Aduninfo: TDunInfo;
  Atmp: string;
  I: Integer;
begin
  with Mainfrm, Mainfrm.telebox.Items, qryWaterfeedun do
  try
    Screen.Cursor := crHourGlass;
    Clear();
    Close;
    try
      Open();
    except end;

    // 添加待催缴的电话列表
    I := 0;
    while not Eof do
    begin
      Atmp := Getdialnumlist(FieldByName('dhhm').AsString);
      if Atmp <> '' then
      begin
        Aduninfo         := TDunInfo.Create;
        Aduninfo.Sbbh    := FieldByName('Sbbh').AsString;
        {if I mod 2 = 0 then
          Aduninfo.Dialnum := '22574262'//Atmp; // 以一个特定号码进行测试
        else
          Aduninfo.Dialnum := '22305779';}
        Aduninfo.Dialnum := Atmp;
        AddObject(Aduninfo.Dialnum, Aduninfo);
      end;
      Inc(I);
      Next();
    end;
    First();
    FDuntaskCount := Count;
    Progressbar.Position := 0;
  finally
    Screen.Cursor := crDefault;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TdmCaller.RefreshDundetails
  Author:    Xsp
  DateTime:  2006.05.09
  Arguments: None
  Result:    None
  Popose:    刷新催缴历史记录
-------------------------------------------------------------------------------}
procedure TdmCaller.RefreshDundetails;
begin
  with qryDundetails do
  try
    Screen.Cursor := crHourGlass;
    Close;
    try
      Open;
    except end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TdmCaller.RefreshDunlog;
begin
  with qryDunlog do
  try
    Screen.Cursor := crHourGlass;
    Close();
    try
      Open();
    except end;
  finally
    Screen.Cursor := crDefault;
  end;
end;

procedure TdmCaller.actRefreshTellistExecute(Sender: TObject);
begin
  RefreshTellist;
end;

//------------------------------------------------------------------------------
// 添加催缴日志记录
//------------------------------------------------------------------------------
procedure TdmCaller.Dunlog(Achl: Integer; Achnltype, Action, Adesc,
  AResult: string);
var
  Athread: TDunlogThread;
begin
  Athread := TDunlogThread.Create(True);
  Athread.SetConnection(conCaller);
  Athread.Channel := Achl;
  Athread.Channeltype := Achnltype;
  Athread.Action := Action;
  Athread.Description := Adesc;
  Athread.ActionResult := AResult;
  Athread.Resume;
end;

//------------------------------------------------------------------------------
// 查询客户当前欠费的总金额
//------------------------------------------------------------------------------
function TdmCaller.GetDunWaterfee(AmeterID: string): string;
const
  cstr = '尊敬的客户您好，这里是东莞市自来水公司，经核实您尚有 %f 元水费未缴，请在接到通知后就近到自来水公司营业网点缴费，以免给您带来不便，更详细的信息请拨打电话''pho22237717。';
begin
  Result := '';
  qryWaterfeedun.First();
  if qryWaterfeedun.Locate('Sbbh', AmeterID, []) then
    Result := Format(cstr, [qryWaterfeedun.FieldByName('Totalsum').AsFloat]);
end;

//------------------------------------------------------------------------------
// 向系统中插入已催缴的记录
//------------------------------------------------------------------------------
procedure TdmCaller.DunInsert(AmeterID, Adhhm: string; ACallCount: Integer;
  Astatus: string);
var
  Athread: TDundetailsThread;
begin
  Athread := TDundetailsThread.Create(True);
  Athread.SetConnection(conCaller);
  Athread.MeterID := AmeterID;
  Athread.Dhhm := Adhhm;
  Athread.DunCount := ACallCount;
  Athread.DunStatus := Astatus;
  Athread.Resume;
end;

procedure TdmCaller.tmrRefreshTimer(Sender: TObject);
begin
  RefreshDundetails;
  RefreshDunlog;
end;

{-------------------------------------------------------------------------------
  Procedure: TdmCaller.SetStartdunflag
  Author:    Xsp
  DateTime:  2006.05.09
  Arguments: const Value: Boolean
  Result:    None
  Popose:    设置催缴标志，如果催缴标志为假则停止所有的催缴操作
-------------------------------------------------------------------------------}
procedure TdmCaller.SetStartdunflag(const Value: Boolean);
var
  I: Integer;
begin
  if FStartdunflag <> Value then
  begin
    FStartdunflag := Value;
    if FStartdunflag then
    begin
      RefreshTellist;
      actRefreshTellist.Enabled := False;
      actStartDun.Caption := '停止催缴(&P)';
    end else
    begin
      for I := 0 to TTSChannel - 1 do // 重置通道信息
        ResetChannel(I);
      actRefreshTellist.Enabled := True;
      actStartDun.Caption := '开始催缴(&S)';
    end;
  end;
end;

end.