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

📄 svmain.~pas

📁 传世源码可编译的,功能齐全.是学习的好模版,会DELPHI的朋友们也可以自己修改,弄个自己的引擎.
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:

procedure TFrmMain.StartEngine();
var
  nCode:Integer;
begin
  try
{$IF IDSOCKETMODE = TIMERENGINE}
    FrmIDSoc.Initialize;
    MemoLog.Lines.Add('登录服务器连接初始化完成...');
{$IFEND}
    g_MapManager.LoadMapDoor;
    MemoLog.Lines.Add('地图环境加载成功...');

    MakeStoneMines();
    MemoLog.Lines.Add('矿物数据初始成功...');

    nCode:= FrmDB.LoadMerchant;
    if nCode < 0 then
    begin
      MemoLog.Lines.Add('Load Merchant Error !!!' + 'Code: ' + IntToStr(nCode));
      exit;
    end;
    MemoLog.Lines.Add('交易NPC列表加载成功...');

    if not g_Config.boVentureServer then
    begin
      nCode:= FrmDB.LoadGuardList;
      if nCode < 0 then
      begin
        MemoLog.Lines.Add('Load GuardList Error !!!' + 'Code: ' + IntToStr(nCode));
      end;
      MemoLog.Lines.Add('守卫列表加载成功...');
    end;

    nCode:= FrmDB.LoadNpcs;
    if nCode < 0 then
    begin
      MemoLog.Lines.Add('Load NpcList Error !!!' + 'Code: ' + IntToStr(nCode));
      exit;
    end;
    MemoLog.Lines.Add('管理NPC列表加载成功...');

    nCode:= FrmDB.LoadMakeItem;
    if nCode < 0 then
    begin
      MemoLog.Lines.Add('Load MakeItem Error !!!' + 'Code: ' + IntToStr(nCode));
      exit;
    end;
    MemoLog.Lines.Add('炼制物品信息加载成功...');
    {$I License.inc}
    nCode:= FrmDB.LoadStartPoint;
    if nCode < 0 then begin
      MemoLog.Lines.Add('加载回城点配置时出现错误 !!!(错误码: ' + IntToStr(nCode) + ')');
      Close;
    end;
    MemoLog.Lines.Add('回城点配置加载成功...');
    FrontEngine.Resume;
    MemoLog.Lines.Add('人物数据引擎启动成功...');
    UserEngine.initialize;
    MemoLog.Lines.Add('游戏处理引擎初始化成功...');
    gamename:= g_Config.sServerName ;
  except
    MainOutMessage('服务启动时出现异常错误 !!!');
  end;
end;

procedure TFrmMain.MakeStoneMines();//004E5E88
var
  i,nW,nH:Integer;
  Envir:TEnvirnoment;
 StoneMineEvent: TStoneMineEvent ;
begin
  for i:=0 to g_MapManager.Count -1 do
  begin
    Envir:=TEnvirnoment(g_MapManager.Items[i]);
    if Envir.m_boMINE then
    begin
      for nW:=0 to Envir.m_nWidth - 1 do
      begin
        for nH:=0 to Envir.m_nHeight - 1 do
        begin
          StoneMineEvent:=TStoneMineEvent.Create(Envir,nW,nH,ET_STONEMINE);
          if not StoneMineEvent.m_boAddmapok  then StoneMineEvent.Free;
        end;
      end;
    end;
  end;
end;

function TFrmMain.LoadClientFile():Boolean;
begin
  MemoLog.Lines.Add('正在加载客户端版本信息...');
  MemoLog.Lines.Add('加载客户端版本信息成功...');
  Result:=True;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
var
  nX,nY:Integer;
  Year, Month, Day: Word;
  MemoryStream:TMemoryStream;
  savelist:TStringList;
  sfilename:string;
ResourceString
  sDemoVersion   = '演示版';
  sGateIdx       = '网关';
  sGateIPaddr    = '网关地址';
  sGateListMsg   = '队列数据';
  sGateSendCount = '发送数据';
  sGateMsgCount  = '剩余数据';
  sGateSendKB    = '平均流量';
  sGateUserCount = '最高人数';
  sStorage='Storage';
