apggps.pas

利用SPCOMM和Socket写的高速短信串口服务器

begin 
	Result:=''; 
	len:=Length(s);   //j 用于移位计数 	
	i:=1;
	j:=0; 
  while i<=len do
	begin
	  if i<len then         //数据变换
	    cur:=(ord(s[i]) shr j) or ((ord(s[i+1]) shl (7-j)) and $ff)
      else
	  cur:=(ord(s[i]) shr j) and $7f;
	  FmtStr(t,'%2.2X',[cur]);
	  Result:=Result+t;
	  inc(i);
	  j:=(j+1) mod 7;    //移位计数达到7位的特别处理
      if j=0 then inc(i);
	end;
end;
 function TfrmMain.GetHex(const aStr:string):string;
  var
   k: Integer;
  begin
   for k := 1 to Length(aStr) do
   begin
    Result := Result + Format('%.2x', [Ord(aStr[k])]);
   end;
  end;
 function TfrmMain.FormatHexDisp(const asHex:string):string;
 var
  k, iLen:integer;
begin
  Result:= asHex;
  iLen:=length(Result);

  if (iLen mod 2)=1 then
  begin
    Result := '0' + Result;
    Inc(iLen);
  end;

  for k:=iLen downto 1 do
  begin
    if (k mod 2)=1 then Continue;
    Insert(' ', Result, k - 1);
  end;
  Result := Trim(Result);
 end;
 function TfrmMain.UnicodeHexToStr(const asUnicodeHex:string):string;
 var
  i: Integer;
  sTemp: string;
begin
  for i := 1 to Length(asUnicodeHex) do
  begin
    if i mod 4 = 0 then
    begin
      sTemp := Copy(asUnicodeHex, i - 3, 4);
      sTemp := WideChar(StrToIntDef('$' + sTemp, 0));
      Result := Result + sTemp;
    end;
  end;
end;
procedure TfrmMain.Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
  BufferLength: Word);
var
     i:integer;
     pStr:pchar;
     rec: string;
begin
    recnum:=recnum+1;
    viewstring:='';
    rec:='';
    if hexshow.Checked then
       begin
         move(buffer^,pchar(@rbuf)^,bufferlength);
         for i:=1 to bufferlength do
            viewstring:=viewstring+ inttohex(rbuf[i],2)+'';
        end
    else
       begin
         pStr:= Buffer;
         Tempstr:=Tempstr+pstr;
         num:=length(Tempstr);
     end;
   end;
   
   procedure read_status1();
     begin
         CommSet.CommName:=frmMain.Comm1.CommName;
         CommSet.BaudRate:=frmMain.Comm1.BaudRate;
         CommSet.ByteSize:=frmMain.Comm1.ByteSize;
         CommSet.StopBits:=frmMain.Comm1.StopBits;
         CommSet.Parity:=frmMain.Comm1.Parity;
    end;
    //**********************************************************

   {**********************返回一个字符串在另一个字符串中出现的次数***************}

   function ReturnSubstringNum(SubStr,ss:string):integer;
     var
       temp_num: integer;
       Sub_len,Org_len,i,j: integer;
       mid_str,orgStr:string;
     begin
       orgstr:=ss;
       i:=0;
       Sub_len:=length(Substr);
       Org_len:=length(OrgStr);
       //*******计算出短信的数量*******
       while pos(substr,orgstr)<>0 do
         begin
            Temp_num:=pos(substr,orgstr);
            orgStr:=copy(orgstr,Temp_num+sub_len,org_len-(Temp_num+sub_len));
            org_len:=length(orgStr);
            i:=i+1;
         end;
       //***********计算出短信的数量
         orgStr:=ss;
         Org_len:=length(OrgStr);
         for j:=1 to i do
           begin
             if j<>i then
               begin
                  Temp_num:=pos(substr,orgstr);
                   mid_str:=copy(orgstr,Temp_num+sub_len,org_len-(Temp_num+sub_len)+1);
                   //******Copy出每一条短信的内容*****
                   smsm_data[j]:=copy(orgstr,Temp_num,pos(substr,mid_str)+sub_len-1);
                   //*****Copy出每一条短信的内容
                   org_len:=length(mid_str);
                   orgstr:=mid_str;
                end
              else
                begin
                   Org_len:=length(orgStr);
                   Temp_num:=pos(subStr,OrgStr);
                    smsm_data[i]:=copy(orgstr,Temp_num,org_len-temp_num+1);
                end;
           end;
           result:=i;
      end;

