main.pas

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

  begin
    submit.WaitForSubmitRep := WAITTING;
    submit.WaitTime := SUBMITTIMER * 1000;  //超时时间 缺省30s
  end;
end;

procedure TMainForm.EnquireLink(Socket: TCustomWinSocket);
var
  Packet: TEMPPPacket;
  Data: string;
begin
  FillMemory(@Packet, SizeOf(Packet), 0);
  Packet.header.command_id := EMPP_ACTIVE_TEST;
  Packet.header.command_len := 0;
  Packet.header.sequence_no := GetSeqNo;
  Data := EncodeEMPP(Packet);
  if Data <> '' then
    SendText(Socket, Data);
end;

procedure TMainForm.CheckLink;
var
  Buf: PEMPPProtocolBuf;
begin
  Buf := @TEMPPClientWinSocket(FSocket).FBuf;
  if (Buf.State = emppDisconnect) then
  begin
    ConnectSocket;
  end
  else if (Buf.State = emppBound) then
    EnquireLink(FSocket);
end;

procedure TMainForm.ConnectSocket;
begin
  try
    FSocket.Close;
    FSocket.Open('', FServerAddress, '', StrToInt(FServerPort), False);
  except
    on E: Exception do
    begin
      FreeSocket;
      CreateSocket;
      Trace(E.Message);
    end;
  end;
end;

procedure TMainForm.ReadQueueHead;
begin
  Seek(FQueue, 0);
  BlockRead(FQueue, FQueueHead, SizeOf(FQueueHead));
end;

procedure TMainForm.WriteQueueHead;
begin
  Seek(FQueue, 0);
  BlockWrite(FQueue, FQueueHead, SizeOf(FQueueHead));
end;

procedure TMainForm.CheckQueueValid;
  procedure ResetQueue;
  var
    i: Integer;
    Temp: TEMPPPacket;
  begin
    Seek(FQueue, 0);
    Truncate(FQueue);
    FillMemory(@Temp, SizeOf(Temp), 0);
    FQueueHead.ReadPos := 0;
    FQueueHead.ReadCountMod2 := 0;
    FQueueHead.WritePos := 0;
    FQueueHead.WriteCountMod2 := 0;
    WriteQueueHead;
    for i := 0 to FQueueSize - 1 do
      BlockWrite(FQueue, Temp, SizeOf(Temp));
  end;
begin
  if (not FQueueHead.ReadCountMod2 in [0..1]) or
     (not FQueueHead.WriteCountMod2 in [0..1]) then
  begin
    ResetQueue;
    Exit;
  end;
  if FileSize(FQueue) <> (SizeOf(FQueueHead) + SizeOf(TEMPPPacket) * FQueueSize) then
  begin
    ResetQueue;
    Exit;
  end;
  if (FQueueHead.WritePos < 0) or (FQueueHead.WritePos >= FQueueSize) then
  begin
    ResetQueue;
    Exit;
  end;
  if (FQueueHead.ReadPos < 0) or (FQueueHead.ReadPos >= FQueueSize) then
  begin
    ResetQueue;
    Exit;
  end;
  if FQueueHead.ReadCountMod2 = FQueueHead.WriteCountMod2 then
  begin
    if (FQueueHead.WritePos < FQueueHead.ReadPos) then
    begin
      ResetQueue;
      Exit;
    end;
  end else
  begin
    if (FQueueHead.WritePos > FQueueHead.ReadPos) then
    begin
      ResetQueue;
      Exit;
    end;
  end;
end;

procedure TMainForm.PutToQueue(const packet: TEMPPPacket);
begin
  with FQueuehead do
  begin
    if (WriteCountMod2 = ReadCountMod2) or (WritePos < ReadPos) then
    begin
      Seek(FQueue, SizeOf(TQueueHead) + SizeOf(TEMPPPacket) * WritePos);
      BlockWrite(FQueue, packet, SizeOf(TEMPPPacket));
      Inc(WritePos);
    end;
    if (WriteCountMod2 = ReadCountMod2) then
      WriteCountMod2 := (WriteCountMod2 + (WritePos div FQueueSize)) mod 2;
    WritePos := WritePos mod FQueueSize;
    WriteQueueHead;
  end;
