usrengn.pas

传世源码可编译的,功能齐全.是学习的好模版,会DELPHI的朋友们也可以自己修改,弄个自己的引擎.

  end;
  dwProcessNpcTimeMin:=GetTickCount - dwRunTick;
  if dwProcessNpcTimeMin > dwProcessNpcTimeMax then dwProcessNpcTimeMax:=dwProcessNpcTimeMin;
end;

//004ADE3C
function TUserEngine.RegenMonsterByName(sMap: String; nX, nY: Integer;
  sMonName: String):TBaseObject;
var
  nRace:Integer;
  BaseObject:TBaseObject;
  n18:Integer;
  MonGen:pTMonGenInfo;
begin
  nRace:=GetMonRace(sMonName);
 
  BaseObject:=AddBaseObject(sMap,nX,nY,nRace,sMonName);
  if BaseObject <> nil then begin
    n18:=m_MonGenList.Count - 1;
    if n18 < 0 then n18:=0;
    MonGen:=m_MonGenList.Items[n18];
    MonGen.CertList.Add(BaseObject);
    BaseObject.m_PEnvir.AddObject(1);
    BaseObject.m_boAddToMaped:=True;
  end;

  Result:=BaseObject;
end;

function TUserEngine.RegenMonsterysByName(sMonName: String;human:Tplayobject):TBaseObject;
var
  nRace:Integer;
  BaseObject:TBaseObject;
  n18:Integer;
  MonGen:pTMonGenInfo;
begin
   BaseObject:=makenewplay(sMonName,human);
  if BaseObject <> nil then begin
    n18:=m_MonGenList.Count - 1;
    if n18 < 0 then n18:=0;
    MonGen:=m_MonGenList.Items[n18];
    MonGen.CertList.Add(BaseObject);
    BaseObject.m_PEnvir.AddObject(1);
    BaseObject.m_boAddToMaped:=True;
  end;

  Result:=BaseObject;
end;

procedure TUserEngine.Run; //004B20B8
ResourceString
  sExceptionMsg = '[Exception] TUserEngine::Run';
begin
    CalceTime:=GetTickCount;
    try
      if (GetTickCount() - dwShowOnlineTick) > g_Config.dwConsoleShowUserCountTime then
      begin
        dwShowOnlineTick:=GetTickCount();
        NoticeManager.LoadingNotice;
        MainOutMessage('在线数: ' + IntToStr(GetUserCount));
        g_CastleManager.Save;
      end;
      if (GetTickCount() - dwSendOnlineHumTime) > 10000 then begin
        dwSendOnlineHumTime:=GetTickCount();
        FrmIDSoc.SendOnlineHumCountMsg(GetOnlineHumCount);
      end;
    except
     on e: Exception do begin
      MainOutMessage(sExceptionMsg);
      MainOutMessage(E.Message);  raise;
     end;
    end;
end;

function TUserEngine.GetStdItem(nItemIdx: Integer): pTStdItem; //004AC2F8
begin
  Result:=nil;
    Dec(nItemIdx);
    if (nItemIdx >= 0) and (StdItemList.Count > nItemIdx) then begin
      Result:=StdItemList.Items[nItemIdx];
      if Result.Name = '' then Result:=nil;
    end;
end;

function TUserEngine.GetStdItem(sItemName:String): PTStdItem; //004AC348
var
  I: Integer;
  StdItem:pTStdItem;
begin
  Result:=nil;
  if sItemName = '' then exit;
    for I := 0 to StdItemList.Count - 1 do begin
      StdItem:=StdItemList.Items[i];
      if CompareText(StdItem.Name,sItemName) = 0 then begin
        Result:=StdItem;
        break;
      end;
    end;
end;

function TUserEngine.GetStdItemWeight(nItemIdx: Integer): Integer; //004AC2B0
var
  StdItem:pTStdItem;
begin
    Dec(nItemIdx);
    if (nItemIdx >= 0) and (StdItemList.Count > nItemIdx) then begin
      StdItem:=StdItemList.Items[nItemIdx];
      Result:=StdItem.Weight;
    end else begin
      Result:=0;
    end;
end;

function TUserEngine.GetStdItemName(nItemIdx: Integer): String;//004AC1AC
begin
  Result:='';
  Dec(nItemIdx);
    if (nItemIdx >= 0) and (StdItemList.Count > nItemIdx) then begin
      Result:=pTStdItem(StdItemList.Items[nItemIdx]).Name;
    end else Result:='';
