uguild.pas

千年源代码,只缺少控件,可以做二次开发用,好不容易得来的

var
   i, j : integer;
   pd : PTCreateGuildData;
   GuildObject: TGuildObject;
begin
   Result := TRUE;
   for i := 0 to DataList.Count -1 do begin
      GuildObject := DataList.Items [i];
      pd := GuildObject.GetSelfData;
      if pd^.Name = '' then continue;
      if pd^.Name = gname then begin Result := FALSE; exit; end;
      if pd^.Sysop = uname then begin Result := FALSE; exit; end;
      for j := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
         if pd^.SubSysop[j] = uname then begin
            Result := FALSE;
            exit;
         end;
      end;
   end;
end;

function  TGuildList.MoveStone (aGuildName : String; aServerID, ax, ay: integer) : Boolean;
var
   i : integer;
   GuildObject : TGuildObject;
begin
   Result := false;
   for i := 0 to DataList.Count -1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = aGuildName then begin
         Result := GuildObject.MoveStone (aServerID, ax, ay);
         exit;
      end;
   end;
end;

function TGuildList.CreateStone (aGuildName, aSysopName : String; aServerID, ax, ay: integer) : Boolean;
var
   i : integer;
   GuildObject : TGuildObject;
begin
   Result := false;
   for i := 0 to DataList.Count -1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.SelfData.Name = aGuildName then begin
         if GuildObject.boRegisted = false then begin
            Result := GuildObject.CreateStone (aSysopName, aServerID, ax, ay);
         end;
         exit;
      end;
   end;
end;

function TGuildList.AddGuildObject (aGuildName, aOwnerName : String; aServerID, aX, aY: integer): TGuildObject;
var
   Manager : TManager;
   GuildObject : TGuildObject;
   pd : PTCreateGuildData;
begin
   GuildObject := TGuildObject.Create;

   pd := GuildObject.GetSelfData;
   pd^.Name := aGuildName;
   pd^.MapID := aServerID;
   pd^.X := aX;
   pd^.Y := aY;
   pd^.Durability := MAX_GUILD_DURA + 100000;
   pd^.MaxDurability := MAX_GUILD_DURA;
   pd^.Sysop := aOwnerName;
   
   Manager := ManagerList.GetManagerByServerID (aServerID);
   GuildObject.SetManagerClass (Manager);
   GuildObject.Initial;
   GuildObject.StartProcess;
   DataList.Add (GuildObject);
   
   Result := GuildObject;
end;

procedure TGuildList.LoadFromFile (aFileName : String);
var
   i, j : Integer;
   str, rdstr : string;
   iName : string;
   pd, pdd : PTCreateGuildData;
   DB : TUserStringDb;
   Manager : TManager;
   GuildObject : TGuildObject;
begin
   if not FileExists (aFileName) then exit;

   DB := TUserStringDb.Create;
   DB.LoadFromFile (aFileName);

   for i := 0 to Db.Count - 1 do begin
      iName := Db.GetIndexName (i);
      if iName = '' then continue;

      GuildObject := TGuildObject.Create;
      pd := GuildObject.GetSelfData;

      FillChar (pd^, SizeOf(TCreateGuildData), 0);

      pd^.Name := iName;
      pd^.Title := Db.GetFieldValueString (iName, 'Title');
      pd^.MapID := Db.GetFieldValueInteger (iName, 'MapID');
      pd^.x := Db.GetFieldValueInteger (iname, 'X');
      pd^.y := Db.GetFieldValueInteger (iname, 'Y');
      pd^.Durability := Db.GetFieldValueInteger (iName, 'Durability');
      pd^.MaxDurability := Db.GetFieldValueInteger (iName, 'MaxDurability');
      pd^.GuildMagic := Db.GetFieldValueString (iName, 'GuildMagic');
      pd^.MagicExp := Db.GetFieldValueInteger (iName, 'MagicExp');
      pd^.MakeDate := Db.GetFieldValueString (iName, 'MakeDate');
      pd^.Sysop := Db.GetFieldValueString (iname, 'Sysop');
      for j := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
         pd^.SubSysop[j] := Db.GetFieldValueString (iName, 'SubSysop' + IntToStr (j));
      end;
      for j := 0 to MAX_GUILDNPC_COUNT - 1 do begin
         str := Db.GetFieldValueString (iName, 'Npc' + IntToStr(j));
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildNpc[j].rName := rdstr;
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildNpc[j].rx := _StrToInt (rdstr);
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildNpc[j].ry := _StrToInt (rdstr);
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildNpc[j].rSex := _StrToInt (rdstr);
      end;
      for j := 0 to MAX_GUILDWEAR_COUNT - 1 do begin
         str := Db.GetFieldValueString (iName, 'Wear0');
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildWear[j].rItemName := rdstr;
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildWear[j].rColor := _StrToInt (rdstr);
         str := GetValidStr3 (str, rdstr, ':');
         pd^.GuildWear[j].rItemCount := _StrToInt (rdstr);
      end;

      pd^.BasicPoint := Db.GetFieldValueInteger (iName, 'BasicPoint');
      pd^.AwardPoint := Db.GetFieldValueInteger (iName, 'AwardPoint');
      pd^.BattleRejectCount := Db.GetFieldValueInteger (iName, 'BattleRejectCount');
      pd^.ChallengeGuild := Db.GetFieldValueString (iName, 'ChallengeGuild');
      pd^.ChallengeGuildUser := Db.GetFieldValueString (iName, 'ChallengeGuildUser');
      pd^.ChallengeDate := Db.GetFieldValueString (iName, 'ChallengeDate');

      Manager := ManagerList.GetManagerByServerID (pd^.MapID);
      if Manager <> nil then begin
         GuildObject.SetManagerClass (Manager);
         GuildObject.Initial;
         GuildObject.StartProcess;
      end else begin
         GuildObject.Initial;
      end;

      DataList.Add (GuildObject);
   end;

   DB.Free;
