tltlogic.pas

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

unit TltLogic;
{Tlt logic layer}
interface
uses Classes, SConnectEx, TltConst, ExtCtrls, Forms, Dialogs, SysUtils, SyncObjs;
type
  TServerInfo = record
    ServerVer : String[255];
  end;

  TrltServerInterpreter = class(TDataBlockInterpreter)


    FClient : Pointer;
    FCriticalSection : TCriticalSection;

    procedure CallProc(Proc : TClientProc);
    function DoCustomAction(Action: Integer; const Data: IDataBlock): Boolean; override;
  public
    {Receiving Calls}
    procedure DoGetServerInfo(const Data: IDataBlock);
    procedure DoGetCurrentRound(const Data: IDataBlock);
    procedure DoGetTimeSetting(const Data: IDataBlock);
    procedure DoLoginPlayer(const Data: IDataBlock);
    procedure DoLogoffPlay(const Data: IDataBlock);
    procedure DoGetPlayerInfo(const Data: IDataBlock);
    procedure DoBet(const Data: IDataBlock);
    procedure DoGetScore(const Data: IDataBlock);
    procedure DoGetWheelParams(const Data: IDataBlock);
    procedure DoGetRoundInfo(const Data: IDataBlock);
    procedure DoPlayerEdit(const Data:IDataBlock);
    procedure DoGetPlayerList(const Data: IDataBlock);
    procedure DoSetRoundResult(const Data: IDataBlock);
    procedure DoGetGameParams(const Data: IDataBlock);
    procedure DoSetGameParams(const Data: IDataBlock);
    procedure DoGetRoundState(const Data: IDataBlock);
    procedure DoSetRoundState(const Data: IDataBlock);
    procedure DoGetRoundScordInfo(const Data: IDataBlock);
    procedure DoUploadPlayerList(const Data: IDataBlock);
    procedure DoGetRoundInfoLog(const Data: IDataBlock);
    procedure DoGetPlayerBetInfoLog(const Data: IDataBlock);
    procedure DoClearRoundInfoLog(const Data: IDataBlock);
    procedure DoClearPlayerBetInfoLog(const Data: IDataBlock);
    procedure DoClearPlayerList(const Data: IDataBlock);
    procedure DoCheckAdmin(const Data: IDataBlock);
    procedure DoLock(const Data: IDataBlock);
    {Sending Calls}
    function CallGetServerInfo : TServerInfo;
    function CallGetCurrentRoundNo: integer;
    {Sendto Client}
    procedure CallSetCountDown;
    procedure CallSetTimeSetting;
    procedure CallSetRound;
    procedure CallSetWheelResult;
    procedure CallSetPlayerInfo(APlayer : TObject);
    procedure CallSetWheelParams(WheelParams : TWheelParams);
    procedure CallLogout(PlayerID: String);
    procedure DoException(const Data: IDataBlock); override;
    constructor Create(SendDataBlock: ISendDataBlock;
      CheckRegValue: String); override;
    destructor Destroy; override;
  end;




implementation
uses ScktCnst, rltSvr;


{ TTltInterpreter }

function TrltServerInterpreter.CallGetServerInfo: TServerInfo;
var
  Data: IDataBlock;
  Size : integer;
  s : TServerInfo;
begin
  Data := TDataBlock.Create as IDataBlock;
  Data.Signature := CallSig or asGetServerInfo;
  Data := FSendDataBlock.Send(Data, True);
  Data.Read(size, sizeof(size));
  Data.Read(s,Size);
  Result := s;
//  Result := ReadVariant(Flags, Data);
end;

function TrltServerInterpreter.CallGetCurrentRoundNo: integer;
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    Data.Signature := CallSig or asGetCurrentRound;
    Data := FSendDataBlock.Send(Data, True);
    Data.Read(size, sizeof(size));
    Data.Read(s,Size);
    Result := s;
  finally
    FCriticalSection.Leave;
  end;
//  Result := ReadVariant(Flags, Data);
end;


function TrltServerInterpreter.DoCustomAction(Action: Integer;
  const Data: IDataBlock): Boolean; 
