tsremoteimport.pas

动态分区内存分配与回收算法,可利用C++实现可变分区内存分配与回收算法

//#    if result = 0 then tsrChannelInfo is filled with the channel info.
//#                If tsrPlayerInfo was not NIL then the player records are
//#                filled. PlayerRecords indicates how many records were filled
//#
//##############################################################################
type TtsrGetChannelInfoByName = Function ( ChannelName: PChar; tsrChannelInfo: PtsrChannelInfo;
                                tsrPlayerInfo : PtsrPlayerInfo; PlayerRecords : PInteger) : integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetChannelInfoByName : TtsrGetChannelInfoByName;
Const fn_tsrGetChannelInfoByName='tsrGetChannelInfoByName';

//##############################################################################
//#
//#  Function tsrGetPlayerInfoByID( PlayerID: Integer;
//#                                 tsrPlayerInfo : PtsrPlayerInfo): Integer;
//#
//#  Description:
//#    Get the Info on the player specified by PlayerID.
//#
//#  Input:
//#    PlayerID: The ID of the player you want the info from
//#    tsrPlayerInfo: This is the pointer to a TtsrPlayerInfo record
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrPlayerInfo is filled with the player info.
//#
//##############################################################################
type TtsrGetPlayerInfoByID = Function ( PlayerID: Integer; tsrPlayerInfo : PtsrPlayerInfo): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetPlayerInfoByID : TtsrGetPlayerInfoByID;
Const fn_tsrGetPlayerInfoByID='tsrGetPlayerInfoByID';

//##############################################################################
//#
//#  Function tsrGetPlayerInfoByName( PlayerName : Pchar
//#                                 tsrPlayerInfo : PtsrPlayerInfo): Integer;
//#
//#  Description:
//#    Get the Info on the player specified by PlayerName.
//#
//#  Input:
//#    PlayerName: The Name of the player you want the info from
//#    tsrPlayerInfo: This is the pointer to a TtsrPlayerInfo record
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrPlayerInfo is filled with the player info.
//#
//##############################################################################
type TtsrGetPlayerInfoByName = Function  ( PlayerName: Pchar; tsrPlayerInfo : PtsrPlayerInfo): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetPlayerInfoByName : TtsrGetPlayerInfoByName;
Const fn_tsrGetPlayerInfoByName='tsrGetPlayerInfoByName';

//##############################################################################
//#
//#  Function tsrGetChannels( tsrChannels : PtsrChannelInfo;
//#                           ChannelRecords: PInteger): Integer;
//#
//#  Description:
//#    Get a list of the channels on the server.
//#
//#  Input:
//#    tsrChannels: A pointer to an array of TtsrChannelInfo records
//#    ChannelRecords: pointer to a integer which specifies how many
//#                    TtsrChannelInfo records tsrChannels can hold.
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrChannels is filled with the channel info.
//#              ChannelRecords will have the number or records that were filled
//#
//##############################################################################
type TtsrGetChannels = Function ( tsrChannels : PtsrChannelInfo; ChannelRecords: PInteger): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetChannels : TtsrGetChannels;
Const fn_tsrGetChannels='tsrGetChannels';

//##############################################################################
//#
//#  Function tsrGetPlayers( tsrPlayers: PtsrPlayerInfo;
//#                          PlayerRecords: PInteger): Integer;
//#
//#  Description:
//#    Get a list of the Players on the server.
//#
//#  Input:
//#    tsrPlayers: A pointer to an array of TtsrPlayerInfo records
//#    PlayerRecords: pointer to a integer which specifies how many
//#                    TtsrPlayerInfo records tsrPlayers can hold.
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#    if result = 0 then tsrPlayers is filled with the Player info.
//#              PlayerRecords will have the number or records that were filled
//#
//##############################################################################
type TtsrGetPlayers = Function ( tsrPlayers: PtsrPlayerInfo; PlayerRecords: PInteger): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrGetPlayers : TtsrGetPlayers;
Const fn_tsrGetPlayers='tsrGetPlayers';

//##############################################################################
//#
//#  Function tsrSetPlayerFlags( tsrPlayerFlags : Integer ): Integer;
//#
//#  Description:
//#    Set player flags of the user
//#
//#  Input:
//#    tsrPlayerFlags: An integer wich has the bitmask for all the flags
//#                    All flags are set to this bitmask.
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
type TtsrSetPlayerFlags = Function ( tsrPlayerFlags : Integer ): Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSetPlayerFlags : TtsrSetPlayerFlags;
Const fn_tsrSetPlayerFlags='tsrSetPlayerFlags';