end;

function TMainForm.GetFromQueue(var packet: TEMPPPacket): Boolean;
begin
  Result := False;
  with FQueuehead do
  begin
    if (WriteCountMod2 <> ReadCountMod2) or (ReadPos < WritePos) then
    begin
      Seek(FQueue, SizeOf(TQueueHead) + SizeOf(TEMPPPacket) * ReadPos);
      BlockRead(FQueue, packet, SizeOf(TEMPPPacket));
      Inc(ReadPos);
    end else
      Exit;
    if (WriteCountMod2 <> ReadCountMod2) then
      ReadCountMod2 := (ReadCountMod2 + (ReadPos div FQueueSize)) mod 2;
    ReadPos := ReadPos mod FQueueSize;
    WriteQueueHead;
    Result := True;
  end;
end;

procedure TMainForm.InitQueue;
begin
  try
    try
      AssignFile(FQueue, ExtractFilePath(Application.ExeName) + 'queue.dat');
      if FileExists(ExtractFilePath(Application.ExeName) + 'queue.dat') then
        Reset(FQueue, 1)
      else
        Rewrite(FQueue, 1);
      ReadQueueHead;
      WriteQueueHead;
    except
    end;  
  finally
    CheckQueueValid;
  end;
end;

procedure TMainForm.ReadSettings;
const
  SMGWSECTION = '短信服务器';
  SYSTEMSECTION = '系统';
var
  Ini: TIniFile;
  i, Days, Hours, Minutes: Integer;
begin
  Ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'smsclient.ini');
  try
    FServerAddress := Ini.ReadString(SMGWSECTION, 'ip', '211.91.132.193');
    FServerPort := Ini.ReadString(SMGWSECTION, 'Port', '3000');
    FClientID := Ini.ReadString(SMGWSECTION, 'User','');
    FSharedSecret := Ini.ReadString(SMGWSECTION, 'Pswd', '');
    FQueueSize := Ini.ReadInteger(SYSTEMSECTION, 'QueueSize', 20000);
    FValidSendStartTime := Ini.ReadTime(SYSTEMSECTION, 'validsendstarttime', EncodeTime(9, 0, 0, 0));
    FValidSendEndTime := Ini.ReadTime(SYSTEMSECTION, 'validsendendtime', EncodeTime(21, 0, 0, 0));
    SetLength(FSubmitBuf, EMPPWINDOWSIZE);
    for i := 0 to EMPPWINDOWSIZE - 1 do
    begin
      FSubmitBuf[i].WaitForSubmitRep := DONE;
      FSubmitBuf[i].WaitTime := 0;
    end;

    Edit1.Text := FServerAddress;
    Edit2.Text := FServerPort;
    Edit3.Text := FClientID;
    Edit4.Text := FSharedSecret;
    DateTimePicker1.DateTime := FValidSendStartTime;
    DateTimePicker2.DateTime := FValidSendEndTime;
  finally
    Ini.Free;
  end;
end;

procedure TMainForm.WriteSettings;
const
  SMGWSECTION = '短信服务器';
  SYSTEMSECTION = '系统';
var
  Ini: TIniFile;
  i, Days, Hours, Minutes: Integer;
begin
  Ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'smsclient.ini');
  try
    Ini.WriteString(SMGWSECTION, 'ip', FServerAddress);
    Ini.WriteString(SMGWSECTION, 'Port', FServerPort);
    Ini.WriteString(SMGWSECTION, 'User', FClientID);
    Ini.WriteString(SMGWSECTION, 'Pswd', FSharedSecret);
    Ini.WriteInteger(SYSTEMSECTION, 'QueueSize', FQueueSize);
    Ini.WriteTime(SYSTEMSECTION, 'validsendstarttime', FValidSendStartTime);
    Ini.WriteTime(SYSTEMSECTION, 'validsendendtime', FValidSendEndTime);
  finally
    Ini.Free;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  Application.OnException := HandleException;
  Font.Handle := GetStockObject(DEFAULT_GUI_FONT);
  PageControl1.ActivePageIndex := 0;
  UpdateNavigateGUI;
  ReadSettings;  
  InitQueue;
  CreateSocket;
  ConnectSocket;
