⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 idsrvclient.pas

📁 原版翎风(LF)引擎(M2)源码(Delphi)
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit IdSrvClient;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, IniFiles, JSocket, WinSock, Grobal2, SDK, M2Share, MudUtil;

type
  TFrmIDSoc = class(TForm)
    IDSocket: TClientSocket;
    Timer1: TTimer;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure IDSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure IDSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure IDSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure IDSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  private

    TList_2DC: TList;
    IDSrvAddr: string; //0x2E0
    IDSrvPort: Integer; //0x2E4
//    sIDSckStr :String; //0x2E8
//    boConnected:Boolean;
    dwClearEmptySessionTick: LongWord;
    procedure GetPasswdSuccess(sData: string);
    procedure GetCancelAdmission(sData: string);
    procedure GetCancelAdmissionA(sData: string);
    procedure SetTotalHumanCount(sData: string);
    procedure GetServerLoad(sData: string);
    procedure DelSession(nSessionID: Integer);
    procedure NewSession(sAccount, sIPaddr: string; nSessionID, nPayMent, nPayMode: Integer);
    procedure ClearSession();
    procedure ClearEmptySession();
    procedure SendSocket(sSENDMSG: string);
    { Private declarations }
  public
    m_SessionList: TGList; //0x2D8
    procedure Initialize();
    procedure Run();
    procedure SendOnlineHumCountMsg(nCount: Integer);
    procedure SendHumanLogOutMsg(sUserID: string; nID: Integer);
    function GetAdmission(sAccount, sIPaddr: string; nSessionID: Integer; var nPayMode: Integer; var nPayMent: Integer): pTSessInfo;
    function GetSessionCount(): Integer;
    procedure GetSessionList(List: TList);
    procedure SendLogonCostMsg(sAccount: string; nTime: Integer);
    procedure Close();
    { Public declarations }
  end;
procedure IDSocketThread(ThreadInfo: pTThreadInfo); stdcall;
var
  FrmIDSoc: TFrmIDSoc;

implementation

uses HUtil32;

{$R *.dfm}

{ TFrmIDSoc }



procedure TFrmIDSoc.FormCreate(Sender: TObject);
var
  Conf: TIniFile;
begin
  IDSocket.Host := '';
  if FileExists(sConfigFileName) then
  begin
    Conf := TIniFile.Create(sConfigFileName);
    if Conf <> nil then
    begin
      IDSrvAddr := Conf.ReadString('Server', 'IDSAddr', '127.0.0.1');
      IDSrvPort := Conf.ReadInteger('Server', 'IDSPort', 5600);
    end;
    Conf.Free;
  end else
    ShowMessage('File not found... <' + sConfigFileName + '>');

  m_SessionList := TGList.Create;
  TList_2DC := TList.Create;
  g_Config.boIDSocketConnected := False;
//    sub_48D290();
end;

procedure TFrmIDSoc.FormDestroy(Sender: TObject);
begin
  ClearSession();
  m_SessionList.Free;
  TList_2DC.Free;
end;

procedure TFrmIDSoc.Timer1Timer(Sender: TObject);
begin
  if not IDSocket.Active then
  begin
    IDSocket.Active := True;
  end;
end;

procedure TFrmIDSoc.IDSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0;
  Socket.Close;
end;

procedure TFrmIDSoc.IDSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  EnterCriticalSection(g_Config.UserIDSection);
  try
    g_Config.sIDSocketRecvText := g_Config.sIDSocketRecvText + Socket.ReceiveText;
  finally
    LeaveCriticalSection(g_Config.UserIDSection);
  end;
end;

procedure TFrmIDSoc.Initialize; //0048D3F8
begin
  IDSocket.Active := False;
  IDSocket.Address := IDSrvAddr;
  IDSocket.Port := IDSrvPort;
  IDSocket.Active := True;
  Timer1.Enabled := True;
end;
{$IF IDSOCKETMODE = TIMERENGINE}
procedure TFrmIDSoc.SendSocket(sSENDMSG: string);
begin
  if IDSocket.Socket.Connected then
  begin
    IDSocket.Socket.SendText(sSENDMSG);
  end;
end;
{$ELSE}
procedure TFrmIDSoc.SendSocket(sSENDMSG: string);
var
  boSendData: Boolean;
  Config: pTM2Config;
  ThreadInfo: pTThreadInfo;
  timeout: TTimeVal;
  writefds: TFDSet;
  nRet: Integer;
  s: TSocket;
