dbsmain.pas

传奇服务端代码 DBServerSQL.rar 通讯部分

          HumanRCD.Header.sChrName := sChrName;
          HumanRCD.Data := HumData;
          HumDataDB.Add(HumanRCD);
          nIndex := HumDataDB.Index(sChrName);
        end;
        if nIndex >= 0 then begin
          HumDataDB.Get(nIndex, HumanRCD);

          HumanRCD.Header.sChrName := sChrName;
          HumanRCD.Data := HumData;
          HumDataDB.Update(nIndex, HumanRCD);
          bo21 := False;
        end;
      end;
    finally
      HumDataDB.Close;
    end;
    FrmIDSoc.SetSessionSaveRcd(sUserID);
  end;
  if not bo21 then begin
    for i := 0 to HumSessionList.Count - 1 do begin
      HumSession := HumSessionList.Items[i];
      if (HumSession.sChrName = sChrName) and (HumSession.nIndex = nRecog) then
      begin
        HumSession.dwTick30 := GetTickCount();
        break;
      end;
    end;
    m_DefMsg := MakeDefaultMsg(DBR_SAVEHUMANRCD, 1, 0, 0, 0);
    SendSocket(Socket, EncodeMessage(m_DefMsg));
  end else begin
    m_DefMsg := MakeDefaultMsg(DBR_LOADHUMANRCD, 0, 0, 0, 0);
    SendSocket(Socket, EncodeMessage(m_DefMsg));
  end;
end;
//004A9104
procedure TFrmDBSrv.SaveHumanRcdEx(sMsg: string; nRecog: integer;
  Socket: TCustomWinSocket);
var
  sChrName: string;
  sUserID: string;
  sHumanRCD: string;
  I:      integer;
  HumSession: pTHumSession;
begin
  sHumanRCD := GetValidStr3(sMsg, sUserID, ['/']);
  sHumanRCD := GetValidStr3(sHumanRCD, sChrName, ['/']);
  sUserID   := DecodeString(sUserID);
  sChrName  := DecodeString(sChrName);
  for i := 0 to HumSessionList.Count - 1 do begin
    HumSession := HumSessionList.Items[i];
    if (HumSession.sChrName = sChrName) and (HumSession.nIndex = nRecog) then begin
      HumSession.bo24     := False;
      HumSession.Socket   := Socket;
      HumSession.bo2C     := True;
      HumSession.dwTick30 := GetTickCount();
      break;
    end;
  end;
  SaveHumanRcd(nRecog, sMsg, Socket);
end;

procedure TFrmDBSrv.Timer1Timer(Sender: TObject);
begin
  LbTransCount.Caption := IntToStr(n348);
  n348 := 0;
  if ServerList.Count > 0 then Label1.Caption := 'Ready...'
  else
    Label1.Caption := 'Not Ready !!';
  Label2.Caption := 'ServerCount: ' + IntToStr(ServerList.Count);
  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;

procedure TFrmDBSrv.FormCreate(Sender: TObject);
var
  nX, nY: integer;
begin
  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;

  // SendGameCenterMsg(SG_FORMHANDLE,IntToStr(Self.Handle));

  boOpenDBBusy := True;
  label4.Caption := '';
  LbAutoClean.Caption := '-/-';
  HumChrDB  := nil;
  HumDataDB := nil;

  LoadConfig();
  ServerList := TList.Create;
  HumSessionList := TList.Create;
  Label5.Caption := 'FDB: ' + sDataDBFilePath + 'Mir.DB  ' + 'Backup: ' + sBackupPath;
  n334    := 0;
  ServerSocket.Address := sServerAddr;
  ServerSocket.Port := nServerPort;
  ServerSocket.Active := True;
  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;
end;

procedure TFrmDBSrv.FormDestroy(Sender: TObject);
var
  i: integer;
  ServerInfo: pTServerInfo;
  HumSession: pTHumSession;
begin
  if HumDataDB <> nil then HumDataDB.Free;
  if HumChrDB <> nil then HumChrDB.Free;
  for i := 0 to ServerList.Count - 1 do begin
    ServerInfo := ServerList.Items[i];
    Dispose(ServerInfo);
  end;
  ServerList.Free;

  for i := 0 to HumSessionList.Count - 1 do begin
    HumSession := HumSessionList.Items[i];
    Dispose(HumSession);
  end;

  HumSessionList.Free;
end;

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

  if MessageDlg('Do you want to quit DBServer?', mtConfirmation, [mbYes, mbNo], 0) =
    mrYes then begin
    CanClose := True;
    ServerSocket.Active := False;
    MainOutMessage('Server Closing...');
  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);
begin
  StartTimer.Enabled := False;
  boOpenDBBusy  := True;
  InitializeSQL;
  HumChrDB      := TFileHumDB.Create(sHumDBFilePath + 'Hum.DB');
  HumDataDB     := TFileDB.Create;
  boOpenDBBusy  := False;
  boAutoClearDB := True;
  Label4.Caption := '';
  FrmIDSoc.OpenConnect();
  OutMainMessage('Server Started...');