end;

procedure TMainForm.HandleException(Sender: TObject; E: Exception);
begin
  Trace('程序发生错误:' + E.Message)
end;

procedure TMainForm.Action2Execute(Sender: TObject);
begin
  PageControl1.ActivePageIndex := PageControl1.ActivePageIndex + 1;
  UpdateNavigateGUI;
  if PageControl1.ActivePageIndex = 2 then
    SendSMSPreview;
end;

procedure TMainForm.Action1Update(Sender: TObject);
begin
  TAction(Sender).Enabled := PageControl1.ActivePageIndex <> 0;
end;

procedure TMainForm.Action2Update(Sender: TObject);
begin
  TAction(Sender).Enabled := PageControl1.ActivePageIndex <> PageControl1.PageCount - 1;
end;

procedure TMainForm.Action3Update(Sender: TObject);
begin
  TAction(Sender).Enabled := PageControl1.ActivePageIndex = PageControl1.PageCount - 1;
end;

procedure TMainForm.Action1Execute(Sender: TObject);
begin
  PageControl1.ActivePageIndex := PageControl1.ActivePageIndex - 1;
  UpdateNavigateGUI;
end;

procedure TMainForm.Action3Execute(Sender: TObject);
var
  I: Integer;
  Mobile: string;
begin
  for I := 0 to NumberMemo.Lines.Count - 1 do
  begin
    Mobile := Trim(NumberMemo.Lines[I]);
    if Mobile = '' then Continue;
    SendSMS(Mobile, HandleSMS);
  end;
  PageControl1.ActivePageIndex := 0;
  UpdateNavigateGUI;
end;

procedure TMainForm.UpdateNavigateGUI;
var
  I: Integer;
begin
  PageControl1.Pages[PageControl1.ActivePageIndex].TabVisible := True;
  for I := 0 to PageControl1.PageCount - 1 do
    if I <> PageControl1.ActivePageIndex then
      PageControl1.Pages[I].TabVisible := False;
end;

procedure TMainForm.UpdateLinkStatus;
begin
  StatusBar.Panels[2].Text := EMPPStateStr[FSocket.FBuf.State];
end;

procedure TMainForm.UpdateAccountBalance(AccountBalance: Integer);
begin
  StatusBar.Panels[1].Text := '帐户余额:' + IntToStr(AccountBalance);
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  FreeSocket;
end;

procedure TMainForm.TimerTimer(Sender: TObject);
var
  UnSend: Integer;
  i: Integer;
begin
  if (FQueuehead.WriteCountMod2 = FQueuehead.ReadCountMod2) then
    UnSend := FQueuehead.WritePos - FQueuehead.ReadPos
  else
    UnSend := FQueueSize + FQueuehead.WritePos - FQueuehead.ReadPos;
  StatusBar.Panels[0].Text := '待发送: ' + IntToStr(UnSend);
  for i := 0 to EMPPWINDOWSIZE - 1 do
  begin
    if FSubmitBuf[i].WaitForSubmitRep = WAITTING then
    begin
      Dec(FSubmitBuf[i].WaitTime, Timer.Interval);
      if FSubmitBuf[i].WaitTime <= 0 then //发送消息超时
      begin
        FSubmitBuf[i].WaitForSubmitRep := RETRY;  // 超时重发
        SubmitAJob(FSubmitBuf[i]);
      end;
    end else if FSubmitBuf[i].WaitForSubmitRep = RETRY then
    begin
      Dec(FSubmitBuf[i].WaitTime, Timer.Interval);
      if FSubmitBuf[i].WaitTime <= 0 then //等待消息流量限制去掉
      begin
        SubmitAJob(FSubmitBuf[i]);
      end;
    end else
      SubmitAJob(FSubmitBuf[i]);
  end;

  Dec(FCheckLinkInterval);
  if FCheckLinkInterval <= 0 then  //10 s 检查连接
  begin
    FCheckLinkInterval := 10;
    CheckLink();
  end;
