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

📄 nhcconfig.pas

📁 NetHook API 对战平台内核库是一套实现时下流行的网络对战平台[如浩方、VS]同样功能的通用内核库
💻 PAS
字号:
unit NhcConfig;

interface

uses
  Windows, SysUtils, Classes, Graphics, Forms, NhConfigMgr, NhGlobalST;

type


{ TNhcConfigMgr }

  TServerIpInfo = record
    Name: string;
    IP: string;
    Port: Word;
  end;
  TServerIPInfoAry = array of TServerIpInfo;

  TNhcConfigMgr = class(TCustomConfigMgr)
  private
    FUpgradeUrl: string;

    FUserName: string;
    FPassword: string;
    FChatFont: TChatFontStyle;

    FBeepOnRecvBroad: Boolean;

    FUpdateSrvListUrl: string;

    FNetServerCount: Integer;
    FNetServers: TServerIpInfoAry;

    FUserServerCount: Integer;
    FUserServers: TServerIpInfoAry;

    FUseSound: Boolean;
    FSkinIndex: Integer;

    function GetIniFileName: string;

    function GetGames(GameID: Integer): TGameRunParam;
    procedure SetGames(GameID: Integer; const Value: TGameRunParam);
    procedure SetChatFont(const Value: TChatFontStyle);
    function GetServers(Index: Integer): TServerIPInfo;
    function GetUserServers(Index: Integer): TServerIpInfo;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Load;
    procedure Save;

    procedure UpdateNetServers(const SrvIpAry: TServerIPInfoAry);
    procedure AddUserServer(const SrvIpInfo: TServerIpInfo);
    procedure RemoveUserServer(Index: Integer);

    property UpdateSrvListUrl: string read FUpdateSrvListUrl;

    property NetServerCount: Integer read FNetServerCount;
    property NetServers[Index: Integer]: TServerIPInfo read GetServers;

    property UserServerCount: Integer read FUserServerCount;
    property UserServers[Index: Integer]: TServerIpInfo read GetUserServers;

    property UpgradeUrl: string read FUpgradeUrl;

    property UserName: string read FUserName write FUserName;
    property Password: string read FPassword write FPassword;
    property ChatFont: TChatFontStyle read FChatFont write SetChatFont;

    property UseSound: Boolean read FUseSound write FUseSound;
    property SkinIndex: Integer read FSkinIndex write FSkinIndex;

    property Games[GameID: Integer]: TGameRunParam read GetGames write SetGames;

    property BeepOnRecvBroad: Boolean read FBeepOnRecvBroad write FBeepOnRecvBroad;
  end;

var
  ConfigMgr: TNhcConfigMgr;  

implementation

const
  SConfigFileName = 'Config.ini';
  SUser = 'User';
  SServer = 'Server';
  SGame = 'Game';
  SMisc = 'Misc';

{ TNhcConfigMgr }

procedure TNhcConfigMgr.AddUserServer(const SrvIpInfo: TServerIpInfo);
begin
  Inc(FUserServerCount);
  SetLength(FUserServers, FUserServerCount);

  with FUserServers[FUserServerCount-1] do
  begin
    Name := SrvIpInfo.Name;
    IP:= SrvIpInfo.IP;
    Port := SrvIpInfo.Port;
  end;
end;

constructor TNhcConfigMgr.Create;
begin
  inherited;
  Load;
end;

destructor TNhcConfigMgr.Destroy;
begin
  Save;
  inherited;
end;

function TNhcConfigMgr.GetGames(GameID: Integer): TGameRunParam;
begin
  Result.GameName := GetString(SGame, 'GameName'+IntToStr(GameID), '');
  Result.GameExe := GetString(SGame, 'GameExe'+IntToStr(GameID), '');
  Result.GameParam := GetString(SGame, 'GameParam'+IntToStr(GameID), '');
end;

function TNhcConfigMgr.GetIniFileName: string;
begin
  Result := ExtractFilePath(Application.ExeName) + SConfigFileName;
end;

function TNhcConfigMgr.GetServers(Index: Integer): TServerIPInfo;
begin
  Result := FNetServers[Index];
end;

function TNhcConfigMgr.GetUserServers(Index: Integer): TServerIpInfo;
begin
  Result := FUserServers[Index];
end;