end;

procedure TGuildList.SaveToFile (aFileName : String);
var
   i, j : integer;
   str, rdstr : string;
   pd : PTCreateGuildData;
   GuildObject : TGuildObject;
   DB : TUserStringDb;
begin
   if not FileExists (aFileName) then exit;

   Db := TUserStringDb.Create;
   Db.LoadFromFile (aFileName);

   for i := 0 to Db.Count - 1 do begin
      Db.DeleteName (Db.GetIndexName (0));
   end;

   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      pd := GuildObject.GetSelfData;
      if pd^.Name = '' then continue;

      GuildObject.SaveToFile;

      Db.AddName (pd^.Name);
      Db.SetFieldValueString (pd^.Name, 'Title', pd^.Title);
      Db.SetFieldValueInteger (pd^.Name, 'MapID', pd^.MapID);
      Db.SetFieldValueInteger (pd^.Name, 'X', pd^.x);
      Db.SetFieldValueInteger (pd^.Name, 'Y', pd^.y);
      Db.SetFieldValueInteger (pd^.Name, 'Durability', pd^.Durability);
      Db.SetFieldValueInteger (pd^.Name, 'MaxDurability', pd^.MaxDurability);
      Db.SetFieldValueString (pd^.Name, 'GuildMagic', pd^.GuildMagic);
      Db.SetFieldValueInteger (pd^.Name, 'MagicExp', pd^.MagicExp);
      Db.SetFieldValueString (pd^.Name, 'MakeDate', pd^.MakeDate);
      Db.SetFieldValueString (pd^.Name, 'Sysop', pd^.Sysop);
      for j := 0 to MAX_SUBSYSOP_COUNT - 1 do begin
         Db.SetFieldValueString (pd^.Name, 'SubSysop' + IntToStr (j), pd^.SubSysop[j]);
      end;
      for j := 0 to MAX_GUILDNPC_COUNT - 1 do begin
         str := pd^.GuildNpc[j].rName + ':';
         str := str + IntToStr (pd^.GuildNpc[j].rx) + ':';
         str := str + IntToStr (pd^.GuildNpc[j].ry) + ':';
         str := str + IntToStr (pd^.GuildNpc[j].rSex) + ':';
         if pd^.GuildNpc[j].rName = '' then str := '';
         Db.SetFieldValueString (pd^.Name, 'Npc' + IntToStr(j), str);
      end;
      for j := 0 to MAX_GUILDWEAR_COUNT - 1 do begin
         str := '';
         if pd^.GuildWear[j].rItemName <> '' then begin
            str := pd^.GuildWear[j].rItemName + ':';
            str := str + IntToStr (pd^.GuildWear[j].rColor) + ':';
            str := str + IntToStr (pd^.GuildWear[j].rItemCount) + ':';
         end;
         Db.SetFieldValueString (pd^.Name, 'Wear' + IntToStr(j), str);
      end;
      Db.SetFieldValueInteger (pd^.Name, 'BasicPoint', pd^.BasicPoint);
      Db.SetFieldValueInteger (pd^.Name, 'AwardPoint', pd^.AwardPoint);
      Db.SetFieldValueInteger (pd^.Name, 'BattleRejectCount', pd^.BattleRejectCount);
      Db.SetFieldValueString (pd^.Name, 'ChallengeGuild', pd^.ChallengeGuild);
      Db.SetFieldValueString (pd^.Name, 'ChallengeGuildUser', pd^.ChallengeGuildUser);
      Db.SetFieldValueString (pd^.Name, 'ChallengeDate', pd^.ChallengeDate);
   end;

   Db.SaveToFile ('.\Guild\CreateGuild.SDB');
   Db.Free;
end;

procedure TGuildList.Update (CurTick: integer);
var
   i, j : Integer;
   DeleteGuildObject, GuildObject : TGuildObject;
   StartPos, GuildProcessCount : Integer;