{  try
    if HumDataDB.Open then begin
      HumDataDB.Test;
    end;
  finally
    HumDataDB.Close;
  end;}
end;

procedure TFrmDBSrv.Timer2Timer(Sender: TObject);
var
  i: integer;
  HumSession: pTHumSession;
begin
  i := 0;

  while (True) do begin
    if HumSessionList.Count <= i then break;
    HumSession := HumSessionList.Items[i];
    if not HumSession.bo24 then begin
      if HumSession.bo2C then begin
        if (GetTickCount - HumSession.dwTick30) > 20 * 1000 then begin
          Dispose(HumSession);
          HumSessionList.Delete(i);
          Continue;
        end;
      end else begin//004A868F
        if (GetTickCount - HumSession.dwTick30) > 2 * 60 * 1000 then begin
          Dispose(HumSession);
          HumSessionList.Delete(i);
          Continue;
        end;
      end;
    end;//004A86D2
    if (GetTickCount - HumSession.dwTick30) > 40 * 60 * 1000 then begin
      Dispose(HumSession);
      HumSessionList.Delete(i);
      Continue;
    end;
    Inc(i);
  end;

end;

procedure TFrmDBSrv.BtnUserDBToolClick(Sender: TObject);
begin
  if boHumDBReady and boDataDBReady then FrmIDHum.Show;
end;

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

procedure TFrmDBSrv.BtnEditAddrsClick(Sender: TObject);
begin
  FrmEditAddr.Open();
end;

procedure TFrmDBSrv.CkViewHackMsgClick(Sender: TObject);
var
  Conf: TIniFile;
begin
  Conf := TIniFile.Create(sConfFileName);
  if Conf <> nil then begin
    Conf.WriteBool('Setup', 'ViewHackMsg', CkViewHackMsg.Checked);
    Conf.Free;
  end;
end;

procedure TFrmDBSrv.WriteLogMsg(sMsg: string);
begin
//
end;

procedure TFrmDBSrv.OutMainMessageA(sMsg: string);
begin
//
end;

procedure TFrmDBSrv.MainOutMessage(sMsg: string);
begin
  MemoLog.Lines.Add(sMsg);
end;
//004A80DC
procedure TFrmDBSrv.ClearSocket(Socket: TCustomWinSocket);

var
  nIndex:     integer;
  HumSession: pTHumSession;
begin
  nIndex := 0;

  while (True) do begin
    if HumSessionList.Count <= nIndex then break;
    HumSession := HumSessionList.Items[nIndex];
    if HumSession.Socket = Socket then begin
      Dispose(HumSession);
      HumSessionList.Delete(nIndex);
      Continue;
    end;
    Inc(nIndex);
  end;

end;

function TFrmDBSrv.CopyHumData(sSrcChrName, sDestChrName, sUserID: string): boolean;
  //0x004A8864
var
  n14:      integer;
  bo15:     boolean;
  HumanRCD: THumDataInfo;
begin
  Result := False;
  bo15   := False;
  try
    if HumDataDB.Open then begin
      n14 := HumDataDB.Index(sSrcChrName);
      if (n14 >= 0) and (HumDataDB.Get(n14, HumanRCD) >= 0) then bo15 := True;
      if bo15 then begin
        n14 := HumDataDB.Index(sDestChrName);
        if (n14 >= 0) then begin
          HumanRCD.Header.sChrName  := sDestChrName;
          HumanRCD.Data.sChrName := sDestChrName;
          HumanRCD.Data.sAccount := sUserID;
          HumDataDB.Update(n14, HumanRCD);
          Result := True;
        end;
      end;
    end;
  finally
    HumDataDB.Close;
  end;
end;

procedure TFrmDBSrv.DelHum(sChrName: string);
//0x004A89F4
begin
  try
    if HumChrDB.Open then HumChrDB.Delete(sChrName);
  finally
    HumChrDB.Close;
  end;
end;



procedure TFrmDBSrv.MENU_MANAGE_DATAClick(Sender: TObject);
begin
  if boHumDBReady and boDataDBReady then FrmIDHum.Show;
end;

procedure TFrmDBSrv.MENU_MANAGE_TOOLClick(Sender: TObject);
begin
  frmDBTool.Top  := Self.Top + 20;
  frmDBTool.Left := Self.Left;
  frmDBTool.Open();
end;

procedure TFrmDBSrv.V1Click(Sender: TObject);
begin
  //showmessage(BoolToStr(CheckChrName('江湖浪客')));
end;

procedure TFrmDBSrv.MENU_TEST_SELGATEClick(Sender: TObject);
begin
  frmTestSelGate := TfrmTestSelGate.Create(Owner);
  frmTestSelGate.ShowModal;
  frmTestSelGate.Free;
end;

procedure TFrmDBSrv.MENU_CONTROL_STARTClick(Sender: TObject);
begin
  if Sender = MENU_CONTROL_START then begin

  end else if Sender = MENU_OPTION_GAMEGATE then begin
    frmRouteManage.Open;
  end;

end;

procedure TFrmDBSrv.Exit1Click(Sender: TObject);
begin
  Close;
end;

end.