sdk.pas

FIR引擎最新源码+注册

unit SDK;

interface
uses
  Windows, SysUtils, Classes, Grobal2, Forms;
const
  MAXPULGCOUNT = 20;

  sROAUTORUN = '#AUTORUN';
  sRONPCLABLEJMP = 'NPC';
  nRONPCLABLEJMP = 100;
  sRODAY = 'DAY';
  nRODAY = 200;
  sROHOUR = 'HOUR';
  nROHOUR = 201;
  sROMIN = 'MIN';
  nROMIN = 202;
  sROSEC = 'SEC';
  nROSEC = 203;
  sRUNONWEEK = 'RUNONWEEK'; //指定星期几运行
  nRUNONWEEK = 300;
  sRUNONDAY = 'RUNONDAY'; //指定几日运行
  nRUNONDAY = 301;
  sRUNONHOUR = 'RUNONHOUR'; //指定小时运行
  nRUNONHOUR = 302;
  sRUNONMIN = 'RUNONMIN'; //指定分钟运行
  nRUNONMIN = 303;
  sRUNONSEC = 'RUNONSEC';
  nRUNONSEC = 304;

type
  TOpType = (o_NPC);
  TAutoRunInfo = record
    dwRunTick: LongWord; //上一次运行时间记录
    dwRunTimeLen: LongWord; //运行间隔时间长
    nRunCmd: Integer; //自动运行类型
    nMoethod: Integer;
    sParam1: string; //运行脚本标签
    sParam2: string; //传送到脚本参数内容
    sParam3: string;
    sParam4: string;
    nParam1: Integer;
    nParam2: Integer;
    nParam3: Integer;
    nParam4: Integer;
    boStatus: Boolean;
  end;
  pTAutoRunInfo = ^TAutoRunInfo;

  TProcArrayInfo = record
    sProcName: string;
    nProcAddr: Pointer;
    nProcCode: Integer;
  end;
  pTProcArrayInfo = ^TProcArrayInfo;

  TObjectArrayInfo = record
    Obj: TObject;
    sObjcName: string;
    nObjcCode: Integer;
  end;
  pTObjectArrayInfo = ^TObjectArrayInfo;

  TProcArray = array[0..MAXPULGCOUNT - 1] of TProcArrayInfo;
  TObjectArray = array[0..MAXPULGCOUNT - 1] of TObjectArrayInfo;

  TMsgProc = procedure(Msg: PChar; nMsgLen: Integer; nMode: Integer); stdcall;
  TFindProc = function(ProcName: PChar; nNameLen: Integer; nProcCode: Integer): Pointer; stdcall;
  TSetProc = function(ProcAddr: Pointer; ProcName: PChar; nNameLen: Integer; nProcCode: Integer): Boolean; stdcall;
  TFindObj = function(ObjName: PChar; nNameLen: Integer; nObjcCode: Integer): TObject; stdcall;
  TStartPlug = function(): Boolean; stdcall;
  TSetStartPlug = function(StartPlug: TStartPlug): Boolean; stdcall;

  TPlugInit = function(AppHandle: HWnd; MsgProc: TMsgProc; FindProc: TFindProc; SetProc: TSetProc; FindObj: TFindObj): PChar; stdcall;
  TClassProc = procedure(Sender: TObject);
  TStartProc = procedure(); stdcall;
  TStartRegister = function(sRegisterInfo: PChar): Boolean; stdcall;
  TGetStrProc = procedure(sRegisterCode: PChar); stdcall;
  TGameDataLog = function(ProcName: PChar; nNameLen: Integer): Boolean; stdcall;
  TIPLocal = procedure(sIPaddr: PChar; sLocal: PChar; nLocalLen: Integer); stdcall;
  TDeCryptString = procedure(Src, Dest: PChar; nSrc: Integer); stdcall;

  TGetProcInt = function(): Integer; stdcall;

  TShortString = packed record
    btLen: Byte;
    Strings: array[0..High(Byte) - 1] of Char;
  end;
  PTShortString = ^TShortString;

  _TBANKPWD = string[6];
  _LPTBANKPWD = ^_TBANKPWD;
  _TMAPNAME = string[MAPNAMELEN];
  _LPTMAPNAME = ^_TMAPNAME;
  _TACTORNAME = string[ACTORNAMELEN];
  _LPTACTORNAME = ^_TACTORNAME;
  _TPATHNAME = string[MAXPATHLEN];
  _LPTPATHNAME = ^_TPATHNAME;
  _TDIRNAME = string[DIRPATHLEN];
  _LPTDIRNAME = ^_TDIRNAME;

  TObjectAction = procedure(PlayObject: TObject); stdcall;
  TObjectActionEx = function(PlayObject: TObject): BOOL; stdcall;
  TObjectActionXY = procedure(AObject, BObject: TObject; nX, nY: Integer); stdcall;
  TObjectActionXYD = procedure(AObject, BObject: TObject; nX, nY: Integer; btDir: Byte); stdcall;
  TObjectActionXYDM = procedure(AObject, BObject: TObject; nX, nY: Integer; btDir: Byte; nMode: Integer); stdcall;
  TObjectActionXYDWS = procedure(AObject, BObject: TObject; wIdent: Word; nX, nY: Integer; btDir: Byte; pszMsg: PChar); stdcall;
  TObjectActionObject = procedure(AObject, BObject, CObject: TObject; nInt: Integer); stdcall;
  TObjectActionDetailGoods = procedure(Merchant: TObject; PlayObject: TObject; pszItemName: PChar; nInt: Integer); stdcall;
  TObjectActionUserSelect = procedure(Merchant: TObject; PlayObject: TObject; pszLabel, pszData: PChar); stdcall;
  TObjectUserCmd = function(AObject: TObject; pszCmd, pszParam1, pszParam2, pszParam3, pszParam4, pszParam5, pszParam6, pszParam7: PChar): Boolean; stdcall;
  TPlaySendSocket = function(AObject: TObject; DefMsg: pTDefaultMessage; pszMsg: PChar): Boolean; stdcall;
  TObjectActionItem = function(AObject: TObject; pszItemName: PChar; boHintMsg: Boolean): Boolean; stdcall;
  TObjectClientMsg = function(PlayObject: TObject; DefMsg: pTDefaultMessage; Buff: PChar; NewBuff: PChar): Integer; stdcall;
  TObjectActionFeature = function(AObject, BObject: TObject): Integer; stdcall;
  TObjectActionSendGoods = procedure(AObject: TObject; nNpcRecog, nCount, nPostion: Integer; pszData: PChar); stdcall;
  TObjectActionCheckUserItem = function(nIdx: Integer; StdItem: pTStdItem): Boolean; stdcall;
  TObjectActionEnterMap = function(AObject: TObject; Envir: TObject; nX, nY: Integer): Boolean; stdcall;
  TObjectFilterMsg = function(PlayObject: TObject; pszSrcMsg, pszDestMsg: PChar): Boolean; stdcall;
  TEDCode = procedure(pszSource: PChar; pszDest: PChar; nSrcLen, nDestLen: Integer); stdcall;
  TDoSpell = function(MagicManager: TObject; PlayObject: TObject; UserMagic: pTUserMagic; nTargetX, nTargetY: Integer; TargeTBaseObject: TObject; var boSpellFail, boSpellFire: Boolean): Boolean; stdcall;

  TScriptCmd = function(pszCmd: PChar): Integer; stdcall;

  TScriptAction = procedure(NPC: TObject;
    PlayObject: TObject;
    nCMDCode: Integer;
    pszParam1: PChar;
    nParam1: Integer;
    pszParam2: PChar;
    nParam2: Integer;
    pszParam3: PChar;
    nParam3: Integer;
    pszParam4: PChar;
    nParam4: Integer;
    pszParam5: PChar;
    nParam5: Integer;
    pszParam6: PChar;
    nParam6: Integer); stdcall;

  TScriptCondition = function(NPC: TObject;
    PlayObject: TObject;
    nCMDCode: Integer;
    pszParam1: PChar;
    nParam1: Integer;
    pszParam2: PChar;
    nParam2: Integer;
    pszParam3: PChar;
    nParam3: Integer;
    pszParam4: PChar;
    nParam4: Integer;
    pszParam5: PChar;
    nParam5: Integer;
    pszParam6: PChar;
    nParam6: Integer): Boolean; stdcall;

  TObjectOperateMessage = function(BaseObject: TObject;
    wIdent: Word;
    wParam: Word;
    nParam1: Integer;
    nParam2: Integer;
    nParam3: Integer;
    MsgObject: TObject;
    dwDeliveryTime: LongWord;
    pszMsg: PChar;
    var boReturn: Boolean): Boolean; stdcall;

  {===================================TGList===================================}

  TGList = class(TList)
  private
    CriticalSection: TRTLCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
  end;

  {=================================TGStringList================================}
  TGStringList = class(TStringList)
  private
    CriticalSection: TRTLCriticalSection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Lock;
    procedure UnLock;
  end;

  TSellOffGoodList = class
  private
    FRecCount: Cardinal;
    FUpDateSellOff: Boolean;
    m_nChangeCount: Integer;
    m_SellOffGoodList: TGList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadSellOffGoodList();
    procedure UnLoadSellOffGoodList();
    procedure GetSellOffGoodList(var SellOffList: TList);
    procedure GetUserSellOffGoodListByChrName(sChrName: string; var SellOffList: TList);
    procedure GetUserSellOffGoodListByItemName(sItemName: string; var SellOffList: TList);
    procedure GetUserSellOffGoodListByMakeIndex(nMakeIndex: Integer; var SellOffInfo: pTSellOffInfo);
    procedure GetUserSellOffItem(sItemName: string; nMakeIndex: Integer; var SellOffInfo: pTSellOffInfo; var StdItem: pTStdItem);
    function GetUserSellOffCount(sCharName: string): Integer;
    function GetUserLimitSellOffCount(sCharName: string): Boolean;
    procedure GetUserSellOffListByIndex(nIndex: Integer; var SellOffList: TList);
    function AddItemToSellOffGoodsList(SellOffInfo: pTSellOffInfo): Boolean;
    function DelSellOffItem(nMakeIndex: Integer): Boolean;
    function SaveSellOffGoodList(): Boolean;
  published
    property RecCount: Cardinal read FRecCount write FRecCount;
    property UpDateSellOff: Boolean read FUpDateSellOff write FUpDateSellOff;
  end;

  TSellOffGoldList = class
  private
    FRecCount: Cardinal;
    FUpDateSellOff: Boolean;
    m_nChangeCount: Integer;
    m_SellOffGoldList: TGList;
  public
    constructor Create;
    destructor Destroy; override;
    procedure LoadSellOffGoldList();
    procedure UnLoadSellOffGoldList();
    procedure GetUserSellOffGoldListByChrName(sChrName: string; var SellOffList: TList);
    function AddItemToSellOffGoldList(SellOffInfo: pTSellOffInfo): Boolean;
    function DelSellOffGoldItem(nMakeIndex: Integer): Boolean;
    function SaveSellOffGoldList(): Boolean;
  published
    property RecCount: Cardinal read FRecCount write FRecCount;
    property UpDateSellOff: Boolean read FUpDateSellOff write FUpDateSellOff;
  end;

  //==============================================================================
  TStorage = class
  private
    FRecordCount: Cardinal;
    FHumManCount: Cardinal;
    m_ItemCount: TItemCount;
  public
    m_StorageList: TGStringList;
    constructor Create;
    destructor Destroy; override;
    procedure LoadBigStorageList(const sFileName: string);
    procedure UnLoadBigStorageList();
    function GetUserBigStorageList(sChrName: string): TList;
    function Add(var StorageList: TList; sChrName: string; UserItem: pTUserItem): Boolean;
    function Delete(var StorageList: TList; sItemName: string; nMakeIndex: Integer): Boolean;
    function GetItem(StorageList: TList; sItemName: string; nMakeIndex: Integer; var UserItem: TUserItem): Boolean;
    procedure SaveToFile(const sFileName: string);
  published
    property RecordCount: Cardinal read FRecordCount write FRecordCount;
    property HumManCount: Cardinal read FHumManCount write FHumManCount;
  end;
  {=================================TSortStringList================================}

  TSortStringList = class(TGStringList)
  public
    procedure StringSort(Order: Boolean);
    procedure ObjectSort(Order: Boolean);
  end;

  TSStringList = class(TGStringList)
  public
    procedure QuickSort(Order: Boolean);
  end;
