dbsmain.pas

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

  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.MainOutMessage(sMsg: string);
begin
  MemoLog.Lines.Add(sMsg)
end;
//004A80DC


procedure TFrmdbsrv.MyMessage(var MsgData: TWmCopyData);
var
  sData             : string;
  ProgramType       : TProgamType;
  wIdent            : Word;
begin
  wIdent := HiWord(MsgData.From);
  //  ProgramType:=TProgamType(LoWord(MsgData.From));
  sData := StrPas(MsgData.CopyDataStruct^.lpData);
  case wIdent of                        //
    GS_QUIT:
      begin

        m_boRemoteClose := True;
        Close();
      end;
    1: ;
    2: ;
    3: ;
  end;                                  // case
end;


procedure TFrmdbsrv.MENU_CONTROL_STARTClick(Sender: TObject);
var
  i:Integer;
begin
 // gMemSaveData.HumanData.sChrName:='︶ㄣ亂戰〆阳阳';
 // gMemSaveData.HasSaved:=1;
  if Sender = MENU_CONTROL_START then
  begin

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

end;

 
{ MyTread }


procedure TFrmdbsrv.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteCriticalSection(CS);
DeleteCriticalSection(DbCS);
end;





procedure TFrmdbsrv.Timer3Timer(Sender: TObject);
var
  i:integer;
  SaveInfo:TSaveinfo;
  HasSave:Boolean;
begin

   if gMemSaveData.LoadData.LoadStatus=1 then
   begin
    //  LoadHumanRcd(gMemSaveData.LoadData.LoadHuman);
    //  SaveInfo.DataTime:=Now();
    //  Move(gMemSaveData.LoadData.LoadData,SaveInfo.Data,SizeOf(ThumData));
   //   DataFileHandle.Write(Saveinfo,SizeOf(TSaveinfo));

   end;
   HasSave:=False;
   for i:=0 to 99 do
   begin
       if gMemSaveData.SaveData[i].SaveStatus=2 then
       begin
          FrmIDSoc.SetSessionSaveRcd(gMemSaveData.savedata[i].HumanData.saccount);
          gMemSaveData.SaveData[i].SaveStatus:=0;
          nSaveActiveTick:=GetTickCount;
       end;
       if gMemSaveData.SaveData[i].SaveStatus=1 then
           HasSave:=True;
   end;
   if HasSave and((GetTickCount-nSaveActiveTick)>5*60*1000) then
   begin
     //OutMainMessage('存盘已死');
     KillSave('Dbsqlsave.dat');
     Inc(nHackerSelChrCount);
     nSaveActiveTick:=GetTickCount;
     RunSave('dbsqlSave.dat');
   End;
end;

procedure TFrmdbsrv.OnProgramException(Sender: TObject; E: Exception);
begin
//MainOutMessage(E.Message);
end;

procedure TFrmdbsrv.KillSave(FileName: String);

const
  PROCESS_TERMINATE=$0001;
var
  ExeFileName: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  ExeFileName := FileName;//你要结束的程序名称！
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
    begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(ExeFileName))) then
      TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0),
                        FProcessEntry32.th32ProcessID), 0);
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
end;


procedure TFrmdbsrv.RunSave(FileName: String);
begin
  while HasSaveRun('DBSqlSave.dat') do
  Begin
      KillSave('DBSqlSave.dat');
      Application.ProcessMessages;
  End;

  WinExec('DBSqlSave.dat',1);
   nSaveActiveTick:=GetTickCount;
end;

function TFrmdbsrv.HasSaveRun(FileName: String): Boolean;
const
  PROCESS_TERMINATE=$0001;
var
  ExeFileName: String;
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result:=False;
  ExeFileName := FileName;//你要结束的程序名称！
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle,FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
    begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) =
         UpperCase(ExeFileName))
     or (UpperCase(FProcessEntry32.szExeFile) =
         UpperCase(ExeFileName))) then
      Begin
        Result:=True;
        break;
      end;
    ContinueLoop := Process32Next(FSnapshotHandle,FProcessEntry32);
    end;
end;

procedure TFrmdbsrv.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  ServerInfo                            : pTServerInfo;
  sIPaddr                               : string;
