smscomm.pas

短信二次开发控件SMSComm

    property OnAfterTimingDelSMS: TNotifyEvent read FOnAfterTimingDelSMS write FOnAfterTimingDelSMS;
    property OnBeforeOpenModem: TNotifyEvent read FOnBeforeOpenModem write FOnBeforeOpenModem;
    property OnAfterOpenModem: TNotifyEvent read FOnAfterOpenModem write FOnAfterOpenModem;
    property OnBeforeSendSMS: TOnBeforeSendSMS read FOnBeforeSendSMS write FOnBeforeSendSMS;
    property OnAfterSendSMS: TOnAfterSendSMS read FOnAfterSendSMS write FOnAfterSendSMS;
    property OnReceiveSMS: TOnReceiveSMS read FOnReceiveSMS write FOnReceiveSMS;
  end;


// Other functions
function ParityToStr(Parity: TParityBits): string;
function StrToParity(Str: string): TParityBits;
procedure EnumComPorts(Ports: TStrings);
procedure _DelayTimems(TCount:integer);
function HexStrToInt(Str: string; var Value: Cardinal): Boolean;
//procedure Register;

implementation

uses
  Dialogs;

var
  // error messages
  ComErrorMessages: array[1..23] of widestring;
  TCB: ArrayOfTCB = ( (TaskName:'定时删除短信'; TaskNum: 1; Status: tsWaiting; TaskHandle: nil) );

{procedure Register;
begin
  RegisterComponents('Samples', [TSMSComm]);
end;}

(*****************************************
 * TSMSCommThread class                  *
 *****************************************)

constructor TSMSCommThread.Create(AOwner: TSMSComm; CreateSuspended: Boolean = False);
begin
  //实例化任务队列
  FOwner := AOwner;
  FreeOnTerminate:= False;
  TCB[0].TaskHandle := TimingDelSMS;
  inherited Create(CreateSuspended);
end;

procedure TSMSCommThread.UpdateCaption;
begin
  case FEventType of
    etAfterSendSMS: begin
                      (FOwner as TSMSComm).OnAfterSendSMS(Self, FSMSItem, FBool);
                    end;
   etBeforeSendSMS: begin
                      (FOwner as TSMSComm).OnBeforeSendSMS(Self, FSMSItem);
                    end;
      etReceiveSMS: begin
                      (FOwner as TSMSComm).OnReceiveSMS(Self, FSMSItem);
                    end;
 etBeforeOpenModem: begin
                      (FOwner as TSMSComm).OnBeforeOpenModem(Self);
                    end;
  etAfterOpenModem: begin
                      (FOwner as TSMSComm).OnAfterOpenModem(Self);
                    end;
etBeforeTimingDelSMS:
                    begin
                      (FOwner as TSMSComm).OnBeforeTimingDelSMS(Self);
                    end;
etAfterTimingDelSMS:
                    begin
                      (FOwner as TSMSComm).OnAfterTimingDelSMS(Self);
                    end;
  end;
end;

destructor TSMSCommThread.Destroy;
begin
  FreeOnTerminate := False; //prevent destroy between Terminate & WaitFor
  (FOwner as TSMSComm).FShouldQuit := True;
  Terminate;                //设置线程的结束标志
  WaitFor;                  //等到Execute的结束
  inherited Destroy;
end;

procedure TSMSCommThread.CallBackEvent;
begin
  FOwner.FInSync := True;
  Synchronize(UpdateCaption);
  FOwner.FInSync := False;
end;

procedure TSMSCommThread.Execute;
var
  CurrentDateTime: TDateTime;
  DiffHour: integer;
  AYear,AMonth,ADay,AHour,AMinute, ASecond,AMilliSecond: Word;    
begin
  { Place thread code here }

     // Keep looping until we break out.
     while (not Terminated) do begin

       FOwner.FWaitEvent.WaitFor(Infinite);

       if FOwner.FShouldQuit then Exit;

       if FOwner.TimingDelSMS.TimingDelSMS then begin
           CurrentDateTime := Now;
           DecodeDateTime( CurrentDateTime, AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond);
           DiffHour := AHour - FOwner.TimingDelSMS.FTimingDelSMSTime;
           if (DiffHour=0) then begin
              FOwner.TimingDelSMS.FTimingDelSMSTime := FOwner.TimingDelSMS.FTimingDelSMSTime + FOwner.TimingDelSMS.DelSMSInteval mod 24;
              TCB[0].Status := tsReady;
           end;
       end;

       FOwner.FLock.Enter;;                //进锁取得需要处理的任务
       try
         TaskItem := nil;
         if FOwner.TaskList.Count>0 then begin //有任务要处理
           TaskItem := TBaseTask(FOwner.TaskList.First);
           FOwner.TaskList.Delete(0);
         end;
       finally
         FOwner.FLock.Leave;
       end;

       if (FOwner as TSMSComm).FDeleteSMSList.Count>=SMSBOUND then begin  //删除消息任务
         try
           DeleteSMSTask;
         finally
           //
         end;
       end

       else if Assigned(TaskItem) then begin
         try
           CommandTask;
         finally
           TaskItem.Finish := True;
           if TaskItem.SendStyle = ctNonBlocking then FreeAndNil(TaskItem)
         end;
       end

       else if TCB[0].Status = tsReady then begin
          try
             TCB[0].Status := tsRunning;
             Windows.Beep(1000, 200);
             TCB[0].TaskHandle;
          finally
             TCB[0].Status := tsWaiting;
          end;
       end

       else begin  // 空闲时监测任务
          try
             InspectTask;
          finally
             //
          end;

       end;

     end;