end;

function TUserEngine.FindOtherServerUser(sName: String;
  var nServerIndex): Boolean;
begin
  Result:=False;
end;

//004AEA00
procedure TUserEngine.CryCry(wIdent: Word; pMap: TEnvirnoment; nX, nY,
  nWide: Integer;btFColor,btBColor:Byte; sMsg: String);
var
  i:integer;
  PlayObject:TPlayObject;
begin
  for I := 0 to m_PlayObjectList.Count - 1 do begin
    PlayObject:=TPlayObject(m_PlayObjectList.Objects[i]);
    if not PlayObject.m_boGhost and
      (PlayObject.m_PEnvir = pMap) and
      (PlayObject.m_boBanShout) and
      (abs(PlayObject.m_nCurrX - nX) < nWide) and
      (abs(PlayObject.m_nCurrY - nY) < nWide) then begin
     if  PlayObject.sYsnameMaster='' then    // 如果不是元神
      PlayObject.SendMsg(nil,wIdent,0,btFColor,btBColor,0,sMsg);
    end;
  end;
end;

procedure TUserEngine.DemoRun;
begin
  Run();
end;

function  TUserEngine.MonGetRandomItems (mon: TBaseObject):Integer;//004AD2E8
var
   i: integer;
   ItemList:TList;
   iname: string;
   MonItem:pTMonItemInfo;
   UserItem:pTUserItem;
   StdItem:pTStdItem;
   Monster:pTMonInfo;
begin
   ItemList:= nil;
     for i:=0 to MonsterList.Count-1 do begin
       Monster:=MonsterList.Items[i];
       if CompareText(Monster.sName, mon.m_sCharName) = 0 then begin
         ItemList:=Monster.Itemlist;
         break;
       end;
     end;
   if ItemList <> nil then begin
      for i:=0 to ItemList.Count-1 do begin
         MonItem:=pTMonItemInfo(ItemList[i]);
         if Random(MonItem.MaxPoint) <= MonItem.SelPoint then begin
           if CompareText(MonItem.ItemName, sSTRING_GOLDNAME) = 0 then begin
             mon.m_nGold := mon.m_nGold + (MonItem.Count div 2) + Random(MonItem.Count);
            end else begin
               iname := '';
                if iname = '' then
                  iname := MonItem.ItemName;

               New(UserItem);
               if CopyToUserItemFromName (iname, UserItem) then begin
                  UserItem.Dura := Round ((UserItem.DuraMax / 100) * (20+Random(80)));

                  StdItem:=GetStdItem(UserItem.wIndex);

                  if Random(g_Config.nMonRandomAddValue{10}) = 0 then
                     RandomUpgradeItem (UserItem);
                  if StdItem.StdMode in [15,19,20,21,22,23,24,26] then begin
                    if (StdItem.Shape = 130) or (StdItem.Shape = 131) or (StdItem.Shape = 132) then begin
                      GetUnknowItemValue(UserItem);
                    end;
                  end;
                  mon.m_ItemList.Add(UserItem)
               end else
                  Dispose(UserItem);
            end;
         end;
      end;
   end;
   Result:= 1;
end;

procedure TUserEngine.RandomUpgradeItem(Item:PTUserItem);//004AD0C8
var
  StdItem:pTStdItem;
begin
  StdItem:=GetStdItem(Item.wIndex);
  if StdItem = nil then exit;
  case StdItem.StdMode of
    5,6: ItemUnit.RandomUpgradeWeapon(Item); //004AD14A
    10,11: ItemUnit.RandomUpgradeDress(Item);
    19: ItemUnit.RandomUpgrade19(Item);
    20,21,24: ItemUnit.RandomUpgrade202124(Item);
    26: ItemUnit.RandomUpgrade26(Item);
    22: ItemUnit.RandomUpgrade22(Item);
    23: ItemUnit.RandomUpgrade23(Item);
    15: ItemUnit.RandomUpgradeHelMet(Item);
  end;
end;

procedure TUserEngine.GetUnknowItemValue(Item: PTUserItem);//004AD1D4
var
  StdItem:pTStdItem;