begin
  Config := @g_Config;
  ThreadInfo := @g_Config.DBSOcketThread;
  s := Config.IDSocket;
  boSendData := False;
  while True do
  begin
    if not boSendData then Sleep(1)
    else Sleep(0);
    boSendData := False;
    ThreadInfo.dwRunTick := GetTickCount();
    ThreadInfo.boActived := True;
    ThreadInfo.nRunFlag := 128;

    ThreadInfo.nRunFlag := 129;
    timeout.tv_sec := 0;
    timeout.tv_usec := 20;

    writefds.fd_count := 1;
    writefds.fd_array[0] := s;

    nRet := select(0, nil, @writefds, nil, @timeout);
    if nRet = SOCKET_ERROR then
    begin
      nRet := WSAGetLastError();
      Config.nIDSocketWSAErrCode := nRet - WSABASEERR;
      Inc(Config.nIDSocketErrorCount);
      if nRet = WSAEWOULDBLOCK then
      begin
        Continue;
      end;
      if Config.IDSocket = INVALID_SOCKET then Break;
      Config.IDSocket := INVALID_SOCKET;
      Sleep(100);
      Config.boIDSocketConnected := False;
      Break;
    end;
    if nRet <= 0 then
    begin
      Continue;
    end;
    boSendData := True;
    nRet := send(s, sSENDMSG[1], Length(sSENDMSG), 0);
    if nRet = SOCKET_ERROR then
    begin
      Inc(Config.nIDSocketErrorCount);
      Config.nIDSocketWSAErrCode := WSAGetLastError - WSABASEERR;
      Continue;
    end;
    Inc(Config.nDBSocketSendLen, nRet);
    Break;
  end;
end;
{$IFEND}
procedure TFrmIDSoc.SendHumanLogOutMsg(sUserID: string; nID: Integer); //0048D448
var
  i: Integer;
  SessInfo: pTSessInfo;
resourcestring
  sFormatMsg = '(%d/%s/%d)';
begin
  m_SessionList.Lock;
  try
    for i := 0 to m_SessionList.Count - 1 do
    begin
      SessInfo := m_SessionList.Items[i];
      if (SessInfo.nSessionID = nID) and (SessInfo.sAccount = sUserID) then
      begin
        //SessInfo.dwCloseTick:=GetTickCount();
        //SessInfo.boClosed:=True;
        Break;
      end;
    end;
  finally
    m_SessionList.UnLock;
  end;
  SendSocket(Format(sFormatMsg, [SS_SOFTOUTSESSION, sUserID, nID]));
end;

procedure TFrmIDSoc.SendLogonCostMsg(sAccount: string; nTime: Integer); //0048D53C
resourcestring
  sFormatMsg = '(%d/%s/%d)';
begin
  SendSocket(Format(sFormatMsg, [SS_LOGINCOST, sAccount, nTime]));
end;

procedure TFrmIDSoc.SendOnlineHumCountMsg(nCount: Integer);
resourcestring
  sFormatMsg = '(%d/%s/%d/%d)';
begin
  SendSocket(Format(sFormatMsg, [SS_SERVERINFO, g_Config.sServerName, nServerIndex, nCount]));
end;

procedure TFrmIDSoc.Run; //0048D724
var
  sSocketText: string;
  sData: string;
  sBody: string;
  sCode: string;
  nLen: Integer;
  Config: pTM2Config;
resourcestring
  sExceptionMsg = '[Exception] TFrmIdSoc::DecodeSocStr';