end;

procedure TSMSCommThread.DeleteSMSTask;
var
  Index: Integer;
begin
  if not TryStrToInt(FOwner.FDeleteSMSList.Strings[0], Index) then Exit;
  if FOwner._GSM_AT_CMGD(Index) then FOwner.FDeleteSMSList.Delete(0);
end;

procedure TSMSCommThread.TimingDelSMS;
var
  TmpStr: string;
begin
  FOwner.DoBeforeTimgingDelSMS;
  FOwner._GSM_AT_CMGL(4, TmpStr);
  FOwner.FilterSMS(TmpStr);
  FOwner.DoAfterTimgingDelSMS;
end; 


procedure TSMSCommThread.InspectTask;
var
  S: string;
begin
  while not FOwner.FShouldQuit and FOwner.FComport.ReadStr(S,1) do begin
    if FOwner.FShouldQuit then Exit;
    FOwner.FCommQueue.AddByStr(S);
    FOwner.JudgeCMTI;
  end;
end;

procedure TSMSCommThread.CommandTask;
var
  aTAT_CMGS_Task: TAT_CMGS_Task;
  aTAT_CSCA_Task: TAT_CSCA_Task;
  aTAT_CMGD_Task: TAT_CMGD_Task;
  aTAT_CMGL_Task: TAT_CMGL_Task;
  aTAT_CMGR_Task: TAT_CMGR_Task;
  TmpInt: Integer;
begin
  case TaskItem.TaskType of
    ttAT_CMGS: begin
                 aTAT_CMGS_Task := TAT_CMGS_Task(TaskItem);
                 aTAT_CMGS_Task.FSuccess := FOwner._GSM_AT_CMGS(aTAT_CMGS_Task.SMSItem);
               end;
    ttAT_CSCA: begin
                 aTAT_CSCA_Task := TAT_CSCA_Task(TaskItem);
                 aTAT_CSCA_Task.FSuccess := FOwner._GSM_AT_CSCA(aTAT_CSCA_Task.SCA);
               end;
    ttAT_CMGD: begin
                 aTAT_CMGD_Task := TAT_CMGD_Task(TaskItem);
                 aTAT_CMGD_Task.FSuccess := FOwner._GSM_AT_CMGD(aTAT_CMGD_Task.Index);
               end;
    ttAT_CMGL: begin
                 aTAT_CMGL_Task := TAT_CMGL_Task(TaskItem);
                 aTAT_CMGL_Task.FSuccess := FOwner._GSM_AT_CMGL(aTAT_CMGL_Task.State, aTAT_CMGL_Task.Msg);
               end;
    ttAT_CMGR: begin
                 aTAT_CMGR_Task := TAT_CMGR_Task(TaskItem);
                 aTAT_CMGR_Task.FSuccess := False;
                 if FOwner._GSM_AT_CMGR(aTAT_CMGR_Task.SerialNo, aTAT_CMGR_Task.Msg) then begin
                   aTAT_CMGR_Task.FSuccess := True;
                   if FOwner.ProcessSMSItemByCMGR(aTAT_CMGR_Task.Msg, aTAT_CMGR_Task.SerialNo, aTAT_CMGR_Task.SMSItem) then begin
                      if (TaskItem.SendStyle = ctNonBlocking) and (aTAT_CMGR_Task.SMSItem.SMSState = csRecUnRead) then
                        FOwner.DoReceive(aTAT_CMGR_Task.SMSItem);

                      if not FOwner.FDeleteSMSList.Find(IntToStr(aTAT_CMGR_Task.SerialNo), TmpInt) then
                         FOwner.FDeleteSMSList.Add(IntToStr(aTAT_CMGR_Task.SerialNo));
                   end;
                 end;
               end;
       ttAT_W: begin
                 FOwner._GSM_AT_W;
               end;

  end;
end;