begin
  FCriticalSection.Enter;
  try
    case (Action and asMask) of
      asGetServerInfo: DoGetServerInfo(Data);
      asGetCurrentRound : DoGetCurrentRound(Data);
      asTimeSetting : DoGetTimeSetting(Data);
      asLoginPlayer : DoLoginPlayer(Data);
      asLogoffPlayer : DoLogoffPlay(Data);
      asPlayerInfo : DoGetPlayerInfo(Data);
      asBet : DoBet(Data);
      asGetRoundScord : DoGetScore(Data);
      asWheelParams : DoGetWheelParams(Data);
      asGetRoundInfo : DoGetRoundInfo(Data);
      asPlayerEdit : DoPlayerEdit(Data);
      asPlayerList : DoGetPlayerList(Data);
      asSetRoundResult : DoSetRoundResult(Data);
      asGetGameParams : DoGetGameParams(Data);
      asSetGameParams : DoSetGameParams(Data);
      asGetRoundState : DoGetRoundState(Data);
      asSetRoundState : DoSetRoundState(Data);
      asUploadPlayerList : DoUploadPlayerList(Data);
      asGetRoundLog : DoGetRoundInfoLog(Data);
      asGetPlayerBetLog : DoGetPlayerBetInfoLog(Data);
      asClearPlayerList : DoClearPlayerList(Data);
      asClearPlayerBetLog : DoClearPlayerBetInfoLog(Data);
      asClearGameLog : DoClearRoundInfoLog(Data);
      asCheckAdmin : DoCheckAdmin(Data);
      asLockServer : DoLock(Data);
      1 :;
    else
      Result := false;
    end;
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TrltServerInterpreter.DoGetServerInfo(const Data: IDataBlock);
var
  ServerInfo : TServerInfo;
  VarSize : integer;
begin
  Data.Clear;
  try
    ServerInfo.ServerVer :='1.0';
  finally
  end;
  VarSize := sizeof(ServerInfo);
  Data.Write(VarSize, sizeof(integer));
  Data.Write(ServerInfo, VarSize);
  Data.Signature := ResultSig or asGetServers;
  FSendDataBlock.Send(Data, False);
end;

procedure TrltServerInterpreter.DoGetCurrentRound(const Data: IDataBlock);
var
  Size : integer;
begin
  Data.Clear;
  Size := SizeOf(TRound);
  Data.Write(Size, SizeOf(Size));
  Data.Write(rltManager.Round,Size);
  Data.Signature := ResultSig or asGetCurrentRound;
  FSendDataBlock.Send(Data, False);
end;


procedure TrltServerInterpreter.CallSetCountDown;
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    WriteVariant(rltManager.CountDown, Data);
    Data.Signature := CallSig or asSetCountDown;

    Data := FSendDataBlock.Send(Data, false);
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TrltServerInterpreter.CallProc(Proc: TClientProc);
begin
  if Assigned(Proc) then
  begin
    Proc;
  end;

end;

procedure TrltServerInterpreter.CallSetTimeSetting;
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    Size := Sizeof(rltManager.TimeSetting);
    Data.Write(Size, Sizeof(Size));
    Data.Write(rltManager.TimeSetting, Size);
    Data.Signature := CallSig or asTimeSetting;
    Data := FSendDataBlock.Send(Data, false);
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TrltServerInterpreter.CallSetRound;
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    Size := Sizeof(rltManager.Round);
    Data.Write(Size, Sizeof(Size));
    Data.Write(rltManager.Round, Size);
    Data.Signature := CallSig or asSetRound;
    Data := FSendDataBlock.Send(Data, false);
  finally
    FCriticalSection.Leave;  
  end;
end;