begin
  SetMenu;

  if not DirectoryExists(g_Config.sEnvirDir) then
  begin
    ShowMessage('核心文件夹' + g_Config.sEnvirDir + '未找到!!!');
    application.Terminate;
  end;
  if not FileExists(g_Config.sEnvirDir + 'top.txt') then
  begin
    SaveList:=TStringList.Create;
    SaveList.Add(';此文件保存天下第一人物的数据');
    SaveList.SaveToFile(g_Config.sEnvirDir + 'top.txt');
    SaveList.Free;
  end;
  if not FileExists(g_Config.sEnvirDir + 'shop.txt') then
  begin
    SaveList:=TStringList.Create;
    SaveList.Add(';此文件保存商城商品的数据');
    SaveList.SaveToFile(g_Config.sEnvirDir + 'shop.txt');
    SaveList.Free;
  end;

  if not DirectoryExists(g_Config.sEnvirDir + sStorage) then
  begin
    CreateDirectory(PChar(g_Config.sEnvirDir + sStorage),nil);
  end;

  if FileExists(g_Config.sEnvirDir + 'top.txt') then
    topfile:=Tinifile.create(g_Config.sEnvirDir + 'top.txt');

  if FileExists(g_Config.sEnvirDir + 'shop.txt') then
    shopfile:=Tinifile.create(g_Config.sEnvirDir + 'shop.txt');

  Randomize;
  g_dwGameCenterHandle:=Str_ToInt(ParamStr(1),0);
  nX:=Str_ToInt(ParamStr(2),-1);
  nY:=Str_ToInt(ParamStr(3),-1);
  if (nX >= 0) or (nY >= 0) then
  begin
    Left:=nX;
    Top:=nY;
  end;

{$IF SoftVersion = VERDEMO}
  sCaptionExtText:=sDemoVersion;
{$IFEND}

  SendGameCenterMsg(SG_FORMHANDLE,IntToStr(Self.Handle));
  MemoryStream:=TMemoryStream.Create;
  Application.Icon.SaveToStream(MemoryStream);

{$IF VEROWNER = TEST}
  g_Config.nAppIconCrc:=-1;
{$IFEND}

  MemoryStream.Free;
  (*DecodeDate(Date, Year, Month, Day);

  if (Year > ENDYEAR) or ((Month * 30 + Day) > ENDMONTH * 30 + ENDDAY) then begin
    Application.MessageBox('程序版本太老,请立即下载最新版本!!!','提示信息',MB_OK + MB_ICONWARNING);
  end;

  if (Year > ENDYEAR) or ((Month * 30 + Day) > ENDMONTH * 30 + ENDDAY + 7) then begin
    Application.MessageBox('请立即下载最新版本!!!','提示信息',MB_OK + MB_ICONERROR);
    //exit;
  end;*)

  GridGate.RowCount:= 21;
  GridGate.Cells[0,0]:=sGateIdx;
  GridGate.Cells[1,0]:=sGateIPaddr;
  GridGate.Cells[2,0]:=sGateListMsg;
  GridGate.Cells[3,0]:=sGateSendCount;
  GridGate.Cells[4,0]:=sGateMsgCount;
  GridGate.Cells[5,0]:=sGateSendKB;
  GridGate.Cells[6,0]:=sGateUserCount;
{$IF SoftVersion = VERDEMO}
  DECODESCRIPT.Visible:=True;
{$IFEND}
  GateSocket:=TServerSocket.Create(Owner);
  GateSocket.OnClientConnect    := GateSocketClientConnect;
  GateSocket.OnClientDisconnect := GateSocketClientDisconnect;
  GateSocket.OnClientError      := GateSocketClientError;
  GateSocket.OnClientRead       := GateSocketClientRead;

  DBSocket.OnConnect        := DBSocketConnect;
  DBSocket.OnError          := DBSocketError;
  DBSocket.OnRead           := DBSocketRead;

  Timer1.OnTimer            := Timer1Timer;
  RunTimer.OnTimer          := RunTimerTimer;
  StartTimer.OnTimer        := StartTimerTimer;
  SaveVariableTimer.OnTimer := SaveVariableTimerTimer;
  ConnectTimer.OnTimer      := ConnectTimerTimer;
  CloseTimer.OnTimer        := CloseTimerTimer;
  MemoLog.OnChange          := MemoLogChange;
  StartTimer.Enabled        := True;
end;

procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
ResourceString
  sCloseServerYesNo = '是否确认关闭游戏服务器?';
  sCloseServerTitle = '确认信息';
begin
  if not boServiceStarted then
  begin
    exit;
  end;
  if g_boExitServer then
  begin
    boStartReady:=False;
    StopService();
    exit;
  end;
  CanClose:=False;
  if Application.MessageBox(PChar(sCloseServerYesNo),PChar(sCloseServerTitle),MB_YESNO + MB_ICONQUESTION) = mrYes then
  begin
    g_boExitServer:=True;
    CloseGateSocket();
    g_Config.boKickAllUser:=True;
    GateSocket.Close;
    CloseTimer.Enabled:=True;
  end;
end;

procedure TFrmMain.CloseTimerTimer(Sender: TObject);
ResourceString
  sCloseServer = '%s [正在关闭服务器(%d/%d)...]';
