Новичок
Регистрация: 05.11.2007
Сообщений: 10
Сказал Спасибо: 2
Имеет 5 спасибок в 2 сообщенях
|
delphi Код:
Uses '.\Scripts\OlegDX by USES.txt';
const
HTML1='<html><body><center><img src="L2UI_CH3.herotower_deco" width=256 height=32><font color="LEVEL">Меню инвентаря "что я типо знаю"'+
'</font><br><font color="LEVEL">Автор: OlegDX</font><img src="L2UI.SquareWhite" width=260 height=1><img src="L2UI.SquareBlank" width=260 height=4><br1>';
HTML2='<br><img src="L2UI.SquareWhite" width=260 height=1><img src="L2UI.SquareBlank" width=260 height=4><br1></center></body></html>';
////////////////////////////////////////////////////////////////////////////////
var
SkillBaffCount,BaffID,BaffType,LiderID:Integer;
SkillBaff:array of integer;
Procedure BaffListAdd(SkillID:Integer;SkillName:String);
Begin
Inc(SkillBaffCount);
SetLength(SkillBaff,SkillBaffCount);
SkillBaff[SkillBaffCount-1]:=SkillID;
End;
Procedure ReBaffListCreate(BaffT:Integer=0);
Begin
BaffType:=BaffT;
SkillBaffCount:=0;
BaffListAdd(1085,'ACUMEN' );
BaffListAdd(1062,'BERSERK_SPIRIT');
BaffListAdd(1045,'BLESS_OF_BOODY');
BaffListAdd(1048,'BLESS_OF_SOUL' );
End;
Procedure BaffListCreate;
Begin
BaffType:=-1;
SkillBaffCount:=0;
BaffListAdd(1085,'ACUMEN' );
BaffListAdd(1086,'HASTE' );
BaffListAdd(1045,'BLESS_OF_BOODY');
BaffListAdd(1048,'BLESS_OF_SOUL' );
BaffListAdd(1036,'MAGIC_BARRIER' );
BaffListAdd(1243,'BLESS_SHIELD' );
BaffListAdd(1044,'REGENERATION' );
//BaffListAdd(1191,'RESIST_FIRE' );
BaffListAdd(1043,'HOLY_WEAPON' );
BaffListAdd(1062,'BERSERK_SPIRIT');
//BaffListAdd(1388,'GREATER_MIGTH' );
BaffListAdd(1389,'GREATER_SHIEL' );
End;
Procedure UsedBaff(Param:Integer=0);
var N:Integer;Done:Boolean;
Begin
Case Param of
0,1:BEGIN
DONE:=FALSE;
IF MyObject[ID]=0 THEN EXIT;
IF Param=0 THEN BaffID:=0;
IF BaffID>=SkillBaffCount THEN UsedBaff(2);
WHILE BaffID<SkillBaffCount DO BEGIN
FOR N:=1 TO mySkillCount DO
IF (SkillBaff[BaffID]= mySkillList[N-1,2]) THEN BEGIN DONE:=TRUE;BREAK; END;
INC(BaffID);
IF DONE THEN BEGIN
UseSkill(SkillBaff[BaffID-1]);
Break;
END;
END;
End;
2,3,4,5:Begin
IF Param=3 THEN BaffListCreate;
IF Param=4 THEN ReBaffListCreate(0);
IF Param=5 THEN ReBaffListCreate(1);
IF Param=2 THEN BEGIN
BaffID:=SkillBaffCount;
IF BaffType=0 THEN SendMSGServer('GoEMP',3);
IF BaffType=1 THEN BEGIN
SendMSGServer('GoTARGET',3);
buf:=hstr('37 01 00');SendToServer;
Action(LiderID);
UsedBaff(3);
UsedBaff(0);
END;
END;
End;
End;
End;
////////////////////////////////////////////////////////////////////////////////
procedure ListSkill;
Var I:Integer; HTMLTEXT:String;
begin
HTMLTEXT:='';
FOR I:=1 TO mySkillCount DO BEGIN
IF mySkillList[I-1,0]=0 THEN BEGIN
HTMLTEXT:=HTMLTEXT+'<br>'+Format('%s(%.d)',[fListSkill.Values[IntToStr(mySkillList[I-1,2])],mySkillList[I-1,2]]);
END;
END;
ShowHTML(HTML1+HTMLTEXT+HTML2);
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//*** Вызывается при включении скрипта *****************************************
procedure Init;
begin
Init_old;
LiderID:=0;
UsedBaff(3);
end;
//*** Вызывается при выключении скрипта ****************************************
procedure Free;
begin
free_old;
end;
////////////////////////////////////////////////////////////////////////////////
//Основная часть скрипта вызывается при приходе каждого пакета если скрипт включен
begin
//----------------------------------------------------------------------------
if pck='' then exit;
//----------------------------------------------------------------------------
if FromServer then begin
Case pck[1] of
#$A6:BEGIN TargetID:=ReadD(2); END;
#$04:BEGIN ReadUserInfo; END;
#$58:BEGIN CreateSkillBase; END;
#$76:BEGIN IF ReadD(2)=MyObject[ID] THEN UsedBaff(1); END;
#$49:BEGIN IF ReadD(2)=MyObject[ID] THEN UsedBaff(2); END;
#$4A:Begin
PosIndex:=02;
ObjectID :=ReadD(PosIndex);
MesageType:=ReadD(PosIndex);
MesageStrg:=ReadS(PosIndex);
MesageStrg:=ReadS(PosIndex);
Case MesageType of
3:BEGIN
If (Length(MesageStrg)=4) and (MesageStrg='Baff') Then begin
buf:=hstr('37 01 00');SendToServer;
Action(ObjectID);
UsedBaff(3);
UsedBaff(0);
End Else
If (Length(MesageStrg)=7) and (MesageStrg='akumBAF') Then begin
LiderID:=ObjectID;
buf:=hstr('37 01 00');SendToServer;
Action(MyObject[ID]);
UsedBaff(4);
UsedBaff(0);
End Else
If (Length(MesageStrg)=6) and (MesageStrg='empBAF') Then begin
buf:=hstr('37 01 00');SendToServer;
Action(ObjectID);
UsedBaff(5);
UsedBaff(0);
End Else
If (Length(MesageStrg)=3) and (MesageStrg='tar') Then begin
buf:=hstr('37 01 00');SendToServer;
Action(ObjectID);
End Else;
END;
END
END;
end;
end else
//----------------------------------------------------------------------------
if FromClient then begin
Case pck[1] of
#$38:Begin
PosIndex:=02;
MesageStrg:=ReadS(PosIndex);
MesageType:=ReadD(PosIndex);
Case MesageType of
//Обычный чат 0:Begin End;
//Крик чат 1:Begin End;
//торговый чат 8:Begin End;
3:Begin //Пати чат
If (Length(MesageStrg)=1) and ((MesageStrg[1]='B')or(MesageStrg[1]='b')) Then begin
UsedBaff(0);
End Else
If (Length(MesageStrg)=1) and ((MesageStrg[1]='L')or(MesageStrg[1]='l')) Then begin
ListSkill;
End Else
End;
Else End;
End;
End;
end else;
end.
////////////////////////////////////////////////////////////////////////////////
Добавлено через 4 минуты
delphi Код:
//xmlNpc:Variant;
//xmlNpc:=CreateOleObject('Msxml.DOMDocument');
//xmlNpc.Load('.\UserData\itemname-e.xml' );
//xmlNpc.documentElement.selectNodes(Format('/itemname/descrt[@id="%d"]/@name',[Inventory[I,3]])).item[0].text;
//xmlNpc:=nil;
//Uses '.\Scripts\OlegDX by USES.txt';
//*****************************************************************
Function Sqr(X:Integer):Integer;
Begin
Result:=X*X;
End;
//*****************************************************************
Function StrToHex(Value:String):String;
Var Len,I:Integer;
Begin
Result:='';
Len:=Length(Value);
IF Len>0 Then Result:= Format('%.2x',[ord(Value[1])]);
For I:=2 to Len do Result:=Result+Format(' %.2x',[ord(Value[i])]);
End;
//*****************************************************************
procedure ShowHTML(HTML:String);
begin
buf:=#$0F;
WriteD(5);
WriteS(HTML);
WriteD(0);
SendToClient;
end;
//*****************************************************************
procedure SendMSGClient(value:string;Types:Integer=10);
begin
buf:=#$4A;
WriteD(0);
WriteD(Types);
WriteS('');
WriteS(value);
SendToClient;
end;
//*****************************************************************
Procedure SendMSGServer(value:String;Types:Integer=0);
Begin
buf:=#$38;
WriteS(value);
WriteD(Types);
SendToServer;
End;
//******************************************************************************
procedure DoorAction(DoorID:Cardinal;Status:Cardinal);
begin
buf:=#$4D;
WriteD(DoorID);
WriteD(Status);
WriteD(0);
WriteD(1);
WriteD(0);
SendToClient;
end;
//******************************************************************************
procedure Action(ObjectID:Cardinal;Action:Integer=0;X,Y,Z:Integer=0);
begin
buf:=#$04;
WriteD(ObjectID);
WriteD(X);
WriteD(Y);
WriteD(Z);
WriteC(Action);
SendToServer;
end;
//*****************************************************************
procedure UseItems(ObjectID:Cardinal;shift:Cardinal=0);
begin
buf:=#$14;
WriteD(ObjectID);
WriteD(shift);
SendToServer;
end;
//******************************************************************************
procedure UseSkill(SkillID:Integer;Ctrl:Integer=0;Shift:byte=0);
begin
buf:=#$2F;
WriteD(SkillID);
WriteD(Ctrl );
WriteC(Shift);
SendToServer;
end;
//*****************************************************************
Procedure MoveXYZ(X1,Y1,Z1,X2,Y2,Z2:Integer);
Begin
IF (X1=X2)and(Y1=Y2)and(Z1=Z2) Then Exit;
buf:=#$01;
WriteD(X1);WriteD(Y1);WriteD(Z1);
WriteD(X2);WriteD(Y2);WriteD(Z2);
WriteD(01);
SendToServer
End;
//******************************************************************************
// /---|H|---\
// [ >>>|1|_______________|3|___________|2|>> ]
Function GetMoveXYZ(X1,Y1,Z1,X2,Y2,Z2,H:Integer; var X,Y,Z:Integer):Boolean;
var AB:Double;
Begin
Result:=False;
AB:=Sqrt(sqr(X2-X1)+sqr(Y2-Y1)+sqr(Z2-Z1));
IF abs(AB)<=H THEN EXIT;
X:=X2-round(((X2-X1)*H)/AB);
Y:=Y2-round(((Y2-Y1)*H)/AB);
Z:=Z2-round(((Z2-Z1)*H)/AB);
Result:=True;
End;
//******************************************************************************
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
Const ID=0;Xnow=1;Ynow=2;Znow=3;Xold=4;Yold=5;Zold=6;
Var
//--------------------------------------------------------------------------
PosIndex,ObjectID,TargetID,X,Y,Z,W:Integer;
MesageStrg:String;MesageType:Integer;
MyObject: array[0..7] of Integer; //ID,X,Y,Z,Xd,Yd,Zd
MyTarget: array[0..7] of Integer; //ID,X,Y,Z,Xd,Yd,Zd
MySkillCount:Integer;MySkillList:array[0..250,0..3] of Integer;//Group,Lvl,SkillID,Reserved
fListSkill,fListItems,fListMessg:TStringList;//:TStrings;
//--------------------------------------------------------------------------
MyItemsCount:integer; //количество занятых слотов/количество вещей
MyInventory: array[1..250,1..10]of integer; //массив инвентаря
//инвентарь
//1 - ItemType1
//2 - ObjectID
//3 - ItemID
//4 - ItemCount
//5 - ItemType2
//6 - CustType1
//7 - IsEquipped
//8 - BodyPart
//9 - EnchantLevel
//10 - CustType2
//--------------------------------------------------------------------------
////////////////////////////////////////////////////////////////////////////////
Procedure CreateSkillBase;
Begin
PosIndex:=2;
mySkillCount:=ReadD(PosIndex);
For W:= 1 to mySkillCount do begin
mySkillList[W-1,0]:=ReadD(PosIndex);
mySkillList[W-1,1]:=ReadD(PosIndex);
mySkillList[W-1,2]:=ReadD(PosIndex);
mySkillList[W-1,3]:=ReadC(PosIndex);
End;
End;
//******************************************************************************
procedure ReadUserInfo;
Begin
PosIndex:=2;
MyObject[Xold]:=ReadD(PosIndex); MyObject[Xnow]:=MyObject[Xold];
MyObject[Yold]:=ReadD(PosIndex); MyObject[Xnow]:=MyObject[Yold];
MyObject[Zold]:=ReadD(PosIndex); MyObject[Xnow]:=MyObject[Zold];
W:=ReadD(PosIndex);
MyObject[ ID]:=ReadD(PosIndex);
End;
//******************************************************************************
procedure Init_old;
Begin
MyItemsCount:=0;
MySkillCount:=0;
MyObject[ID]:=0;
MyTarget[ID]:=0;
fListMessg:=nil;fListMessg:=TStringList.Create;//TStrings.Create;
fListItems:=nil;fListItems:=TStringList.Create;//TStrings.Create;
fListSkill:=nil;fListSkill:=TStringList.Create;//TStrings.Create;
fListMessg.LoadFromFile('.\sysmsgid.ini');
fListItems.LoadFromFile('.\itemsid.ini' );
fListSkill.LoadFromFile('.\skillsid.ini');
//ShowTab;UserTab.caption:=fListSkill.Values['150']
End;
procedure Free_Old; //Вызывается при выключении скрипта
begin
HideTab;
fListMessg.free;fListMessg:=nil;
fListItems.free;fListItems:=nil;
fListSkill.free;fListSkill:=nil;
end;
//******************************************************************************
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
//***процедура считывания параметров одного предмета ***************************
//******************************************************************************
procedure ItemAction(var Position:integer;CurrentSlot:integer);
begin
MyInventory[CurrentSlot,01]:=ReadH(Position);//ItemType1
MyInventory[CurrentSlot,02]:=ReadD(Position);//ObjectID
MyInventory[CurrentSlot,03]:=ReadD(Position);//ItemID
MyInventory[CurrentSlot,04]:=ReadD(Position);//ItemCount
MyInventory[CurrentSlot,05]:=ReadH(Position);//ItemType2
MyInventory[CurrentSlot,06]:=ReadH(Position);//CustType1
MyInventory[CurrentSlot,07]:=ReadH(Position);//isEquipped
MyInventory[CurrentSlot,08]:=ReadD(Position);//BodyPart
MyInventory[CurrentSlot,09]:=ReadH(Position);//EnchantLevel
MyInventory[CurrentSlot,10]:=ReadH(Position);//CustType2
end;
//******************************************************************************
//*** Пакет от сервера 1В - создаем или модифицируем весь инвентарь ************
//******************************************************************************
procedure ItemBaseCreate;
var i,PosInt: integer;
begin
//Считываем количество вещей в инвентаре
MyItemsCount:=ReadC(4);PosInt:=6;
for i:=1 to MyItemsCount do ItemAction(PosInt,i);
end;
//******************************************************************************
//*** Пакет от сервера 27 - действия (доавить/изменить/удалить)
//*** над одним/несколькими предметами
//******************************************************************************
procedure ItemBaseUpdate;
var I,J,N,count,PosInt:integer;
begin
//Считываем количество изменяемых предметов
Count:=ReadC(2);
for I:=1 to Count do begin
N:=(I-1)*30+4;PosInt:=N+2;
Case ReadC(N) of
01:begin //ADD
Inc(MyItemsCount);//Увеличиваем количество занятых слотов
ItemAction(PosInt,MyItemsCount);//Добавляем предмет
end;
02:begin //UPD
N:=ReadD(PosInt+2);
for J:=1 to MyItemsCount do
//Ищем изменяемый предмет по ObjectID в списке обеков
If MyInventory[J,2]=N Then begin ItemAction(PosInt,j);break;end;
end;
03:begin //DEL
N:=ReadD(PosInt+2);
for J:=1 to MyItemsCount do
//Ищем изменяемый предмет по ObjectID в списке обеков
If MyInventory[J,2]=N Then begin
MyInventory[J,01]:=MyInventory[MyItemsCount,01];
MyInventory[J,02]:=MyInventory[MyItemsCount,02];
MyInventory[J,03]:=MyInventory[MyItemsCount,03];
MyInventory[J,04]:=MyInventory[MyItemsCount,04];
MyInventory[J,05]:=MyInventory[MyItemsCount,05];
MyInventory[J,06]:=MyInventory[MyItemsCount,06];
MyInventory[J,07]:=MyInventory[MyItemsCount,07];
MyInventory[J,08]:=MyInventory[MyItemsCount,08];
MyInventory[J,09]:=MyInventory[MyItemsCount,09];
MyInventory[J,10]:=MyInventory[MyItemsCount,10];
Dec(MyItemsCount);//Уменьшаем количество занятых слотов
break;
end
end;
end;
end;
end;
//******************************************************************************
//Получить ObjectID предмета, зная его ItemsID *********************************
function ItemBaseGetInfo(ItemsID:integer):integer;
var c1:integer;
begin
Result:=-1;
for c1:=1 to MyItemsCount do
if ItemsID=MyInventory[c1,3] then begin
Result:=MyInventory[c1,2];
exit;//Если нашли - выходим из цикла
end;
end;
//Использовать предмет с заданным ItemsID **************************************
Function ItemBaseUseItem(ItemsID:integer):Boolean;
var c1:integer;
begin
Result:=False;
for c1:=1 to MyItemsCount do
if ItemsID=MyInventory[c1,3] then begin
Result:=True;
UseItems(MyInventory[c1,2]);
//buf:=#$14; WriteD(MyInventory[c1,2]);WriteD(0);SendToServer;
Break; //Чтоб не использовать несколько предметов с одинаковым ItemID (например заточки)
end;
end;
////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////
Begin
End.
Добавлено через 11 минут
сразу извеняюсь за разпрос кодо
но тут правило
1)все команды серверу выносятся в проседуры (а не строчки хекс кода)
2) незя использовать баф который твой чар незнает (нужно проверить что он знаит и от эирго отталкиватся)
3) нужно следить за задержками и ответами сервера
Последний раз редактировалось NLObP, 30.04.2008 в 19:50.
Причина: Добавлено сообщение
|