main.pas

传圣(测试版)说明 本软件适用于装有IP/TCP协议的电脑. 主要功能:电脑间传送大型文件.(如电影等) 主要特点: 1.采用了多线程技术,速度明显高于同类软件. 2.支持多文件同时传送.

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, StdCtrls, ActnList, ScktComp, WinSock, IniFiles, MD5, emppdef,
  Utils, ExtCtrls, ToolWin, Math, ComCtrls;
const
  EMPPWINDOWSIZE = 5;
  MSGQFULTIMER   = 1;
  SUBMITTIMER    = 120;
type
  TSubmitStat = (DONE, WAITTING, RETRY);

  TSubmitData = record
    WaitForSubmitRep: TSubmitStat;
    WaitTime: Integer;
    Submit: TEMPPPacket;
  end;

  PEMPPProtocolBuf = ^TEMPPProtocolBuf;
  TEMPPProtocolBuf = packed record
    RcvBuf: array [0..EMPPHeadLength + EMPPMaxPacketLength - 1] of Char;
    RcvBufMemory: PChar;
    BufPos: Integer;
    RequireBytes: Integer;
    HeadComplete: Boolean;
    LastTick: DWord;
    State: TEMPPState;
  end;

  TEMPPClientWinSocket = class(TClientWinSocket)
  private
    FBuf: TEMPPProtocolBuf;
    FSession: string;
  end;

  TQueueHead = record
    SeqNo: DWord;
    ReadPos: Integer;
    ReadCountMod2: Integer;
    WritePos: Integer;
    WriteCountMod2: Integer;
  end;

  TMainForm = class(TForm)
    PageControl: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    SaveButton: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    StatusBar: TStatusBar;
    Label5: TLabel;
    Label6: TLabel;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    PageControl1: TPageControl;
    TabSheet4: TTabSheet;
    TabSheet5: TTabSheet;
    TabSheet6: TTabSheet;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    ActionList1: TActionList;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    SMSMemo: TMemo;
    Timer: TTimer;
    Action4: TAction;
    OpenDialog: TOpenDialog;
    NumberMemo: TMemo;
    Label7: TLabel;
    Button4: TButton;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    SMSPrivewMemo: TMemo;
    Label8: TLabel;
    SMSCount: TLabel;
    Label9: TLabel;
    PreviewMemo: TMemo;
    Memo1: TMemo;
    TabSheet7: TTabSheet;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure Action2Execute(Sender: TObject);
    procedure Action1Update(Sender: TObject);
    procedure Action2Update(Sender: TObject);
    procedure Action3Update(Sender: TObject);
    procedure Action1Execute(Sender: TObject);
    procedure Action3Execute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
    procedure Action4Execute(Sender: TObject);
    procedure Action4Update(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SMSMemoChange(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure ToolButton2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
  private
    { Private declarations }
    FCheckLinkInterval: Integer;
    FQueueSize: Integer;
    FQueue: File;
    FQueueHead: TQueueHead;
    FSocket: TEMPPClientWinSocket;
    FServerAddress: string;
    FServerPort: string;
    FClientID: string;
    FSharedSecret: string;
    FValidSendStartTime: TDateTime;
    FValidSendEndTime: TDateTime;
    FSubmitBuf: array of TSubmitData;
  protected
    procedure ReadSettings;
    procedure WriteSettings;    
    procedure InitQueue;
    procedure HandleException(Sender: TObject; E: Exception);
    procedure CreateSocket;
    procedure FreeSocket;
    procedure ConnectSocket;
    procedure ResetState(var Buf: TEMPPProtocolBuf);
    function  SendText(Socket: TCustomWinSocket; Data: string): Boolean;
    function  GetSeqNo: DWord;
    procedure SocketErrorEvent(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure SocketEventEvent(Sender: TObject; Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
    function  BindSMGW(Socket: TCustomWinSocket): Boolean;
    procedure SocketRead(Socket: TCustomWinSocket);
    procedure EnquireLink(Socket: TCustomWinSocket);
    procedure CheckLink;
    procedure ReadQueueHead;
    procedure WriteQueueHead;
    procedure CheckQueueValid;

    procedure SendSMS(Mobile: string; Msg: string);

    procedure PutToQueue(const packet: TEMPPPacket);
    function  GetFromQueue(var packet: TEMPPPacket): Boolean;
    procedure SubmitAJob; overload;
    procedure SubmitAJob(var submit: TSubmitData); overload;

    procedure UpdateNavigateGUI;
    procedure UpdateLinkStatus;
    procedure UpdateAccountBalance(AccountBalance: Integer);
    function HandleSMS: string;
    procedure SendSMSPreview;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}
procedure Trace(Msg: string);
begin
  if MainForm.Memo2.Lines.Count > 200 then
    MainForm.Memo2.Lines.Clear;
  MainForm.Memo2.Lines.Append(Msg);  
end;

procedure TMainForm.CreateSocket;
begin
  FSocket := TEMPPClientWinSocket.Create(INVALID_SOCKET);
  FSocket.OnSocketEvent := SocketEventEvent;
  FSocket.OnErrorEvent := SocketErrorEvent;
  FSocket.FBuf.State := emppDisconnect;
  ResetState(FSocket.FBuf);
end;

procedure TMainForm.FreeSocket;
begin
  if Assigned(FSocket) then
  begin
    FSocket.OnSocketEvent := nil;
    FSocket.OnErrorEvent := nil;
    FSocket.Free;
    FSocket := nil;
  end;
end;

procedure TMainForm.ResetState(var Buf: TEMPPProtocolBuf);
begin
  Buf.RequireBytes := EMPPHeadLength;
  Buf.HeadComplete := False;
  Buf.LastTick := GetTickCount;
  Buf.RcvBufMemory := @Buf.RcvBuf[0];
  Buf.BufPos := 0;
end;

function TMainForm.SendText(Socket: TCustomWinSocket;
  Data: string): Boolean;
var
  Sended, i, Len: Integer;
begin
  Sended := 0;
  for i := 0 to 39 do
  begin
    Len := Socket.SendBuf((PChar(Data) + Sended)^, Length(Data) - Sended);
    if Len > 0 then Inc(Sended, Len);
    if Sended >= Length(Data) then
      Break
    else
      Sleep(50);
  end;
  Result := Sended = Length(Data);
end;

function TMainForm.GetSeqNo: DWord;
begin
  Inc(FQueueHead.SeqNo);
  if FQueueHead.SeqNo >= $7FFFFFFF then
    FQueueHead.SeqNo := 1;
  Result := FQueueHead.SeqNo;
  WriteQueueHead;
end;

procedure TMainForm.SocketErrorEvent(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  Socket.Close;
  Trace(Format('Winsocket error, errno:%d', [ErrorCode]));
  ErrorCode := 0;
end;

procedure TMainForm.SocketEventEvent(Sender: TObject;
  Socket: TCustomWinSocket; SocketEvent: TSocketEvent);
var
  Buf: PEMPPProtocolBuf;
begin
  Buf := @TEMPPClientWinSocket(Socket).FBuf;
  case SocketEvent of
    seLookup: Trace('寻找服务器...');
    seConnecting: Trace('正在连接服务器...');
    seConnect:
      begin
        ResetState(Buf^);
        Trace('已连接服务器.');
      end;
    seListen:
      begin
      end;
    seDisconnect:
      begin
        Buf.State := emppDisconnect;
        Buf.LastTick := GetTickCount();
        Trace('已断开服务器!');
        UpdateLinkStatus();
      end;
    seAccept: ;
    seRead:
      begin
        SocketRead(Socket);
      end;
    seWrite:
      begin
        Buf.State := emppConnect;
        UpdateLinkStatus();
        Buf.LastTick := GetTickCount();
      end;
  end;
end;

function TMainForm.BindSMGW(Socket: TCustomWinSocket): Boolean;
var
  Login: TEMPPPacket;
  Data: string;
  AuthenticatorClient: MD5Digest;
begin
  Login.header.command_id := EMPP_CONNECT;
  Login.header.command_len := 0;
  Login.header.sequence_no := GetSeqNo;
  Str2Array(FClientID, Login.connect.src_addr);
  AuthenticatorClient := MD5String(FSharedSecret + TEMPPClientWinSocket(Socket).FSession);
  CopyMemory(@Login.connect.pswdmd5[0], @AuthenticatorClient[0], SizeOf(MD5Digest));
  Data := EncodeEMPP(Login);
  Result := SendText(Socket, Data);
end;

procedure TMainForm.SocketRead(Socket: TCustomWinSocket);
var
  Buf: PEMPPProtocolBuf;
  i: Integer;
var
  RcvLen: Integer;
  Head: TEMPPHeader;
  packet: TEMPPPacket;

  procedure ACTIVE_TEST_RESP;
  var
    Resp: TEMPPPacket;
    RespBuf: string;
  begin
    Resp.header.command_id := EMPP_ACTIVE_TEST_REP;
    Resp.header.sequence_no := packet.header.sequence_no;
    RespBuf := EncodeEMPP(Resp);
    if RespBuf <> '' then
      SendText(Socket, RespBuf);
  end;

  procedure DELIVER_RESP;
  var
    Resp: TEMPPPacket;
    RespBuf: string;
  begin
    Resp.header.command_id := EMPP_DELIVER_REP;
    Resp.header.sequence_no := packet.header.sequence_no;
    RespBuf := EncodeEMPP(Resp);
    if RespBuf <> '' then
      SendText(Socket, RespBuf);
  end;
begin
  Buf := @TEMPPClientWinSocket(Socket).FBuf;
  try
    if (GetTickCount - Buf.LastTick) > EMPPTIMEOUT then
      ResetState(Buf^);
    Buf.LastTick := GetTickCount;
    if not Buf.HeadComplete then
    begin
      RcvLen := Socket.ReceiveBuf((Buf.RcvBufMemory + Buf.BufPos)^, Buf.RequireBytes);
      if RcvLen = -1 then Exit;
      Inc(Buf.BufPos, RcvLen);
      Dec(Buf.RequireBytes, RcvLen);
      if Buf.RequireBytes = 0 then
      begin
        Buf.HeadComplete := True;
        Buf.BufPos := 0;
        CopyMemory(@Head, Buf.RcvBufMemory, EMPPHeadLength);
        Head.command_len := ntohl(Head.command_len);
        Head.command_id := ntohl(Head.command_id);
        Head.sequence_no := ntohl(Head.sequence_no);
        Inc(Buf.BufPos, EMPPHeadLength);
        Buf.RequireBytes := Head.command_len - EMPPHeadLength;
        if CheckEMPPHead(Head) <> 0 then raise Exception.Create('Protocol Head Has Error!');
      end;
    end;
    if Buf.HeadComplete then
    begin
      if Buf.RequireBytes > 0 then
      begin
        RcvLen := Socket.ReceiveBuf((Buf.RcvBufMemory + Buf.BufPos)^, Buf.RequireBytes);
        if RcvLen = -1 then Exit;        
        Inc(Buf.BufPos, RcvLen);
        Dec(Buf.RequireBytes, RcvLen);
      end;
      if Buf.RequireBytes = 0 then
      begin
         ResetState(Buf^);
        if DecodeEMPP(Buf.RcvBuf, packet) then
        begin
          if Buf.State = emppConnect then
          begin
            if (packet.header.command_id = EMPP_SESSION) then
            begin
              TEMPPClientWinSocket(Socket).FSession := StrFromPCharM(@packet.session.id[0], SizeOf(packet.session.id));
              if BindSMGW(FSocket) then
                Buf.State := emppBinding
              else
                FSocket.Close;
            end else
              Socket.Close;
          end else if Buf.State = emppBinding then
          begin
            if (packet.header.command_id = EMPP_CONNECT_REP) and (packet.connectresp.result = 0) then
            begin
              Buf.State := emppBound;
              UpdateAccountBalance(packet.connectresp.balance);
              UpdateLinkStatus();
            end else
              Socket.Close;
          end else if Buf.State = emppBound then
          begin
            if (packet.header.command_id = EMPP_SUBMIT_REP) then
            begin
              UpdateAccountBalance(packet.submitresp.balance);
              for i := 0 to EMPPWINDOWSIZE - 1 do
              begin
                if (packet.header.sequence_no = FSubmitBuf[i].submit.header.sequence_no) then
                begin
                  case packet.SubmitResp.result of
                    0:
                    begin
                      FSubmitBuf[i].WaitForSubmitRep := DONE;
                      SubmitAJob(FSubmitBuf[i]);  //如成功提交，马上发下一条消息
                    end;
                    1,8:
                    begin         //流量控制错,让定时器(2s)重发本条消息
                      FSubmitBuf[i].WaitForSubmitRep := RETRY;
                      FSubmitBuf[i].WaitTime := MSGQFULTIMER * 1000;   //堵得不太厉害，很快能恢复，等待2秒
                    end;
                  else           //如不可纠正错误，告警.检查
                    Trace('服务器拒绝此消息');
                    FSubmitBuf[i].WaitForSubmitRep := DONE;
                    SubmitAJob(FSubmitBuf[i]);
                  end;
                  Break;
                end;
              end;
            end else if (packet.header.command_id = EMPP_DELIVER) then
            begin
              DELIVER_RESP();
              Trace('收到一条短信息!');
              PrintEMPP(packet, Trace);
            end else if (packet.header.command_id = EMPP_TERMINATE_REP) then
            begin
              Buf.State := emppUnBind;
              Socket.Close;
            end else if (packet.header.command_id = EMPP_ACTIVE_TEST) then
            begin
              ACTIVE_TEST_RESP();
            end;
          end else
          begin
            Trace('收到无法解析的数据!');
            Socket.Close;
          end;
        end else
        begin
          Trace('*** 无法分析协议数据***');
        end;
      end;
    end;
  except
    on E: Exception do
    begin
      Trace(E.Message);
      ResetState(Buf^);
    end;
  end;
end;

procedure TMainForm.SubmitAJob;
var
  i: Integer;
begin
  for i := 0 to EMPPWINDOWSIZE - 1 do
    SubmitAJob(FSubmitBuf[i]);
end;

procedure TMainForm.SubmitAJob(var submit: TSubmitData);
var
  Buf: string;
begin
  if (Time() < FValidSendStartTime) or (Time() > FValidSendEndTime) then
    Trace('不在发送时间范围内,等待..');
  if (FSocket.FBuf.State <> emppBound) then
    Exit;
  if submit.WaitForSubmitRep = DONE then
  begin
    if (not GetFromQueue(submit.Submit)) then Exit;
  end
  else if submit.WaitForSubmitRep = WAITTING then
    Exit;
  Buf := EncodeEMPP(submit.Submit);
  if SendText(FSocket, Buf) then