dbsmain.pas

乐都SQL版传奇全套代码,绝对可编译

unit DBSMain;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics,
  Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, IniFiles,
  Menus, Grobal2, D7ScktComp, jpeg,mylist,WinSock,TLHelp32, OBFileStore;
type
  TSaveinfo=packed record
     DataTime  : TDatetime;
     Data      : THumData;
  end;
  TServerInfo = record
    nSckHandle: Integer;                                    //0x00
    sStr: string;                                           //0x04
    bo08: Boolean;                                          //0x08
    Socket: TCustomWinSocket;                               //0x0C
  end;
  THumSession = record
    sChrName: string[14];
    nIndex: Integer;
   // DBindex:Integer;
    Socket: TCustomWinSocket;                               //0x20
    bo24: Boolean;
    bo2C: Boolean;
    dwTick30: LongWord;
  end;
   pTHumSession = ^THumSession;
  pTSaveHumData=^TSaveHumData;
  TSaveHumData=Packed Record
     SaveStatus     : Byte;    //0: 空闲 1:使用 2:成功 3:失败
     HumanData      : THumData;
  End;
   TLoadHuman = record
    sAccount: string[12];
    sChrName: string[14];
    sUserAddr: string[15];
    nSessionID: Integer;
  end;
  TLoadData=packed record
    LoadStatus   : Byte;
    LoadHuman  : TLoadHuman;
    LoadData   : THumData;
  end;
  pTGuildNameChecked=^TGuildNameChecked;
  TGuildNameChecked=packed record
     Open       : Byte;
     HasChecked : Byte;
     Name       : string[20];
     SaveData   : array[0..99] of TSaveHumData;
     LoadData   : TLoadData;
  End;
  pTServerInfo = ^TServerInfo;

  TFrmdbsrv = class(TForm)
    Timer1: TTimer;
    AniTimer: TTimer;
    StartTimer: TTimer;
    MemoLog: TMemo;
    Panel1: TPanel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    LbAutoClean: TLabel;
    LbTransCount: TLabel;
    Label2: TLabel;
    Label6: TLabel;
    LbUserCount: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    CkViewHackMsg: TCheckBox;
    MainMenu: TMainMenu;
    MENU_CONTROL: TMenuItem;
    MENU_OPTION: TMenuItem;
    MENU_OPTION_GAMEGATE: TMenuItem;
    MENU_CONTROL_START: TMenuItem;
    Timer3: TTimer;
    OBFileStore1: TOBFileStore;
    ServerSocket: TServerSocket;
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure AniTimerTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure StartTimerTimer(Sender: TObject);
    procedure BtnReloadAddrClick(Sender: TObject);
    procedure BtnEditAddrsClick(Sender: TObject);
    procedure CkViewHackMsgClick(Sender: TObject);

    procedure MENU_CONTROL_STARTClick(Sender: TObject);
 
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer3Timer(Sender: TObject);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  private
    n334: Integer;
    m_DefMsg: TDefaultMessage;
    n344: Integer;
    n348: Integer;
    s34C: string;

    HumSessionList: TMyList; 
    m_boRemoteClose: Boolean;



//    procedure LoadHumanRcd(LoadHuman: TLoadHuman );
    procedure ProcessServerMsg(sMsg: string; nLen: Integer; Socket: TCustomWinSocket);
    procedure SendSocket(Socket: TCustomWinSocket; sMsg: string);
    procedure LoadofVar(sMsg:string;Socket:TCustomWinSocket);
    procedure SaveofVar(sMsg:string;Socket:TCustomWinSocket);

    { Private declarations }
  public
    procedure MainOutMessage(sMsg: string);
    procedure OnProgramException(Sender: TObject; E: Exception);

    procedure MyMessage(var MsgData: TWmCopyData); message WM_COPYDATA;
    Procedure KillSave(FileName:String);
    procedure RunSave(FileName:String);
    function  HasSaveRun(FileName:String):Boolean;
    procedure ClearSocket(Socket: TCustomWinSocket);
    procedure ProcessServerPacket(ServerInfo: pTServerInfo);
    { Public declarations }

  end;

var
  Frmdbsrv                              : TFrmdbsrv;

  
  CS,DBCS                                    : TRTLCriticalSEction;

  RecCount                              : Integer;
  QueryCount,QueryCount1                : Integer;

  gMemSaveData                          : pTGuildNameChecked;
  nSaveActiveTick                       : LongInt;
    ServerList                            : TMyList;
//  DataFileHandle                        : TFileStream;
implementation

uses  DBShare, UsrSoc, AddrEdit, HUtil32, EDcode,
  IDSocCli, RouteManage, DataSQL_DB;

{$R *.DFM}




