main.pas

东软CMPP Delphi版简单实现 很简单的一个程序 测试成功

//文件名称：main.pas
//文件标识：东软CMPP简单收发程序
//当前版本：1.0
//作    者：邵青山
//完成日期：2003年6月20日
unit main;

interface

uses
    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
    Dialogs, StdCtrls, ExtCtrls, Buttons, ScktComp, md5, SmaisCmpp, winsock;
const
    FRMMAIN_CAPTION = '东软CMPP简单收发程序---';
    CMPPCLIENT_PORT = 7890;
    CMPP_SERVICE_TYPE = 'HELLO'; //  ServiceType
type
    TfrmMain = class( TForm )
        Memo1: TMemo;
        Panel1: TPanel;
        Label5: TLabel;
        eSpid: TEdit;
        Label6: TLabel;
        eShSe: TEdit;
        Label7: TLabel;
        eSouAdd: TEdit;
        Panel2: TPanel;
        Label1: TLabel;
        bLogout: TButton;
        bSubmit: TButton;
        bActiveTest: TButton;
        eTel: TEdit;
        bLogin: TButton;
        Cmpp_Client: TClientSocket;
        Label2: TLabel;
        eIP: TEdit;
        procedure bLoginClick( Sender: TObject );
        procedure FormShow( Sender: TObject );
        procedure Cmpp_ClientRead( Sender: TObject; Socket: TCustomWinSocket );
        procedure bActiveTestClick( Sender: TObject );
        procedure bLogoutClick( Sender: TObject );
        procedure Cmpp_ClientError( Sender: TObject; Socket: TCustomWinSocket;
            ErrorEvent: TErrorEvent; var ErrorCode: Integer );
        procedure bSubmitClick( Sender: TObject );
    private
        { Private declarations }
    public
        { Public declarations }
        Sequence_Number: integer;
        procedure SetCursorHour;
        procedure setCursorDef;
        function OpenSocket: boolean;
        function CmppLogin( CmppSocket: TCustomWinSocket ): boolean;
        function CmppLogout( CmppSocket: TCustomWinSocket ): boolean;
        function CmppSubmit( CmppSocket: TCustomWinSocket ): boolean;
        function CmppActive( CmppSocket: TCustomWinSocket ): boolean;
        function CmppLSH: integer;
    end;

var
    frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.bLoginClick( Sender: TObject );
begin
    if not openSocket then
        exit;
    CmppLogin( Cmpp_Client.Socket );
end;

function TfrmMain.OpenSocket: boolean;
var
    temptime: TDateTime;
begin
    Result := false;
    try
        with Cmpp_Client do
        begin
            Active := False;
            Address := eIP.Text;
            Port := CMPPCLIENT_PORT;
            Open;
            temptime := now( );
            SetCursorHour;
            while true do
            begin
                application.ProcessMessages;
                if ( now - temptime ) > 5 / 86400 then
                    break;
                if Cmpp_Client.Active then
                    break;
            end; //end while
            setCursorDef;
            if Cmpp_Client.Active then
            begin
                FrmMain.Caption := FRMMAIN_CAPTION + 'Socket连接成功';
                Result := True;
            end
            else
            begin
                ShowMessage( 'Socket连接失败,请检查Socket设置或网络设置' );
                FrmMain.Caption := FRMMAIN_CAPTION + 'Socket连接失败,请检查Socket设置或网络设置';
            end;
        end;
    except
        on e: exception do
        begin
            ShowMessage( '请检查Socket设置,错误如下:' + e.Message );
            FrmMain.Caption := FRMMAIN_CAPTION + e.Message;
        end;
    end;
end;

procedure TfrmMain.FormShow( Sender: TObject );
begin
    FrmMain.Caption := FRMMAIN_CAPTION;
    Memo1.Lines.Clear;
    Sequence_Number := 1;
end;

function TfrmMain.CmppActive( CmppSocket: TCustomWinSocket ): boolean;
var
    CCMPPHead: TCMPPHead;
begin
    Result := False;
    try
        FillChar( CCMPPHead, SizeOf( TCMPPHead ), 0 );
        with CCMPPHead do
        begin
            MessageLength := htonl( 16 ); //longword; //消息的总长度(字节)
            CommandId := htonl( CMPPE_ACTIVE ); //longword; //命令ID
            CommandStauts := htonl( 0 ); //longword; //命令状态,仅在应答请求包里有效
            SequenceNumber := htonl( CMPPLSH ); //longword; //序列号,循环使用,步长为1,范围1-0x7fffffff
        end;
        CmppSocket.SendBuf( CCMPPHead, 16 );
        Memo1.Lines.Add( '测试包发送成功' );
        Result := True;
    except
        on e: exception do
            memo1.Lines.Add( '发送测试包错误： ' + e.Message );
    end;
