apggps.~pas

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

unit APGGPS;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ScktComp, CSMSControl, SPComm, ExtCtrls;
const
  CMax=10;
//************************************//
//*******Socketk客户端的数据结构******//
type
  client_record=record
  CHandle:integer;
  CSocket:TCustomWinSocket;
  CName:string;
  CAddress:string;
  CUsed:Boolean;
end;
//******Socket客户端数据结构*********//
//***********************************//
//***********************************//
//*************Comm端口的数据结构****//
type
   TCommset=record
     CommName:string;
     BaudRate:DWORD;
     ByteSize:TByteSize;
     StopBits:TStopBits;
     Parity:TParity;
end;
//***********Comm端口的数据结构*****//
//**********************************//
type
   TmsmData=record
     smscNumber:string;   //短信中心号码
     callNumber:string;   //发送方电话号码
     messageLen:string;   //短信长度
     messageData:string;  //短信内容
     smsDate:string;     //短信时间
     messagetype:string;  //短信数据编码方式
     numbertype:string;   //Caller 号码类型
     messageindex:string; //第几条短信
end; 
type
  TfrmMain = class(TForm)
    ServerSocket: TServerSocket;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    edtListenPort: TEdit;
    Button1: TButton;
    GroupBox2: TGroupBox;
    Label2: TLabel;
    edtComPort: TEdit;
    Label3: TLabel;
    Button2: TButton;
    Button3: TButton;
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    edtComSpeed: TEdit;
    Comm1: TComm;
    Timer1: TTimer;
    auto_rec_timer: TTimer;
    autoRecMessage: TCheckBox;
    hexshow: TCheckBox;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure ServerSocketClientRead(Sender:TObject;Socket:TCustomWinSocket);
    procedure ServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketGetClient(Sender: TObject; Socket: Integer;
      var ClientSocket: TServerClientWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sendHex(s:string);
    procedure Comm1ReceiveData(Sender: TObject; Buffer: Pointer;
      BufferLength: Word);
    procedure Timer1Timer(Sender: TObject);
    procedure auto_rec_timerTimer(Sender: TObject);
  private
    { Private declarations }
    function GetHex(const aStr:string):string;
    function FormatHexDisp(const asHex:string):string;
    function UnicodeHexToStr(const asUnicodeHex:string):string;
  public
    { Public declarations }
    Session:array[0..CMax] of client_record;
    Sessions:integer;
  end;

var
  frmMain: TfrmMain;
  CommSet:TcommSet;
  comm2set:TcommSet;
  smsDataFull:TmsmData;
  waite_time,time_flag:integer;
  sms_Flag: string;
  viewstring , portstatus: string;
  smsm_data:Array[1..200] of string;
  recnum,num:integer;
  TempStr:string;
  timeN:integer;
  a: array[0..128,0..128] of integer;
  b:array of byte;
  c:array of byte;
  rbuf: array[0..50000] of byte; 
  procedure read_status1();
  procedure write_set();
  procedure DEcodePDU( PDUstr:string);
  function EncodeNumber( PNum: string):string;
  function DecodeNumber( PNum: string):string;
  function HexToInt(HexStr:String):Integer;
  function ReturnSubstringNum(SubStr,Ss:string):integer;
  function DataTransform(s:string):string;
  function EncodeEnglish(s:String):String;
  function DecodeEnglish(s:String):String;   
implementation

{$R *.dfm}
(*********************取16进制字符的10进制的integer值*******************)
function HexToInt(HexStr:String):Integer;
var
  i,TempInt,LocalInt:Integer;
begin
  HexStr:=UpperCase(HexStr);

  LocalInt:=1;
  Result:=0;
  for i:=Length(HexStr) downto 1 do
  begin
    if HexStr[i] in ['0'..'9'] then
      TempInt:=StrToInt(HexStr[i])
    else
      TempInt:=Ord(HexStr[i])-Ord('A')+10;

    if i=Length(HexStr) then
      LocalInt:=1
    else
      LocalInt:=LocalInt*16;

    Result:=Result+TempInt*LocalInt;
  end;
end;
//*********************取16进制字符的10进制的integer值**************
procedure TfrmMain.Button1Click(Sender: TObject);
begin
  ServerSocket.Port:=strtoint(edtListenPort.Text);
  ServerSocket.Open;
end;
//从客户端读取数据
procedure TfrmMain.ServerSocketClientRead(Sender:TObject;Socket:TCustomWinSocket);
var
i,j:integer;
strReceive,PhoneNO,Msg,SMSHead,UserData,UserData_Len,Num_Len,Num_Type,SMSData:string;
Message_Len,cmd:string;
CalledNumLen:Integer;
begin
 strReceive:=socket.ReceiveText;
 frmMain.Memo1.Lines.Add(strReceive);
 j:=length(strReceive);
 PhoneNO:=Copy(strReceive,1,11);
 Msg:=Copy(strReceive,12,j-11);
 CalledNumLen:=length(PhoneNO);
 Num_Type:='A1';
 FmtStr(Num_Len,'%2.2X',[CalledNumLen]);
 SMSHead:='0891'+ EncodeNumber('8613800100500')+'1100'+num_len+num_type+EncodeNumber(PhoneNO)+'000090';
 UserData:=EncodeEnglish(Msg);
 FmtStr(UserData_Len,'%2.2X',[(length(UserData))div 2]);
 SMSData:=SMSHead+UserData_Len+UserData;
 Message_Len:=inttostr((length(SMSData)-18) div 2);
 cmd:=FormatHexDisp(GetHex('AT+CMGS='+message_Len+#$0D+#$0A));
 SendHex(cmd);
 sleep(200);
 cmd:=FormatHexDisp(GetHex(smsData+#$1A+#$0D+#$0A));
 SendHex(cmd);  
 for i:= 0 to sessions do
   begin
      if session[i].CHandle = Socket.SocketHandle then
         begin
             session[i].CSocket.SendText('回复客户端'+session[i].CAddress+'===>'+'自动回复了一条');
         end;
   end;
end;
procedure TfrmMain.ServerSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
 frmMain.StatusBar1.Panels[0].Text:='正在等待客户的连接';
end;

procedure TfrmMain.SerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i,j:integer;
begin
   j:=-1;
   for i:=0 to Sessions do
     begin
        if not session[i].CUsed then
           begin
              session[i].CHandle:=Socket.SocketHandle;
              session[i].CSocket:=Socket;
              session[i].CName :=Socket.RemoteHost;
              session[i].CAddress:=Socket.RemoteAddress;
              session[i].CUsed:=true;
              break;
           end;
          j:=i;
     end;
    if j=sessions then
       begin
           inc(Sessions);
           session[j].CHandle:=socket.SocketHandle;
           session[j].CSocket :=Socket;
           session[j].CName:=Socket.RemoteHost;
           session[j].CAddress:=Socket.RemoteAddress;
           session[j].CUsed:=true;
       end;
    frmMain.StatusBar1.Panels[1].Text:='客户端'+Socket.RemoteHost+'  '+Socket.RemoteAddress +' 已经连接';   
end;

procedure TfrmMain.ServerSocketGetClient(Sender: TObject; Socket: Integer;
  var ClientSocket: TServerClientWinSocket);
begin
    frmMain.StatusBar1.Panels[2].Text:='客户端正在连接......';
end;

procedure TfrmMain.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
statusbar1.Panels[3].Text := '客户端'+Socket.RemoteHost+'发生意外';
errorcode:=0;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
Sessions := 0;
// SMSControl.AutoDeleteMsg:=true;
 commset.CommName:='COM1';
 commset.BaudRate:=9600;
 commset.ByteSize:= _8;
 commset.StopBits:=_1;
 commset.Parity:= None;
// comm1:=tcomm.Create(commset);
 comm1.CommName:=commset.CommName;
 comm1.BaudRate:=commset.BaudRate;
 comm1.ByteSize:=commset.ByteSize;
 comm1.StopBits:=commset.StopBits;
 comm1.Parity:=commset.Parity;
 comm1.StartComm;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ServerSocket.Close;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
//SMSControl.Destroy;
end;

procedure TfrmMain.Button2Click(Sender: TObject);
Var
  strAT:string;
  strCenterNO:string;
begin
   comm1.CommName:=edtcomport.Text;
   Comm1.BaudRate:=strtoint(edtcomspeed.Text);
   comm1.StartComm;
 //  strCenterNO:='13800100500';
 //  strAT:='AT+CMGF=0'+#$0D+#$0A;
 //  sendHex(strAT);
 //  sleep(200);
 //  strAT:='AT+CSCA="' +strCenterNO+'"'+#$0D+#$0A;
 //  sendHex(strAT);
end;

procedure TfrmMain.Button3Click(Sender: TObject);
begin
  //SMSControl.SetOpenProcess(TRUE);
end;

procedure TfrmMain.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
i,j:Integer;
begin
 j:=-1;
 for i:=0 to sessions do
    begin
      if session[i].CHandle = socket.SocketHandle then
         begin
             session[i].CHandle:=0;
             session[i].CUsed:=false;
             Break;
         end;
    end;
statusbar1.Panels[0].Text:='客户端'+socket.RemoteHost+' 已经断开';
end;

procedure TfrmMain.SendHex(S: String);
var
  s2:string;
  buf1:array[0..50000] of char;
  i:integer;
begin
  s2:='';
  for i:=1 to  length(s) do
  begin
    if ((copy(s,i,1)>='0') and (copy(s,i,1)<='9'))or((copy(s,i,1)>='a') and (copy(s,i,1)<='f'))
        or((copy(s,i,1)>='A') and (copy(s,i,1)<='F')) then
    begin
        s2:=s2+copy(s,i,1);
    end;
  end;
  for i:=0 to (length(s2) div 2-1) do
  buf1[i]:=char(strtoint('$'+copy(s2,i*2+1,2)));
  Comm1.WriteCommData(buf1,(length(s2) div 2));
end;
function EncodeNumber(PNum:string):string;
var
    a,b,c:string;
    i,len:integer;
begin
    len:=length(PNum);
    if (len mod 2)=1 then
     begin
     PNum:=PNum+'F';
     len:=len+1;
     end;
     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;
     result:=c;
end;
 function EncodeEnglish(s:string):string;
 var 
	i,j,len:Integer;
	cur:Integer; 
	t:String;