?? 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -