main.pas

短信收发程序

//文件名称：YiDong_Cmpp.pas
//文件标识：tYD_Cmpp类
//当前版本：1.0

unit main;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls, ScktComp, md5, CMPP_Protocol, cmpp, winsock,
  Buttons;

type
    TFrmMain = class( TForm )
        Memo1: TMemo;
        Panel1: TPanel;
        Label1: TLabel;
        eIp: TEdit;
        Label4: TLabel;
        eSpid: TEdit;
        Label5: TLabel;
        eShaSec: TEdit;
        Panel2: TPanel;
    Label3: TLabel;
    eTel: TEdit;
    Label2: TLabel;
    BtnExit: TSpeedButton;
    bInit: TSpeedButton;
    bSubmit: TSpeedButton;
    bTerminate: TSpeedButton;
    Label6: TLabel;
    eSourceAdd: TEdit;
    Label7: TLabel;
    ePort: TEdit;
    eMsg: TMemo;
    ServerSocket: TServerSocket;
        procedure ClientSocket1Error( Sender: TObject; Socket: TCustomWinSocket;
            ErrorEvent: TErrorEvent; var ErrorCode: Integer );
        procedure bInitClick( Sender: TObject );
        procedure bSubmitClick( Sender: TObject );
        procedure bTerminateClick( Sender: TObject );
        procedure ClientSocket1Read( Sender: TObject; Socket: TCustomWinSocket );
    procedure BtnExitClick(Sender: TObject);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    private
        { Private declarations }
    public
        { Public declarations }
        Cmpp_Sequence_ID: integer;
        function Cmpp_lsh: integer;
        procedure bCmpp_Init( cSocket: TCustomWinSocket );
        //procedure bCmpp_Terminate( cSocket: TCustomWinSocket );
        procedure bCmpp_Submit( cSocket: TCustomWinSocket; cCMPP_SUBMIT: tCMPP_SUBMIT_tag );
        procedure bCmpp_Deliver( cSocket: TServerWinSocket; cCMPP_DELIVER_BODY : tCMPP_DELIVER_BODY_tag);
        procedure bCmpp_ActiveTest( cSocket: TCustomWinSocket );
        procedure CmppRead_CONNECT_RESP( ReadSock: TCustomWinSocket;
            Cmpp_Head: tCMPP_HEAD_tag );
        procedure CmppRead_CONNECT( ReadSock: TCustomWinSocket;
            Cmpp_Head: tCMPP_HEAD_tag );
        procedure CmppRead_TERMINATE(ReadSock: TCustomWinSocket;
          Cmpp_Head: tCMPP_HEAD_tag);
        procedure CmppRead_DELIVER(ReadSock: TCustomWinSocket;
            Cmpp_Head: tCMPP_HEAD_tag);
        procedure CmppRead_DELIVER_RESP(ReadSock: TCustomWinSocket;
          Cmpp_Head: tCMPP_HEAD_tag);
        procedure CmppRead_SUBMIT(ReadSock: TCustomWinSocket;
          Cmpp_Head: tCMPP_HEAD_tag);
        procedure CmppRead_SUBMIT_RESP(ReadSock: TCustomWinSocket;
          Cmpp_Head: tCMPP_HEAD_tag);

        procedure bSubmitSms();
        procedure bDeliverSms();
    end;

var
    FrmMain: TFrmMain;

implementation

{$R *.dfm}

procedure TFrmMain.ClientSocket1Error( Sender: TObject;
    Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
    var ErrorCode: Integer );
begin
    ErrorCode := 0;
end;

procedure TFrmMain.bInitClick( Sender: TObject );
begin
    bCmpp_Init( ServerSocket.Socket );
end;

procedure TFrmMain.bCmpp_Init( cSocket: TCustomWinSocket );
begin
    try
        ServerSocket.Active := False;
        ServerSocket.Port := strtoint(ePort.Text);
        ServerSocket.Active:=true;

