guild.pas

飞尔传奇世界的引擎代码可直接编译M2Engine 请使用Delphi编译

  sFileName := sGuildName + '.txt';
  Result := LoadGuildFile(sFileName);
  LoadGuildConfig(sGuildName + '.ini');
end;

function TGUild.LoadGuildConfig(sGuildFileName: string): Boolean;
begin
  m_nBuildPoint := m_Config.ReadInteger('Guild', 'BuildPoint', m_nBuildPoint);
  m_nAurae := m_Config.ReadInteger('Guild', 'Aurae', m_nAurae);
  m_nStability := m_Config.ReadInteger('Guild', 'Stability', m_nStability);
  m_nFlourishing := m_Config.ReadInteger('Guild', 'Flourishing', m_nFlourishing);
  m_nChiefItemCount := m_Config.ReadInteger('Guild', 'ChiefItemCount', m_nChiefItemCount);
  Result := True;
end;

function TGUild.LoadGuildFile(sGuildFileName: string): Boolean;
var
  I: Integer;
  LoadList: TStringList;
  s18, s1C, s20, s24, sFileName: string;
  n28, n2C: Integer;
  GuildWar: pTWarGuild;
  GuildRank: pTGuildRank;
  Guild: TGUild;
begin
  Result := False;
  GuildRank := nil;
  sFileName := g_Config.sGuildDir + sGuildFileName;
  if not FileExists(sFileName) then Exit;
  ClearRank();
  NoticeList.Clear;
  for I := 0 to GuildWarList.Count - 1 do begin
    Dispose(pTWarGuild(GuildWarList.Objects[I]));
  end; // for
  GuildWarList.Clear;
  GuildAllList.Clear;
  n28 := 0;
  n2C := 0;
  s24 := '';
  LoadList := TStringList.Create;
  LoadList.LoadFromFile(sFileName);
  for I := 0 to LoadList.Count - 1 do begin
    s18 := LoadList.Strings[I];
    if (s18 = '') or (s18[1] = ';') then Continue;
    if s18[1] <> '+' then begin
      if s18 = g_Config.sGuildNotice then n28 := 1;
      if s18 = g_Config.sGuildWar then n28 := 2;
      if s18 = g_Config.sGuildAll then n28 := 3;
      if s18 = g_Config.sGuildMember then n28 := 4;
      if s18[1] = '#' then begin
        s18 := Copy(s18, 2, Length(s18) - 1);
        s18 := GetValidStr3(s18, s1C, [' ', ',']);
        n2C := Str_ToInt(s1C, 0);
        s24 := Trim(s18);
        GuildRank := nil;
      end;
      Continue;
    end;
    s18 := Copy(s18, 2, Length(s18) - 1);
    case n28 of
      1: NoticeList.Add(s18);
      2: begin
          while (s18 <> '') do begin
            s18 := GetValidStr3(s18, s1C, [' ', ',']);
            if s1C = '' then Break;
            New(GuildWar);
            GuildWar.Guild := g_GuildManager.FindGuild(s1C);
            if GuildWar.Guild <> nil then begin
              GuildWar.dwWarTick := GetTickCount();
              GuildWar.dwWarTime := Str_ToInt(Trim(s20), 0);
              GuildWarList.AddObject(TGUild(GuildWar.Guild).sGuildName, TObject(GuildWar));
            end else begin
              Dispose(GuildWar);
            end;
          end;
        end;
      3: begin
          while (s18 <> '') do begin
            s18 := GetValidStr3(s18, s1C, [' ', ',']);
            s18 := GetValidStr3(s18, s20, [' ', ',']);
            if s1C = '' then Break;
            Guild := g_GuildManager.FindGuild(s1C);
            if Guild <> nil then GuildAllList.AddObject(s1C, Guild);
          end;
        end;
      4: begin
          if (n2C > 0) and (s24 <> '') then begin
            if Length(s24) > 30 then //Jacky 限制职倍的长度
              s24 := Copy(s24, 1, g_Config.nGuildRankNameLen {30});
            if GuildRank = nil then begin
              New(GuildRank);
              GuildRank.nRankNo := n2C;
              GuildRank.sRankName := s24;
              GuildRank.MemberList := TStringList.Create;
              m_RankList.Add(GuildRank);
            end;
            while (s18 <> '') do begin
              s18 := GetValidStr3(s18, s1C, [' ', ',']);
              if s1C = '' then Break;
              GuildRank.MemberList.Add(s1C);
            end;
          end;
        end;
    end; // case
  end;
  LoadList.Free;
  Result := True;
end;

procedure TGUild.RefMemberName;
var
  I, II: Integer;
  GuildRank: pTGuildRank;
  BaseObject: TBaseObject;
begin
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    for II := 0 to GuildRank.MemberList.Count - 1 do begin
      BaseObject := TBaseObject(GuildRank.MemberList.Objects[II]);
      if BaseObject <> nil then BaseObject.RefShowName;
    end;
  end;
end;

