gsm_sms.pas

This delphi 7 source code have a function to send SMS trough computer with serial communication. You

unit gsm_sms;

{
*******************************************************************************
* Descriptions: GSM/PDU Handing Class
* $Source: /cvsroot/fma/fma/gsm_sms.pas,v $
* $Locker:  $
*
* Todo:
*   - Add support for Icelandic character
*   - Rename unit as 'uGsmSMS.pas' for example
*
* Change Log:
* $Log: gsm_sms.pas,v $
* Revision 1.16.6.3  2005/01/25 16:03:05  z_stoichev
* Merged with 2.1 Beta 1 bugfixes
*
* Revision 1.16.6.2  2004/10/15 11:27:58  z_stoichev
* Bugfixes
*
* Revision 1.16.6.1  2004/10/14 16:43:23  z_stoichev
* Bugfixes
*
* Revision 1.16  2004/07/26 12:50:56  z_stoichev
* Force UCS-2 support
*
* Revision 1.15  2004/07/14 09:34:50  z_stoichev
* - Fixed GSM 7bit decoding end of text detection.
*
* Revision 1.14  2004/07/07 10:22:38  z_stoichev
* Added convert handling and debug msg
*
* Revision 1.13  2004/03/26 18:37:39  z_stoichev
* Build 0.1.0.35 RC5
*
* Revision 1.12  2004/03/12 16:56:10  z_stoichev
* Fixed Long SMS last character deleted.
*
* Revision 1.11  2004/03/04 16:53:47  z_stoichev
* Fixed append @ at message end.
*
* Revision 1.10  2004/01/27 15:52:07  z_stoichev
* Fixed prefix @@@@ on long sms.
* Added update refference field method.
*
* Revision 1.9  2004/01/23 12:50:02  z_stoichev
* Bugfixes, set get PDU, change Msg Refference
*
* Revision 1.8  2003/11/28 09:38:07  z_stoichev
* Merged with branch-release-1-1 (Fma 0.10.28c)
*
* Revision 1.7.2.2  2003/11/21 10:56:07  z_stoichev
* Fixed msg text cut in Fma.
*
* Revision 1.7.2.1  2003/10/27 07:22:53  z_stoichev
* Build 0.1.0 RC1 Initial Checkin.
*
* Revision 1.7  2003/10/24 12:22:03  z_stoichev
* Fixed UCS-2 issue with german special symbols.
*
* Revision 1.6  2003/10/21 09:15:37  z_stoichev
* Sending UTF8/UCS2 messages (cyrillic etc. support)
*
* Revision 1.5  2003/07/02 12:21:23  crino77
* fixed some bugs with UCS2 sms
*
* Revision 1.4  2003/02/14 07:23:48  crino77
* Add the MessageReference
* Add the UDHI support and request status
* Added FMessageLength:Integer; in private
* Modified GetMessage to prevent some char at the end of the message ;)
* Add support for Greek - Thanks to George Billios
*
* Revision 1.3  2003/01/30 04:15:57  warren00
* Updated with header comments
*
*
*
*******************************************************************************
}

interface

uses
  SysUtils, DateUtils, Dialogs, StrUtils;

type
  TSMS = class(TObject)
  private
    FIsSMSSumit: Boolean;
    FValidityLen: Integer;
    FSMSCLen: Integer;
    FSenderLen: Integer;
    FSenderPos: Integer;
    FPDU: String;
    FSMSDeliverStartPos: Integer;
    FMessage: WideString;
    FMessageRef: String;
    FAddress: String;
    FFlashSMS: Boolean;
    FRequestReply: Boolean;
    FDataCoding: Integer;
    FMessageLength: Integer;
    FIsUDH: Boolean;
    FUDHI: String;
    FStatusRequest: Boolean;
    FSizeOfPDU: integer;
    procedure SetPDU(const Value: String);
    function GetPDU: String;
    function ReverseOctets(Octets: String): String;
    function DecodeNumber(raw: String): String;
    function EncodeNumber(Number: String): String;
    function GetMessage: WideString;
    function GetAddress: String;
    function GetSMSC: String;
    function GetTimeStamp: TDateTime;
    function Get7bit(str: String): String;
    function Get8bit(str: String): String;
    function GetUCS2(str: String): WideString;
    function MakeCRLF(str: string): String;
    procedure Set_MessageRef(const Value: String);
  public
    dcs: Integer;
    function GetNewPDU(AMessageReference: String): String;
    property RequestReply: Boolean read FRequestReply write FRequestReply;
    property PDU: String read GetPDU write SetPDU;
    property UDHI: String read FUDHI write FUDHI;
    property MessageReference: String read FMessageRef write Set_MessageRef;
    property Text: WideString read GetMessage write FMessage;
    property Number: String read GetAddress write FAddress;
    property SMSC: String read GetSMSC;
    property FlashSMS: Boolean read FFlashSMS write FFlashSMS;
    property StatusRequest: Boolean read FStatusRequest write FStatusRequest;
    property IsOutgoing: Boolean read FIsSMSSumit;
    property IsUDH: Boolean read FIsUDH;
    property TimeStamp: TDateTime read GetTimeStamp;
    property TPLength: integer read FSizeOfPDU;
  end;