begin
  sIPaddr := Socket.RemoteAddress;
  if not CheckServerIP(sIPaddr) then
  begin
    OutMainMessage('非法服务器连接: ' + sIPaddr);
    Socket.Close;
    exit;
  end;

  if not boOpenDBBusy then
  begin
    New(ServerInfo);
    ServerInfo.bo08 := True;
    ServerInfo.nSckHandle := Socket.SocketHandle;
    ServerInfo.sStr := '';
    ServerInfo.Socket := Socket;
    ServerList.Add(ServerInfo);
  end
  else
  begin
    Socket.Close;
  end;
end;

procedure TFrmdbsrv.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i                                     : Integer;
  ServerInfo                            : pTServerInfo;
begin
  for i := 0 to ServerList.Count - 1 do
  begin
    ServerInfo := ServerList.Items[i];
    if ServerInfo.nSckHandle = Socket.SocketHandle then
    begin
      Dispose(ServerInfo);
      ServerList.Delete(i);
      ClearSocket(Socket);
      break;
    end;
  end;
end;


procedure TFrmdbsrv.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode := 0;
  Socket.Close;
end;
procedure TFrmdbsrv.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i                                     : Integer;
  ServerInfo                            : pTServerInfo;
  s10                                   : string;
begin
  g_CheckCode.dwThread0 := 1001000;
  for i := 0 to ServerList.Count - 1 do
  begin
    g_CheckCode.dwThread0 := 1001001;
    ServerInfo := ServerList.Items[i];
    if ServerInfo=nil then continue;

    g_CheckCode.dwThread0 := 1001002;
    if ServerInfo.nSckHandle = Socket.SocketHandle then
    begin
      g_CheckCode.dwThread0 := 1001003;
      s10 := Socket.ReceiveText;
      Inc(n4ADBF4);
      if s10 <> '' then
      begin
        g_CheckCode.dwThread0 := 1001004;
        try
          EnterCriticalSection(CS);
          ServerInfo.sStr := ServerInfo.sStr + s10;
        finally
          LeaveCriticalSection(CS);
        End;

        g_CheckCode.dwThread0 := 1001005;
        if Pos('!', s10) > 0 then
        begin
          g_CheckCode.dwThread0 := 1001006;
          ProcessServerPacket(ServerInfo);
          g_CheckCode.dwThread0 := 1001007;
          Inc(n4ADBF8);
          Inc(n348);
          break;
        end
        else
        begin                                               //004A7DC7
          if Length(ServerInfo.sStr) > 81920 then
          begin
            ServerInfo.sStr := '';
            Inc(n4ADC2C);
          end;
        end;
       
      end;
      break;
    end;
  end;
  g_CheckCode.dwThread0 := 1001008;
end;

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;

procedure TFrmdbsrv.ProcessServerPacket(ServerInfo: pTServerInfo);
var
  bo25                                  : Boolean;
  SC, s1C, s20, s24                     : string;
  n14, n18                              : Integer;
  wE, w10                               : Word;
  DefMsg                                : TDefaultMessage;
begin

  if boOpenDBBusy then
    exit;
  try
    bo25 := False;
    EnterCriticalSection(CS);
    TRY
       s1C := ServerInfo.sStr;
       s20 := '';
       g_CheckCode.dwThread0 := 1001101;
       s1C := ArrestStringEx(s1C, '#', '!', s20);
       ServerInfo.sStr:=s1C;
    Finally
       LeaveCriticalSection(CS);
    End;
    g_CheckCode.dwThread0 := 1001102;
    if s20 <> '' then
    begin
      g_CheckCode.dwThread0 := 1001103;
      s20 := GetValidStr3(s20, s24, ['/']);
      n14 := Length(s20);
      if (n14 >= DEFBLOCKSIZE) and (s24 <> '') then
      begin
        wE := Str_ToInt(s24, 0) xor 170;
        w10 := n14;
        n18 := MakeLong(wE, w10);
        SC := EncodeBuffer(@n18, SizeOf(Integer));
        s34C := s24;
       // if CompareBackLStr(s20, SC, Length(SC)) then
        begin
          g_CheckCode.dwThread0 := 1001104;
          ProcessServerMsg(s20, n14, ServerInfo.Socket);
          g_CheckCode.dwThread0 := 1001105;
          bo25 := True;
        end;
      end;                                                  //0x004A7F7B
    end;                                                    //0x004A7F7B
    if s1C <> '' then
    begin
      Inc(n4ADC00);
    end;                                                    //0x004A7FB5
    if not bo25 then
    begin
      m_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);

      SendSocket(ServerInfo.Socket, EncodeMessage(m_DefMsg));
      Inc(n4ADC00);
    end;                                                    //0x004A8048
  finally
  end;
  g_CheckCode.dwThread0 := 1001106;