procedure TGUild.SaveGuildInfoFile;
begin
  if nServerIndex = 0 then begin
    SaveGuildFile(g_Config.sGuildDir + sGuildName + '.txt');
    SaveGuildConfig(g_Config.sGuildDir + sGuildName + '.ini');
  end else begin
    SaveGuildFile(g_Config.sGuildDir + sGuildName + '.' + IntToStr(nServerIndex));
  end;
end;

procedure TGUild.SaveGuildConfig(sFileName: string);
begin
  m_Config.WriteString('Guild', 'GuildName', sGuildName);
  m_Config.WriteInteger('Guild', 'BuildPoint', m_nBuildPoint);
  m_Config.WriteInteger('Guild', 'Aurae', m_nAurae);
  m_Config.WriteInteger('Guild', 'Stability', m_nStability);
  m_Config.WriteInteger('Guild', 'Flourishing', m_nFlourishing);
  m_Config.WriteInteger('Guild', 'ChiefItemCount', m_nChiefItemCount);
end;

procedure TGUild.SaveGuildFile(sFileName: string);
var
  SaveList: TStringList;
  I, II: Integer;
  WarGuild: pTWarGuild;
  GuildRank: pTGuildRank;
  n14: Integer;
begin
  SaveList := TStringList.Create;
  SaveList.Add(g_Config.sGuildNotice);
  for I := 0 to NoticeList.Count - 1 do begin
    SaveList.Add('+' + NoticeList.Strings[I]);
  end;
  SaveList.Add(' ');
  SaveList.Add(g_Config.sGuildWar);
  for I := 0 to GuildWarList.Count - 1 do begin
    WarGuild := pTWarGuild(GuildWarList.Objects[I]);
    n14 := WarGuild.dwWarTime - (GetTickCount - WarGuild.dwWarTick);
    if n14 <= 0 then Continue;
    SaveList.Add('+' + GuildWarList.Strings[I] + ' ' + IntToStr(n14));
  end;
  SaveList.Add(' ');
  SaveList.Add(g_Config.sGuildAll);
  for I := 0 to GuildAllList.Count - 1 do begin
    SaveList.Add('+' + GuildAllList.Strings[I]);
  end;
  SaveList.Add(' ');
  SaveList.Add(g_Config.sGuildMember);
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    SaveList.Add('#' + IntToStr(GuildRank.nRankNo) + ' ' + GuildRank.sRankName);
    for II := 0 to GuildRank.MemberList.Count - 1 do begin
      SaveList.Add('+' + GuildRank.MemberList.Strings[II]);
    end;
  end;
  try
    SaveList.SaveToFile(sFileName);
  except
    MainOutMessage('保存行会信息失败！！！ ' + sFileName);
  end;
  SaveList.Free;
end;

procedure TGUild.SendGuildMsg(sMsg: string);
var
  I: Integer;
  II: Integer;
  GuildRank: pTGuildRank;
  PlayObject: TPlayObject;
  nCheckCode: Integer;
begin
  nCheckCode := 0;
  try
    if g_Config.boShowPreFixMsg then
      sMsg := g_Config.sGuildMsgPreFix + sMsg;
    //if RankList = nil then exit;
    nCheckCode := 1;
    for I := 0 to m_RankList.Count - 1 do begin
      GuildRank := m_RankList.Items[I];
      nCheckCode := 2;
      if GuildRank.MemberList = nil then Continue;
      for II := 0 to GuildRank.MemberList.Count - 1 do begin
        nCheckCode := 3;
        PlayObject := TPlayObject(GuildRank.MemberList.Objects[II]);
        if (PlayObject = nil) or (UserEngine.GetPlayObject(PlayObject) = nil) then Continue; {2007-01-27 增加}
        nCheckCode := 4;
        if PlayObject.m_boBanGuildChat then begin
          nCheckCode := 5;
          PlayObject.SendMsg(PlayObject, RM_GUILDMESSAGE, 0, g_Config.btGuildMsgFColor, g_Config.btGuildMsgBColor, 0, sMsg);
          nCheckCode := 6;
        end;
      end;
    end;
    (*
    TGuild.SendGuildMsg CheckCode: 5 GuildName = 〖統治〗 Msg = 〖行会〗釢fěη﹖: 换的玩撒
  2004-12-2 15:45:48 Access violation at address 0041FD64 in module 'M2Server.exe'. Read of address 00000008
    *);
  except
    on E: Exception do begin
      MainOutMessage('[Exceptiion] TGuild.SendGuildMsg CheckCode: ' + IntToStr(nCheckCode) + ' GuildName = ' + sGuildName + ' Msg = ' + sMsg);
      MainOutMessage(E.Message);
    end;
  end;
end;

function TGUild.SetGuildInfo(sChief: string): Boolean;
var
  GuildRank: pTGuildRank;
begin
  if m_RankList.Count = 0 then begin
    New(GuildRank);
    GuildRank.nRankNo := 1;
    GuildRank.sRankName := g_Config.sGuildChief;
    GuildRank.MemberList := TStringList.Create;
    GuildRank.MemberList.Add(sChief);
    m_RankList.Add(GuildRank);
    SaveGuildInfoFile();
  end;
  Result := True;
end;

