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

📄 svmain.pas

📁 乐都SQL版传奇全套代码,绝对可编译
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit svMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Buttons, StdCtrls, IniFiles, M2Share,
  Grobal2, HUtil32, RunSock, Envir, ItmUnit, Magic, NoticeM, Guild, Event,
  Castle, FrnEngn, UsrEngn, MudUtil, SyncObjs, Menus, ComCtrls, Grids,
  D7ScktComp, UnitManage, jpeg, Sockets,mylist,Activex,MyUnits,WinSock;
const
    WM_MYMSG = WM_USER + 1;
type


  TFrmMain = class(TForm)
    MemoLog: TMemo;
    Panel1: TPanel;
    LbRunTime: TLabel;
    LbUserCount: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    LbTimeCount: TLabel;
    Label5: TLabel;
    Timer1: TTimer;
    RunTimer: TTimer;
    DBSocket: TClientSocket;
    ConnectTimer: TTimer;
    StartTimer: TTimer;
    SaveVariableTimer: TTimer;
    CloseTimer: TTimer;

    MainMenu: TMainMenu;
    MENU_CONTROL: TMenuItem;
    MENU_CONTROL_START: TMenuItem;
    MENU_CONTROL_STOP: TMenuItem;
    MENU_CONTROL_EXIT: TMenuItem;
    MENU_CONTROL_RELOAD_CONF: TMenuItem;
    MENU_CONTROL_CLEARLOGMSG: TMenuItem;
    MENU_MANAGE: TMenuItem;
    MENU_CONTROL_RELOAD: TMenuItem;
    MENU_CONTROL_RELOAD_ITEMDB: TMenuItem;
    MENU_CONTROL_RELOAD_MAGICDB: TMenuItem;
    MENU_CONTROL_RELOAD_MONSTERDB: TMenuItem;
    MENU_MANAGE_PLUG: TMenuItem;
    MENU_OPTION: TMenuItem;
    MENU_OPTION_GENERAL: TMenuItem;
    MENU_OPTION_SERVERCONFIG: TMenuItem;
    MENU_OPTION_GAME: TMenuItem;
    MENU_OPTION_FUNCTION: TMenuItem;
    MENU_CONTROL_RELOAD_MONSTERSAY: TMenuItem;
    MENU_CONTROL_RELOAD_DISABLEMAKE: TMenuItem;
    LbRunSocketTime: TLabel;
    GridGate: TStringGrid;
    MENU_CONTROL_GATE: TMenuItem;
    MENU_CONTROL_GATE_OPEN: TMenuItem;
    MENU_CONTROL_GATE_CLOSE: TMenuItem;
    Label20: TLabel;
    MENU_VIEW: TMenuItem;
    MENU_VIEW_GATE: TMenuItem;
    MENU_VIEW_SESSION: TMenuItem;
    MENU_VIEW_ONLINEHUMAN: TMenuItem;
    MENU_VIEW_LEVEL: TMenuItem;
    MENU_VIEW_LIST: TMenuItem;
    MENU_MANAGE_ONLINEMSG: TMenuItem;
    MENU_VIEW_KERNELINFO: TMenuItem;
    MENU_TOOLS: TMenuItem;
    MENU_TOOLS_MERCHANT: TMenuItem;
    MENU_TOOLS_NPC: TMenuItem;
    MENU_OPTION_ITEMFUNC: TMenuItem;
    MENU_TOOLS_MONGEN: TMenuItem;
    MENU_TOOLS_TEST: TMenuItem;
    MemStatus: TLabel;
    Lbcheck: TLabel;
    aaa1: TMenuItem;
    DECODESCRIPT: TMenuItem;
    MENU_CONTROL_RELOAD_STARTPOINT: TMenuItem;
    G1: TMenuItem;
    MenuStackTest: TMenuItem;
    MENU_OPTION_MONSTER: TMenuItem;
    MENU_TOOLS_IPSEARCH: TMenuItem;
    MENU_MANAGE_CASTLE: TMenuItem;
    LogUDP: TUdpSocket;
    MENU_CONTROL_RELOAD_SABAK: TMenuItem;

    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure MemoLogChange(Sender: TObject);
    procedure MemoLogDblClick(Sender: TObject);
    procedure MENU_CONTROL_EXITClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_CONFClick(Sender: TObject);
    procedure MENU_CONTROL_CLEARLOGMSGClick(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_ITEMDBClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_MAGICDBClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_MONSTERDBClick(Sender: TObject);
    procedure MENU_CONTROL_STARTClick(Sender: TObject);
    procedure MENU_CONTROL_STOPClick(Sender: TObject);
    procedure MENU_HELP_ABOUTClick(Sender: TObject);
    procedure MENU_OPTION_SERVERCONFIGClick(Sender: TObject);
    procedure MENU_OPTION_GENERALClick(Sender: TObject);
    procedure MENU_OPTION_GAMEClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MENU_OPTION_FUNCTIONClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_MONSTERSAYClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_DISABLEMAKEClick(Sender: TObject);
    procedure MENU_CONTROL_GATE_OPENClick(Sender: TObject);
    procedure MENU_CONTROL_GATE_CLOSEClick(Sender: TObject);
    procedure MENU_CONTROLClick(Sender: TObject);
    procedure MENU_VIEW_GATEClick(Sender: TObject);
    procedure MENU_VIEW_SESSIONClick(Sender: TObject);
    procedure MENU_VIEW_ONLINEHUMANClick(Sender: TObject);
    procedure MENU_VIEW_LEVELClick(Sender: TObject);
    procedure MENU_VIEW_LISTClick(Sender: TObject);
    procedure MENU_MANAGE_ONLINEMSGClick(Sender: TObject);
    procedure MENU_VIEW_KERNELINFOClick(Sender: TObject);
    procedure MENU_TOOLS_MERCHANTClick(Sender: TObject);
    procedure MENU_OPTION_ITEMFUNCClick(Sender: TObject);
    procedure MENU_TOOLS_MONGENClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_STARTPOINTClick(Sender: TObject);
    procedure G1Click(Sender: TObject);
    procedure MENU_OPTION_MONSTERClick(Sender: TObject);
    procedure MENU_MANAGE_CASTLEClick(Sender: TObject);
    procedure MENU_CONTROL_RELOAD_SABAKClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure CloseTimerTimer(Sender: TObject);
    procedure RunTimerTimer(Sender: TObject);
    procedure ConnectTimerTimer(Sender: TObject);
    procedure SaveVariableTimerTimer(Sender: TObject);
    procedure DBSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure DBSocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure DBSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    boServiceStarted: Boolean;
    procedure GateSocketClientError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure GateSocketClientDisconnect(Sender: TObject; Socket:
      TCustomWinSocket);
    procedure GateSocketClientConnect(Sender: TObject; Socket:
      TCustomWinSocket);
    procedure GateSocketClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure StartService();
    procedure StopService();
    procedure SaveItemNumber;

    procedure StartEngine;
    procedure MakeStoneMines;
    procedure ReloadConfig(Sender: TObject);
    procedure ClearMemoLog();
    procedure CloseGateSocket();
    { Private declarations }
  public
    GateSocket: TServerSocket;
    procedure AppOnIdle(Sender: TObject; var Done: Boolean);
    procedure OnProgramException(Sender: TObject; E: Exception);
    procedure SetMenu(); virtual;
    procedure MyMessage(var MsgData: TWmCopyData); message WM_COPYDATA;
    procedure WM_MessageTest(var AMessage : TMessage); message WM_MYMSG;
    { Public declarations }
  end;

function  LoadAbuseInformation(FileName: string): Boolean;
procedure LoadServerTable();
procedure WriteConLog(MsgList: TStringList);
procedure ChangeCaptionText(Msg: PChar; nLen: Integer); stdcall;
procedure UserEngineThread(ThreadInfo: pTThreadInfo); stdcall;
procedure ProcessGameRun();

var
  FrmMain                               : TFrmMain;
  g_GateSocket                          : TServerSocket;
  CrackBuf                              : ^TBmpCrack;
implementation
uses
  LocalDB, InterServerMsg, InterMsgClient, IdSrvClient, FSrvValue,
  GeneralConfig, GameConfig, FunctionConfig, ObjRobot, ViewSession,
  ViewOnlineHuman, ViewLevel, ViewList, OnlineMsg, ViewKernelInfo,
  ConfigMerchant, ItemSet, ConfigMonGen, EDcode, EncryptUnit,
  GameCommand, MonsterConfig, RunDB, CastleManage, about, DataModule_Sql;
var
  sCaption                              : string;
  sCaptionExtText                       : string;
  l_dwRunTimeTick                       : LongWord;
  boRemoteOpenGateSocket                : Boolean = False;
  boRemoteOpenGateSocketed              : Boolean = False;
  sChar                                 : string = ' ?';
  sRun                                  : string = 'Run';

  DllHandle                             : Integer;
  
{$R *.dfm}

procedure ChangeCaptionText(Msg: PChar; nLen: Integer); stdcall;
var
  sMsg                                  : string;
begin
  if (nLen > 0) and (nLen < 30) then
  begin
    setlength(sMsg, nLen);
    Move(Msg^, sMsg[1], nLen);
    sCaptionExtText := sMsg;
  end;

end;

procedure PlugRunOver();
begin
{$IF DEBUG = 0}
  asm
    jz @@Start
    jnz @@Start
    db 0F4h
    db 0EBh
    db 004h
    db 0E8h
    @@Start:
  end;
{$IFEND}
  boRemoteOpenGateSocket := True;
{$IF DEBUG = 0}
  asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
  end;
{$IFEND}
  if RemoteXORKey <> LocalXORKey then
  begin
{$IF DEBUG = 0}
    asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
    end;
{$IFEND}
    sChar := '?';
{$IF DEBUG = 0}
    asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
    end;
{$IFEND}
    sRun := 'run';
{$IF DEBUG = 0}
    asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
    end;
{$IFEND}
{$IF SoftVersion = VERENT}

{$ELSEIF DEBUG = 0}
{$IF DEBUG = 0}
    asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
    end;
{$IFEND}
    FrontEngine.Suspend;
{$IFEND}
{$IF DEBUG = 0}
    asm
    jz @@Start
    jnz @@Start
    db 0E8h
    @@Start:
    end;
{$IFEND}
  end;
end;

function LoadAbuseInformation(FileName: string): Boolean;
var
  i                                     : Integer;
  sText                                 : string;
begin
  Result := False;
  if FileExists(FileName) then
  begin
    AbuseTextList.Clear;
    AbuseTextList.LoadFromFile(FileName);
    i := 0;
    while (True) do
    begin
      if AbuseTextList.Count <= i then
        break;
      sText := Trim(AbuseTextList.Strings[i]);
      if sText = '' then
      begin
        AbuseTextList.Delete(i);
        Continue;
      end;
      Inc(i);
    end;
    Result := True;
  end;
end;

procedure LoadServerTable();                                //004E3E64
var
  i, ii                                 : Integer;
  LoadList                              : TStringList;
  GateList                              : TStringList;

  sLineText, sGateMsg                   : string;
  sIPaddr, sPort            : string;
begin
  for i := 0 to ServerTableList.Count - 1 do
  begin
    TmyList(ServerTableList.Items[i]).Free;
  end;
  ServerTableList.Clear;
  if FileExists('.\!servertable.txt') then
  begin
    LoadList := TStringList.Create;
    try
      LoadList.LoadFromFile('.\!servertable.txt');
      for i := 0 to LoadList.Count - 1 do
      begin
        sLineText := Trim(LoadList.Strings[i]);
        if (sLineText <> '') and (sLineText[1] <> ';') then
        begin
          sGateMsg := Trim(GetValidStr3(sLineText, sGateMsg, [' ', #9]));
          if sGateMsg <> '' then
          begin
            GateList := TStringList.Create;
            for ii := 0 to 30 do
            begin
              if sGateMsg = '' then
                break;
              sGateMsg := Trim(GetValidStr3(sGateMsg, sIPaddr, [' ', #9]));
              sGateMsg := Trim(GetValidStr3(sGateMsg, sPort, [' ', #9]));
              if (sIPaddr <> '') and (sPort <> '') then
              begin
                GateList.AddObject(sIPaddr, TObject(Str_ToInt(sPort, 0)));
              end;
            end;
            ServerTableList.Add(GateList);
          end;
        end;
      end;
    finally
       LoadList.Free;
    End;
  end
  else
  begin
    ShowMessage('文件!servertable.txt未找到!!!');
  end;
end;

procedure WriteConLog(MsgList: TStringList);
var
  i                                     : Integer;
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  sLogDir, sLogFileName                 : string;
  LogFile                               : TextFile;
begin
  if MsgList.Count <= 0 then
    exit;
  DecodeDate(Date, Year, Month, Day);
  DecodeTime(Time, Hour, Min, Sec, MSec);
  if not DirectoryExists(g_Config.sConLogDir) then
  begin
    //CreateDirectory(PChar(g_Config.sConLogDir),nil);
    CreateDir(g_Config.sConLogDir);
  end;
  sLogDir := g_Config.sConLogDir + IntToStr(Year) + '-' + IntToStr2(Month) + '-'
    + IntToStr2(Day);
  if not DirectoryExists(sLogDir) then
  begin
    CreateDirectory(PChar(sLogDir), nil);
  end;
  sLogFileName := sLogDir + '\C-' + IntToStr(nServerIndex) + '-' +
    IntToStr2(Hour) + 'H' + IntToStr2((Min div 10 * 2) * 5) + 'M.txt';
  AssignFile(LogFile, sLogFileName);
  if not FileExists(sLogFileName) then
  begin
    Rewrite(LogFile);
  end
  else
  begin
    Append(LogFile);
  end;
  for i := 0 to MsgList.Count - 1 do
  begin
    WriteLn(LogFile, '1' + #9 + MsgList.Strings[i]);
  end;                                                      // for
  CloseFile(LogFile);
end;


procedure TFrmMain.SaveItemNumber();
var
  i                                     : Integer;
begin
  try
    Config.WriteInteger('Setup', 'ItemNumber', g_Config.nItemNumber);
    Config.WriteInteger('Setup', 'ItemNumberEx', g_Config.nItemNumberEx);
    for i := Low(g_Config.GlobalVal) to High(g_Config.GlobalVal) do
    begin
      Config.WriteInteger('Setup', 'GlobalVal' + IntToStr(i),g_Config.GlobalVal[i])
    end;
    Config.WriteInteger('Setup', 'WinLotteryCount', g_Config.nWinLotteryCount);
    Config.WriteInteger('Setup', 'NoWinLotteryCount',g_Config.nNoWinLotteryCount);
    Config.WriteInteger('Setup', 'WinLotteryLevel1', g_Config.nWinLotteryLevel1);
    Config.WriteInteger('Setup', 'WinLotteryLevel2', g_Config.nWinLotteryLevel2);
    Config.WriteInteger('Setup', 'WinLotteryLevel3', g_Config.nWinLotteryLevel3);
    Config.WriteInteger('Setup', 'WinLotteryLevel4', g_Config.nWinLotteryLevel4);
    Config.WriteInteger('Setup', 'WinLotteryLevel5',g_Config.nWinLotteryLevel5);

⌨️ 快捷键说明

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