Measure/Encrypt/多用户网络版/Server/CorrespondService.pas

unit CorrespondService;

interface

uses
  ClientInfoService, Classes, IdTCPServer, EncryptService, SysUtils,
  SoftDogService, TypeUnit, Windows;

type
  TThrdsType = (ttTerminate, ttNoDog);

  TScMonitor = class
  private
    FLinkCtrl: TLinkControl;
    FCriticalSection: TRTLCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;

    procedure AddCount(AUser: Integer);
    procedure DeleteCount(AUser: Integer);
    function CanNotify(AUser: Integer): Boolean;
    procedure SetMaxLinks(const AV0Count, AV1Count, AV2Count: Integer);
    procedure InitCount;

    procedure NotifyClientInfo(AClientService: TClientInfoDM;
      AType: TOperType; APointer: Pointer = nil);
    procedure NotifyClientThreads(AClientThrds: TIdPeerThread; AType: TThrdsType);
  end;

  TScCorrespondService = class
  private
    FClientInfoService: TClientInfoDM;
    FIdTcpServer: TIdTcpServer;
    FMonitor: TScMonitor;
    FThrdsList: TThreadList;
    FPersistent: TScPersistent;
    {发送数据加密}
    FEncryptService: TScEncryptService;

    FSofeDog: TScSoftDog;

    function GetPort: Integer;
    procedure SetPort(const Value: Integer);
    procedure InitMethods;
    procedure ClearThrdsInfo;
    procedure AddClientThrdsInfo(AThread: TIdPeerThread; AInfo: PInfoRecd);
    procedure DeleteClientthrdsInfo(AThread: TIdPeerThread);
    procedure DoServerConnect(AThread: TIdPeerThread);
    procedure DoServerExecute(AThread: TIdPeerThread);
    procedure DoServerDisconnect(AThread: TIdPeerThread);
    procedure DoServerException(AThread: TIdPeerThread; AException: Exception);
  public
    constructor Create;
    destructor Destroy; override;

    function Open: Boolean;
    procedure CloseService;
    procedure DeleteClientThrds;
    procedure SetMaxLinks(const AV0Count, AV1Count, AV2Count: Integer);

    property Port: Integer read GetPort write SetPort;
    property SoftDog: TScSoftDog write FSofeDog;
    property ClientInfoService: TClientInfoDM read FClientInfoService write FClientInfoService;
  end;

implementation

{ TScMonitor }

procedure TScMonitor.AddCount(AUser: Integer);
begin
  FLinkCtrl.AddCount(AUser);
end;

function TScMonitor.CanNotify(AUser: Integer): Boolean;
begin
  Result := not FLinkCtrl.CheckIsFull(AUser);
end;

constructor TScMonitor.Create;
begin
  FLinkCtrl := TLinkControl.Create;
  InitializeCriticalSection(FCriticalSection);
end;

procedure TScMonitor.DeleteCount(AUser: Integer);
begin
  FLinkCtrl.DeleteCount(AUser);
end;

destructor TScMonitor.Destroy;
begin
  FLinkCtrl.Free;
  DeleteCriticalSection(FCriticalSection);
  inherited;
end;

procedure TScMonitor.InitCount;
begin
  FLinkCtrl.InitCount;
end;

procedure TScMonitor.NotifyClientInfo(AClientService: TClientInfoDM;
  AType: TOperType; APointer: Pointer);
begin
  EnterCriticalSection(FCriticalSection);
  try
    AClientService.HandlerNotify(AType, APointer);
  finally
    LeaveCriticalSection(FCriticalSection);
  end;
end;

procedure TScMonitor.NotifyClientThreads(AClientThrds: TIdPeerThread;
  AType: TThrdsType);
begin
  if AType = ttTerminate then
  begin
    AClientThrds.Connection.Disconnect;
  end;
end;

procedure TScMonitor.SetMaxLinks(const AV0Count, AV1Count,
  AV2Count: Integer);
begin
  FLinkCtrl.V0MaxLinks := AV0Count;
  FLinkCtrl.V1MaxLinks := AV1Count;
  FLinkCtrl.V2MaxLinks := AV2Count;
end;

{ TScCorrespondService }