end;

procedure TFrmdbsrv.ProcessServerMsg(sMsg: string; nLen: Integer;
  Socket: TCustomWinSocket);
var
  sDefMsg, sData                        : string;
  DefMsg                                : TDefaultMessage;
begin

  if nLen = DEFBLOCKSIZE then
  begin
    sDefMsg := sMsg;
    sData := '';
  end
  else
  begin
    sDefMsg := Copy(sMsg, 1, DEFBLOCKSIZE);
    sData := Copy(sMsg, DEFBLOCKSIZE + 1, Length(sMsg) - DEFBLOCKSIZE - 6);
  end;                                                      //0x004A9304
  DefMsg := DecodeMessage(sDefMsg);
  case DefMsg.Ident of
    DB_LOADVAR:
    begin
       LoadofVar(sData,Socket);
    end;
    DB_SAVEVAR:
    begin
      SaveofVar(sData,Socket);
    End;
  else
    begin
      m_DefMsg := MakeDefaultMsg(DBR_FAIL, 0, 0, 0, 0);
      SendSocket(Socket, EncodeMessage(m_DefMsg));
      Inc(n4ADC04);
      MemoLog.Lines.Add('Fail ' + IntToStr(n4ADC04));
    end;
  end;
  g_CheckCode.dwThread0 := 1001216;
end;

procedure TFrmdbsrv.SendSocket(Socket: TCustomWinSocket; sMsg: string);
var
  n10:Integer;
  s18:String;
begin
  Inc(n4ADBFC);
  n10:=MakeLong(Str_ToInt(s34C,0) xor 170,Length(sMsg) + 6);
  s18:=EncodeBuffer(@n10,SizeOf(Integer));
  Socket.SendText('#' + s34C + '/' + sMsg + s18 + '!')
end;

procedure TFrmdbsrv.LoadofVar(sMsg: string; Socket: TCustomWinSocket);
 var
   VarName,VarValue,VArType : String;
   charname,Data,valuestr   : String;
   valueInt                 : Integer;
begin
   Data:=DecodeString(sMsg);
   Data:=GetValidStr3(Data,charName,['/']);
   Data:=GetValidStr3(Data,VarName,['/']);

   Data:='';
   if (VarName='') or (charName='') then
     m_DefMsg := MakeDefaultMsg(DB_LOADVar, 1, 0, 0, 0)
   else
   begin
      if DataModule_DB.LoadVar(charname,VarName,valuestr,valueInt) then
      begin
        Data:=Format('%s/%s/%s/%d',[charname,VarName,valuestr,valueInt]);
        Data:=EncodeString(Data);
        m_DefMsg := MakeDefaultMsg(DB_LOADVar, 0, 0, 0, 0);
      end
      else
        m_DefMsg := MakeDefaultMsg(DB_LOADVar, 1, 0, 0, 0);

   end;
   SendSocket(Socket, EncodeMessage(m_DefMsg)+Data);

end;

procedure TFrmdbsrv.SaveofVar(sMsg: string; Socket: TCustomWinSocket);
var
   VarName,VarValue,VArType : String;
   charname,Data,valuestr   : String;
   valueInt                 : Integer;
begin
   Data:=DecodeString(sMsg);
   Data:=GetValidStr3(Data,charName,['/']);
   Data:=GetValidStr3(Data,VarName,['/']);
   Data:=GetValidStr3(Data,valuestr,['/']);
   valueInt:=Str_ToInt(Data,0);
   Data:='';
   if (VarName='')  then
     m_DefMsg := MakeDefaultMsg(DB_SAVEVAR, 1, 0, 0, 0)
   else
   begin
      if DataModule_DB.SaveVar(charname,VarName,valuestr,valueInt) then
      begin
 
        m_DefMsg := MakeDefaultMsg(DB_SaveVar, 0, 0, 0, 0);
      end
      else
        m_DefMsg := MakeDefaultMsg(DB_SaveVar, 1, 0, 0, 0);

   end;
   //SendSocket(Socket, EncodeMessage(m_DefMsg) );

end;


end.