procedure TrltServerInterpreter.DoGetTimeSetting(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
begin
  Size := Sizeof(rltManager.TimeSetting);
  Data.Write(Size, Sizeof(Size));
  Data.Write(rltManager.TimeSetting, Size);
  Data.Signature := ResultSig or asTimeSetting;
  FSendDataBlock.Send(Data, false);
end;

procedure TrltServerInterpreter.DoException(const Data: IDataBlock);
begin
//  inherited;
  //do nothing;

end;

procedure TrltServerInterpreter.DoLoginPlayer(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
  PlayerID : String;
  Password : String;
  VarFlag : TVarFlags;
  ResultValue : Boolean;
begin
  PlayerID := ReadVariant(VarFlag, Data);
  Password := ReadVariant(VarFlag, Data);
  ResultValue := rltManager.LoginPlayer(PlayerID, password, TTltClient(FClient));
  Data.Clear;
  WriteVariant(ResultValue, Data);
  Data.Signature := ResultSig or asLoginPlayer;
  FSendDataBlock.Send(Data, false);
end;

procedure TrltServerInterpreter.DoLogoffPlay(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
  PlayerID : String;
  Password : String;
  VarFlag : TVarFlags;
  ResultValue : Boolean;
begin
  PlayerID := ReadVariant(VarFlag, Data);
  rltManager.LogoffPlayer(PlayerID);
  Data.Clear;
  WriteVariant(true, Data);
  Data.Signature := ResultSig or asLogOffPlayer;
  FSendDataBlock.Send(Data, false);
end;

constructor TrltServerInterpreter.Create(SendDataBlock: ISendDataBlock;
  CheckRegValue: String);
begin
  inherited;
  FClient := Pointer(TTltClient.Create(rltManager));
  TTltClient(FClient).Interpreter := Self;
  FCriticalSection := TCriticalSection.Create;
end;

procedure TrltServerInterpreter.DoGetPlayerInfo(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
  Player : TPlayer;
  PlayerID : String;
  VarFlag : TVarFlags;
  PlayerInfo : TPlayerInfo;
begin
  PlayerID := ReadVariant(VarFlag, Data);
  Data.Clear;
  Player := rltManager.GetPlayerByID(PlayerID);
  if Player <> nil then PlayerInfo := Player.GetPlayerInfo
  else
  begin
    PlayerInfo.ID := PlayerID;
    PlayerInfo.money := 0;
    PlayerInfo.State := psLoginError;
  end;
  Size := sizeof(PlayerInfo);
  Data.Write(Size, Sizeof(Size));
  Data.Write(PlayerInfo, size);
  Data.Signature := ResultSig or asPlayerInfo;
  FSendDataBlock.Send(Data, false);

end;

destructor TrltServerInterpreter.Destroy;
begin
  TTltClient(FClient).Free;
  FCriticalSection.Free;  
  inherited;
end;

procedure TrltServerInterpreter.DoBet(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
  Player : TPlayer;
  PlayerID : String;
  VarFlag : TVarFlags;
  Result : boolean;
  RBet, BBet, GBet:longint;
begin
  PlayerID := ReadVariant(VarFlag, Data);
  RBet := ReadVariant(VarFlag, Data);
  BBet := ReadVariant(VarFlag, Data);
  GBet := ReadVariant(VarFlag, Data);
  Data.Clear;
  Result := false;
  Player := rltManager.GetPlayerByID(PlayerID);
  if Player <> nil then
  begin
    Result := true;
    if (RBet + BBet + GBet)>Player.Money then
    begin
      Result := false;
      with Player do
      begin
        RBet := Player.Bet[btRed];
        BBet := Player.Bet[btBlack];
        GBet := Player.Bet[btGreen];
      end;

    end
    else
    begin
      with Player do
      begin
        Player.Bet[btRed] := RBet;
        Player.Bet[btBlack] := BBet;
        Player.Bet[btGreen]:= GBet;
      end;
    end;
  end
  else
  begin
    Result := false;
  end;
  WriteVariant(PlayerID, Data);
  WriteVariant(Result, Data);
  WriteVariant(RBet, Data);
  WriteVariant(BBet, Data);
  WriteVariant(GBet, Data);
  Data.Signature := ResultSig or asBet;
  FSendDataBlock.Send(Data, false);
end;

procedure TrltServerInterpreter.CallSetWheelResult;
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    WriteVariant(rltManager.WheelResult, Data);
    Data.Signature := CallSig or asWheelResult;
    Data := FSendDataBlock.Send(Data, false);
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TrltServerInterpreter.CallSetPlayerInfo(APlayer: TObject);
var
  Data: IDataBlock;
  Size : integer;
  s : integer;
  PlayerID : String;
  VarFlag : TVarFlags;
  PlayerInfo : TPlayerInfo;
begin
  FCriticalSection.Enter;
  try
    Data := TDataBlock.Create as IDataBlock;
    with TPlayer(APlayer) do
    begin
      PlayerInfo := GetPlayerInfo;
      Size := sizeof(PlayerInfo);
      Data.Write(Size, Sizeof(Size));
      Data.Write(PlayerInfo, size);
      Data.Signature := CallSig or asPlayerInfo;
      Data := FSendDataBlock.Send(Data, false);
    end;
  finally
    FCriticalSection.Leave;
  end;
end;

procedure TrltServerInterpreter.DoGetScore(const Data: IDataBlock);
var
  Size : integer;
  s : integer;
  PlayerID : String;
  VarFlag : TVarFlags;
  RoundNo, WheelNo : integer;