deliverunit.pas

联通短信平台,1,3版稳定版400条/s

{*******************************************************************************
功能简述 : 中国联通短信接收端


其它说明 :  1. 参考中国联合通信公司短消息网关系统接口协议(SGIP1.3)
            2. 参考Short Message Peer-to-Peer Protocol Specification Version 5.0-Draft09
            3. GSM 03.38 version 7.2.0 Release 1998


********************************************************************************}

unit DeliverUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, Buttons, DB, ADODB,IniFiles,ScktComp,
  DateUtils,MD5,WinSock,AppEvnts,SGIP12_Protocol;

type
  TDeliverForm = class(TForm)
    InfoMemo: TMemo;
    Panel1: TPanel;
    MainStatusBar: TStatusBar;
    Button_Start: TSpeedButton;
    Button_Shut: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Panel_Line: TPanel;
    ADOConn: TADOConnection;
    SpeedButton4: TSpeedButton;
    ApplicationEvents_X: TApplicationEvents;
    SGIPServerSocket: TServerSocket;
    procedure FormCreate(Sender: TObject);
    procedure SpStringToList(List: TStrings; const W: WideString;ICount:integer);
    procedure StrCopy(const Src: string; Dest: PChar; MaxSize: Integer);
    procedure WriteInfo(Str:String);
    procedure WriteActiveLog(SLines:String);
    function OpenSocket():boolean;
    function GetBuf(Packet: TMemoryStream;ASavePath:String): String;
    procedure CloseSocket();
    function  GetIniConfigFile():String;
    function  ConnectToDB():boolean;
    function  PackBadWord(Msg:String):String;
    procedure DelayTime();
    procedure LoadParameters();
    function  UCS2toGB( P : Pointer;  Size : Integer = 70 ):String;
    function  UniCodeArrayToString(Content: PChar; Size: Integer): string;
    function  ConvertMsgID(Msg_ID: PChar):string;
    function  SGIP12_GetLSH(): LongWord;
    procedure Button_StartClick(Sender: TObject);
    procedure Button_ShutClick(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure InfoMemoChange(Sender: TObject);
    procedure ADOConnAfterConnect(Sender: TObject);
    procedure ADOConnAfterDisconnect(Sender: TObject);
    procedure ADOConnBeforeConnect(Sender: TObject);
    procedure ADOConnBeforeDisconnect(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ApplicationEvents_XException(Sender: TObject; E: Exception);
    procedure SGIPServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure SGIPServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SGIPServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SGIPServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SGIPServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SpeedButton4Click(Sender: TObject);
  private
    { Private declarations }
     BadWordList:TStringList;
     F_Sequence_Number : LongWord;

     F_SPCode,F_SPCorpID,F_User,F_Passwd,F_NodId,F_BaseFetchFlag :String;
     F_DelayTime,F_MaxRecCount : Integer;
     F_ClearInfoLineCount,F_CanWriteLog,F_CanPackBadWord,F_DeliverCount,F_ReportCount : integer;
  public
    { Public declarations }
  end;

var
  DeliverForm: TDeliverForm;

implementation

uses ReceiveThreadUnit;

{$R *.dfm}
procedure TDeliverForm.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 TDeliverForm.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 TDeliverForm.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)) + '.R.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 TDeliverForm.WriteInfo(Str:String);
var
  StrMKLine :String;
begin
  StrMKLine := 'SGIP1.3-> ' + format('%-20.20s',[DateTimeToStr(Now)]) + Str;
  self.InfoMemo.Lines.Add(StrMKLine);
  if F_CanWriteLog = 1 then
  begin
    self.WriteActiveLog(StrMKLine);
  end;
end;

function TDeliverForm.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 TDeliverForm.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 TDeliverForm.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 TDeliverForm.SGIP12_GetLSH(): LongWord;
begin
  if ( F_Sequence_Number < 1 ) or ( F_Sequence_Number > 4294967295 ) then
  begin
    F_Sequence_Number := 2;
  end;
  Result := F_Sequence_Number;
  inc( F_Sequence_Number );
end;

function TDeliverForm.OpenSocket():boolean;
var
  IniFile : TIniFile;
  TmpTime : TDateTime;
begin
  try
    try
      self.SGIPServerSocket.Close;
      IniFile := TIniFile.Create(self.GetIniConfigFile);
      self.SGIPServerSocket.Port := IniFile.ReadInteger('Option','ServerPORT',8001);
      self.SGIPServerSocket.Open;

      TmpTime := Now( );
      while true do
      begin
        Application.ProcessMessages;
        if SGIPServerSocket.Active then  break;
        if ( Now - TmpTime ) > 5 / 86400 then  break;        
      end;

      self.WriteInfo('SOCKET环境初使化成功...');
      Result := true;
    except
      self.WriteInfo('SOCKET连接失败，请检查网络及配置文件!');
      Result := false;
    end;
  finally
    FreeAndNil(IniFile);
  end;
end;

procedure TDeliverForm.CloseSocket();
begin
  try
    self.SGIPServerSocket.Close;
    self.WriteInfo('服务器断开连接成功.');
  except
    self.WriteInfo('服务器断开连接失败.');
  end;
end;

procedure TDeliverForm.LoadParameters();
var
  IniFile : TIniFile;
begin
  try
    IniFile := TIniFile.Create(self.GetIniConfigFile);

    F_DelayTime := iniFile.ReadInteger('Option','DelayTime',20);
    F_SPCode := trim(iniFile.ReadString('Option','SPCode',''));
    F_NodId := trim(iniFile.ReadString('Option','NodId',''));
    F_SPCorpID := trim(iniFile.ReadString('Option','SPCorpID',''));
    F_User := trim(iniFile.ReadString('Option','User',''));
    F_Passwd := trim(iniFile.ReadString('Option','Passwd',''));
    F_MaxRecCount := iniFile.ReadInteger('Option','MaxRecCount',500);
    F_BaseFetchFlag := iniFile.ReadString('Option','BaseFetchFlag','1');
    F_ClearInfoLineCount := iniFile.ReadInteger('Option','ClearInfoLineCount',1000);
    F_CanWriteLog := iniFile.ReadInteger('Option','CanWriteLog',0);
    F_CanPackBadWord := iniFile.ReadInteger('Option','CanPackBadWord',0);
  finally
    FreeAndNil(IniFile);
  end;

  if self.F_CanPackBadWord = 1 then
  begin
    BadWordList.Clear;
    BadWordList.LoadFromFile(ExtractFilePath(Application.ExeName)+'BadWord.DB');
  end;

end;

procedure TDeliverForm.DelayTime();
var
  IStart:LongInt;
begin
  IStart := GetTickCount();
  while ((LongInt(GetTickCount()) - IStart) <= self.F_DelayTime) do
  begin
    Application.ProcessMessages;  //100为毫秒