rltsvr.pas

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

      CPlayer.Free;
      for I := 0 to FPlayerList.Count -1 do
      begin
        if TPlayer(FPlayerList[i]).ID = APlayerEditInfo.PlayerInfo.ID then
        begin
          CPlayer := TPlayer(FPlayerList[i]);
          LogoffPlayer(CPlayer.ID);
        end;
      end;
    end;
  end;
end;

function TTltManager.GetPlayerList(APlayerList: TPlayerList): TPlayerList;
var
  I : integer;
begin
  FillChar(Result, sizeof(Result), #0);
  Result.Flag := APlayerList.Flag;
  case APlayerList.Flag of
    PLFCountOnly:
    begin
      Result.PlayerCount := GetPlayerCount;
    end;

    PLFAllPlayer:
    begin
      Result.PlayerCount := GetPlayerCount;
      Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
      GetMem(Result.Data, Result.Size);
      DAReadPlayers(Result.Data, 0, Result.PlayerCount);
    end;
    PLFSelectPlayer:
    begin
      Result.PlayerCount := APlayerList.PlayerCount;
      Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
      Result.Data := AllocMem(Result.Size);
      for i := 0 to Result.PlayerCount-1  do
      begin
          Result.Data^[i] := DAReadPlayer(APlayerList.Data^[i].ID);
      end;
    end;
    PLFLastChangePlayer:
    begin
      Result.PlayerCount := GetPlayerCount;
      Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
      GetMem(Result.Data, Result.Size);
      Result.LastUpdate := APlayerList.LastUpdate;
      Result.PlayerCount := DAReadLastChangePlayer(Result.Data, Result.LastUpdate);
      Result.Size := Result.PlayerCount * sizeof(tplayerinfo);
    end;
    PLFRoundLength:
    begin
    end;
    
  end;

end;

function TTltManager.SetOpenColorIndex(AColorIndex : integer): boolean;
var
  Num : integer;
begin
  Result := State = rsBeforeWheel;
  if not Result then Exit;
  Num := GetRandomNumByColor(AColorIndex);
  SetOpenNumber(Num);
  FSpecialNum := true;
  Round.Auto := false;
  Level2 := 1;
//  DoBeforeWheel;
end;

function TTltManager.GetGameParams: TGameParams;
begin
  with Result do
  begin
    BelTime := FBetTimeSetting;
    BeforeWheelTime := FBeforeWheelTimeSetting;
    TotalValue := self.TotalValue;//总彩池值；
    ObjectValue := self.ObjectValue;//期望
    Rate := self.Rate; //提成比,游戏难度
    Bleed := self.Bleed; //阀值
  end;
end;

function TTltManager.SetGameParams(AGameParams: TGameParams): boolean;
begin
  Result := false;
  DASaveGameParams(AGameParams);
  with AGameParams do
  begin
    FBetTimeSetting := BelTime;
    FBeforeWheelTimeSetting := BeforeWheelTime;
    FRoundMain := RoundMain;
//    Self.TotalValue := TotalValue;
//    Self.ObjectValue := ObjectValue;
    self.Rate := Rate;
//    self.Bleed := Bleed;
  end;
  FTimeSettingModified := true;
  Result := True;
end;
procedure TTltManager.ResetPlayerBet();
var
  I : integer;
  rltInterpreter : TrltServerInterpreter;
begin
  for I :=0 to FPlayerList.Count-1 do
  begin
    try
      with TPlayer(FPlayerList[i]) do
      begin
        FillChar(Bet, sizeof(Bet), #0);
        rltInterpreter := Client.Interpreter;
        rltInterpreter.CallSetPlayerInfo(TPlayer(FPlayerList[i]));
      end;
    except
    end;
  end;
  NeedResetPlayerBet := false;
end;


function TTltManager.SetRoundState(const Value: TRoundState) : boolean;
begin
  Result := true;
  Level2 := 1;
  if IsLocked then
  begin
    Result := false;
    Round.State := rsStop;
    Exit;
  end;
  if Value <> Round.State then
  begin
    //如果是切换游戏中的状态，则无效
    if (Round.State in [rsBeting..rsScore{分数}])
     and (Value in [rsBeting..rsScore{分数}]) then
    begin
      Result := false;
    end else
    if Value = rsBeting then
    begin
      NeedResetPlayerBet := true;
      InitRound; //重新开始游戏
    end else
    if Value = rsPaused then
    begin
      Round.State := rsPaused;//游戏暂停了；
    end else
    if Value = rsStop then
    begin
      // do nothing. not support;
      Round.State := rsStop;
    end else
    if Value = rsPauseAtRoundEnd then
    begin
      FPauseAtRoundEnd := true;
    end else
    if Value = rsReset then
    begin
      NeedResetPlayerBet := true;
      ResetRound;
    end else
      Result := false;
  end;
end;

procedure TTltManager.ResetRound;
begin
  FillChar(Round, Sizeof(Round), #0);
  FillChar(RoundScords, Sizeof(RoundScords), #0);
  Round.State := rsPaused;
  Round.No := 1;
  Round.WheelNo := 0;
  Level2 := 1;
end;

procedure TTltManager.DoInit;
var
  GameParams : TGameParams;
  Reg : TRegINIFile;
  CInt : integer;
begin
  if DAReadGameParams(GameParams) then
    SetGameParams(GameParams);

  Reg := TRegINIFile.Create('');
  Reg.RootKey := HKEY_LOCAL_MACHINE;
  Reg.OpenKey(KEY_SOCKETSERVER, True);
  FIsLocked := Reg.ReadBool('',ckLocked, False);
  if FIsLocked and (Round.State <> rsStop) then SetRoundState(rsStop);
  Reg.Free;
end;

function TTltManager.GetRoundScordInfo(RoundID: integer): TRoundScordInfos;
var
  I : integer;
begin
  if (RoundID >0) and (RoundID<=Round.No) then
  begin
    Result := RoundScordInfosArray[RoundID];
  end;
end;

function TTltManager.SetPlayerList(APlayerList: TPlayerList): TPlayerList;
var
  CPlayer : TPlayer;
  I, J : integer;
begin
  Result := APlayerList;
  CPlayer := TPlayer.Create;
  try
    for I :=0 to APlayerList.PlayerCount-1 do
    begin
      CPlayer.SetPlayerInfo(APlayerList.Data^[I]);
      CPlayer.Password := APlayerList.Data^[I].Password;
      CPlayer.LastActiveTime := APlayerList.Data^[I].LastActiveTime;
      if DAEditPlayer(CPlayer)<0 then
        DACreatePlayer(CPlayer);
      for J := 0 to FPlayerList.Count -1 do
      begin
        if TPlayer(FPlayerList[j]).ID = APlayerList.Data^[I].ID then
        begin
          DALoadPlayer(TPlayer(FPlayerList[J]));
          if (TPlayer(FPlayerList[J]).Client<>nil) and
            (TPlayer(FPlayerList[J]).Client.Interpreter <> nil) then
            (TPlayer(FPlayerList[J]).Client.Interpreter.CallSetPlayerInfo(
              TPlayer(FPlayerList[J])));
        end;
      end;
    end;
  finally
    CPlayer.Free;
  end;
end;

function TTltManager.GetRoundInfoLog(
  var AArrayofRoundInfo: TArrayofRoundInfo): integer;
begin
  Result := DAGetRoundInfoLog(AArrayofRoundInfo);
end;

function TTltManager.GetPlayerBetInfoLog(
  var AArrayofPlayerBetInfo: TArrayofPlayerBetInfo): integer;
begin
  Result := DAGetPlayerBetInfoLog(AArrayofPlayerBetInfo);
end;

function TTltManager.ClearPlayerBetInfoLog: boolean;
begin
  Result :=  DAClearPlayerBetInfoLog;
end;

function TTltManager.ClearRoundInfoLog: boolean;
begin
  Result :=  DAClearRoundInfoLog;
  TotalValue := 0;
  ObjectValue := 0;
end;

function TTltManager.ClearPlayerList: boolean;
begin
  Result := DAClearPlayerList;
end;

procedure TTltManager.DoStop;
var
  I : integer;
  rltInterpreter : TrltServerInterpreter;
begin
  //通知所有以连接终端，服务器已经停止，并注销用户；
  for i := 0 to FPlayerList.Count -1 do
  begin
    LogoffPlayer(TPlayer(FPlayerList[0]).ID);
  end;
  for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
  begin
    rltInterpreter := SocketForm.GetrltInterpreter(I);
    rltInterpreter.CallSetRound;
  end;
end;

var
  PauseCounter : integer;
procedure TTltManager.DoPaused;
var
  I : integer;
  rltInterpreter : TrltServerInterpreter;

begin
  if Level2 = 1 then
  begin
    PauseCounter := 60;
    Level2 :=2;
  end;
  if Level2 =2 then
  begin
    dec(PauseCounter);
    if PauseCounter<=0 then
    begin
      Level2 := 1;
      SetRoundState(rsStop);
    end;
  end;

  for I := 0 to SocketForm.ConnectionList.Items.Count -1 do
  begin
    try
      rltInterpreter := SocketForm.GetrltInterpreter(I);
      rltInterpreter.CallSetRound;
    except
    end;
  end;

end;

function TTltManager.CheckAdmin(Tag :integer; AdminStr: String): boolean;
var
  GameParams : TGameParams;
begin
  Result := false;
  case Tag of
  1 : begin
  //修改密码
    DAReadGameParams(GameParams);
    GameParams.AdminStr := AdminStr;
    DASaveGameParams(GameParams);
    Result := true;
  end;
  0: begin
  //校验密码
    DAReadGameParams(GameParams);
    Result := Trim(GameParams.AdminStr) = Trim(AdminStr);
  end;
  end;
end;


procedure TTltManager.SetIsLocked(const Value: boolean);
var
  Reg : TRegINIFile;
  CInt : integer;
begin
  if FIsLocked <> Value then
  begin
    FIsLocked := Value;
    Reg := TRegINIFile.Create('');
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(KEY_SOCKETSERVER, True);
    Reg.WriteBool('',ckLocked, Value);
    if FIsLocked and (Round.State <> rsStop) then SetRoundState(rsStop);
    Reg.Free;
  end;

end;

{ TPlayer }

constructor TPlayer.Create;
begin
  State := psNoBody; 
end;

function TPlayer.GetPlayerInfo: TPlayerInfo;
begin
  with Result do
  begin
    ID := Self.ID;
    password := Self.Password;
    UserName := Self.UserName;
    Memo := Self.Memo;
    money := Self.Money;
    State := Self.State;
    Move(self.Bet, Bet, sizeof(bet));
//    Password := Self.Password;
  end;
end;

procedure TPlayer.SetPlayerInfo(PlayerInfo: TPlayerInfo);
begin
  ID := PlayerInfo.ID;
  Password := PlayerInfo.password;
  Memo := PlayerInfo.Memo;
  UserName := PlayerInfo.UserName;
  Money := PlayerInfo.money;
  State := PlayerInfo.State;
end;

{ TTltClient }

procedure TTltClient.AddPlayer(Player: TPlayer);
begin
  if PlayerList.IndexOf(Player)>=0 then Exit;
  PlayerList.Add(Player);
  Player.Client := Self;
end;

constructor TTltClient.Create(manager : TTltManager);
begin
  FManager := manager;
  PlayerList := TList.Create;
  FManager.AddClient(Self);
end;

destructor TTltClient.Destroy;
begin
  FManager.RemoveClient(Self);
  PlayerList.Free;
  inherited;
end;

function TTltClient.HasPlayer(Player: TPlayer): boolean;
begin
  Result := PlayerList.IndexOf(Player) >=0;
end;

procedure TTltClient.RemovePlayer(Player: TPlayer);
begin
  PlayerList.Remove(Player);
  Interpreter.CallLogout(Player.ID);
end;

initialization
  DAUInit();
  rltManager := TTltManager.Create(nil);
finalization
  rltManager.Free;
  DAUFinit;
end.