begin
   GuildProcessCount := (DataList.Count * 4 div 100);
   if GuildProcessCount = 0 then GuildProcessCount := DataList.Count;

   GuildProcessCount := ProcessListCount;

   if DataList.Count > 0 then begin
      StartPos := CurProcessPos;
      for i := 0 to GuildProcessCount - 1 do begin
         if CurProcessPos >= DataList.Count then CurProcessPos := 0;
         GuildObject := DataList.Items [CurProcessPos];
         // if (GuildObject.SelfData.Durability <= 0) or (GuildObject.FboAllowDelete = true) then begin
         if GuildObject.FboAllowDelete = true then begin
            GuildObject.EndProcess;
            GuildObject.Free;
            DataList.Delete (CurProcessPos);
         end else begin
            try
               GuildObject.Update (CurTick);
            except
               frmMain.WriteLogInfo (format ('TGuild.Update (%s) exception', [GuildObject.GuildName]));
               exit;
            end;
         end;
         Inc (CurProcessPos);
         if CurProcessPos = StartPos then break;
      end;
   end;
end;

procedure TGuildList.CompactGuild;
var
   i : Integer;
   GuildObject : TGuildObject;
   Str, iName : String;
   buffer : array [0..4096 - 1] of char;
   DB : TUserStringDB;
   Stream : TFileStream;
begin
   if not FileExists ('.\Guild\DeletedGuild.SDB') then begin
      Str := 'Index,DeletedDate,Name,Durability,X,Y,Sysop,SubSysop0,SubSysop1,SubSysop2,GuildMagic,MakeDate,MagicExp' + #13#10;
      StrPCopy (@buffer, Str);
      Stream := TFileStream.Create ('.\Guild\DeletedGuild.SDB', fmCreate);
      Stream.WriteBuffer (buffer, StrLen (@buffer));
      Stream.Free;
   end;

   DB := TUserStringDB.Create;
   DB.LoadFromFile ('.\Guild\DeletedGuild.SDB');

   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = '' then continue;
      if GuildObject.SelfData.Durability <= 0 then begin
         iName := IntToStr (DB.Count);
         DB.AddName (iName);
         DB.SetFieldValueString (iName, 'DeletedDate', DateToStr (Date));
         DB.SetFieldValueString (iName, 'Name', GuildObject.GuildName);
         DB.SetFieldValueInteger (iName, 'Durability', GuildObject.SelfData.Durability);
         DB.SetFieldValueInteger (iName, 'X', GuildObject.SelfData.X);
         DB.SetFieldValueInteger (iName, 'Y', GuildObject.SelfData.Y);
         DB.SetFieldValueString (iName, 'Sysop', GuildObject.SelfData.Sysop);
         DB.SetFieldValueString (iName, 'SubSysop0', GuildObject.SelfData.SubSysop [0]);
         DB.SetFieldValueString (iName, 'SubSysop1', GuildObject.SelfData.SubSysop [1]);
         DB.SetFieldValueString (iName, 'SubSysop2', GuildObject.SelfData.SubSysop [2]);
         DB.SetFieldValueString (iName, 'GuildMagic', GuildObject.SelfData.GuildMagic);
         DB.SetFieldValueString (iName, 'MakeDate', GuildObject.SelfData.MakeDate);
         DB.SetFieldValueInteger (iName, 'MagicExp', GuildObject.SelfData.MagicExp);

         GuildObject.boAllowDelete := true;
         try DeleteFile ('.\Guild\' + GuildObject.GuildName + 'GUser.SDB'); except end;
      end;
   end;

   DB.SaveToFile ('.\Guild\DeletedGuild.SDB');
   DB.Free;

   MagicClass.CompactGuildMagic;
end;

procedure TGuildList.DeleteStone (aGuildName : String);
var
   i : Integer;
   GuildObject : TGuildObject;
begin
   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = aGuildName then begin
         GuildObject.SelfData.Durability := 0;
         CompactGuild;
         exit;
      end;
   end;
end;

function TGuildList.GetGuildObject (aGuildName : String) : TGuildObject;
var
   i : Integer;
   GuildObject : TGuildObject;
begin
   Result := nil;
   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = aGuildName then begin
         Result := GuildObject;
         exit;
      end;
   end;
end;

function TGuildList.GetGuildObjectByMagicName (aMagicName : String) : TGuildObject;
var
   i : Integer;
   GuildObject : TGuildObject;
begin
   Result := nil;
   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.SelfData.GuildMagic = aMagicName then begin
         Result := GuildObject;
         exit;
      end;
   end;
end;

function TGuildList.GetCharInformation (aName : String) : String;
var
   i, j : Integer;
   GuildObject : TGuildObject;
begin
   Result := '';

   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = '' then continue;
      if GuildObject.SelfData.Sysop = aName then begin
         Result := format ('%s巩狼 巩林', [GuildObject.GuildName]);
         exit;
      end;
      for j := 0 to 3 - 1 do begin
         if GuildObject.SelfData.SubSysop[j] = aName then begin
            Result := format ('%s巩狼 何巩林', [GuildObject.GuildName]);
            exit;
         end;
      end;
   end;
end;

function TGuildList.GetInformation (aName : String) : String;
var
   i : Integer;
   GuildObject : TGuildObject;
begin
   Result := '';

   for i := 0 to DataList.Count - 1 do begin
      GuildObject := DataList.Items [i];
      if GuildObject.GuildName = '' then continue;
      Result := GuildObject.GetInformation;
   end;
end;

end.