{        timestr1:= now;
        while (now-timestr1)< 5/86400 do
        begin
            if ServerSocket.Active then break;
            application.ProcessMessages;
        end;
        if not ServerSocket.Active then
        begin
            memo1.Lines.Add( 'socket未打开' );
            exit;
        end;
    except
        on e: exception do
        begin
            memo1.Lines.Add( 'socket异常:' + e.Message );
            exit;
        end;
    end;
    try
        int1 := SizeOf( TCMPP_HEAD_tag );
        int2 := SizeOf( TCMPP_CONNECT_tag );
        int3 := int1 + int2;
        FillChar( bInit.head, int1, 0 );
        FillChar( bInit.body, int2, 0 );
        DateTimeToString( timestr, 'MMDDHHMMSS', now );
        StrPCopy( str1, trim( eSourceAdd.Text ) + '000000000' + trim( eShaSec.Text ) + timestr );
        LengthI := Length( trim( eSourceAdd.Text ) );
        for i := LengthI to ( LengthI + 8 ) do
            str1[i] := #0;
        Md5UpLen := LengthI + 9 + Length( trim( eShaSec.Text ) ) + 10;
        MD5Init( md5_con );
        MD5Update( md5_con, str1, Md5UpLen );
        MD5Final( md5_con, md5str );
        bInit.head.Total_Length := htonl( int3 );
        bInit.head.Command_ID := htonl( CMPP_CONNECT );
        bInit.head.Sequence_ID := htonl( Cmpp_lsh );
        StrPCopy( bInit.body.Source_Addr, eSourceAdd.text );
        move( md5str, bInit.body.AuthenticatorSource, 16 );
        bInit.body.Version := $20;
        bInit.body.Timestamp := htonl( StrToInt( timestr ) );
        if cSocket.SendBuf( bInit, int3 ) <> int3 then
        begin
            memo1.Lines.Add( '发送连接操作失败' );
            exit;
        end;
}
        memo1.Lines.Add( '服务器开启,正等待连接...' );
    except
        on e: exception do
            memo1.Lines.Add( '错误信息' + e.Message );
    end; //try-except
end;

function TFrmMain.Cmpp_lsh: integer;
begin
    Result := Cmpp_Sequence_ID;
    inc( Cmpp_Sequence_ID );
end;

procedure TFrmMain.bCmpp_ActiveTest( cSocket: TCustomWinSocket );
begin
    //
end;

//  ISGP向SP发送消息
procedure TFrmMain.bCmpp_Deliver( cSocket: TServerWinSocket; cCMPP_DELIVER_BODY : tCMPP_DELIVER_BODY_tag);
var
  Cmpp_Deliver_ItoS: TCmpp_Deliver_Itos;
  SizeIni1         : integer;
  i                : integer;
begin
  try
    SizeIni1 := Sizeof( Cmpp_Deliver_ItoS );
    FillChar( Cmpp_Deliver_ItoS , SizeIni1,0);
    Move( cCMPP_DELIVER_BODY,Cmpp_Deliver_ItoS.body,Sizeof( tCMPP_DELIVER_BODY_tag) );
    with Cmpp_Deliver_ItoS do
    begin
       head.Total_Length  := htonl( Sizeof( Cmpp_Deliver_ItoS ));
       head.Command_ID    := htonl( CMPP_DELIVER );
       head.Sequence_ID   := htonl( Cmpp_LSH );
    end;
    for i:=0 to cSocket.ActiveConnections-1 do
    if cSocket.Connections[i].SendBuf( Cmpp_Deliver_ItoS, SizeIni1) <> SizeIni1 then
    begin
        memo1.Lines.Add('发送Cmpp_Deliver_I2S包错误');
        exit;
    end;
    memo1.Lines.Add('发送Cmpp_Deliver_I2S包成功，正等待返回信息...');
  except
    On E : Exception Do memo1.Lines.Add( '发送Cmpp_Deliver_I2S包异常:' + e.Message );
  end;
end;

//  SP向ISGP发送消息
procedure TFrmMain.bCmpp_Submit( cSocket: TCustomWinSocket; cCMPP_SUBMIT: tCMPP_SUBMIT_tag );
var
    Cmpp_Submit_StoI: TCmpp_Submit_StoI;
    SizeIni1: integer;
begin
    try
        SizeIni1 := Sizeof( Cmpp_Submit_StoI );
        FillChar( Cmpp_Submit_StoI, SizeIni1, 0 );
        Move( cCMPP_SUBMIT, Cmpp_Submit_StoI.body, SizeOf( tCMPP_SUBMIT_tag ) );
        with Cmpp_Submit_StoI do
        begin
            head.Total_Length := htonl( SizeOf( Cmpp_Submit_StoI ) );
            head.Command_Id := htonl( CMPP_SUBMIT );
            head.Sequence_Id := htonl( Cmpp_LSH );
        end;
        if cSocket.SendBuf( Cmpp_Submit_StoI, SizeIni1 ) <> SizeIni1 then
        begin
            memo1.Lines.Add( '发送Cmpp_Submit_S2I包错误' );
            exit;
        end;
        if (memo1.Lines.Count > 1000 ) then
                memo1.Lines.Clear();
        memo1.Lines.Add( '发送Cmpp_Submit_S2I包成功，正等待返回信息...' );
    except
        on e: exception do
        begin
            memo1.Lines.Add( '发送Cmpp_Submit_S2I包异常:' + e.Message );
        end;
    end;