//**********************返回一个字符串在另一个字符串中出现的次数***************
  procedure write_set();
  begin
         frmMain.Comm1.CommName:=CommSet.CommName;
         frmMain.Comm1.BaudRate:=CommSet.BaudRate;
         frmMain.Comm1.ByteSize:=CommSet.ByteSize;
         frmMain.Comm1.StopBits:=CommSet.StopBits;
         frmMain.Comm1.Parity:=CommSet.Parity;
   end;
   function DataTransform(s:string):string;
    var
      N,yue,yue1,yue2,D,H,se,m,z,stemp:string;
    begin
     stemp:=s;
     N:='20'+copy(stemp,1,2);
     yue1:=copy(stemp,3,1);
     yue2:=copy(stemp,4,1);
     if yue='0' then
        yue:=yue2
     else
        yue:=yue1+yue2;
     d:=copy(stemp,5,2);
     h:=copy(stemp,7,2);
     m:=copy(stemp,9,2);
     se:=copy(stemp,11,2);
     z:=copy(stemp,13,2);
     result:=N+'年'+yue+'月'+d+'日'+h+'时'+m+'分'+se+'秒';
    end;
    {****************************英文短信解码****************}

    function DecodeEnglish(s:String):String;
     var
       i,j,len:Integer;
       TempIntArray:Array of Integer;
       TempStr:String;
       cur:Integer;
     begin
       len:=Length(s) div 2;
       SetLength(TempIntArray,Len);
       for i:=0 to Len-1 do
         begin
           TempStr:=Copy(s,i*2+1,2);
           TempIntArray[i]:=HexToInt(TempStr);
       end;
       i:=0;        //j 用于移位计数
       j:=0;
       while i<=len-1 do
        begin
          if i<>0 then     //数据变换
             cur:=((TempIntArray[i] shl j) and $7f) or (TempIntArray[i-1] shr (8-j))
          else
             cur:=(TempIntArray[i] shl j) and $7f;
           Result:=Result+Chr(cur);
           j:=(j+1) mod 7;      //移位计数达到7位的特别处理
          if j=0 then
            begin
               cur:=TempIntArray[i] shr 1;
               Result:=Result+Chr(cur);
           end;
          inc(i);
        end;
     end;
//****************************英文短信解码****************
//********************************************************//
{*************************手机号码解码****************************}
function DecodeNumber( Pnum: string):string;
var
    a,b,c,d,e,f:string;
    i,len:integer;
begin
    len:=length(Pnum);
     i:=1;
     a:='';
     b:='';
     c:='';
     while i<len do
       begin
         a:=copy(PNum,i,1);
         b:=copy(PNum,i+1,1);
         c:=c+b+a;
         i:=i+2;
       end;
     e:=copy(c,1,2);
     if e='86' then
     begin
     f:=c;
     c:=copy(f,3,length(f));
     len:=length(c);
     end;
     if copy(c,len,1)='F' then
     begin
     d:=copy(c,1,len-1);
     result:=d;
     end
     else
     result:=c;
end;
//*************************手机号码解码****************************
{*********************收到短信PDU解码********************}
procedure DEcodePDU( PDUstr:string);
var
    Call_num_type,Mtemp,read_or,sms_index,smsc_Head,sms_Data,message_len,sms_len,sms_Date,message_Data,data_Type,Call_Num,smsc_Num:string;
    call_num_len: integer;