function TGUild.GetRankName(PlayObject: TPlayObject; var nRankNo: Integer): string;
var
  I, II: Integer;
  GuildRank: pTGuildRank;
begin
  Result := '';
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    for II := 0 to GuildRank.MemberList.Count - 1 do begin
      if GuildRank.MemberList.Strings[II] = PlayObject.m_sCharName then begin
        GuildRank.MemberList.Objects[II] := PlayObject;
        nRankNo := GuildRank.nRankNo;
        Result := GuildRank.sRankName;
        //PlayObject.RefShowName();
        PlayObject.SendMsg(PlayObject, RM_CHANGEGUILDNAME, 0, 0, 0, 0, '');
        Exit;
      end;
    end;
  end;
end;

function TGUild.GetChiefName: string;
var
  GuildRank: pTGuildRank;
begin
  Result := '';
  if m_RankList.Count <= 0 then Exit;
  GuildRank := m_RankList.Items[0];
  if GuildRank.MemberList.Count <= 0 then Exit;
  Result := GuildRank.MemberList.Strings[0];
end;

procedure TGUild.CheckSaveGuildFile();
begin
  if boChanged and ((GetTickCount - dwSaveTick) > 30 * 1000) then begin
    boChanged := False;
    SaveGuildInfoFile();
  end;
end;

procedure TGUild.DelHumanObj(PlayObject: TPlayObject);
var
  I, II: Integer;
  GuildRank: pTGuildRank;
begin
  CheckSaveGuildFile();
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    for II := 0 to GuildRank.MemberList.Count - 1 do begin
      if TPlayObject(GuildRank.MemberList.Objects[II]) = PlayObject then begin
        GuildRank.MemberList.Objects[II] := nil;
        Exit;
      end;
    end;
  end;
end;

procedure TGUild.TeamFightWhoDead(sName: string);
var
  I, n10: Integer;
begin
  if not boTeamFight then Exit;
  for I := 0 to TeamFightDeadList.Count - 1 do begin
    if TeamFightDeadList.Strings[I] = sName then begin
      n10 := Integer(TeamFightDeadList.Objects[I]);
      TeamFightDeadList.Objects[I] := TObject(MakeLong(LoWord(n10) + 1, HiWord(n10)));
    end;
  end;
end;

procedure TGUild.TeamFightWhoWinPoint(sName: string; nPoint: Integer);
var
  I, n14: Integer;
begin
  if not boTeamFight then Exit;
  Inc(nContestPoint, nPoint);
  for I := 0 to TeamFightDeadList.Count - 1 do begin
    if TeamFightDeadList.Strings[I] = sName then begin
      n14 := Integer(TeamFightDeadList.Objects[I]);
      TeamFightDeadList.Objects[I] := TObject(MakeLong(LoWord(n14), HiWord(n14) + nPoint));
    end;
  end;
end;

procedure TGUild.UpdateGuildFile();
begin
  boChanged := True;
  dwSaveTick := GetTickCount();
  SaveGuildInfoFile();
end;
procedure TGUild.BackupGuildFile;
var
  I, II: Integer;
  PlayObject: TPlayObject;
  GuildRank: pTGuildRank;
begin
  if nServerIndex = 0 then
    SaveGuildFile(g_Config.sGuildDir + sGuildName + '.' + IntToStr(GetTickCount) + '.bak');
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    for II := 0 to GuildRank.MemberList.Count - 1 do begin
      PlayObject := TPlayObject(GuildRank.MemberList.Objects[II]);
      if PlayObject <> nil then begin
        PlayObject.m_MyGuild := nil;
        PlayObject.RefRankInfo(0, '');
        PlayObject.RefShowName(); //10/31
      end;
    end;
    GuildRank.MemberList.Free;
    Dispose(GuildRank);
  end;
  m_RankList.Clear;
  NoticeList.Clear;
  for I := 0 to GuildWarList.Count - 1 do begin
    Dispose(pTWarGuild(GuildWarList.Objects[I]));
  end;
  GuildWarList.Clear;
  GuildAllList.Clear;
  SaveGuildInfoFile();
end;

function TGUild.AddMember(PlayObject: TPlayObject): Boolean;
var
  I: Integer;
  GuildRank: pTGuildRank;
  GuildRank18: pTGuildRank;
begin
  Result := False;
  GuildRank18 := nil;
  for I := 0 to m_RankList.Count - 1 do begin
    GuildRank := m_RankList.Items[I];
    if GuildRank.nRankNo = 99 then begin
      GuildRank18 := GuildRank;
      Break;
    end;
  end;
  if GuildRank18 = nil then begin
    New(GuildRank18);
    GuildRank18.nRankNo := 99;
    GuildRank18.sRankName := g_Config.sGuildMemberRank;
    GuildRank18.MemberList := TStringList.Create;
    m_RankList.Add(GuildRank18);
  end;
  GuildRank18.MemberList.AddObject(PlayObject.m_sCharName, TObject(PlayObject));
  UpdateGuildFile();
  Result := True;
end;

function TGUild.DelMember(sHumName: string): Boolean;
var
  I, II: Integer;
  GuildRank: pTGuildRank;
begin
  Result := False;