procedure TNhcConfigMgr.Load;
  procedure LoadServer;
  var
    I: Integer;
  begin
    FNetServerCount := GetInteger(SServer, 'NetServerCount', 0);
    SetLength(FNetServers, FNetServerCount);

    for I := 0 to FNetServerCount - 1 do
    begin
      FNetServers[I].Name := GetString(SServer, 'NetServerName_'+IntToStr(I), '');
      FNetServers[I].IP := GetString(SServer, 'NetServerIp_'+IntToStr(I), '');
      FNetServers[I].Port := GetInteger(SServer, 'NetServerPort_'+IntToStr(I), 25000);
    end;

    FUserServerCount := GetInteger(SServer, 'UserServerCount', 0);
    SetLength(FUserServers, FUserServerCount);

    for I := 0 to FUserServerCount - 1 do
    begin
      FUserServers[I].Name := GetString(SServer, 'UserServerName_'+IntToStr(I), '');
      FUserServers[I].IP := GetString(SServer, 'UserServerIp_'+IntToStr(I), '');
      FUserServers[I].Port := GetInteger(SServer, 'UserServerPort_'+IntToStr(I), 25000);
    end;

    FUpdateSrvListUrl := GetString(SServer, 'UpdateSrvListUrl', '');
    FUpgradeUrl := GetString(SServer, 'UpgradeUrl', '');
  end;
  procedure LoadMisc;
  begin
    FBeepOnRecvBroad := GetBoolean(SMisc, 'BeepOnRecvBroad', True);
    FUseSound := GetBoolean(SMisc, 'UseSound', True);
    FSkinIndex := GetInteger(SMisc, 'SkinIndex', 0);
  end;
  procedure LoadUser;
  begin
    FUserName := GetString(SUser, 'UserName', '');
    FPassword := GetString(SUser, 'Password', '');

    FChatFont.Name := GetString(SUser, 'FONT_Name', '宋体');
    FChatFont.Color := GetInteger(SUser, 'FONT_Color', 0);
    FChatFont.Size := GetInteger(SUser, 'FONT_Size', 9);
    FChatFont.Bold := GetInteger(SUser, 'FONT_Bold', 0);
    FChatFont.Italic := GetInteger(SUser, 'FONT_Italic', 0);
    FChatFont.Underline := GetInteger(SUser, 'FONT_Underline', 0);
    FChatFont.Strikeout := GetInteger(SUser, 'FONT_StrikeOut', 0);
  end;
  procedure LoadGames;
  begin
  end;
begin
  LoadFromIniFile(GetIniFileName);

  LoadUser;
  LoadServer;
  LoadMisc;
  LoadGames;
end;

procedure TNhcConfigMgr.RemoveUserServer(Index: Integer);
var
  I: Integer;
begin
  if (Index < 0) or (Index >= FUserServerCount) then
    raise Exception.Create('Config Index Out Of Bound');

  for I := Index + 1 to FUserServerCount - 1 do
  begin
    FUserServers[Index] := FUserServers[Index + 1];
  end;
  
  SetLength(FUserServers, FUserServerCount-1);
  Dec(FUserServerCount);
end;

procedure TNhcConfigMgr.Save;
  procedure SaveServer;
  var
    I: Integer;
  begin
    SetInteger(SServer, 'NetServerCount', FNetServerCount);
    for I := 0 to FNetServerCount - 1 do
    begin
      SetString(SServer, 'NetServerName_' + IntToStr(I), FNetServers[I].Name);
      SetString(SServer, 'NetServerIp_' + IntToStr(I), FNetServers[I].IP);
      SetInteger(SServer, 'NetServerPort_' + IntToStr(I), FNetServers[I].Port);
    end;

    SetInteger(SServer, 'UserServerCount', FUserServerCount);
    for I := 0 to FUserServerCount - 1 do
    begin
      SetString(SServer, 'UserServerName_' + IntToStr(I), FUserServers[I].Name);
      SetString(SServer, 'UserServerIp_' + IntToStr(I), FUserServers[I].IP);
      SetInteger(SServer, 'UserServerPort_' + IntToStr(I), FUserServers[I].Port);
    end;
  end;
  procedure SaveMisc;
  begin
    SetBoolean(SMisc, 'BeepOnRecvBroad', FBeepOnRecvBroad);
    SetBoolean(SMisc, 'UseSound', FUseSound);
    SetInteger(SMisc, 'SkinIndex', FSkinIndex);
  end;
  procedure SaveUser;
  begin
    SetString(SUser, 'UserName', FUserName);
    SetString(SUser, 'Password', FPassword);

    SetString(SUser, 'FONT_Name', FChatFont.Name);
    SetInteger(SUser, 'FONT_Color', FChatFont.Color);
    SetInteger(SUser, 'FONT_Size', FChatFont.Size);
    SetInteger(SUser, 'FONT_Bold', FChatFont.Bold);
    SetInteger(SUser, 'FONT_Italic', FChatFont.Italic);
    SetInteger(SUser, 'FONT_Underline', FChatFont.Underline);
    SetInteger(SUser, 'FONT_StrikeOut', FChatFont.Strikeout);
  end;
  procedure SaveGame;
  begin
  end;
begin
  SaveUser;
  SaveServer;
  SaveMisc;
  SaveGame;

  SaveToIniFile(GetIniFileName);
end;

procedure TNhcConfigMgr.SetChatFont(const Value: TChatFontStyle);
begin
  FChatFont := Value;
end;

procedure TNhcConfigMgr.SetGames(GameID: Integer; const Value: TGameRunParam);
begin
  SetString(SGame, 'GameName'+IntToStr(GameID), Value.GameName);
  SetString(SGame, 'GameExe'+IntToStr(GameID), Value.GameExe);
  SetString(SGame, 'GameParam'+IntToStr(GameID), Value.GameParam);

  Save;
end;

procedure TNhcConfigMgr.UpdateNetServers(const SrvIpAry: TServerIPInfoAry);
var
  I: Integer;
begin
  if Length(SrvIpAry) > 0 then
  begin
    FNetServerCount := Length(SrvIpAry);
    SetLength(FNetServers, FNetServerCount);

    for I := 0 to Length(SrvIpAry) - 1 do
    begin
      FNetServers[I] := SrvIpAry[I];
    end;
  end;

  Save;
end;

initialization
  ConfigMgr := TNhcConfigMgr.Create;  

finalization
  ConfigMgr.Free;

end.

⌨️ 快捷键说明

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