begin
    Mtemp:=PDUstr;
    if sms_flag='+CMGL' then
       read_or:=copy(Mtemp,pos(',',Mtemp)+1,1)
    else
       read_or:=copy(Mtemp,pos(#$20,Mtemp)+1,(pos(',',Mtemp)-pos(#$20,Mtemp)-1));
    sms_index:=copy(Mtemp,pos(#$20,Mtemp)+1,(pos(',',Mtemp)-pos(#$20,Mtemp)-1));
    sms_len:=copy(Mtemp,pos(',,',Mtemp)+2,pos((#$0D+#$0A),Mtemp)-pos(',,',Mtemp)-2);
    smsc_head:=copy(Mtemp,pos((#$0D+#$0A),Mtemp)+2,18);
    smsc_num:=DecodeNumber(copy(smsc_head,5,14));
    sms_Data:=copy(Mtemp,pos((#$0D+#$0A),Mtemp)+20,strtoint(sms_len)*2);
    if ((read_or <> '1') and (read_or <>'0')) then
    begin
     call_Num_len:=HexToInt(copy(sms_data,5,2));
    if (Call_num_len mod 2)=1 then  inc(call_Num_len);
    Call_num:=DecodeNumber(copy(sms_data,9,Call_Num_len));
    data_type:=copy(sms_Data,11+Call_Num_len,2);
    call_num_type:=copy(sms_data,7,2);
    sms_Date:='05000000000000';
    message_len:=copy(sms_data,15+call_Num_len,2);
    message_data:=copy(sms_data,17+call_num_len,HexToInt(message_len)*2);
     end
    else
    begin
    Call_Num_len:=HexToInt(copy(sms_data,3,2));
    if (Call_num_len mod 2)=1 then  inc(call_Num_len);
    Call_num:=DecodeNumber(copy(sms_data,7,Call_Num_len));
    data_type:=copy(sms_Data,9+Call_Num_len,2);
    call_num_type:=copy(sms_data,5,2);
    sms_Date:=DecodeNumber(copy(sms_data,11+Call_Num_len,14));
    message_len:=copy(sms_data,25+call_Num_len,2);
    message_data:=copy(sms_data,27+call_num_len,HexToInt(message_len)*2);
    end;


    if data_type='08' then
    begin
   //   smsDataFull.messageData:=DecodeUniCode(message_data);
      smsdatafull.messagetype:='unicode编码短信!';
    end
    else
    begin
      smsDataFull.messageData:=DecodeEnglish(message_data);
      smsdatafull.messagetype:='7Bit 英文编码短信!';
    end;
    smsDataFull.messageLen:=inttostr(HexToInt(message_len) div 2);
    smsDataFull.smsDate:=DataTransform(sms_Date);
    smsDataFull.callNumber:=Call_Num;
    smsdatafull.smscNumber:=smsc_Num;
    if  call_num_type='91' then
    smsdatafull.numbertype:='长途号码'
    else if  call_num_type='A1' then
    smsdatafull.numbertype:='本地号码'
    else
    smsdatafull.numbertype:='未知号码';
    smsdatafull.messageindex:=sms_index;
end;


//**********************************************************

procedure TfrmMain.auto_rec_timerTimer(Sender: TObject);
var
     cmd,strTemp:string;
    message_Num,i,j:integer;
begin
     auto_rec_timer.Enabled:=false;
     strTemp:=Tempstr;
     message_Num:=ReturnSubstringNum(sms_flag,strTemp);
     Memo1.Text:='共有 '+ inttostr(message_Num) +'未读短信:'+#$0D+#$0A;
   for i:=2 to message_Num do
    begin
      DEcodePDU(smsm_data[i]);
      memo1.Text:=memo1.Text+'第'+inttostr(i)+'短信：'+#$0D+#$0A;
      memo1.Text:=memo1.Text+smsdatafull.messageData +#$0D+#$0A+#$0D+#$0A;
      memo1.Text:=memo1.Text+'发送人号码：'+smsdatafull.callNumber+#$0D+#$0A;
      memo1.Text:=memo1.Text+smsdatafull.numbertype +#$0D+#$0A;
      memo1.Text:=memo1.Text+'手机中存储位置：'+smsdatafull.messageindex +#$0D+#$0A;
      memo1.Text:=memo1.Text+'发送中收号码：'+smsdatafull.smscNumber+#$0D+#$0A;
      memo1.Text:=memo1.Text+'发送日期:'+smsdatafull.smsDate+#$0D+#$0A+#$0D+#$0A;
      cmd:=FormatHexDisp(GetHex('AT+CMGD='+smsdatafull.messageindex+#$0D+#$0A));
      for j:=0 to sessions do
         begin
            if session[j].CUsed then
               begin
                  serverSocket.Socket.Connections[j].SendText(smsdatafull.callNumber+smsdatafull.messageData);
               end;
         end;
      sendHex(cmd);
      sleep(200);
    end;
     if autoRecMessage.Checked then
        begin
         auto_Rec_timer.Enabled:=true;
         tempstr:='';
        waite_time:=0;
        cmd:=FormatHexDisp(GetHex('AT+CMGL=4'+#$0D+#$0A));
        sms_flag:='+CMGL';
        SendHex(cmd);
     end;
     TempStr:='';
     auto_rec_timer.Enabled:=true;
 end;

procedure TfrmMain.Timer1Timer(Sender: TObject);
var
    strTemp:string;
    message_Num,i:integer;
begin
    case Time_flag of
    0: begin
       frmMain.Timer1.Enabled:=false;
      if Pos('OK',TempStr)<>0 then
       begin
       // Unconnect_btn.Enabled:=true;