end;


procedure TMainForm.Action4Execute(Sender: TObject);
begin
  FServerAddress := Edit1.Text;
  FServerPort := Edit2.Text;
  FClientID := Edit3.Text;
  FSharedSecret := Edit4.Text;
  FValidSendStartTime := DateTimePicker1.DateTime;
  FValidSendEndTime := DateTimePicker2.DateTime;
  WriteSettings;  
end;

procedure TMainForm.Action4Update(Sender: TObject);
begin
  TAction(Sender).Enabled := (Edit1.Text <> FServerAddress) or
    (Edit2.Text <> FServerPort) or
    (Edit3.Text <> FClientID) or
    (Edit4.Text <> FSharedSecret) or
    (DateTimePicker1.DateTime <> FValidSendStartTime) or
    (DateTimePicker2.DateTime <> FValidSendEndTime);
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
  if OpenDialog.Execute then
  begin
    NumberMemo.Lines.LoadFromFile(OpenDialog.FileName);
  end;
end;

procedure TMainForm.SMSMemoChange(Sender: TObject);
begin
  SMSCount.Caption := IntToStr(Length(StrToUcs2(HandleSMS)) div 2);
end;

function TMainForm.HandleSMS: string;
const
  FLAG1STR = '!,.?:;"`~$#^&*|';
  FLAG2STR = '0123456789';
  FLAG3STR = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  S: string;
  I: Integer;
begin
  Result := '';
  S := SMSMemo.Lines.Text;
  I := 1;
  while I <= Length(S) do
  begin
    if (S[I] = '%') and (I < Length(S)) then
    begin
      case S[I + 1] of
        'f': begin Result := Result + FLAG1STR[Random(Length(FLAG1STR)) + 1]; I := I + 1; end;
        'd': begin Result := Result + FLAG2STR[Random(Length(FLAG2STR)) + 1]; I := I + 1; end;
        's': begin Result := Result + FLAG3STR[Random(Length(FLAG3STR)) + 1]; I := I + 1; end;
      else
        Result := Result + S[I];
      end;
    end else
      Result := Result + S[I];
    I := I + 1;
  end;
end;

procedure TMainForm.ToolButton1Click(Sender: TObject);
begin
  SMSMemo.SetSelTextBuf(PChar('%f'));
end;

procedure TMainForm.ToolButton2Click(Sender: TObject);
begin
  SMSMemo.SetSelTextBuf(PChar('%d'));
end;

procedure TMainForm.ToolButton3Click(Sender: TObject);
begin
  SMSMemo.SetSelTextBuf(PChar('%s'));
end;

procedure TMainForm.ToolButton5Click(Sender: TObject);
begin
  SMSPrivewMemo.Lines.Text := HandleSMS;
end;

procedure TMainForm.SendSMSPreview;
const
  PREVIEWCNT = 20;
var
  I: Integer;
begin
  PreviewMemo.Lines.Clear;
  for I := 0 to Min(PREVIEWCNT, NumberMemo.Lines.Count - 1) do
  begin
    PreviewMemo.Lines.Append(Format('%-20s%s', [Trim(NumberMemo.Lines[I]), HandleSMS]));
  end;
  if PREVIEWCNT < NumberMemo.Lines.Count - 1 then
    PreviewMemo.Lines.Append('更多消息省略...');
end;

procedure TMainForm.SendSMS(Mobile: string; Msg: string);
var
  Submit: TEMPPPacket;
  AString: string;
begin
  FillMemory(@Submit, SizeOf(Submit), 0);
  Submit.header.command_id := EMPP_SUBMIT;
  Submit.header.command_len := 0;
  Submit.header.sequence_no := GetSeqNo;

  Str2Array(Mobile, Submit.Submit.dest_addr);
  AString := StrToUcs2(Msg);
  Str2Array(AString, Submit.Submit.sm);
  Submit.Submit.sm_length := Length(AString);
  PutToQueue(Submit);
  SubmitAJob();
end;


end.