adgsm.pas

测试用例

  published
    property ComPort;
    property QuickConnect;
    property GSMMode;                                                   {!!.PDU}
    property SMSAddress;
    property SMSMessage;
    property SMSCenter;
    property NotifyOnNewMessage;

    {published events}
    property OnNewMessage;
    property OnNextMessage;
    property OnMessageList;
    property OnGSMComplete;
    
  end;
  
  function StringToPDU (v : string) : string;                           {!!.PDU}
  function PDUToString (v : string) : string;                           {!!.PDU}

implementation

const
  { +CMS ERROR:  =  Message Service Failure Result Code }
  GSMConfigAvail : array[0..6] of string =
              ('E0',                // Turn off echo
               '+CMGF=?',           // Support Text,PDU mode?           {!!.PDU}
               '+CMGF=',            // Set appropriate mode
               '+CSMS=0',           // Select Message Service
               //'+CPMS=?',         // Preferred Message Storage         {!!.06}

               {!!.PDU}             // Moved from GSMSendMessageCommands
               '+CNMI= 2,1,0,1,0',  // New message indication =2,1,0,1,0
                                    // or = 2,,2,,0
               '+CSMP=,167,0,0',    // variable 17 for status 32 for no status

               //'+CSCS?',          // Set Character Set                 {!!.06}
               '+CSDH=1');          // Show Text Code Parameters
               //'+CSMP?');         // Get Default values for SMS-SUBMIT {!!.06}
  GSMConfigResponse : array[0..6] of string =
              ('OK',               // No Response Expected, just OK
               '+CMGF: ',          // +CMGF:[20](0,1), 0 is PDU, 1 is Text
               'OK',               // No Response Expected, just OK
               '+CSMS: ',          // Response StartString expected
               //'+CPMS: ',        // Response StartString expected
               'OK',               // No Response Expected, just OK
               'OK',               // No Response Expected, just OK
               //'+CSCS: ', // Show default character set like "PCCP437" {!!.06}
               'OK');              // No Response Expected, just OK
               //'+CSMP: ');       // Response StartString expected      {!!.06}

  GSMSendMessageCommands : array[0..3] of string =
    { Some commands moved to GSMConfigAvail and look at QueryModem procedure}
               (//'+CNMI?',          // Default query for new message indication
                //'+CNMI= 2,1,0,1,0', // New message indication =2,1,0,1,0
                                      // or = 2,,2,,0
                //'+CSCB?',           // Types of CBMs to be received by the ME
                //'+CSMP=,167,0,0',   // variable 17 for status 32 for no status
                '',
                '+CSCA=',             // Service Center if FSMSCenter not empty
                '+CMGS=',             // Send Destination address
                '');                  // Sending message text

  GSMSendMessageResponse : array[0..3] of string =
               (//'+CNMI: ',          // Response StartString expected
                //'OK',               // No Response Expected, just OK
                //'+CSCB: ',          // Response StartString expected
                //'OK',               // No Response Expected, just OK
                'OK',                 // No Response Expected, just OK
                'OK',                 // No Response Expected, just OK
                #13#10,               // Response from phone to Send Message
                '+CMGS: ');           // Response StartString expected

  GSMListAllMessagesCommands : array[0..0] of string =
               ('+CMGL');           // List Messages on Phone
  GSMListAllMessagesResponse : array[0..0] of string =
               ('+CMGL: ');         // Response StartString expected

  GSMSendMessFromStorage : array[0..0] of string =
               ('+CMSS=');          // Send Message from Storage
  GSMSendMessFromStorageResp : array[0..0] of string =
               (#13#10'OK');        // Response StartString expected

  GSMWriteToMemoryCommands : array[0..1] of string =
               ('+CMGW=',           // Write Message to Memory
                '');                // Writing message text
  GSMWriteToMemoryResponse : array[0..1] of string =
               (#13#10,             // Response StartString expected
                '+CMGW: ');
  GSMDeleteAMessageCommand : array[0..0] of string =
               ('+CMGD=');          // Delete Message from Memory
  GSMDeleteAMessageResponse : array[0..0] of string =
               (#13#10'OK');        // No Response Expected, just OK

{ TApdSMSMessage }

function TApdSMSMessage.GetMessageAsPDU : string;
begin
  Result := StringToPDU (FMessage);
end;

function PDUToString (v : string) : string;
var
  I, InLen, OutLen, OutPos : Integer;
  TempByte, PrevByte : Byte;
begin
  { Check for empty input }
  if v = '' then Exit;

  { Init variables }
  PrevByte := 0;
  OutPos := 1;

  { Set length of output string }
  InLen := Length(v);
  Assert(InLen <= 140, 'Input string greater than 140 characters');
  OutLen := (InLen * 8) div 7;
  SetLength(Result, OutLen);

  { Encode output string }
  for I := 1 to InLen do begin
    TempByte := Byte(v[I]);
    TempByte := TempByte and not ($FF shl (7-((I-1) mod 7)));
    TempByte := TempByte shl ((I-1) mod 7);
    TempByte := TempByte or PrevByte;
    Result[OutPos] := AnsiChar(TempByte);
    Inc(OutPos);

    { Set PrevByte for next round (or directly put it to Result) }
    PrevByte := Byte(v[I]);
    PrevByte := PrevByte shr (7-((I-1) mod 7));
    if (I mod 7) = 0 then begin
      Result[OutPos] := AnsiChar(PrevByte);
      Inc(OutPos);
      PrevByte := 0;
    end;
  end;
  if Result[Length(Result)] = #0 then
    Result := Copy(Result, 1, pred(Length(Result)));
end;

procedure TApdSMSMessage.SetMessageAsPDU (v : string);
begin
  FMessage := PDUToString (v);
end;

function StringToPDU (v : string) : string;
var
  I, InLen, OutLen, OutPos : Integer;
  RoundUp : Boolean;
  TempByte, NextByte : Byte;
begin
  { Check for empty input }
  if v = '' then Exit;

  { Init OutPos }
  OutPos := 1;

  { Set length of output string }
  InLen := Length(v);
  Assert(InLen <= 160, 'Input string greater than 160 characters');
  RoundUp := (InLen * 7 mod 8) <> 0;
  OutLen := InLen * 7 div 8;
  if RoundUp then Inc(OutLen);
  SetLength(Result, OutLen);

  { Encode output string }
  for I := 1 to InLen do begin
    TempByte := Byte(v[I]);
    Assert((TempByte and $80) = 0, 'Input string contains 8-bit data');
    if (I < InLen) then
      NextByte := Byte(v[I+1])
    else
      NextByte := 0;
    TempByte := TempByte shr ((I-1) mod 8);
    NextByte := NextByte shl (8 - ((I) mod 8));
    TempByte := TempByte or NextByte;
    Result[OutPos] := AnsiChar(TempByte);
    if I mod 8 <> 0 then
      Inc(OutPos);
  end;
end;

{ TApdCustomGSMPhone }

{ opens the port, issues configuration commands }
{Generates the OnMessageList (+CMGL) event when complete if not QuickConnect}
procedure TApdCustomGSMPhone.Connect;
var
  Res : Integer;
  ET : EventTimer;
begin
  if FGSMState > gsNone then begin
    DoFail(secSMSBusy,-8100);
    Exit;
  end;
  if not FConnected then begin
    { Do connection/configuration stuff }
    CheckPort;
  end;
  if FQueryModemOnly then                                                {!!.06}
    exit;                                                                {!!.06}
  if FNotifyOnNewMessage and not Assigned(NotifyPacket) then begin{!!.02}{!!.05}
    NotifyPacket := TApdDataPacket.Create(Self);                         {!!.05}
    NotifyPacket.OnStringPacket := NotifyStringPacket;                   {!!.05}
    NotifyPacket.StartCond := scString;                                  {!!.05}
    NotifyPacket.StartString := '+CMTI:';                                {!!.05}
    NotifyPacket.EndCond := [ecString];                                  {!!.05}
    NotifyPacket.EndString := #13;                                       {!!.05}
    NotifyPacket.IncludeStrings := False;                                {!!.05}
    NotifyPacket.ComPort := FComPort;                                    {!!.05}
    NotifyPacket.Enabled := True;                                        {!!.02}
    NotifyPacket.AutoEnable := True;                                     {!!.02}
  end;                                                                   {!!.02}
  FConfigList := True;                                                   {!!.02}
  CmdIndex := 0;
  ResponsePacket.StartString := GSMConfigResponse[CmdIndex];
  ResponsePacket.EndString := #13;
  ResponsePacket.ComPort := FComPort;                                    {!!.05}
  ResponsePacket.Enabled := True;
  //DelayTicks(4, True);                                                 {!!.04}
  SetState(gsConfig);
  FComPort.Output := 'AT' + GSMConfigAvail[CmdIndex] + #13;
  NewTimer(ET, 1080); // 60 second timer
  repeat
    Res := SafeYield;
  until (FGSMState = gsNone) or (FGSMState = gsListAll) or (Res = wm_Quit)
        or TimerExpired(ET);
  if TimerExpired(ET) then begin
    DoFail(secSMSTimedOut,-8101);
    Exit;
  end;
end;

constructor TApdCustomGSMPhone.Create(AOwner: TComponent);
begin
  inherited;
  { Some of the initialization for the packets were moved to Checkport to make
    sure there was a comport - Marked there with "!!.05" }

  FConnected := False;
  FNeedNewMessage := 0;                                                  {!!.04}
  FRecNewMess := '';                                                     {!!.06}
  FQueryModemOnly := False;                                              {!!.06}
  FHandle := AllocateHWnd(WndProc);
  FMessageStore := TApdMessageStore.Create(Self);
  FComPort := SearchComPort(Owner);
end;

destructor TApdCustomGSMPhone.Destroy;
begin
  FConnected := False;
  ResponsePacket.Free;
  ErrorPacket.Free;
  NotifyPacket.Free;                                                     {!!.02}
  FMessageStore.Clear;
  FMessageStore.Free;
  DeallocateHwnd(FHandle);
  inherited;
end;

{!!.PDU}
procedure TApdCustomGSMPhone.SetPDUMode (v : Boolean);
begin
  if v <> FPDUMode then
    FPDUMode := v;
end;

{ +CMS ERROR: message Service Failure Result Code }
procedure TApdCustomGSMPhone.ErrorStringPacket(Sender: TObject;
  Data: string);
var
  ErrorCode : Integer;
  ErrorMessage : string;
  Temp : string;
begin
  //Display Message Service Failure Result Code
  Temp := Data;
  if Temp <> '' then begin                                               {!!.06}
    Temp := Copy(Data, Pos(' ', Data), Length(Data));
    ErrorCode := -8000 - StrToInt(Temp);
    ErrorMessage := 'Phone error <refer to AdExcept.inc>';               {!!.06}
  end else begin                                                         {!!.06}
    ErrorCode := -8500;                                                  {!!.06}
    ErrorMessage := 'Unknown Error';                                     {!!.06}
  end;                                                                   {!!.06}
  DoFail(ErrorMessage, ErrorCode);                                       {!!.06}
  //raise Exception.Create('Exception ' + IntToStr(ErrorCode) + ' ' +    {!!.06}
                          //ErrorMessage);                               {!!.06}
end;

procedure TApdCustomGSMPhone.ResponseStringPacket(Sender: TObject;
  Data: string);
begin
  // Handle data from packet -State Machine-
  ResponseStr := Data;
  PostMessage(FHandle, ApdGSMResponse, 0,0);
end;

procedure TApdCustomGSMPhone.NotifyStringPacket(Sender: TObject;         {!!.02}
  Data: string);                                                         {!!.02}
var                                                                      {!!.02}
  MessageIndex : Integer;                                                {!!.02}
begin                                                                    {!!.02}
  NotifyStr := Data;                                                     {!!.02}
  if NotifyStr <> '' then begin                                          {!!.02}
    if assigned(FOnNewMessage) then begin                                {!!.02}
      NotifyStr := Copy(NotifyStr,
        Pos('",', NotifyStr) + 2, Length(NotifyStr));                    {!!.02}