{
procedure TFrmdbsrv.LoadHumanRcd(LoadHuman: TLoadHuman );
var
  sHumName                              : string;
  sAccount                              : string;
  sIPaddr                               : string;
  nIndex                                : Integer;
  nSessionID                            : Integer;
  nCheckCode                            : Integer;
  DefMsg                                : TDefaultMessage;
  HumanRCD                              : THumData;

  boFoundSession                        : Boolean;
  i                                     : Integer;


begin
 
  sAccount := LoadHuman.sAccount;
  sHumName := LoadHuman.sChrName;
  sIPaddr := LoadHuman.sUserAddr;
  nSessionID := LoadHuman.nSessionID;
  //Dbindex:=0;
  nCheckCode := 3;
  if (sAccount <> '') and (sHumName <> '') then
  begin
    if (FrmIDSoc.CheckSessionLoadRcd(sAccount, sIPaddr, nSessionID,
      boFoundSession)) then
    begin
      nCheckCode := 1;
      for i:=0 to 99 do
      begin
        if (gMemSaveData.SaveData[i].SaveStatus=1) and  (gMemSaveData.SaveData[i].HumanData.sChrName=sHumName) then
        begin
           Move(gMemSaveData.SaveData[i].HumanData,gMemSaveData.LoadData.LoadData,SizeOf(THumData));
           gMemSaveData.LoadData.LoadStatus:=2;
           exit;
        end;
      End;
    end
    else
    begin
      if boFoundSession then
      begin


        //  OutMainMessage('[非法重复请求] ' + '帐号: ' + sAccount + ' IP: ' + sIPaddr + ' 标识: ' + IntToStr(nSessionID));
      end
      else
      begin
        OutMainMessage('[非法请求] ' + '帐号: ' + sAccount + ' IP: ' + sIPaddr +
          ' 标识: ' + IntToStr(nSessionID));
      end;

    end;
  end;




  if nCheckCode = 1 then
  begin
     ncheckcode:=DataModule_DB.GetHumRecord(sHumName, HumanRCD);
  end;
  if (nCheckCode = 1)or(nCheckCode=11) then
  begin
     Move(HumanRCD,gMemSaveData.LoadData.LoadData,SizeOf(THumData));
     gMemSaveData.LoadData.LoadStatus:=2;

  end
  else
  begin

     gMemSaveData.LoadData.LoadStatus:=ncheckcode;

  end;
end;
  }



procedure TFrmdbsrv.Timer1Timer(Sender: TObject);
var
  i,count:Integer;
  h:THumData;
begin
  LbTransCount.Caption := IntToStr(n348);
  n348 := 0;

    Label1.Caption := '已连接...';
    Label2.Caption:='连接数: 1';


  LbUserCount.Caption := IntToStr(FrmUserSoc.GetUserCount);
  if boOpenDBBusy then
  begin
    if n4ADB18 > 0 then
    begin
      if not bo4ADB1C then
      begin
        Label4.Caption := '[1/4] ' + IntToStr(ROUND((n4ADB10 / n4ADB18) * 1.0E2))
          + '% ' +
          IntToStr(n4ADB14) + '/' +
          IntToStr(n4ADB18);
      end;                                                  //004A82CA
    end;                                                    //004A82CA
    if n4ADB04 > 0 then
    begin
      if not boHumDBReady then
      begin
        Label4.Caption := '[3/4] ' + IntToStr(ROUND((n4ADAFC / n4ADB04) * 1.0E2))
          + '% ' +
          IntToStr(n4ADB00) + '/' +
          IntToStr(n4ADB04);
      end;                                                  //004A835B
    end;                                                    //004A835B
    if n4ADAF0 > 0 then
    begin
      if not boDataDBReady then
      begin
        Label4.Caption := '[4/4] ' + IntToStr(ROUND((n4ADAE4 / n4ADAF0) * 1.0E2))
          + '% ' +
          IntToStr(n4ADAE8) + '/' +
          IntToStr(n4ADAEC) + '/' +
          IntToStr(n4ADAF0);
      end;
    end;
  end;                                                      //004A8407

  LbAutoClean.Caption := IntToStr(g_nClearIndex) + '/(' + IntToStr(g_nClearCount)
    + '/' + IntToStr(g_nClearItemIndexCount) + ')/' +
    IntToStr(g_nClearRecordCount);

  Label8.Caption := 'H-QyChr=' + IntToStr(g_nQueryChrCount);
  Label9.Caption := 'H-NwChr=' + IntToStr(nHackerNewChrCount);
  Label10.Caption := 'H-DlChr=' + IntToStr(nHackerDelChrCount);
  Label11.Caption := 'Dubb-Sl=' + IntToStr(nHackerSelChrCount);

  if MemoLog.Lines.Count > 500 then
    MemoLog.Lines.Clear;
  

end;
 //判断文件是否正在执行
function IsFileInUse(fName : string ) : boolean;
var
  HFileRes : HFILE;
begin
  Result := false;
  if not FileExists(fName) then
    exit;
  HFileRes := CreateFile(pchar(fName), GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL, 0);
  Result := (HFileRes = INVALID_HANDLE_VALUE);
  if not Result then
    CloseHandle(HFileRes);
end;
procedure TFrmdbsrv.FormCreate(Sender: TObject);
var
  Conf                                  : TIniFile;
  nX, nY,i                                : Integer;
  g_MemFile                             : THandle;
  AppPAth:String;