begin
  Config := @g_Config;
  EnterCriticalSection(Config.UserIDSection);
  try
    if Pos(')', Config.sIDSocketRecvText) <= 0 then Exit;
    sSocketText := Config.sIDSocketRecvText;
    Config.sIDSocketRecvText := '';
  finally
    LeaveCriticalSection(Config.UserIDSection);
  end;
  try
    while (True) do
    begin
      sSocketText := ArrestStringEx(sSocketText, '(', ')', sData);
      if sData = '' then Break;
      sBody := GetValidStr3(sData, sCode, ['/']);
      case Str_ToInt(sCode, 0) of
        SS_OPENSESSION {100}: GetPasswdSuccess(sBody);
        SS_CLOSESESSION {101}: GetCancelAdmission(sBody);
        SS_KEEPALIVE {104}: SetTotalHumanCount(sBody);
        UNKNOWMSG: ;
        SS_KICKUSER {111}: GetCancelAdmissionA(sBody);
        SS_SERVERLOAD {113}: GetServerLoad(sBody);
      end;
      if Pos(')', sSocketText) <= 0 then Break;
    end;
    EnterCriticalSection(Config.UserIDSection);
    try
      Config.sIDSocketRecvText := sSocketText + Config.sIDSocketRecvText;
    finally
      LeaveCriticalSection(Config.UserIDSection);
    end;
  except
    MainOutMessage(sExceptionMsg);
  end;
  if GetTickCount - dwClearEmptySessionTick > 10000 then
  begin
    dwClearEmptySessionTick := GetTickCount();
    //ClearEmptySession();
  end;
{$IF (DEBUG = 0) and (SoftVersion <> VERDEMO)}
  if IsDebuggerPresent then
    Application.Terminate;
{$IFEND}
end;

procedure TFrmIDSoc.GetPasswdSuccess(sData: string); //0048D9B4
var
  sAccount: string;
  sSessionID: string;
  sPayCost: string;
  sIPaddr: string;
  sPayMode: string;
resourcestring
  sExceptionMsg = '[Exception] TFrmIdSoc::GetPasswdSuccess';
begin
  try
    sData := GetValidStr3(sData, sAccount, ['/']);
    sData := GetValidStr3(sData, sSessionID, ['/']);
    sData := GetValidStr3(sData, sPayCost, ['/']); //boPayCost
    sData := GetValidStr3(sData, sPayMode, ['/']); //nPayMode
    sData := GetValidStr3(sData, sIPaddr, ['/']); //sIPaddr
    NewSession(sAccount, sIPaddr, Str_ToInt(sSessionID, 0), Str_ToInt(sPayCost, 0), Str_ToInt(sPayMode, 0));
  except
    MainOutMessage(sExceptionMsg);
  end;
end;

procedure TFrmIDSoc.GetCancelAdmission(sData: string); //0048DB60
var
  SC, sSessionID: string;
resourcestring
  sExceptionMsg = '[Exception] TFrmIdSoc::GetCancelAdmission';
begin
  try
    sSessionID := GetValidStr3(sData, SC, ['/']);
    DelSession(Str_ToInt(sSessionID, 0));
  except
    on E: Exception do
    begin
      MainOutMessage(sExceptionMsg);
      MainOutMessage(E.Message);
    end;
  end;
end;

procedure TFrmIDSoc.NewSession(sAccount, sIPaddr: string; nSessionID, nPayMent, nPayMode: Integer); //0048DC44
var
  SessInfo: pTSessInfo;
begin
  New(SessInfo);
  SessInfo.sAccount := sAccount;
  SessInfo.sIPaddr := sIPaddr;
  SessInfo.nSessionID := nSessionID;
  SessInfo.nPayMent := nPayMent;
  SessInfo.nPayMode := nPayMode;
  SessInfo.nSessionStatus := 0;
  SessInfo.dwStartTick := GetTickCount();
  SessInfo.dwActiveTick := GetTickCount();
  SessInfo.nRefCount := 1;
  m_SessionList.Lock;
  try
    m_SessionList.Add(SessInfo);
  finally
    m_SessionList.UnLock;
  end;
end;

procedure TFrmIDSoc.DelSession(nSessionID: Integer); //0048DD5C
var
  i: Integer;
  sAccount: string;
  SessInfo: pTSessInfo;
resourcestring
  sExceptionMsg = '[Exception] FrmIdSoc::DelSession %d';
begin
  try

    sAccount := '';
    m_SessionList.Lock;
    try

      for i := 0 to m_SessionList.Count - 1 do
      begin
        SessInfo := m_SessionList.Items[i];

        if SessInfo.nSessionID = nSessionID then
        begin
          sAccount := SessInfo.sAccount;
          m_SessionList.Delete(i);
          Dispose(SessInfo);
          Break;
        end;
      end;

    finally
      m_SessionList.UnLock;
    end;

    if sAccount <> '' then
    begin

      RunSocket.KickUser(sAccount, nSessionID);

    end;

  except
    on E: Exception do
    begin
      MainOutMessage(Format(sExceptionMsg, [0]));
      MainOutMessage(E.Message);
    end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -