📄 mainunit.pas
字号:
//---------------------中国移动CMPP2 SP接入端-----------------------------------
//CMPP_Protocol2 为 互联网短信网关接口部分协议CMPP2.0
//StrPCopy 遇 #0 就退出。
//------------------------------------------------------------------------------
unit MainUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, DB, ADODB,IniFiles,
ScktComp,DateUtils,MD5,WinSock, DBClient, Provider,MidasLib, AppEvnts,CMPP_Protocol2;
type
TMainForm = class(TForm)
InfoMemo: TMemo;
Panel1: TPanel;
MainStatusBar: TStatusBar;
Button_Start: TSpeedButton;
Button_Shut: TSpeedButton;
SpeedButton3: TSpeedButton;
Panel_Line: TPanel;
ADOConn: TADOConnection;
CMPP2Socket: TClientSocket;
LoopTimer: TTimer;
CheckTimer: TTimer;
SpeedButton4: TSpeedButton;
Query1: TADOQuery;
DSP1: TDataSetProvider;
CDS1: TClientDataSet;
Command_Update: TADOCommand;
StoredProc_MSG: TADOStoredProc;
StoredProc_Report: TADOStoredProc;
Command_Delete: TADOCommand;
ApplicationEvents_X: TApplicationEvents;
Timer_CheckNet: TTimer;
Query2: TADOQuery;
Query4: TADOQuery;
Query5: TADOQuery;
Query6: TADOQuery;
Query3: TADOQuery;
procedure FormCreate(Sender: TObject);
procedure My_SpStringToList(List: TStrings; const W: WideString;ICount:integer);
procedure My_StrCopy(const Src: string; Dest: PChar; MaxSize: Integer);
procedure My_WriteInfo(Str:String);
procedure WriteActiveLog(SLines:String);
function My_OpenSocket():boolean;
function My_GetBuf(Packet: TMemoryStream;ASavePath:String): String;
procedure My_CloseSocket();
function My_GetIniConfigFile():String;
function My_ConnectToDB():boolean;
function My_PackBadWord(Msg:String):String;
procedure My_DelayTime();
procedure My_StartServer();
procedure My_LoadParameters();
procedure My_ReceiveShortMessage(ReceiveShortMessage :TReceiveShortMessage);
procedure My_ReveiveReport(ReceiveReport : TReceiveReport);
function My_UCS2toGB( P : Pointer; Size : Integer = 70 ):String;
function My_UniCodeArrayToString(Content: PChar; Size: Integer): string;
function ConvertMsgID(Msg_ID: PChar):string;
function CMPP2_GetLSH(): LongWord;
function CMPP2_CONNECT():boolean;
function CMPP2_TERMINATE():boolean;
function CMPP2_SUBMIT(ACMPP_SUBMIT:TCMPP_SUBMIT;SubmitID:String):boolean;
function CMPP2_DELIVER():boolean;
function CMPP2_ACTIVE_TEST():boolean;
function GetLocalIP() : String;
procedure Button_StartClick(Sender: TObject);
procedure Button_ShutClick(Sender: TObject);
procedure CMPP2SocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure CMPP2SocketConnecting(Sender: TObject;
Socket: TCustomWinSocket);
procedure CMPP2SocketDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure CMPP2SocketError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure CMPP2SocketRead(Sender: TObject; Socket: TCustomWinSocket);
procedure SpeedButton3Click(Sender: TObject);
procedure CheckTimerTimer(Sender: TObject);
procedure InfoMemoChange(Sender: TObject);
procedure LoopTimerTimer(Sender: TObject);
procedure ADOConnAfterConnect(Sender: TObject);
procedure ADOConnAfterDisconnect(Sender: TObject);
procedure ADOConnBeforeConnect(Sender: TObject);
procedure ADOConnBeforeDisconnect(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ApplicationEvents_XException(Sender: TObject; E: Exception);
procedure Timer_CheckNetTimer(Sender: TObject);
private
{ Private declarations }
BadWordList:TStringList;
My_Sequence_Number : LongWord;
My_DelayCount,My_MaxRecCount , My_ClearInfoLineCount : integer;
My_SPCode , My_SPCorpID, My_Passwd , My_CanWriteLog ,My_CanPackBadWord: String;
My_LoginFlag :boolean;
My_ReceiveCount,My_SendCount : integer;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
uses SubmitRespErrorProcUnit;
{$R *.dfm}
function TMainForm.GetLocalIP() : String;
var
HostEnt: PHostEnt;
Ip: string;
addr: pchar;
Buffer: array [0..63] of char;
GInitData: TWSADATA;
begin
try
WSAStartup(2, GInitData);
GetHostName(Buffer, SizeOf(Buffer));
HostEnt := GetHostByName(buffer);
if HostEnt = nil then Exit;
addr := HostEnt^.h_addr_list^;
ip := Format('%d.%d.%d.%d', [byte(addr [0]),
byte (addr [1]), byte (addr [2]), byte (addr [3])]);
Result := Ip;
finally
WSACleanup;
end;
end;
procedure TMainForm.My_SpStringToList(List: TStrings; const W: WideString;ICount:integer);
var
V: string;
P: PWideChar;
begin
List.Clear;
V := '';
P := Pointer(W);
while True do
begin
case P^ of
#0: break;
else
V := V + P^;
if Length(V) >= ICount then
begin
List.Add(V);
V := '';
end;
end;
Inc(P);
end;
if V <> '' then
List.Add(V);
end;
procedure TMainForm.My_StrCopy(const Src: string; Dest: PChar; MaxSize: Integer);
var
I, Len: Integer;
begin
FillChar(Dest^, MaxSize, 0);
Len := Length(Src) - 1;
if Len > MaxSize then
Len := MaxSize;
for I := 0 to Len do
Dest[I] := Src[I + 1];
end;
procedure TMainForm.WriteActiveLog(SLines:String);
var
StrLogFile :String;
tmpDate :TDateTime;
TxtFile: TextFile;
begin
tmpDate := Now;
if not SysUtils.DirectoryExists(ExtractFilePath(Application.ExeName) + 'Log\') then
begin
Mkdir(PChar(ExtractFilePath(Application.ExeName) + 'Log\'));
end;
StrLogFile := IntToStr(YearOf(tmpDate)) + IntToStr(MonthOf(tmpDate)) + IntToStr(DayOf(tmpDate)) + '.txt';
StrLogFile := ExtractFilePath(Application.ExeName) + 'Log\' + StrLogFile;
AssignFile(TxtFile,StrLogFile);
if FileExists(StrLogFile) then Append(TxtFile)
else Rewrite(TxtFile);
Writeln(TxtFile,SLines);
CloseFile(TxtFile);
end;
procedure TMainForm.My_WriteInfo(Str:String);
var
StrMKLine :String;
begin
StrMKLine := 'CMPP20->A ' + format('%-20.20s',[DateTimeToStr(Now)]) + Str;
self.InfoMemo.Lines.Add(StrMKLine);
if My_CanWriteLog = '1' then
begin
self.WriteActiveLog(StrMKLine);
end;
end;
function TMainForm.My_UniCodeArrayToString(Content: PChar; Size: Integer): string;
var
R: PWord;
P: PByteArray;
W: WideString;
Offset: Integer;
begin
P := PByteArray(Content);
Size := Size div 2;
SetLength(W, Size);
Offset := 0;
R := PWord(W);
while Size > 0 do
begin
R^ := P^[Offset] * 256 + P^[Offset + 1];
Inc(R);
Dec(Size);
Inc(Offset, 2);
end;
Result := W;
end;
function TMainForm.My_UCS2toGB( P : Pointer; Size : Integer = 70 ):String;
Var
PP : PByte;
I : Integer;
ByteA : Byte;
ByteB : Byte;
P1 : PByte;
P2 : PByte;
Pw : PWideChar;
// s:string;
Begin
PP := PByte( P );
I := 0;
While ( I < Size ) Do
Begin
P1 := PP;
ByteA := PP^;
Inc( PP );
P2 := PP;
ByteB := PP^;
Inc( PP );
P1^ := ByteB;
P2^ := ByteA;
Inc( I );
End;
Pw := PWidechar( P );
Result:=Pw;
end;
function TMainForm.CMPP2_CONNECT():boolean;
type
TPK_CONNECT = packed record
Head: TCMPP_HEAD;
Body: TCMPP_CONNECT;
end;
var
PK_CONNECT : TPK_CONNECT;
Md5_Digest : MD5Digest;
MD5_Context : MD5Context;
StrTimeStamp,StrLine : String;
Md5_InputStr : array[0..35] of char;
Int4TimeStamp : LongWord;
Md5_InputLen : integer;
begin
FillChar(PK_CONNECT,SizeOf(PK_CONNECT),0);
FillChar(Md5_InputStr,SizeOf(Md5_InputStr),0);
DateTimeToString(StrTimeStamp,'MMDDHHMMSS',Now());
Int4TimeStamp := WinSock.htonl(StrToInt(StrTimeStamp));
StrLine := self.My_SPCorpID + StringOfChar(#0, 9) + self.My_Passwd + StrTimeStamp;
Move(StrLine[1], Md5_InputStr[0], Length(StrLine));
Md5_InputLen := Length(self.My_SPCorpID) + 9 + Length(self.My_Passwd) + 10;
MD5Init( MD5_Context );
MD5Update( MD5_Context, Md5_InputStr, Md5_InputLen );
MD5Final( MD5_Context, Md5_Digest );
PK_CONNECT.Head.Total_Length := WinSock.htonl(SizeOf(PK_CONNECT));
PK_CONNECT.Head.Command_ID := WinSock.htonl(CMPP_Protocol2.CMPP_CONNECT);
PK_CONNECT.Head.Sequence_ID := WinSock.htonl(self.CMPP2_GetLSH);
StrPCopy(PK_CONNECT.Body.Source_Addr,self.My_SPCorpID);
Move(Md5_Digest[0],PK_CONNECT.Body.AuthenticatorSource[0],SizeOf(PK_CONNECT.Body.AuthenticatorSource));
PK_CONNECT.Body.Version := CMPP_Protocol2.CMPP_Version;
PK_CONNECT.Body.Timestamp := Int4TimeStamp;
if not self.CMPP2Socket.Active then
begin
Result := false;
Exit;
end;
try
if self.CMPP2Socket.Socket.SendBuf(PK_CONNECT,SizeOf(PK_CONNECT)) = SizeOf(PK_CONNECT) then
begin
self.My_WriteInfo('正在登陆网关,请稍候...');
Result := true;
end else
begin
self.My_WriteInfo('登陆网关失败.!');
Result := false;
end;
except
Result := false;
end;
end;
function TMainForm.CMPP2_TERMINATE():boolean;
type
TPK_TERMINATE = packed record
Head: TCMPP_HEAD;
Body: TCMPP_TERMINATE;
end;
var
PK_TERMINATE : TPK_TERMINATE;
begin
FillChar(PK_TERMINATE,SizeOf(PK_TERMINATE),0);
PK_TERMINATE.Head.Total_Length := WinSock.htonl(SizeOf(PK_TERMINATE));
PK_TERMINATE.Head.Command_ID := WinSock.htonl(CMPP_Protocol2.CMPP_TERMINATE);
PK_TERMINATE.Head.Sequence_ID := WinSock.htonl(self.CMPP2_GetLSH());
if not self.CMPP2Socket.Active then
begin
Result := false;
Exit;
end;
try
if self.CMPP2Socket.Socket.SendBuf(PK_TERMINATE,SizeOf(PK_TERMINATE)) = SizeOf(PK_TERMINATE) then
begin
self.My_WriteInfo('正在退出网关,请稍候...');
Result := true;
end else
begin
self.My_WriteInfo('退出网关失败.!');
Result := false;
end;
except
Result := false;
end;
end;
function TMainForm.My_GetBuf(Packet: TMemoryStream;ASavePath:String): string;
var
P: PByteArray;
I: Integer;
SL :TStringList;
begin
Result := '';
P := Packet.Memory;
for I := 0 to Packet.Size - 1 do
Result := Result + Format('%.2x ', [P^[I]]);
if trim(ASavePath) <> '' then
begin
try
SL := TStringList.Create;
SL.Text := Result ;
SL.SaveToFile(ASavePath);
finally
FreeAndNil(SL);
end;
end;
end;
function TMainForm.CMPP2_SUBMIT(ACMPP_SUBMIT:TCMPP_SUBMIT;SubmitID:String):boolean;
var
PK_Head : TCMPP_HEAD;
MemStream :TMemoryStream;
TMPSequence_ID : LongWord;
begin
FillChar(PK_Head,SizeOf(PK_Head),0);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -