plugin.pas

来自「飞尔传奇世界的引擎代码可直接编译M2Engine 请使用Delphi编译」· PAS 代码 · 共 361 行

unit PlugIn;

interface
uses
  Windows, Classes, SysUtils, Forms, Grobal2, SDK, HUtil32;
type
  TPlugInfo = record
    DllName: string;
    sDesc: string;
    Module: THandle;
  end;
  pTPlugInfo = ^TPlugInfo;

  TPlugInManage = class
    PlugList: TStringList;
    GetFeature: TObjectActionFeature;
    ObjectEnterAnotherMap: TObjectActionEnterMap;
    ObjectDie: TObjectActionEx;
    ChangeCurrMap: TObjectActionEx;
    ClientQueryBagItems: TObjectAction;
    ClientQueryUserState: TObjectActionXY;
    SendActionGood: TObjectAction;
    SendActionFail: TObjectAction;
    SendWalkMsg: TObjectActionXYD;
    SendHorseRunMsg: TObjectActionXYD;
    SendRunMsg: TObjectActionXYD;
    SendDeathMsg: TObjectActionXYDM;
    SendSkeletonMsg: TObjectActionXYD;
    SendAliveMsg: TObjectActionXYD;
    SendSpaceMoveMsg: TObjectActionXYDWS;
    SendChangeFaceMsg: TObjectActionObject;
    SendUseitemsMsg: TObjectAction;
    SendUseMagicMsg: TObjectAction;
    SendUserLevelUpMsg: TObjectAction;
    SendUserAbilieyMsg: TObjectAction;
    SendUserStruckMsg: TObjectActionObject;
    SendSocket: TPlaySendSocket;
    SendGoodsList: TObjectActionSendGoods;
    SendUserStatusMsg: TObjectActionXYDWS;
    CheckCanDropItem: TObjectActionItem;
    CheckCanDealItem: TObjectActionItem;
    CheckCanStorageItem: TObjectActionItem;
    CheckCanRepairItem: TObjectActionItem;
    CheckUserItems: TObjectActionCheckUserItem;
    PlayObjectRun: TObjectAction;
    PlayObjectFilterMsg: TObjectFilterMsg;
    MerchantClientGetDetailGoodsList: TObjectActionDetailGoods;
    UserEngineRun: TObjectAction;
    ObjectClientMsg: TObjectClientMsg;
    SetHookDoSpell: TDoSpell;
    PlayObjectUserLogin1: TObjectAction;
    PlayObjectUserLogin2: TObjectAction;
    PlayObjectUserLogin3: TObjectAction;
    PlayObjectUserLogin4: TObjectAction;
    PlayObjectCreate: TObjectAction;
    PlayObjectDestroy: TObjectAction;
    PlayObjectUserCmd: TObjectUserCmd;
    ObjectOperateMessage: TObjectOperateMessage;
    QuestActionScriptCmd: TScriptCmd;
    QuestConditionScriptCmd: TScriptCmd;
    ActionScriptProcess: TScriptAction;
    ConditionScriptProcess: TScriptCondition;
    PlayObjectUserSelect: TObjectActionUserSelect;
  private
    procedure Initialize;
    function GetPlug(Module: THandle): Boolean;
  public
    constructor Create();
    destructor Destroy; override;
    procedure StartPlugMoudle();
    procedure LoadPlugIn();
    procedure UnLoadPlugIn();
  end;
procedure MainMessage(Msg: PChar; nMsgLen: Integer; nMode: Integer); stdcall;
procedure SendBroadCastMsg(Msg: PChar; MsgType: TMsgType); stdcall;
function FindEngnProc(ProcName: PChar; nNameLen: Integer): Pointer; stdcall;
function FindPlugProc(ProcName: PChar; nNameLen: Integer): Pointer; stdcall;
function SetProcTable(ProcAddr: Pointer; ProcName: PChar; nNameLen: Integer): Boolean; stdcall;
function FindOBjTable(ObjName: PChar; nNameLen: Integer): TObject; stdcall;

implementation

uses M2Share, EDcode;

procedure MainMessage(Msg: PChar; nMsgLen: Integer; nMode: Integer);
var
  MsgBuff: string;
begin
  if (Msg <> nil) and (nMsgLen > 0) then begin
    setlength(MsgBuff, nMsgLen);
    Move(Msg^, MsgBuff[1], nMsgLen);
    case nMode of
      0: begin
          if Memo <> nil then Memo.Lines.Add(MsgBuff);
        end;
    else MainOutMessage(MsgBuff);
    end;
  end;