procedure TScCorrespondService.CloseService;
{var
  I: Integer;
  thsList: TList;
  sText: string;
  thrds: TIdPeerThread;  }
begin
  if not FIdTcpServer.Active then Exit;
  
{  thsList := FIdTcpServer.Threads.LockList;
  try
    for I := thsList.Count - 1 downto 0 do
    begin
      thrds := TIdPeerThread(thsList.List^[I]);
      sText := FEncryptService.EncryptString('QUITOUT');
      thrds.Connection.WriteLn(sText);
    end;
  finally
    FIdTcpServer.Threads.UnlockList;
  end;      }
  
  FMonitor.InitCount;
  FMonitor.NotifyClientInfo(FClientInfoService, otDelete);
  ClearThrdsInfo;

  FIdTcpServer.Active := False;
end;

constructor TScCorrespondService.Create;
begin
  FIdTcpServer := TIdTCPServer.Create(nil);
  FMonitor := TScMonitor.Create;
  FEncryptService := TScEncryptService.Create;

  FPersistent := TScPersistent.Create;
  FPersistent.ReadPersistentProperty;

  FThrdsList := TThreadList.Create;

  InitMethods;
end;

destructor TScCorrespondService.Destroy;
begin
  CloseService;

  FIdTcpServer.Free;
  FMonitor.Free;
  FEncryptService.Free;

  FPersistent.WritePersistentProperty;
  FPersistent.Free;

  ClearThrdsInfo;
  FThrdsList.Free;
  inherited;
end;

function TScCorrespondService.GetPort: Integer;
begin
  Result := FPersistent.Port;
end;

procedure TScCorrespondService.DoServerConnect(AThread: TIdPeerThread);
begin

end;

procedure TScCorrespondService.DoServerDisconnect(
  AThread: TIdPeerThread);
begin

end;

procedure TScCorrespondService.DoServerException(AThread: TIdPeerThread;
  AException: Exception);
var
  I: Integer;
  ptThrds: PThrdsRecd;
  infoRec: PInfoRecd;
  lstThrds: TList;
begin
  AThread.Connection.Disconnect;
  New(infoRec);
  lstThrds := FThrdsList.LockList;
  try
    for I := 0 to lstThrds.Count - 1 do
    begin
      ptThrds := lstThrds.List^[I];
      if AThread = ptThrds.Thread then
      begin
        infoRec.IP := ptThrds.IP;
        infoRec.User := ptThrds.User;
        FMonitor.NotifyClientInfo(FClientInfoService, otDelete, infoRec);
        FMonitor.DeleteCount(infoRec.User);

        lstThrds.Delete(I);
        Dispose(ptThrds);
        Break;
      end;
    end;
  finally
    FThrdsList.UnlockList;
    Dispose(infoRec);
  end;
end;

procedure TScCorrespondService.DoServerExecute(AThread: TIdPeerThread);
var
  infoRec: PInfoRecd;
  strText: string;