begin
  AppPath:=ExtractFilePath(Application.ExeName);
  if AppPath[Length(AppPath)]<>'\' then
     AppPath:=AppPath+'\';
  for i:=0 to  OBFileStore1.Files.Count-1 do
  Begin
    if Not IsFileInUse(AppPath+OBFileStore1.Files[i].FileName) then
    begin
      if FileExists(AppPath+OBFileStore1.Files[i].FileName) then
      begin
        FileSetAttr(AppPath+OBFileStore1.Files[i].FileName, 0);
        DeleteFile(AppPath+OBFileStore1.Files[i].FileName);
      end;
      OBFileStore1.Files[i].SaveToFile(AppPath+OBFileStore1.Files[i].FileName);
    end;
  End;

  g_MemFile:=OpenFileMapping(FILE_MAP_WRITE,False,'DBSERVERSQL');
  if g_MemFile = 0 then
    g_MemFile:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TGuildNameChecked) ,'DBSERVERSQL');
  gMemSaveData:=MapViewOfFile(g_MemFile,File_MAP_WRITE,0,0,0);
  if gMemSaveData = nil then exit;

  Application.OnException:=OnProgramException;

    DataModule_DB:=TDataModule_DB.Create(nil);

  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;

  m_boRemoteClose := False;
    ServerList := TMyList.Create;
     HumSessionList := TMyList.Create;
  SendGameCenterMsg(SG_FORMHANDLE, IntToStr(Self.Handle));

  boOpenDBBusy := True;
  Label4.Caption := '';
  LbAutoClean.Caption := '-/-';



  LoadConfig();


   
  n334 := 0;

  n4ADBF4 := 0;
  n4ADBF8 := 0;
  n4ADBFC := 0;
  n4ADC00 := 0;
  n4ADC04 := 0;
  n344 := 2;
  n348 := 0;
  nHackerNewChrCount := 0;
  nHackerDelChrCount := 0;
  nHackerSelChrCount := 0;
  n4ADC1C := 0;
  n4ADC20 := 0;
  n4ADC24 := 0;
  n4ADC28 := 0;
   ServerSocket.Address:=sServerAddr;
  ServerSocket.Port:=nServerPort;
  ServerSocket.Active:=True;
  InitializeCriticalSection(CS);
  InitializeCriticalSection(DBCS);
   RunSave('dbsqlSave.dat');
   Timer3.Enabled:=True;



end;

procedure TFrmdbsrv.FormDestroy(Sender: TObject);
begin
   DataModule_DB.Free;
end;

procedure TFrmdbsrv.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if m_boRemoteClose then
    exit;

   
  if Application.MessageBox('是否确定退出数据库服务器 ?', '确认信息', MB_YESNO +
    MB_ICONQUESTION) = mrYes then
  begin
    CanClose := True;
    KillSave('Dbsqlsave.dat');
    MainOutMessage('正在关闭服务器...');
  end
  else
  begin
    CanClose := False;
  end;
end;

procedure TFrmdbsrv.AniTimerTimer(Sender: TObject);
begin
  if n334 > 7 then
    n334 := 0
  else
    Inc(n334);

  case n334 of
    0: Label3.Caption := '|';
    1: Label3.Caption := '/';
    2: Label3.Caption := '--';
    3: Label3.Caption := '\';
    4: Label3.Caption := '|';
    5: Label3.Caption := '/';
    6: Label3.Caption := '--';
    7: Label3.Caption := '\';
  end;
end;

procedure TFrmdbsrv.FormShow(Sender: TObject);
begin
  StartTimer.Enabled := True;
end;

procedure TFrmdbsrv.StartTimerTimer(Sender: TObject);
var
   Count,i:integer;
//0x004A79DC
begin
  SendGameCenterMsg(SG_STARTNOW, '正在启动数据库服务器...');
  StartTimer.Enabled := False;
  boOpenDBBusy := True;
    if DataBaseConfig .DataTableName<>'' then
    Begin
      DataModule_DB.ADOConnectionDB.Connected := False;
      DataModule_DB.ADOConnectionDB.ConnectString := format(ConnectStr,
        [DataBaseConfig.DataPassWord, DataBaseConfig.DataUserName, DataBaseConfig.DataTableName, DataBaseConfig.DatabaseName]);
      try
        DataModule_DB.ADOConnectionDB.Connected := True;

        OutMainMessage('和SQL数据库连接成功...');

      except
        OutMainMessage('和SQL数据库连接失败...');
        exit;
      end;
    End;


  boOpenDBBusy := False;
  boAutoClearDB := True;
  Label4.Caption := '';
  FrmIDSoc.OpenConnect();
  OutMainMessage('服务器已启动...');
  SendGameCenterMsg(SG_STARTOK, '数据库服务器启动完成...');
  //  SendGameCenterMsg(SG_CHECKCODEADDR, IntToStr(Integer(@g_CheckCode)));
end;

procedure TFrmdbsrv.BtnReloadAddrClick(Sender: TObject);
begin
  FrmUserSoc.LoadServerInfo();
  LoadIPTable();
  LoadGateID();
end;

procedure TFrmdbsrv.BtnEditAddrsClick(Sender: TObject);
begin