end;

procedure SendBroadCastMsg(Msg: PChar; MsgType: TMsgType); stdcall;
begin
  if UserEngine <> nil then
    UserEngine.SendBroadCastMsgExt(Msg, MsgType);
end;

//=================================
//由DLL调用按名字查找函数地址
function FindPlugProc(ProcName: PChar; nNameLen: Integer): Pointer;
var
  I: Integer;
  sProcName: string;
begin
  Result := nil;
  setlength(sProcName, nNameLen);
  Move(ProcName^, sProcName[1], nNameLen);
  for I := Low(PlugProcArray) to High(PlugProcArray) do begin
    if (PlugProcArray[I].nProcAddr = nil) and (CompareText(sProcName, PlugProcArray[I].sProcName) = 0) then begin
      Result := @PlugProcArray[I];
      Break;
    end;
  end;
end;

function FindEngnProc(ProcName: PChar; nNameLen: Integer): Pointer;
var
  I: Integer;
  sProcName: string;
begin
  Result := nil;
  setlength(sProcName, nNameLen);
  Move(ProcName^, sProcName[1], nNameLen);
  for I := Low(ProcArray) to High(ProcArray) do begin
    if (ProcArray[I].nProcAddr <> nil) and (CompareText(sProcName, ProcArray[I].sProcName) = 0) then begin
      Result := ProcArray[I].nProcAddr;
      Break;
    end;
  end;
end;
//=================================
//由DLL调用按名字设置插件中的函数地址
function SetProcTable(ProcAddr: Pointer; ProcName: PChar; nNameLen: Integer): Boolean;
var
  I: Integer;
  sProcName: string;
begin
  Result := False;
  setlength(sProcName, nNameLen);
  Move(ProcName^, sProcName[1], nNameLen);
  for I := Low(PlugProcArray) to High(PlugProcArray) do begin
    if (PlugProcArray[I].nProcAddr = nil) and (CompareText(sProcName, PlugProcArray[I].sProcName) = 0) then begin
      PlugProcArray[I].nProcAddr := ProcAddr;
      Result := True;
      Break;
    end;
  end;
end;

//=================================
//由DLL调用按名字查找全局对象地址
function FindOBjTable(ObjName: PChar; nNameLen: Integer): TObject;
var
  I: Integer;
  sObjName: string;
begin
  Result := nil;
  setlength(sObjName, nNameLen);
  Move(ObjName^, sObjName[1], nNameLen);
  for I := Low(ProcArray) to High(ProcArray) do begin
    if (ObjectArray[I].Obj <> nil) and (CompareText(sObjName, ObjectArray[I].sObjcName) = 0) then begin
      Result := @ObjectArray[I];
      Break;
    end;
  end;
end;
{ TPlugIn }

constructor TPlugInManage.Create;
begin
  Initialize;
  PlugList := TStringList.Create;
end;

destructor TPlugInManage.Destroy;
begin
  UnLoadPlugIn();
  PlugList.Free;
  inherited;
end;

procedure TPlugInManage.Initialize;
begin
  GetFeature := nil;
  ObjectEnterAnotherMap := nil;
  ObjectDie := nil;
  ChangeCurrMap := nil;
  ClientQueryBagItems := nil;
  ClientQueryUserState := nil;
  SendActionGood := nil;
  SendActionFail := nil;
  SendWalkMsg := nil;
  SendHorseRunMsg := nil;
  SendRunMsg := nil;
  SendDeathMsg := nil;
  SendSkeletonMsg := nil;
  SendAliveMsg := nil;
  SendSpaceMoveMsg := nil;
  SendChangeFaceMsg := nil;
  SendUseitemsMsg := nil;
  SendUseMagicMsg := nil;
  SendUserLevelUpMsg := nil;
  SendUserAbilieyMsg := nil;
  SendUserStruckMsg := nil;
  SendSocket := nil;
  SendGoodsList := nil;
  SendUserStatusMsg := nil;
  CheckCanDropItem := nil;
  CheckCanDealItem := nil;
  CheckCanStorageItem := nil;
  CheckCanRepairItem := nil;
  CheckUserItems := nil;
  PlayObjectRun := nil;
  PlayObjectFilterMsg := nil;
  MerchantClientGetDetailGoodsList := nil;
  UserEngineRun := nil;
  ObjectClientMsg := nil;
  SetHookDoSpell := nil;
  PlayObjectCreate := nil;
  PlayObjectDestroy := nil;
  PlayObjectUserCmd := nil;
  ObjectOperateMessage := nil;
  QuestActionScriptCmd := nil;
  QuestConditionScriptCmd := nil;
  ActionScriptProcess := nil;
  ConditionScriptProcess := nil;
  PlayObjectUserSelect := nil;
  PlayObjectUserLogin1 := nil;
  PlayObjectUserLogin2 := nil;
  PlayObjectUserLogin3 := nil;
  PlayObjectUserLogin4 := nil;
end;

function TPlugInManage.GetPlug(Module: THandle): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to PlugList.Count - 1 do begin
    if Module = pTPlugInfo(PlugList.Objects[I]).Module then begin
      Result := True;
      Break;
    end;
  end;
end;

procedure TPlugInManage.StartPlugMoudle();
var
  I: Integer;
  Module: THandle;
  StartPlug: TStartPlug;
begin
  for I := 0 to PlugList.Count - 1 do begin
    Module := pTPlugInfo(PlugList.Objects[I]).Module;
    StartPlug := GetProcAddress(Module, 'Start');
    if @StartPlug <> nil then begin
      StartPlug();
    end;
  end;
end;

procedure TPlugInManage.LoadPlugIn;
var
  I: Integer;
  LoadList: TStringList;
  sPlugFileName: string;
  sPlugLibName: string;
  sPlugLibFileName: string;
  Module: THandle;
  Init: TPlugInit;
  PlugInfo: pTPlugInfo;
begin
  sPlugFileName := g_Config.sPlugDir + 'PlugList.txt';
  if not DirectoryExists(g_Config.sPlugDir) then begin
    //CreateDirectory(PChar(g_Config.sConLogDir),nil);
    CreateDir(g_Config.sPlugDir);
  end;
  if not FileExists(sPlugFileName) then begin
    LoadList := TStringList.Create;
    LoadList.Add('SystemModule.dll');
    LoadList.SaveToFile(sPlugFileName);
    LoadList.Free;
  end;
  if FileExists(sPlugFileName) then begin
    LoadList := TStringList.Create;
    LoadList.LoadFromFile(sPlugFileName);
    for I := 0 to LoadList.Count - 1 do begin
      sPlugLibName := Trim(LoadList.Strings[I]);
      if (sPlugLibName = '') or (sPlugLibName[1] = ';') then Continue;
      sPlugLibFileName := g_Config.sPlugDir + sPlugLibName;
      if FileExists(sPlugLibFileName) then begin
        Module := LoadLibrary(PChar(sPlugLibFileName)); //FreeLibrary
        if Module > 32 then begin
          if GetPlug(Module) then begin //2007-01-22 增加 是否重复加载同一个插件
            FreeLibrary(Module);
            Continue;
          end;
          Init := GetProcAddress(Module, 'Init');
          if @Init <> nil then begin
            New(PlugInfo);
            PlugInfo.DllName := sPlugLibFileName;
            PlugInfo.Module := Module;
            PlugInfo.sDesc := Init(Application.Handle, @MainMessage, @MainMessage, @FindEngnProc, @SetProcTable);
            PlugList.AddObject(PlugInfo.sDesc, TObject(PlugInfo));
          end;
        end;
      end;
    end;
    LoadList.Free;
  end;
end;

procedure TPlugInManage.UnLoadPlugIn;
var
  I: Integer;
  Module: THandle;
  PFunc: procedure(); stdcall;
begin
  for I := 0 to PlugList.Count - 1 do begin
    Module := pTPlugInfo(PlugList.Objects[I]).Module;
    PFunc := GetProcAddress(Module, 'UnInit');
    if @PFunc <> nil then
      PFunc();
    FreeLibrary(Module);
  end;
end;

initialization

finalization

end.
nteger;
  Module: THandle;
  PFunc: procedure(); stdcall;
begin
  for I := 0 to PlugList.Count - 1 do begin
    Module := pTPlugInfo(PlugList.Objects[I]).Module;
    PFunc := GetProcAddress(Module, 'UnInit');
    if @PFunc <> nil then
      PFunc();
    FreeLibrary(Module);
  end;
end;

initialization

finalization

end.