dbsmain.pas
来自「FIR引擎最新源码+注册」· PAS 代码 · 共 1,088 行 · 第 1/3 页
PAS
1,088 行
HumChrDB := nil;
HumDataDB := nil;
LoadConfig();
ResServerArray;
nServerCount := 0;
AttackIPaddrList := TGList.Create; //攻击IP临时列表
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;
SendGameCenterMsg(SG_STARTNOW, '正在启动数据库服务器...');
StartTimer.Enabled := True;
end;
procedure TFrmDBSrv.StartTimerTimer(Sender: TObject);
begin
StartTimer.Enabled := False;
if SizeOf(THumDataInfo) <> 3164 then begin
ShowMessage('sizeof(THuman) ' + IntToStr(SizeOf(THumDataInfo)) + ' <> SIZEOFTHUMAN ' + '3164');
Close;
Exit;
end;
ListView.Items.Clear;
boOpenDBBusy := True;
HumChrDB := TFileHumDB.Create(sHumDBFilePath + 'Hum.DB');
HumDataDB := TFileDB.Create(sDataDBFilePath + 'Mir.DB');
boOpenDBBusy := False;
boAutoClearDB := True;
Label4.Caption := '';
LoadItemsDB();
LoadMagicDB();
ServerSocket.Address := sServerAddr;
ServerSocket.Port := nServerPort;
ServerSocket.Active := True;
FrmIDSoc.OpenConnect();
MainOutMessage('服务器已启动...');
SendGameCenterMsg(SG_STARTOK, '数据库服务器启动完成...');
SendGameCenterMsg(SG_CHECKCODEADDR, IntToStr(Integer(@g_CheckCode)));
if boMinimize then Application.Minimize;
end;
procedure TFrmDBSrv.FormDestroy(Sender: TObject);
var
i, ii: Integer;
begin
if HumDataDB <> nil then HumDataDB.Free;
if HumChrDB <> nil then HumChrDB.Free;
AttackIPaddrList.Lock;
try
for i := 0 to AttackIPaddrList.Count - 1 do begin
Dispose(pTSockaddr(AttackIPaddrList.Items[i]));
end;
finally
AttackIPaddrList.UnLock;
end;
AttackIPaddrList.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;
ServerSocket.Active := False;
MainOutMessage('正在关闭服务器...');
end else begin
CanClose := False;
end;
end;
function TFrmDBSrv.LoadItemsDB(): Integer;
var
i, Idx: Integer;
StdItem: pTStdItem;
nRecordCount: Integer;
resourcestring
sSQLString = 'select * from StdItems';
begin
MainOutMessage('正在加载物品数据...');
try
Result := -1;
Query.SQL.Clear;
Query.DatabaseName := sHeroDB;
Query.SQL.Add(sSQLString);
try
Query.Open;
finally
Result := -2;
end;
nRecordCount := Query.RecordCount;
for i := 0 to nRecordCount - 1 do begin
New(StdItem);
Idx := Query.FieldByName('Idx').AsInteger;
StdItem.Name := Query.FieldByName('Name').AsString;
StdItem.StdMode := Query.FieldByName('StdMode').AsInteger;
StdItem.Shape := Query.FieldByName('Shape').AsInteger;
StdItem.Weight := Query.FieldByName('Weight').AsInteger;
StdItem.AniCount := Query.FieldByName('AniCount').AsInteger;
StdItem.Source := Query.FieldByName('Source').AsInteger;
StdItem.Reserved := Query.FieldByName('Reserved').AsInteger;
StdItem.Looks := Query.FieldByName('Looks').AsInteger;
StdItem.DuraMax := Word(Query.FieldByName('DuraMax').AsInteger);
StdItem.AC := MakeLong(Round(Query.FieldByName('Ac').AsInteger), Round(Query.FieldByName('Ac2').AsInteger));
StdItem.MAC := MakeLong(Round(Query.FieldByName('Mac').AsInteger), Round(Query.FieldByName('MAc2').AsInteger));
StdItem.DC := MakeLong(Round(Query.FieldByName('Dc').AsInteger), Round(Query.FieldByName('Dc2').AsInteger));
StdItem.MC := MakeLong(Round(Query.FieldByName('Mc').AsInteger), Round(Query.FieldByName('Mc2').AsInteger));
StdItem.SC := MakeLong(Round(Query.FieldByName('Sc').AsInteger), Round(Query.FieldByName('Sc2').AsInteger));
StdItem.Need := Query.FieldByName('Need').AsInteger;
StdItem.NeedLevel := Query.FieldByName('NeedLevel').AsInteger;
StdItem.Price := Query.FieldByName('Price').AsInteger;
if StdItemList.Count = Idx then begin
StdItemList.Add(StdItem);
Result := 1;
end else begin
MainOutMessage(Format('加载物品(Idx:%d Name:%s)数据失败!!!', [Idx, StdItem.Name]));
Result := -100;
Exit;
end;
Query.Next;
end;
Result := nRecordCount;
MainOutMessage(Format('物品数据库加载完成(%d)...', [nRecordCount]));
finally
Query.Close;
end;
end;
function TFrmDBSrv.LoadMagicDB(): Integer;
var
i, nRecordCount: Integer;
Magic: pTMagic;
resourcestring
sSQLString = 'select * from Magic';
begin
Result := -1;
MainOutMessage('正在加载技能数据库...');
Query.SQL.Clear;
Query.DatabaseName := sHeroDB;
Query.SQL.Add(sSQLString);
try
Query.Open;
finally
Result := -2;
end;
nRecordCount := Query.RecordCount;
for i := 0 to nRecordCount - 1 do begin
New(Magic);
Magic.wMagicId := Query.FieldByName('MagId').AsInteger;
Magic.sMagicName := Query.FieldByName('MagName').AsString;
Magic.btEffectType := Query.FieldByName('EffectType').AsInteger;
Magic.btEffect := Query.FieldByName('Effect').AsInteger;
Magic.wSpell := Query.FieldByName('Spell').AsInteger;
Magic.wPower := Query.FieldByName('Power').AsInteger;
Magic.wMaxPower := Query.FieldByName('MaxPower').AsInteger;
Magic.btJob := Query.FieldByName('Job').AsInteger;
Magic.TrainLevel[0] := Query.FieldByName('NeedL1').AsInteger;
Magic.TrainLevel[1] := Query.FieldByName('NeedL2').AsInteger;
Magic.TrainLevel[2] := Query.FieldByName('NeedL3').AsInteger;
Magic.TrainLevel[3] := Query.FieldByName('NeedL3').AsInteger;
Magic.MaxTrain[0] := Query.FieldByName('L1Train').AsInteger;
Magic.MaxTrain[1] := Query.FieldByName('L2Train').AsInteger;
Magic.MaxTrain[2] := Query.FieldByName('L3Train').AsInteger;
Magic.MaxTrain[3] := Magic.MaxTrain[2];
Magic.btTrainLv := 3;
Magic.dwDelayTime := Query.FieldByName('Delay').AsInteger;
Magic.btDefSpell := Query.FieldByName('DefSpell').AsInteger;
Magic.btDefPower := Query.FieldByName('DefPower').AsInteger;
Magic.btDefMaxPower := Query.FieldByName('DefMaxPower').AsInteger;
Magic.sDescr := Query.FieldByName('Descr').AsString;
if Magic.wMagicId > 0 then begin
MagicList.Add(Magic);
end else begin
Dispose(Magic);
end;
Result := 1;
Query.Next;
end;
Query.Close;
MainOutMessage(Format('技能数据库加载完成(%d)...', [nRecordCount]));
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.BtnUserDBToolClick(Sender: TObject);
begin
if boHumDBReady and boDataDBReady then
FrmIDHum.Show;
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.ClearSocket(Socket: TCustomWinSocket);
begin
end;
function TFrmDBSrv.CopyHumData(sSrcChrName, sDestChrName,
sUserId: string): Boolean;
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.sName := 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);
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.MyMessage(var MsgData: TWmCopyData);
var
sData: string;
wIdent: Word;
begin
wIdent := HiWord(MsgData.From);
sData := StrPas(MsgData.CopyDataStruct^.lpData);
case wIdent of
GS_QUIT: begin
ServerSocket.Active := False;
m_boRemoteClose := True;
Close();
end;
1: ;
2: ;
3: ;
end;
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.G1Click(Sender: TObject);
begin
try
FrmUserSoc.LoadServerInfo();
LoadIPTable();
LoadGateID();
MainOutMessage('加载网关设置完成...');
except
MainOutMessage('加载网关设置失败...');
end;
end;
procedure TFrmDBSrv.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
MemoLog.Lines.Add(E.Message);
end;
procedure TFrmDBSrv.X1Click(Sender: TObject);
begin
Close;
end;
procedure TFrmDBSrv.N3Click(Sender: TObject);
begin
MainOutMessage(g_sVersion);
MainOutMessage(g_sUpDateTime);
MainOutMessage(g_sProgram);
MainOutMessage(g_sWebSite);
end;
procedure TFrmDBSrv.MENU_OPTION_GENERALClick(Sender: TObject);
begin
FrmSetting := TFrmSetting.Create(Owner);
FrmSetting.Open;
FrmSetting.Free;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?