//##############################################################################
//#
//#  Function tsrSetWantVoiceReason( tsrReason: pchar ):Integer;
//#
//#  Description:
//#    set the reason you want voice on a channel
//#
//#  Input:
//#    tsrReason: The reseason for voice
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
type TtsrSetWantVoiceReason = Function ( tsrReason: pchar ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSetWantVoiceReason : TtsrSetWantVoiceReason;
Const fn_tsrSetWantVoiceReason='tsrSetWantVoiceReason';

//##############################################################################
//#
//#  Function tsrSetOperator( PlayerID: Integer; GrantRevoke: Integer ):Integer;
//#
//#  Description:
//#    Grant or revoke Operator status
//#
//#  Input:
//#    PlayerID: ID of the player to set the operator status for
//#    GrantRevoke: Set to grGrant to grant or grRevoke to revoke the privilege
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
type TtsrSetOperator = Function ( PlayerID: Integer; GrantRevoke: Integer ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSetOperator : TtsrSetOperator;
Const fn_tsrSetOperator='tsrSetOperator';

//##############################################################################
//#
//#  Function tsrSetVoice( PlayerID: Integer; GrantRevoke: Integer ):Integer;
//#
//#  Description:
//#    Grant or revoke Voice status
//#
//#  Input:
//#    PlayerID: ID of the player to set the Voice status for
//#    GrantRevoke: Set to grGrant to grant or grRevoke to revoke the privilege
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
Type TtsrSetVoice = Function ( PlayerID: Integer; GrantRevoke: Integer ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSetVoice : TtsrSetVoice;
Const fn_tsrSetVoice='tsrSetVoice';

//##############################################################################
//#
//#  Function tsrKickPlayerFromServer( PlayerID: Integer;
//#                                    Reason : Pchar ):Integer;
//#
//#  Description:
//#    Kick a player from the server;
//#
//#  Input:
//#    PlayerID: ID of the player to set the Voice status for
//#    Reason: The reason why he was kicked
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
type TtsrKickPlayerFromServer = Function ( PlayerID: Integer; Reason : Pchar ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrKickPlayerFromServer : TtsrKickPlayerFromServer;
Const fn_tsrKickPlayerFromServer='tsrKickPlayerFromServer';

//##############################################################################
//#
//#  Function tsrKickPlayerFromChannel( PlayerID: Integer;
//#                                     Reason : Pchar ):Integer;
//#
//#  Description:
//#    Kick a player from the Channel;
//#
//#  Input:
//#    PlayerID: ID of the player to set the Voice status for
//#    Reason: The reason why he was kicked
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
type TtsrKickPlayerFromChannel = Function ( PlayerID: Integer; Reason : Pchar ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrKickPlayerFromChannel : TtsrKickPlayerFromChannel;
Const fn_tsrKickPlayerFromChannel='tsrKickPlayerFromChannel';

//##############################################################################
//#
//#  Function tsrSendTextMessageToChannel( ChannelID: Integer;
//#                                        Message : Pchar ):Integer;
//#
//#  Description:
//#    Send a text message to a channel
//#
//#  Input:
//#    ChannelID: The ID of the channel you want to send the txt message to
//#    Message : The message you want to send.
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
Type TtsrSendTextMessageToChannel = Function ( ChannelID: Integer; Message : Pchar ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSendTextMessageToChannel : TtsrSendTextMessageToChannel;
Const fn_tsrSendTextMessageToChannel='tsrSendTextMessageToChannel';

//##############################################################################
//#
//#  Function tsrSendTextMessage( Message : Pchar ):Integer;
//#
//#  Description:
//#    Send a text message to everyone
//#
//#  Input:
//#    Message : The message you want to send.
//#
//#  Output:
//#    Result: 0 = OK, else the error number
//#
//##############################################################################
Type TtsrSendTextMessage = Function ( Message : Pchar ):Integer;
                 {$ifdef linux}cdecl;{$endif} {$ifdef mswindows}stdcall;{$endif}
var tsrSendTextMessage : TtsrSendTextMessage;
Const fn_tsrSendTextMessage='tsrSendTextMessage';


implementation
{$ifdef mswindows}
uses windows, SysUtils;
{$endif}
{$ifdef LINUX}
uses Libc, SysUtils;
{$endif}
Var Handle : Integer = 0;

Function GetAddress(Handle: Integer; Const FunctionName: PChar):Pointer;
begin
{$Ifdef mswindows}Result := GetProcAddress(Handle, FunctionName);{$Endif}
{$Ifdef linux}Result := dlsym(pointer(Handle), FunctionName);{$Endif};
end;

Function GetHandle( Name : Pchar ): Integer;
begin
{$ifdef mswindows}
  Result := LoadLibrary(Name);
{$endif}
{$ifdef linux}
  Result := integer(dlopen(Name,RTLD_NOW));
{$endif}
end;

Function InitTsRemoteLibrary(TryLocal: Boolean): Integer;
var
 LocalName : String;
begin
  if handle <> 0 then
  begin
    Result := -1;
    Exit;
  end;

  if TryLocal then
  begin
    LocalName := ExtractFilePath(ParamStr(0))+LibName;
    handle := GetHandle(pchar(LocalName));
    if Handle = 0 then handle := GetHandle(LibName);
  end
  else handle := GetHandle(LibName);
  if handle = 0 then
  begin
    Result := -2;
    exit;
  end;
  result := -3;

  @tsrGetLastError := GetAddress(Handle, fn_tsrGetLastError);
  if not assigned(tsrGetLastError ) then exit;
  @tsrConnect := GetAddress(Handle, fn_tsrConnect);
  if not assigned(tsrConnect) then exit;
  @tsrDisconnect := GetAddress(Handle, fn_tsrDisconnect);
  if not assigned(tsrDisconnect) then exit;
  @tsrQuit := GetAddress(Handle, fn_tsrQuit);
  if not assigned(tsrQuit) then exit;
  @tsrSwitchChannelName := GetAddress(Handle, fn_tsrSwitchChannelName);
  if not assigned(tsrSwitchChannelName) then exit;
  @tsrSwitchChannelID := GetAddress(Handle, fn_tsrSwitchChannelID);
  if not assigned(tsrSwitchChannelID ) then exit;
  @tsrGetVersion := GetAddress(Handle, fn_tsrGetVersion);
  if not assigned(tsrGetVersion) then exit;
  @tsrGetServerInfo := GetAddress(Handle, fn_tsrGetServerInfo);
  if not assigned(tsrGetServerInfo) then exit;
  @tsrGetUserInfo := GetAddress(Handle, fn_tsrGetUserInfo);
  if not assigned(tsrGetUserInfo) then exit;
  @tsrGetChannelInfoByID := GetAddress(Handle, fn_tsrGetChannelInfoByID);
  if not assigned(tsrGetChannelInfoByID) then exit;
  @tsrGetChannelInfoByName := GetAddress(Handle, fn_tsrGetChannelInfoByName);
  if not assigned(tsrGetChannelInfoByName) then exit;
  @tsrGetPlayerInfoByID := GetAddress(Handle, fn_tsrGetPlayerInfoByID);
  if not assigned(tsrGetPlayerInfoByID) then exit;
  @tsrGetPlayerInfoByName := GetAddress(Handle, fn_tsrGetPlayerInfoByName);
  if not assigned(tsrGetPlayerInfoByName) then exit;
  @tsrGetChannels := GetAddress(Handle, fn_tsrGetChannels);
  if not assigned(tsrGetChannels) then exit;
  @tsrGetPlayers := GetAddress(Handle, fn_tsrGetPlayers);
  if not assigned(tsrGetPlayers) then exit;
  @tsrSetPlayerFlags := GetAddress(Handle, fn_tsrSetPlayerFlags);
  if not assigned(tsrSetPlayerFlags) then exit;
  @tsrSetWantVoiceReason := GetAddress(Handle, fn_tsrSetWantVoiceReason);
  if not assigned(tsrSetWantVoiceReason) then exit;
  @tsrSetOperator := GetAddress(Handle, fn_tsrSetOperator);
  if not assigned(tsrSetOperator) then exit;
  @tsrSetVoice := GetAddress(Handle, fn_tsrSetVoice);
  if not assigned(tsrSetVoice) then exit;
  @tsrKickPlayerFromServer := GetAddress(Handle, fn_tsrKickPlayerFromServer);
  if not assigned(tsrKickPlayerFromServer) then exit;
  @tsrKickPlayerFromChannel := GetAddress(Handle, fn_tsrKickPlayerFromChannel);
  if not assigned(tsrKickPlayerFromChannel) then exit;
  @tsrSendTextMessageToChannel := GetAddress(Handle, fn_tsrSendTextMessageToChannel);
  if not assigned(tsrSendTextMessageToChannel) then exit;
  @tsrSendTextMessage := GetAddress(Handle, fn_tsrSendTextMessage);
  if not assigned(tsrSendTextMessage) then exit;

  result := 0;
end;

Function CloseTsRemoteLibrary: Integer;
begin
  if handle = 0 then
  begin
    Result := -1;
    Exit;
  end;
  try
  {$ifdef mswindows}
    FreeLibrary(Handle);
  {$endif}
  {$ifdef linux}
    dlclose(pointer(Handle));
  {$endif}
    Handle := 0;
    Result := 0;
  Except
    Handle := 0;
    Result := -2;
  end;
end;

end.