end;

// ISGP 向 SP发送短信
procedure TFrmMain.bDeliverSms();
var
  cCMPP_DELIVER_BODY : tCMPP_DELIVER_BODY_tag ;
begin
  try
     FillChar( cCMPP_DELIVER_BODY,SizeOf( cCMPP_DELIVER_BODY),0);
     with cCMPP_DELIVER_BODY do
     begin
        Head.Msg_Id := Cmpp_LSH();
        strpcopy(Head.Dest_Id,eTel.Text);
        strpcopy(Head.Service_Id,'ISMG');
        Head.TP_pid := 0;
        Head.TP_udhi := 0;
        Head.Msg_Fmt := 8;
        strpcopy(Head.Src_terminal_Id,eSourceAdd.Text);
        Head.Registered_Delivery := 0;
        Head.Msg_Length := 140;
        strpcopy(Body.Msg_Content,eMsg.Text);
     end;
     bCmpp_Deliver( ServerSocket.Socket, cCMPP_DELIVER_BODY );
  except
     On E: Exception Do memo1.Lines.Add( 'ISGP下发短信,异常:' + e.Message );
  end;
end;

// SP向ISGP发送短信
procedure TFrmMain.bSubmitSms();
var
    CMPP_SUBMIT_tag: TCMPP_SUBMIT_tag;
begin
    FillChar( CMPP_SUBMIT_tag, SizeOf( CMPP_SUBMIT_tag ), 0 );
    with CMPP_SUBMIT_tag do
    begin
        Pk_total := 1;
        Pk_number := 1;
        Registered_Delivery := 0;
        Msg_level := 0;
        strpcopy( Service_Id, 'SP' );
        Fee_UserType := 0;
        strpcopy( Fee_terminal_Id, '' ); //:array[0..20] of char;  //被计费用户的号码（如本字节填空，则表示本字段无效，对谁计费参见Fee_Userstruct字段，本字段与Fee_Userstruct字段互斥）
        TP_pId := 0; //byte;//GSM协议类型。详细是解释请参考GSM03.40中的9.2.3.9
        TP_udhi := 0; //byte;//GSM协议类型。详细是解释请参考GSM03.40中的9.2.3.23,仅使用1位，右对齐
        Msg_Fmt := 8; //byte;//信息格式  0：ASCII串  3：短信写卡操作  4：二进制信息  8：UCS2编码15：含GB汉字
        strpcopy( Msg_src, eSpid.Text ); //array[0..5] of char;   //信息内容来源(SP_Id)
        strpcopy( FeeType, '01' ); //:array[0..1] of char;   //资费类别01：对"计费用户号码"免费
        strpcopy( FeeCode, '00010' ); //:array[0..5] of char;   //资费代码（以分为单位）
        strpcopy( ValId_Time, '' ); //:array[0..16] of char;  //存活有效期，格式遵循SMPP3.3协议
        strpcopy( At_Time, '' ); //:array[0..16] of char;  //定时发送时间，格式遵循SMPP3.3协议
        strpcopy( Src_Id, eSourceAdd.Text ); //:array[0..20] of char;  //源号码SP的服务代码或前缀为服务代码的长号码, 网关将该号码完整的填到SMPP协议Submit_SM消息相应的source_addr字段，该号码最终在用户手机上显示为短消息的主叫号码
        DestUsr_tl := 1; //byte;//接收信息的用户数量(小于100个用户)
        strpcopy( Dest_terminal_Id, eTel.Text ); //:array[0..20] of char;  //接收短信的MSISDN号码
        Msg_Length := 140; //byte;//信息长度(Msg_Fmt值为0时：<160个字节；其它<=140个字节)
        strpcopy( Msg_Content, eMsg.Text ); //:array[0..MSG_LENGTH-1] of char; //信息内容
        //Reserve             :array[0..7] of char;//保留
    end;
    bCmpp_Submit( ServerSocket.Socket, CMPP_SUBMIT_tag );
end;


procedure TFrmMain.bSubmitClick( Sender: TObject );
begin
  try
     bDeliverSms();
  except
    On E : Exception Do  memo1.Lines.Add( 'ISMG下发短信,异常:' + e.Message );
  end;
end;

procedure TFrmMain.bTerminateClick( Sender: TObject );
begin