text2pdu.pas

很好的手机发短信的例子。含GSM群发机设计原理和使用说明。还有详细代码

unit Text2pdu;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, Math;

type
  Tpdu = array [1..2] of string;
  Tsms = array [1..4] of string;
  TText2pdu = class(TComponent)
  private
    { Private declarations }
    prKillEvent: THandle;
  protected
    { Protected declarations }
    procedure Execute;
  public
    { Public declarations }
    constructor Create(aOwner: TComponent);
    destructor Destroy; override;

  published
    { Published declarations }
    function texttosms(smscenter: string; targetms: string; text: string): Tpdu;
    function smstotext(pdu: string): Tsms;
  end;
function texttosms(smscenter: string; targetms: string; text: string): Tpdu;

procedure Register;

implementation

function texttosms(smscenter: string; targetms: string; text: string): Tpdu;
var
  smsc,targ,leng,data : string;
  ses1 : string;
  i,d,e,j,k,n : integer;
  a,b,c : array [1..8] of byte;
  smsh : integer;
  jump : boolean;
  res : Tpdu;

begin
  ses1:=smscenter;
  smsc:=ses1[2]+ses1[1]+ses1[4]+ses1[3]+ses1[6]+ses1[5]+ses1[8]+ses1[7]+ses1[10]+ses1[9]+'F'+ses1[11];
  ses1:=targetms;
  targ:=ses1[2]+ses1[1]+ses1[4]+ses1[3]+ses1[6]+ses1[5]+ses1[8]+ses1[7]+ses1[10]+ses1[9]+'F'+ses1[11];
  ses1:=text;

  j:=0;
  d:=ord(ses1[1]);

  c[8]:=round((d and 128)/128);
  c[7]:=round((d and 64)/64);
  c[6]:=round((d and 32)/32);
  c[5]:=round((d and 16)/16);
  c[4]:=round((d and 8)/8);
  c[3]:=round((d and 4)/4);
  c[2]:=round((d and 2)/2);
  c[1]:=round((d and 1));
  jump:=false;
  for i:=2 to length(ses1) do
  begin
    j:=j+1;
    if j=8 then
    begin
      j:=0;
      jump:=true;
    end;

    d:=ord(ses1[i]);

    a[8]:=round((d and 128)/128);
    a[7]:=round((d and 64)/64);
    a[6]:=round((d and 32)/32);
    a[5]:=round((d and 16)/16);
    a[4]:=round((d and 8)/8);
    a[3]:=round((d and 4)/4);
    a[2]:=round((d and 2)/2);
    a[1]:=round((d and 1));

    if jump=false then
    begin
      for e:=1 to 8-j do
      begin
        b[e]:=c[e];
      end;

      k:=0;

      for e:=8-j+1 to 8 do
      begin
        k:=k+1;
        b[e]:=a[k];
      end;

      n:=128*b[8]+64*b[7]+32*b[6]+16*b[5]+8*b[4]+4*b[3]+2*b[2]+b[1];
      if n>0 then data:=data+inttohex(n,2);

    end;

    jump:=false;

    for e:=1 to 8-j do
    begin
      c[e]:=a[e+j]
    end;

    for e:=8-j to 8 do
    begin
      c[e]:=0;
    end;
  end;
  n:=128*c[8]+64*c[7]+32*c[6]+16*c[5]+8*c[4]+4*c[3]+2*c[2]+c[1];
  if n>0 then data:=data+inttohex(n,2);
  leng:=inttohex(length(text),2);
  res[1]:='0011000B91'+targ+'0000A7'+leng+data;
  smsh:=round(length(res[1])/2-1);
  res[2]:=inttostr(smsh);
  result:=res;
end;

procedure Register;
begin
  RegisterComponents('SMS', [TText2pdu]);
end;

constructor TText2pdu.Create(aOwner: TComponent);
begin
  //inherited Create(True);
  prKillEvent := CreateEvent(nil, false, false, nil);
end;

destructor TText2pdu.Destroy;
begin
  SetEvent(prKillEvent);
  CloseHandle(prKillEvent);
  inherited;
end;

procedure TText2pdu.Execute;
begin
  //inherited Create(True);
end;

function TText2pdu.texttosms(smscenter: string; targetms: string; text: string): Tpdu;
var
  smsc,targ,leng,data : string;
  ses1 : string;
  i,d,e,j,k,n : integer;
  a,b,c : array [1..8] of byte;
  smsh : integer;
  jump : boolean;
  res : Tpdu;

