delphi Код:
// *****************************************************************************
// plugin для работы с БД
// alexsl / 29.01.09
// *****************************************************************************
library dbhelper;
// --- закоментить если компилируется под Delphi 2007 +
{$define ShareMM}
{$define AttemptToUseSharedMM}
// -----------------------------
{.$define RELEASE} // для совместимости с релизом пакетхака, при дебуге можно закоментировать
{$define DBDebug} //
uses
FastMM4,
SysUtils,
Windows,
Variants,
Dialogs,
Coding,
classes;
type
TL2Obj = class
private
FX: integer;
FID: integer;
FZ: integer;
FY: integer;
procedure SetID(const Value: integer);
procedure SetX(const Value: integer);
procedure SetY(const Value: integer);
procedure SetZ(const Value: integer);
public
property ID: integer read FID write SetID;
property X: integer read FX write SetX;
property Y: integer read FY write SetY;
property Z: integer read FZ write SetZ;
end;
TL2World = class
private
function GetCount: integer;
protected
FLIst: TLIst;
function GetOrCreate(AObjID: integer): TL2Obj;
function Get(AObjID: integer): TL2Obj;
public
constructor Create;
destructor Destroy; override;
property Count: integer read GetCount;
procedure Clear;
procedure Add(AObjID,AX,AY,AZ: integer);
procedure Move(AObjID,AX,AY,AZ: integer);
procedure Delete(AObjID: integer);
function Dist(FromObjID,ToObjID: integer): integer;
function DistEx(FromObjID,AX,AY,AZ: integer): integer;
// возвр. ближ. объект
function GetMinDistObj(AX,AY,AZ: integer): integer;
// возвр. ближ. объект в указанном Радиусе
function GetMinDistObjEx(AX,AY,AZ,Radius: integer): integer;
end;
var {version} {revision}
min_ver_a: array[0..3] of Byte = ( 3,4,1, 0 );
min_ver: Integer absolute min_ver_a; // минимальная поддерживаемая версия программы
ps: TPluginStruct;
// ppck: PPacket;
db: TL2World;
function GetPluginInfo(const ver: Integer): PChar; stdcall;
begin
if ver<min_ver then
Result:='Plugin к программе l2phx'+sLineBreak+
'Для версий 3.4.1+'+sLineBreak+
'У вас старая версия программы! Плагин не сможет корректно с ней работать!'
else
Result:='Plugin к программе l2phx'+sLineBreak+
'Для версий 3.4.1+'+sLineBreak+
'DB Helper (alexsl)';
end;
function SetStruct(const struct: TPluginStruct): Boolean; stdcall;
begin
ps:=struct;
Result:=True;
end;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при выгрузке плагине
procedure OnFree; stdcall;
begin
if assigned(db) then
try
db.Free;
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при загрузке плагине
procedure OnLoad; stdcall;
begin
db := TL2World.Create;
end;
// Необязательно вызываемая функция. (может отсутствовать в плагине)
// Вызывается при вызове скриптовой функции обьявленной в RefreshPrecompile
function OnCallMethod(const MethodName: String; // имя функции в верхнем регистре
var Params, // параметры функции
FuncResult: Variant // результат функции
): Boolean; stdcall; // если вернёт True то дальнейшая
// обработка функции прекратиться
begin
Result:=False; // передаём обработку функции программе
if MethodName='DB_COUNT' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
FuncResult:=db.Count;
end
else
if MethodName='DB_CLEAR' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
db.Clear;
end
else
// добавить объект в базу
if MethodName='DB_ADD' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
try
// ObjID, X, Y,Z
db.Add(Params[0],Params[1],params[2],params[3]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// объект удален
if MethodName='DB_DELETE' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
try
db.Delete(Params[0]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// объект двигается, если нету в БД то создается автоматически
if MethodName='DB_MOVE' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
try
db.Move(Params[0],Params[1],params[2],params[3]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// растояние между объектами, если нет объекта/ов возвр. -1
if MethodName='DB_DIST' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
try
// FromObjID, ToObjID
FuncResult:=db.Dist(Params[0],Params[1]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// растояние между объектом и координатами
if MethodName='DB_DISTEX' then begin
Result:=True; // запрещаем дальнейшую обработку функции в программе
try
// ObjID, X,Y,Z
FuncResult:=db.DistEx(Params[0],Params[1],Params[2],Params[3]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// возвр. ИД ближайщего объекта от заданных координат
// или -1 если нету
if MethodName='DB_MINDIST' then begin
Result:=True;
try
// X,Y,Z
FuncResult:=db.GetMinDistObj(Params[0],Params[1],Params[2]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end
else
// возвр. ИД ближайщего объекта от заданных координат с учетом Радиуса
// или -1 если нету
if MethodName='DB_MINDISTEX' then begin
Result:=True;
try
// X,Y,Z, Radius
FuncResult:=db.GetMinDistObjEx(Params[0],Params[1],Params[2],Params[3]);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
end;
{ TL2World }
procedure TL2World.Add(AObjID, AX, AY, AZ: integer);
var
obj: TL2Obj;
begin
obj := TL2Obj.Create;
FLIst.Add(obj);
obj.ID:=AObjID;
obj.X:=AX;
obj.Y:=AY;
obj.Z:=AZ;
end;
procedure TL2World.Clear;
var
i: integer;
begin
for i:= FLIst.Count-1 downto 0 do
try
TL2Obj(FList[i]).Free;
FList.Delete(i);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
constructor TL2World.Create;
begin
FList:=TList.Create;
end;
procedure TL2World.Delete(AObjID: integer);
var
i: integer;
begin
for i:= FLIst.Count-1 downto 0 do
if TL2Obj(FList[i]).ID = AObjID then
try
TL2Obj(FList[i]).Free;
FList.Delete(i);
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
destructor TL2World.Destroy;
begin
FList.free;
inherited;
end;
function TL2World.Dist(FromObjID, ToObjID: integer): integer;
begin
result := -1;
if assigned(Get(FromObjID)) and assigned(Get(ToObjID)) then
try
result := round(sqrt(Get(FromObjID).X-Get(ToObjID).X)+sqrt(Get(FromObjID).Y-Get(ToObjID).Y));
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
function TL2World.DistEx(FromObjID, AX, AY, AZ: integer): integer;
begin
result := -1;
if assigned(Get(FromObjID)) then
try
result := round(sqrt(Get(FromObjID).X-AX)+sqrt(Get(FromObjID).Y-AY));
except
{$IFDEF DBDebug}
raise;
{$ENDIF}
end;
end;
function TL2World.Get(AObjID: integer): TL2Obj;
var
i: integer;
begin
result := nil;
for i:= FList.Count-1 downto 0 do
if TL2Obj(FList[i]).ID=AObjID then
begin
result := TL2Obj(FList[i]);
exit;
end;
end;
function TL2World.GetCount: integer;
begin
result := FList.Count;
end;
function TL2World.GetOrCreate(AObjID: integer): TL2Obj;
var
i: integer;
begin
for i:= FList.Count-1 downto 0 do
if TL2Obj(FList[i]).ID=AObjID then
begin
result := TL2Obj(FList[i]);
exit;
end;
result := TL2Obj.Create;
result.ID:=AObjID;
end;
function TL2World.GetMinDistObj(AX, AY, AZ: integer): integer;
var
i,dst: integer;
begin
result:=-1;
if count<=0 then
exit;
dst:=DistEx(0,AX,AY,AZ);
result:=TL2Obj(FList[0]).ID;
for i:=FList.Count-1 downto 0 do
begin
if DistEx(i,AX,AY,AZ)<=dst then
begin
result:=TL2Obj(FList[i]).ID;
dst:=DistEx(0,AX,AY,AZ);
end;
end;
end;
procedure TL2World.Move(AObjID, AX, AY, AZ: integer);
var
obj: TL2Obj;
begin
obj := GetOrCreate(AObjID);
obj.X:=AX;
obj.Y:=AY;
obj.Z:=AZ;
end;
function TL2World.GetMinDistObjEx(AX, AY, AZ, Radius: integer): integer;
var
id: integer;
begin
result := -1;
id:=GetMinDistObj(AX,AY,AZ);
if id=-1 then
exit;
if DistEx(id,AX,AY,AZ)>Radius then
result := -1;
end;
{ TL2Obj }
procedure TL2Obj.SetID(const Value: integer);
begin
FID := Value;
end;
procedure TL2Obj.SetX(const Value: integer);
begin
FX := Value;
end;
procedure TL2Obj.SetY(const Value: integer);
begin
FY := Value;
end;
procedure TL2Obj.SetZ(const Value: integer);
begin
FZ := Value;
end;
exports
GetPluginInfo,
SetStruct,
OnCallMethod,
onLoad,
onFree;
begin
end.