implementation
uses ItmUnit, UsrEngn, M2Share, HUtil32;

procedure TSStringList.QuickSort(Order: Boolean); //速度更快的排行
  procedure QuickSortStrListCase(List: TStringList; l, r: Integer);
  var
    I, j: Integer;
    p: string;
  begin
    if List.Count <= 0 then Exit;
    repeat
      I := l;
      j := r;
      p := List[(l + r) shr 1];
      repeat
        if Order then begin //升序
          while CompareStr(List[I], p) < 0 do Inc(I);
          while CompareStr(List[j], p) > 0 do Dec(j);
        end else begin //降序
          while CompareStr(p, List[I]) < 0 do Inc(I);
          while CompareStr(p, List[j]) > 0 do Dec(j);
        end;
        if I <= j then begin
          List.Exchange(I, j);
          Inc(I);
          Dec(j);
        end;
      until I > j;
      if l < j then QuickSortStrListCase(List, l, j);
      l := I;
    until I >= r;
  end;
  procedure AddList(TempList: TStringList; slen: string; s: string; AObject: TObject);
  var
    I: Integer;
    List: TStringList;
    boFound: Boolean;
  begin
    boFound := False;
    for I := 0 to TempList.Count - 1 do begin
      if CompareText(TempList.Strings[I], slen) = 0 then begin
        List := TStringList(TempList.Objects[I]);
        List.AddObject(s, AObject);
        boFound := True;
        Break;
      end;
    end;
    if not boFound then begin
      List := TStringList.Create;
      List.AddObject(s, AObject);
      TempList.AddObject(slen, List);
    end;
  end;
var
  TempList: TStringList;
  List: TStringList;
  I: Integer;
  nLen: Integer;
begin
  TempList := TStringList.Create;
  for I := 0 to Self.Count - 1 do begin
    nLen := Length(Self.Strings[I]);
    AddList(TempList, IntToStr(nLen), Self.Strings[I], Self.Objects[I]);
  end;
  QuickSortStrListCase(TempList, 0, TempList.Count - 1);
  Self.Clear;
  for I := 0 to TempList.Count - 1 do begin
    List := TStringList(TempList.Objects[I]);
    QuickSortStrListCase(List, 0, List.Count - 1);
    Self.AddStrings(List);
    List.Free;
  end;
  TempList.Free;
end;

{ TBigStorage }

constructor TStorage.Create;
begin
  FRecordCount := 0;
  FHumManCount := 0;
  m_StorageList := TGStringList.Create;
  FillChar(m_ItemCount, SizeOf(TItemCount), #0);
end;

destructor TStorage.Destroy;
begin
  UnLoadBigStorageList();
  m_StorageList.Free;
end;

procedure TStorage.LoadBigStorageList(const sFileName: string);
var
  I: Integer;
  FileHandle: Integer;
  List: TList;