end;

function TfrmMain.CmppLogin( CmppSocket: TCustomWinSocket ): boolean;
type
    T_Login = packed record
        Head: TCMPPHead;
        Body: TSpLogin;
    end;
var
    cLogin: T_Login;
    Md5_Dig: MD5Digest;
    MD5_Con: MD5Context;
    Md5UpLen: Integer; //MD5Update Length;
    str1: array[0..35] of char;
    timestr: string;
    i, LengthI: integer;
    Login_file: TFileStream;
    tempint1: longword;
    str2: array[0..3] of char;
begin
    try
        Result := False;
        DateTimeToString( timestr, 'MMDDHHMMSS', now );
        //timestr:='1055830373';
        fillchar( str2, 4, 0 );
        tempint1 := htonl( strtoint( timestr ) );
        move( tempint1, str2, 4 );
        LengthI := Length( trim( eSpid.Text ) );
        StrPCopy( str1, trim( eSpid.Text ) + '000000000' + trim( eShSe.Text ) + str2 );
        for i := LengthI to ( LengthI + 8 ) do
            str1[i] := #0;
        Md5UpLen := LengthI + 9 + Length( trim( eShSe.Text ) ) + 4;
        MD5Init( MD5_Con );
        MD5Update( MD5_Con, str1, Md5UpLen );
        MD5Final( MD5_Con, Md5_Dig );

        with cLogin.Head do
        begin
            MessageLength := htonl( SizeOf( T_Login ) );
            CommandId := htonl( CMPPE_LOGIN );
            CommandStauts := htonl( CMPPE_RSP_SUCCESS );
            SequenceNumber := htonl( CmppLSH );
        end;
        with cLogin.Body do
        begin
            StrPCopy( SP_ID, trim( eSpid.Text ) );
            Move( Md5_Dig, SP_AUTH, 16 );
            SP_BindType := 2; //登陆类型，0，发；1，收；2，收发
            IF_Ver := $12; //byte;       //接口版本 0，11，12
            TimeStamp := ( tempint1 ); //      LongWord;   //时间戳，mmddhhmmss
        end;

        if CmppSocket.SendBuf( cLogin, SizeOf( T_Login ) ) <> SizeOf( T_Login ) then
        begin
            Memo1.Lines.Add( 'login提交失败,请检查socket是否连接' );
            FrmMain.Caption := FRMMAIN_CAPTION + 'login提交失败,请检查socket是否连接';
        end
        else
        begin
            Memo1.Lines.Add( 'login发送成功,等待响应信息' );
            FrmMain.Caption := FRMMAIN_CAPTION + 'login发送成功,等待响应信息';
            Result := True;
        end;

        Login_file := TFileStream.Create( '.\login_' + timestr + '.in', fmCreate );
        try
            login_file.WriteBuffer( cLogin, SizeOf( T_Login ) );
        finally
            Login_file.Free;
        end; //end try-finally
    except
        on e: exception do
        begin
            Result := False;
            Memo1.Lines.Add( 'login发送有异常:' + e.Message );
            FrmMain.Caption := FRMMAIN_CAPTION + e.Message;
        end;
    end;
end;

function TfrmMain.CmppLogout( CmppSocket: TCustomWinSocket ): boolean;
var
    CCMPPHead: TCMPPHead;
begin
    Result := False;
    try
        FillChar( CCMPPHead, SizeOf( TCMPPHead ), 0 );
        with CCMPPHead do
        begin
            MessageLength := htonl( 16 ); //longword; //消息的总长度(字节)
            CommandId := htonl( CMPPE_LOGOUT ); //longword; //命令ID
            CommandStauts := htonl( 0 ); //longword; //命令状态,仅在应答请求包里有效
            SequenceNumber := htonl( CMPPLSH ); //longword; //序列号,循环使用,步长为1,范围1-0x7fffffff
        end;
        CmppSocket.SendBuf( CCMPPHead, 16 );
        Memo1.Lines.Add( 'LOGOUT发送成功' );
        FrmMain.Caption := FRMMAIN_CAPTION + 'LOGOUT发送成功';

        Result := True;
    except
        on e: exception do
            memo1.Lines.Add( '发送LOGOUT错误： ' + e.Message );
    end;
end;