const
  DoStrictUCScheck: boolean = True;
  ForceUCSusage: boolean = False;

function CheckCodingType(str: WideString): Integer;
function ConvertCharSet(inputStr: String; toGSM: Boolean): String; overload; // from GSM mode only!
function ConvertCharSet(inputChr: Char; toGSM: Boolean = False): Char; overload;

{ implementation found on interget, might solve chinese utf8 problems ? 
function DecodeUTF8(const Value : string):string;
function EncodeUTF8(const Value : string):string;
}

implementation

uses Windows, Unit1;

{ UTF8 }

function DecodeUTF8(const Value : string):string;
var i, j : integer;
    N : integer;
    HugeChar : ULONG; //4 bytes
begin
  Result:='';
  i:=1;
  while i < Length(Value) do begin
    if byte(Value[i]) < $80 then begin
      Result:=Result+Value[i]; //no change required
      i:=i+1;
    end
    else begin
      //find out the number of bytes used for this character
      N:=0;
      for j:=1 to 8 do begin
      //start with the highest bit and cound the bumber
      //of "1" before "0"
        if (byte(Value[i]) and (1 shl (8-j))) = 0 then Break;
        inc(N);
      end;
      //ShowMessage('N:'+IntToStr(N));
      HugeChar:=byte(Value[i]) and ($FF shr (N+1));
      //ShowMessage('HugeChar:'+IntToStr(HugeChar));
      for j:=1 to N-1 do begin
        HugeChar:=(HugeChar shl 6) or byte(byte(Value[i+j]) and $3F);
      end;
      //ShowMessage('HugeChar:'+IntToStr(HugeChar));
      Result:=Result+char(HugeChar);
      i:=i+N;
    end;
  end;
end;

//only work on bytes 0..255
function EncodeUTF8(const Value : string):string;
var i : integer;
begin
  for i:=1 to Length(Value) do begin
    if byte(Value[i]) < $80 then begin
      Result:=Result+Value[i]; //no change required
    end
    else begin
      Result:=Result+char($C0{11000000} or (byte(Value[i]) shr 6))+
                     char($80{10000000} or (byte(Value[i]) and $3F{111111}));
    end;
  end;
end;

{ TSMS }

function TSMS.DecodeNumber(raw: String): String;
var
  addrType: Integer;
begin
  try
    addrType := StrToInt('$' + copy(Raw, 1, 2));
    if ((addrType and $50) = $50) then begin
      Result := Get7bit(copy(Raw, 3, length(Raw) - 2));
    end
    else begin
      Result := ReverseOctets(copy(Raw, 3, length(Raw) - 2));
      if Result[length(Result)] = 'F' then Result := copy(Result, 1, length(Result) - 1);
      if ((StrToInt('$' + copy(Raw, 1, 2)) and $70) shr 4) = 1 then Result := '+' + result;
    end;
  except
    Result := '';
  end;
end;

function TSMS.EncodeNumber(Number: String): String;
begin
  Result := '81';

  if Number[1] = '+' then begin
    Result := '91'; // International Numner, ISDN/Telephone (E.164/E.163)
    Number := copy(Number, 2, length(Number));
  end;

  Result := IntToHex(length(Number), 2) + Result;

  if length(Number) mod 2 > 0 then Number := Number + 'F';
  Result := Result + ReverseOctets(Number);
end;

function TSMS.Get7bit(str: String): String;
var
  i, j, x: Integer;
  leftover, octet: byte;
  c: string[2];
begin
  Result := '';
  x := 1;
  leftover := 0;
  j := Round(length(str) / 2) - 1;

  for i := 0 to j do begin
    try
      c := copy(str, (i*2)+1, 2);
      if not (Copy(c,1,1)[1] in ['0'..'9','A'..'F']) then
        break;
      if (Length(c) = 2) and not (Copy(c,2,1)[1] in ['0'..'9','A'..'F']) then
        Delete(c,2,1);
      octet := StrToInt('$' + c);
      Result := Result + chr(((octet and ($FF shr x)) shl (x - 1)) or leftover);
      leftover := (octet and (not ($FF shr x))) shr (8 - x);
      x := x + 1;
    except
    end;

    if x = 8 then begin
      { do not add extra @ at the end of text, bug 849905 fixed }
      if (i <> j) or (leftover <> 0) then
        Result := Result + chr(leftover);
      x := 1;
      leftover := 0;
    end;
  end;

  Result := ConvertCharSet(Result, false);
end;

function TSMS.Get8bit(str: String): String;
var
  i: Integer;
  octet: Integer;
begin
  Result := '';

  for i := 0 to Round(length(str) / 2) - 1 do begin
    octet := StrToInt('$' + copy(str, (i*2)+1, 2));
    Result := Result + chr(octet);
  end;

  Result := ConvertCharSet(Result, false);
end;