(*****************************************
 * EComPort exception                    *
 *****************************************)

// create exception with windows error code
constructor EComPort.Create(ACode: Integer; AWinCode: Integer);
begin
  FWinCode := AWinCode;
  FCode := ACode;
  inherited CreateFmt(ComErrorMessages[ACode] + ' (win error code: %d)', [AWinCode]);
end;

// create exception
constructor EComPort.CreateNoWinCode(ACode: Integer);
begin
  FWinCode := -1;
  FCode := ACode;
  inherited Create(ComErrorMessages[ACode]);
end;


(*****************************************
 * TComBuffer class                      *
 *****************************************)

// create class
constructor TComBuffer.Create(AOwner: TComPort);
begin
  inherited Create;
  FOwner := AOwner; 
  FInputSize := 1024;
  FOutputSize := 1024;
end;

// copy properties to other class
procedure TComBuffer.AssignTo(Dest: TPersistent);
begin
  if Dest is TComBuffer then
  begin
    with TComBuffer(Dest) do
    begin
      FOutputSize  := Self.OutputSize;
      FInputSize   := Self.InputSize;
    end
  end
  else
    inherited AssignTo(Dest);
end;

// set input size
procedure TComBuffer.SetInputSize(const Value: Integer);
begin
  if Value <> FInputSize then
  begin
    FInputSize := Value;
    if (FInputSize mod 2) = 1 then
      Dec(FInputSize);
    if FOwner <> nil then
      FOwner.ApplyBuffer;
  end;
end;

// set ouput size
procedure TComBuffer.SetOutputSize(const Value: Integer);
begin
  if Value <> FOutputSize then
  begin
    FOutputSize := Value;
    if (FOutputSize mod 2) = 1 then
      Dec(FOutputSize);
    if FOwner <> nil then
      FOwner.ApplyBuffer;
  end;
end;


(*****************************************
 * TComTimeouts class                    *
 *****************************************)

// create class
constructor TComTimeouts.Create(AOwner: TComport);
begin
  inherited Create;
  FOwner:= AOwner;
  FReadInterval:= 0;
  FReadTotalM  := 2;
  FReadTotalC  := 20;
  FWriteTotalM := 0;
  FWriteTotalC := 0;
end;

// copy properties to other class
procedure TComTimeouts.AssignTo(Dest: TPersistent);
begin
  if Dest is TComTimeouts then
  begin
    with TComTimeouts(Dest) do
    begin
      FReadInterval := Self.ReadInterval;
      FReadTotalM   := Self.ReadTotalMultiplier;
      FReadTotalC   := Self.ReadTotalConstant;
      FWriteTotalM  := Self.WriteTotalMultiplier;
      FWriteTotalC  := Self.WriteTotalConstant;
    end
  end
  else
    inherited AssignTo(Dest);
end;

// set read interval
procedure TComTimeouts.SetReadInterval(const Value: Integer);
begin
  if Value <> FReadInterval then
  begin
    FReadInterval := Value;
    // if possible, apply the changes
    if FOwner <> nil then
      FOwner.ApplyTimeouts;
  end;
end;

// set read total constant
procedure TComTimeouts.SetReadTotalC(const Value: Integer);
begin
  if Value <> FReadTotalC then
  begin
    FReadTotalC := Value;
    if FOwner <> nil then
      FOwner.ApplyTimeouts;
  end;
end;

// set read total multiplier
procedure TComTimeouts.SetReadTotalM(const Value: Integer);
begin
  if Value <> FReadTotalM then
  begin
    FReadTotalM := Value;
    if FOwner <> nil then
      FOwner.ApplyTimeouts;
  end;
end;

// set write total constant
procedure TComTimeouts.SetWriteTotalC(const Value: Integer);
begin
  if Value <> FWriteTotalC then
  begin
    FWriteTotalC := Value;
    if FOwner <> nil then
      FOwner.ApplyTimeouts;
  end;
end;

// set write total multiplier
procedure TComTimeouts.SetWriteTotalM(const Value: Integer);
begin
  if Value <> FWriteTotalM then
  begin
    FWriteTotalM := Value;
    if FOwner <> nil then
      FOwner.ApplyTimeouts;
  end;
end;


(*****************************************
 * TComParity class                      *
 *****************************************)

// create class
constructor TComParity.Create(AOwner: TComport);
begin
  inherited Create;
  FOwner:= AOwner;
  FBits := prNone;
end;

// copy properties to other class
procedure TComParity.AssignTo(Dest: TPersistent);
begin
  if Dest is TComParity then
  begin
    with TComParity(Dest) do
    begin
      FBits        := Self.Bits;
      FCheck       := Self.Check;
      FReplace     := Self.Replace;
      FReplaceChar := Self.ReplaceChar;
    end