begin 
  Caption:=format(sCloseServer,[g_Config.sServerName,UserEngine.OnlinePlayObject,FrontEngine.SaveListCount]);
  if UserEngine.OnlinePlayObject = 0 then
  begin
    if FrontEngine.IsIdle then
    begin
      CloseTimer.Enabled:=False;
      Close;
    end;
  end;
end;

procedure TFrmMain.SaveVariableTimerTimer(Sender: TObject);
begin
  SaveItemNumber();
end;

procedure TFrmMain.GateSocketClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var
  ErrorCode: Integer);
begin
  RunSocket.CloseErrGate(Socket,ErrorCode);
end;

procedure TFrmMain.GateSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RunSocket.CloseGate(Socket);
end;

procedure TFrmMain.GateSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RunSocket.AddGate(Socket);
end;

procedure TFrmMain.GateSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  RunSocket.SocketRead(Socket);
end;

procedure TFrmMain.RunTimerTimer(Sender: TObject);
begin
  if boStartReady then
  begin
    RunSocket.Run;
{$IF IDSOCKETMODE = TIMERENGINE}
    FrmIDSoc.Run;
{$IFEND}
    UserEngine.Run;
{$IF USERENGINEMODE = TIMERENGINE}
    ProcessGameRun();     //游戏处理过程
{$IFEND}
    if nServerIndex = 0 then
      FrmSrvMsg.Run
    else
      FrmMsgClient.Run;
  end;
  Inc(n4EBD1C);
  if (GetTickCount - g_dwRunTick) > 250 then
  begin
    g_dwRunTick:=GetTickCount();
    nRunTimeMin:=n4EBD1C;
    if nRunTimeMax > nRunTimeMin then nRunTimeMax:=nRunTimeMin;
    n4EBD1C:=0;
  end;
  if boRemoteOpenGateSocket then
  begin
    if not boRemoteOpenGateSocketed then
    begin
      boRemoteOpenGateSocketed:=True;
      try
        if Assigned(g_GateSocket) then
        begin
          g_GateSocket.Active:=True;
        end;
      except
        on e: Exception do
        begin
          MainOutMessage(E.Message);
          raise;
        end;
      end;
    end;
  end;
end;

procedure TFrmMain.ConnectTimerTimer(Sender: TObject);
begin
  if DBSocket.Active then exit;
  DBSocket.Active:=True;
end;

procedure TFrmMain.ReloadConfig(Sender: TObject);
begin
  try
    LoadConfig();
    FrmIDSoc.Timer1Timer(Sender);
    if not (nServerIndex = 0) then
    begin
      if not FrmMsgClient.MsgClient.Active then
      begin
        FrmMsgClient.MsgClient.Active:=True;
      end;
    end;
    LogUDP.RemoteHost:=g_Config.sLogServerAddr;
    LogUDP.RemotePort:=g_Config.nLogServerPort;
    LoadServerTable();
    LoadClientFile();
  finally

  end;
end;

procedure TFrmMain.MemoLogChange(Sender: TObject);
begin
  if MemoLog.Lines.Count > 500 then MemoLog.Clear;
end;

procedure TFrmMain.MemoLogDblClick(Sender: TObject);
begin
  ClearMemoLog();
end;

procedure TFrmMain.MENU_CONTROL_EXITClick(Sender: TObject);
begin
  Close;
end;

procedure TFrmMain.MENU_CONTROL_RELOAD_CONFClick(Sender: TObject);
begin
  ReloadConfig(Sender);
end;

procedure TFrmMain.MENU_CONTROL_CLEARLOGMSGClick(Sender: TObject);
begin
  ClearMemoLog();
end;

procedure TFrmMain.SpeedButton1Click(Sender: TObject);
begin
  ReloadConfig(Sender);
end;

procedure TFrmMain.MENU_CONTROL_RELOAD_ITEMDBClick(Sender: TObject);
begin
  FrmDB.LoadItemsDB();
  MainOutMessage('重新加载物品数据库完成...');
end;

procedure TFrmMain.MENU_CONTROL_RELOAD_MAGICDBClick(Sender: TObject);
begin
  FrmDB.LoadMagicDB();
  MainOutMessage('重新加载技能数据库完成...');
end;

procedure TFrmMain.MENU_CONTROL_RELOAD_MONSTERDBClick(Sender: TObject);
begin
  FrmDB.LoadMonsterDB();
  MainOutMessage('重新加载怪物数据库完成...');
end;

procedure TFrmMain.StartService;
var
  TimeNow: TDateTime;
  Year, Month, Day, Hour, Min, Sec, MSec:Word;
  F: TextFile;
  Config:pTConfig;
  i:integer;
begin
  Config:=@g_Config;
  MENU_CONTROL_START.Enabled:=False;
  MENU_CONTROL_STOP.Enabled:=False;

  nRunTimeMax       := 99999;

⌨️ 快捷键说明

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