function TSMS.GetUCS2(str: String): WideString;
var
  i: Integer;
  octet: Integer;
begin
  Result := '';

  while (length(str) mod 4) <> 0 do str := str + '0';

  for i := 0 to (length(str) div 4) - 1 do begin
    octet := StrToInt('$' + copy(str, (i*4)+1, 4));
    Result := Result + Widechar(octet);
  end;
end;

function TSMS.GetMessage: WideString;
var
  startpos: Integer;
  str, UDHnull: String;
  UDHIlength, i :Integer;
  function RemoveTail00(s: string): string;
  var
    i: integer;
  begin
    i := Length(s);
    if i >= 2 then begin
      if Copy(s,i-1,2) = '00' then
        Delete(s,i-1,2);
    end;
    Result := s;
  end;
begin
  try
    Result := '';
    UDHILength := 0;

    startpos := FSMSDeliverStartPos + FSenderLen + FValidityLen + 12;
    if not FIsSMSSumit then startpos := startpos + 12;

    if FIsUDH then begin
      UDHILength := StrToInt('$' + copy(FPDU, startpos + 2, 2));

      FUDHI := copy(FPDU, startpos + 2, UDHILength * 2 + 2);
      //Replace UDH with NULL chars
      for i:=0 to UDHILength do begin
         UDHnull := UDHnull + '00';
      end;
      Delete(FPDU,startpos + 2,UDHILength * 2 + 2);
      Insert(UDHNull,FPDU,startpos + 2);
      //FPDU := AnsiReplaceStr(FPDU, FUDHI, UDHNull);
    end;

    // TP-User-Data-Length. Length of message. The TP-DCS field indicated 7-bit data, so the length here is the number
    // of septets. If the TP-DCS field were set to 8-bit data or Unicode, the length would be the number of octets.
    FMessageLength := StrToInt('$' + copy(FPDU, startpos, 2));

    if FDataCoding = 0 then begin
       str := copy(FPDU, startpos + 2, length(FPDU)); // process the rest of PDU data, will cut the message length later
       Result := Get7bit(str);
       // here FMessageLength contains number of septets (decoded chars)
       if FIsUDH then
         Result := Copy(Result, ((UDHILength div 7) + UDHILength + 2) + 1, FMessageLength)
       else
         Result := Copy(Result, 1, FMessageLength);
    end
    else if FDataCoding = 1 then begin
       // here FMessageLength contains numbers of octets (encoded bytes)
       str := copy(FPDU, startpos + 2, (FMessageLength)*2);
       Result := Get8bit(str);
       if FIsUDH then
         Result := Copy(Result, ((UDHILength div 7) + UDHILength + 2) + 1, Length(Result));
    end
    else if FDataCoding = 2 then begin
       // here FMessageLength contains numbers of octets (encoded bytes)
       str := copy(FPDU, startpos + 2, (FMessageLength)*2);
       Result := GetUCS2(str);
       if FIsUDH then begin
         i := ((UDHILength + 1) mod 4) + 2;
         Result := Copy(Result, i, Length(Result));
         { TODO: unicode support instead of copy? }
         //Result := WideCharLenToString(@Result[i], Length(Result) - i + 1);
       end;
    end
    else Result := '(Unsupported: Unknown coding scheme)';

    Result := MakeCRLF(Result);
  except
    Result := '(Decoding Error)';
  end;
end;

function TSMS.GetPDU: String;
var
  udhl: Integer;
  i, j, x, head: Integer;
  Octet: String;
  nextChr: Byte;

  pduAddr, pduMsgL, pduMsg: String;
  pduSMSC, pduFirst, pduMsgRef, pduPID, pduDCS, pduTPVP: String;
  AMessage: WideString;
begin
  AMessage := FMessage;
  udhl := 0;
  try
    // Convert Address (Destination No)
    pduAddr := EncodeNumber(FAddress);

    pduMsg := '';
    if (dcs = 0) or ((dcs = -1) and (CheckCodingType(AMessage) = 0)) then begin // 7-bit coding
      // Convert Message
      if FUDHI <> '' then begin
         udhl := StrToInt(Copy(FUDHI,1,2));
         udhl := (udhl div 7) + udhl + 2;
         for i:=0 to udhl - 1 do begin
            AMessage := '@' + AMessage;
         end;
      end;
      pduMsgL := IntToHex(length(AMessage), 2); // number of septets!! IT IS NOT NUMBER OF OCTETS IN 7-bit encoding mode!!

      x := 0;
      j := length(AMessage);
      for i := 1 to j do begin
        if x < 7 then begin
          if i = j then
            nextChr := 0
          else
            nextChr := Ord(ConvertCharSet(Char(AMessage[i+1]), True));

          Octet := IntToHex( ((nextChr and (not ($FF shl (x+1)))) shl (7-x)) or (Ord(ConvertCharSet(Char(AMessage[i]), True)) shr x) , 2);
          pduMsg := pduMsg + Octet;

          x := x + 1;
        end
        else x := 0;
      end;

      pduDCS := '00';