begin
  StdItem:=GetStdItem(Item.wIndex);
  if StdItem = nil then exit;
  case StdItem.StdMode of
    15: ItemUnit.UnknowHelmet(Item);
    22,23: ItemUnit.UnknowRing(Item);
    24,26: ItemUnit.UnknowNecklace(Item);
  end;
end;

//004AC404
function TUserEngine.CopyToUserItemFromName(sItemName:String;Item:pTUserItem):Boolean;
var
  I: Integer;
  StdItem:pTStdItem;
begin
  Result:=False;
    if sItemName <> '' then begin
      for I := 0 to StdItemList.Count - 1 do begin
        StdItem:=StdItemList.Items[i];
        if CompareText(StdItem.Name,sItemName) = 0 then begin
          FillChar(Item^,SizeOf(TUserItem),#0);
          Item.wIndex:=i + 1;
          Item.MakeIndex:=GetItemNumber();
          Item.Dura:=StdItem.DuraMax;
          Item.DuraMax:=StdItem.DuraMax;
          Result:=True;
          break;
        end;
      end;
    end;
end;

procedure TUserEngine.ProcessUserMessage(PlayObject:TPlayObject;DefMsg:pTDefaultMessage;Buff:PChar); //004B232C
var
  sMsg:String;
ResourceString
  sExceptionMsg = '[Exception] TUserEngine::ProcessUserMessage..';
begin
  if (DefMsg = nil) then exit;
  if (PlayObject<>nil) and (PlayObject.m_boDeath or PlayObject.m_boGhost) then exit;   //死掉不接受客户端命令
  try
    if Buff = nil then sMsg:=''
    else sMsg:=StrPas(Buff);

    case DefMsg.Ident of
      CM_SPELL: begin //3017
        if g_Config.boSpellSendUpdateMsg then begin //使用UpdateMsg 可以防止消息队列里有多个操作
          PlayObject.SendUpdateMsg(PlayObject,
                            DefMsg.Ident,
                            DefMsg.Tag,
                            LoWord(DefMsg.Recog),
                            HiWord(DefMsg.Recog),
                            MakeLong(DefMsg.Param,
                            DefMsg.Series),
                            '');
        end else begin
          PlayObject.SendMsg(PlayObject,
                            DefMsg.Ident,
                            DefMsg.Tag,
                            LoWord(DefMsg.Recog),
                            HiWord(DefMsg.Recog),
                            MakeLong(DefMsg.Param,
                            DefMsg.Series),
                            '');
         end;
      end;

      CM_QUERYUSERNAME: begin//80
        PlayObject.SendMsg(PlayObject,DefMsg.Ident,0,DefMsg.Recog,DefMsg.Param{x},DefMsg.Tag{y},'');
      end;

      CM_DROPITEM,
      CM_TAKEONITEM,
      CM_TAKEOFFITEM,
      CM_1005,

      CM_MERCHANTDLGSELECT,
      CM_MERCHANTQUERYSELLPRICE,
      CM_USERSELLITEM,
      CM_USERBUYITEM,
      CM_USERGETDETAILITEM,

      CM_CREATEGROUP,
      CM_ADDGROUPMEMBER,
      CM_DELGROUPMEMBER,
      CM_USERREPAIRITEM,
      CM_MERCHANTQUERYREPAIRCOST,
      CM_DEALTRY,
      CM_DEALADDITEM,
      CM_DEALDELITEM,

      CM_USERSTORAGEITEM,
      CM_USERTAKEBACKSTORAGEITEM,

      CM_USERMAKEDRUGITEM,

      CM_GUILDADDMEMBER,
      CM_GUILDDELMEMBER,
      CM_GUILDUPDATENOTICE,
      CM_GUILDUPDATERANKINFO: begin
        PlayObject.SendMsg(PlayObject,
                          DefMsg.Ident,
                          DefMsg.Series,
                          DefMsg.Recog,
                          DefMsg.Param,
                          DefMsg.Tag,
                          DecodeString(sMsg));
      end;
      CM_PASSWORD,
      CM_CHGPASSWORD,
      CM_SETPASSWORD: begin
        PlayObject.SendMsg(PlayObject,
                          DefMsg.Ident,
                          DefMsg.Param,
                          DefMsg.Recog,
                          DefMsg.Series,
                          DefMsg.Tag,
                          DecodeString(sMsg))