begin
  ses1:=smscenter;
  smsc:=ses1[2]+ses1[1]+ses1[4]+ses1[3]+ses1[6]+ses1[5]+ses1[8]+ses1[7]+ses1[10]+ses1[9]+'F'+ses1[11];
  ses1:=targetms;
  targ:=ses1[2]+ses1[1]+ses1[4]+ses1[3]+ses1[6]+ses1[5]+ses1[8]+ses1[7]+ses1[10]+ses1[9]+'F'+ses1[11];
  ses1:=text;

  j:=0;
  d:=ord(ses1[1]);

  c[8]:=round((d and 128)/128);
  c[7]:=round((d and 64)/64);
  c[6]:=round((d and 32)/32);
  c[5]:=round((d and 16)/16);
  c[4]:=round((d and 8)/8);
  c[3]:=round((d and 4)/4);
  c[2]:=round((d and 2)/2);
  c[1]:=round((d and 1));
  jump:=false;
  for i:=2 to length(ses1) do
  begin
    j:=j+1;
    if j=8 then
    begin
      j:=0;
      jump:=true;
    end;

    d:=ord(ses1[i]);

    a[8]:=round((d and 128)/128);
    a[7]:=round((d and 64)/64);
    a[6]:=round((d and 32)/32);
    a[5]:=round((d and 16)/16);
    a[4]:=round((d and 8)/8);
    a[3]:=round((d and 4)/4);
    a[2]:=round((d and 2)/2);
    a[1]:=round((d and 1));

    if jump=false then
    begin
      for e:=1 to 8-j do
      begin
        b[e]:=c[e];
      end;

      k:=0;

      for e:=8-j+1 to 8 do
      begin
        k:=k+1;
        b[e]:=a[k];
      end;

      n:=128*b[8]+64*b[7]+32*b[6]+16*b[5]+8*b[4]+4*b[3]+2*b[2]+b[1];
      if n>0 then data:=data+inttohex(n,2);

    end;

    jump:=false;

    for e:=1 to 8-j do
    begin
      c[e]:=a[e+j]
    end;

    for e:=8-j to 8 do
    begin
      c[e]:=0;
    end;
  end;
  n:=128*c[8]+64*c[7]+32*c[6]+16*c[5]+8*c[4]+4*c[3]+2*c[2]+c[1];
  if n>0 then data:=data+inttohex(n,2);
  leng:=inttohex(length(text),2);
  res[1]:='0011000B91'+targ+'0000A7'+leng+data;
  smsh:=round(length(res[1])/2-1);
  res[2]:=inttostr(smsh);
  result:=res;
end;

function TText2pdu.smstotext(pdu: string): Tsms;

var
  res : Tsms;
  ins : string;
  smsc,sendr,dt,body : string;
  binb,s,ss,t : string;
  i,j,k,chv : integer;
  smsbody : string;

begin
  ins:=pdu;
  if copy(ins,1,4)='0791' then
  begin
    smsc:=copy(ins,5,12);
    smsc:=smsc[2]+smsc[1]+smsc[4]+smsc[3]+smsc[6]+smsc[5]+smsc[8]+smsc[7]+smsc[10]+smsc[9]+smsc[12];
    res[1]:=smsc;
    sendr:=copy(ins,23,12);
    sendr:=sendr[2]+sendr[1]+sendr[4]+sendr[3]+sendr[6]+sendr[5]+sendr[8]+sendr[7]+sendr[10]+sendr[9]+sendr[12];
    res[2]:=sendr;
    dt:=copy(ins,39,14);
    dt:=dt[2]+dt[1]+'/'+dt[4]+dt[3]+'/'+dt[6]+dt[5]+' '+dt[8]+dt[7]+':'+dt[10]+dt[9]+':'+dt[12]+dt[11]+'.'+dt[14]+dt[13];
    res[3]:=dt;
    body:=copy(ins,55,length(ins)-54);
    for i:=1 to length(body) do
    begin
      case body[i] of
        '0': binb:=binb+'0000';
        '1': binb:=binb+'0001';
        '2': binb:=binb+'0010';
        '3': binb:=binb+'0011';
        '4': binb:=binb+'0100';
        '5': binb:=binb+'0101';
        '6': binb:=binb+'0110';
        '7': binb:=binb+'0111';
        '8': binb:=binb+'1000';
        '9': binb:=binb+'1001';
        'A': binb:=binb+'1010';
        'B': binb:=binb+'1011';
        'C': binb:=binb+'1100';
        'D': binb:=binb+'1101';
        'E': binb:=binb+'1110';
        'F': binb:=binb+'1111';
      end;
    end;
    j:=8;
    t:='';
    for i:=0 to round(length(binb)/8)-1 do
    begin
      s:=copy(binb,i*8+1,8);
      j:=j-1;
      if j=0 then j:=7;
      ss:=copy(s,9-j,j)+t;
      ss:='0'+ss;
      t:=copy(s,1,8-j);
      chv:=0;
      for k:=1 to 8 do
      begin
        chv:=chv+strtoint(ss[k])*round(power(2,8-k));
      end;
      smsbody:=smsbody+chr(chv);
      if length(t)=7 then
      begin
        ss:='0'+t;
        chv:=0;
        for k:=1 to 8 do
        begin
          chv:=chv+strtoint(ss[k])*round(power(2,8-k));
        end;
        t:='';
        smsbody:=smsbody+chr(chv);
      end;
    end;
    res[4]:=smsbody;
  end;
  result:=res;
end;

end.