begin
  if AThread.Connection.Server.Active and not AThread.Terminated then
  begin
    strText := AThread.Connection.ReadLn(#13#10, 1000, 100);
    New(infoRec);
    FEncryptService.DeEncryptString(strText, infoRec);
    if infoRec.Action = 0 then  {链接}
    begin
      if FMonitor.CanNotify(infoRec.User) then
      begin
        FMonitor.NotifyClientInfo(FClientInfoService, otAdd, infoRec);
        strText := FEncryptService.EncryptString('SUCCESS');
        AThread.Connection.WriteLn(strText);
        FMonitor.AddCount(infoRec.User);
        AddClientThrdsInfo(AThread, infoRec);
      end
      else
      begin
        strText := FEncryptService.EncryptString('ISFULL');
        AThread.Connection.WriteLn(strText);
      end;
    end
    else if infoRec.Action = 1 then  {断开}
    begin
      FMonitor.NotifyClientInfo(FClientInfoService, otDelete, infoRec);
      FMonitor.DeleteCount(infoRec.User);
      DeleteClientthrdsInfo(AThread);
    end
    else if infoRec.Action = 9 then  {检测}
    begin
      strText := FSofeDog.ReadData(StrToInt(infoRec.IP), infoRec.User);
      strText := FEncryptService.EncryptString(strText);
      AThread.Connection.WriteLn(strText);
      FMonitor.NotifyClientInfo(FClientInfoService, otModify, infoRec);
    end;
    Dispose(infoRec);
  end;
end;

procedure TScCorrespondService.InitMethods;
begin
//  FIdTcpServer.OnConnect := DoServerConnect;
  FIdTcpServer.OnExecute := DoServerExecute;
//  FIdTcpServer.OnDisconnect := DoServerDisconnect;
  FIdTcpServer.OnException := DoServerException;
end;

function TScCorrespondService.Open: Boolean;
begin
  Result := True;

  if FIdTcpServer.Active then Exit;
  
  FIdTcpServer.Bindings.Clear;
  FIdTcpServer.Threads.Clear;

  FIdTcpServer.DefaultPort := Port;
  try
    FIdTcpServer.Active := True;
  except
    Result := False;
  end;
end;

procedure TScCorrespondService.SetPort(const Value: Integer);
begin
  FPersistent.Port := Value;
end;

procedure TScCorrespondService.SetMaxLinks(const AV0Count, AV1Count,
  AV2Count: Integer);
begin
  FMonitor.SetMaxLinks(AV0Count, AV1Count, AV2Count);
end;

procedure TScCorrespondService.DeleteClientThrds;
var
  I, iUser: Integer;
  strIP: string;
  lstThrds: TList;
  thrds: PThrdsRecd;
begin
  iuser := FClientInfoService.CurUser;
  strIP := FClientInfoService.CurIP;
  lstThrds := FThrdsList.LockList;
  try
    for I := 0 to lstThrds.Count - 1 do
    begin
      thrds := lstThrds.List^[I];
      if SameText(thrds.IP, strIP) and (iUser = thrds.User) then
      begin
        if Assigned(thrds.Thread.Connection) then
          thrds.Thread.Connection.DisconnectSocket;
        FClientInfoService.DeleteCurRecord;
        FMonitor.DeleteCount(iUser);
        lstThrds.Delete(I);
        Dispose(thrds);
        Break;
      end;
    end;
  finally
    FThrdsList.UnlockList;
  end;
end;

procedure TScCorrespondService.AddClientThrdsInfo(AThread: TIdPeerThread;
  AInfo: PInfoRecd);
var
  I: Integer;
  blFlag: Boolean;
  lstThrds: TList;
  ptThrds: PThrdsRecd;
begin
  blFlag := False;
  lstThrds := FThrdsList.LockList;
  try
    for I := 0 to lstThrds.Count - 1 do
    begin
      ptThrds := lstThrds.List^[I];
      if AThread = ptThrds.Thread then
      begin
        blFlag := True;
        Break;
      end;
    end;

    if not blFlag then
    begin
      New(ptThrds);
      ptThrds.Thread := AThread;
      ptThrds.IP := AInfo.IP;
      ptThrds.User := AInfo.User;
      lstThrds.Add(ptThrds);
    end;
  finally
    FThrdsList.UnlockList;
  end;
end;

procedure TScCorrespondService.DeleteClientthrdsInfo(
  AThread: TIdPeerThread);
var
  I: Integer;
  lstThrds: TList;
  ptThrds: PThrdsRecd;
begin
  lstThrds := FThrdsList.LockList;
  try
    for I := 0 to lstThrds.Count - 1 do
    begin
      ptThrds := lstThrds.List^[I];
      if AThread = ptThrds.Thread then
      begin
        lstThrds.Delete(I);
        Dispose(ptThrds);
        Break;
      end;
    end;
  finally
    FThrdsList.UnlockList;
  end;
end;

procedure TScCorrespondService.ClearThrdsInfo;
var
  I: Integer;
  lstThrds: TList;
  thrdsRec: PThrdsRecd;
begin
  lstThrds := FThrdsList.LockList;
  try
    for I := 0 to lstThrds.Count - 1 do
    begin
      thrdsRec := lstThrds.List^[I];
      Dispose(thrdsRec);
    end;
  finally
    FThrdsList.UnlockList;
  end;
  FThrdsList.Clear;
end;

end.