mixster

//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
//Check "Accessable SCAR Functions.txt" for which functions you can call from SCAR
library ListenSocket;

uses
  Forms,
  FastShareMem,
  SysUtils,
  Classes,
  Windows,
  Graphics,
  ScktComp;

{$R *.res}

type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TMessage = record
    host, mess: string;
  end;

  TMessArr = array of TMessage;

  TStringArray = array of string;
type
  THandleServer = class
    ServerSock: TServerSocket;
    messages: TMessArr;
    constructor create;
    procedure SetupServer(port: Integer);
    procedure ServerSockRead(Sender: TObject; Socket: TCustomWinSocket);
  end;

type
  TConnection = record
    Server: THandleServer;
    Open: Boolean;
  end;

var
  Connections: array of TConnection;

constructor THandleServer.Create;
begin
  inherited;
  ServerSock := TServerSocket.Create(nil);
end;

procedure THandleServer.SetupServer(port: Integer);
begin
  ServerSock.Port := port;
  ServerSock.ServerType := stNonBlocking;
  ServerSock.OnClientRead := ServerSockRead;
  ServerSock.Active := True;
end;

procedure THandleServer.ServerSockRead(Sender: TObject; Socket: TCustomWinSocket);
var
  con, i: Integer;
  inText, inHost: string;
begin
  for con := 0 to ServerSock.Socket.ActiveConnections - 1 do
  begin
    inText := ServerSock.Socket.Connections[con].ReceiveText;
    inHost := ServerSock.Socket.Connections[con].RemoteAddress;
    if ((inHost <> '') and (inText <> '')) then
    begin
      i := Length(messages);
      SetLength(messages, i + 1);
      messages[i].host := inHost;
      messages[i].mess := inText;
    end;
  end;
end;

function CreateServerConnection(port: Integer): Integer; stdcall;
var
  i, l: Integer;
begin
  i := 0;
  try
    l := Length(Connections);
    if l  <> 0 then
      for i := 0 to l - 1 do
        if (Connections[i].Open) then
          break;
    if (i = l) then
      SetLength(Connections, l + 1);

    Connections[i].Open := False;
    Connections[i].Server := THandleServer.create;
    Connections[i].Server.SetupServer(port);

    Result := i;

  except
    Result := -1;
  end;
end;

function ReadServerData(num: Integer): TMessArr; stdcall;
var
  i: Integer;
begin
  if ((num < 0) or (num >= Length(Connections)) or (Connections[num].Open)) then
    exit;
  SetLength(Connections[num].Server.messages, 0);
  try
    Application.ProcessMessages;

    SetLength(Result, Length(Connections[num].Server.messages));
    for i := 0 to Length(Connections[num].Server.messages) - 1 do
    begin
      Result[i].host := Connections[num].Server.messages[i].host;
      Result[i].mess := Connections[num].Server.messages[i].mess;
    end;
  except
  end;
end;

function SendServerData(num: Integer; host, data: string): Boolean; stdcall;
var
  i: Integer;
begin
  if ((num < 0) or (num >= Length(Connections)) or (Connections[num].Open)) then
  begin
    Result := False;
    exit;
  end;

  try
    try
      i := StrToInt(host);
      if ((i < 0) or (i >= Connections[num].Server.ServerSock.Socket.ActiveConnections)) then
      begin
        Result := False;
        exit;
      end;
    except
      for i := 0 to Connections[num].Server.ServerSock.Socket.ActiveConnections - 1 do
        if (Connections[num].Server.ServerSock.Socket.Connections[i].RemoteHost = host) then
          break;
      if ((i = Connections[num].Server.ServerSock.Socket.ActiveConnections) or (not Connections[num].Server.ServerSock.Socket.Connections[i].Connected)) then
      begin
        Result := False;
        exit;
      end;
    end;

    Connections[num].Server.ServerSock.Socket.Connections[i].SendText(data);

    Result := True;
  except
    Result := False;
  end;
end;

function GetServerClients(num: Integer): TStringArray; stdcall;
var
  i, l: Integer;
begin
  if ((num < 0) or (num >= Length(Connections)) or (Connections[num].Open) or (Connections[num].Server.ServerSock.Socket.ActiveConnections = 0)) then
    exit;
  try
    l := Connections[num].Server.ServerSock.Socket.ActiveConnections;
    SetLength(Result, l);
    for i := 0 to l - 1 do
    begin
      Result[i] := StrAlloc(Length(Connections[num].Server.ServerSock.Socket.Connections[i].RemoteHost));
      Result[i] := Connections[num].Server.ServerSock.Socket.Connections[i].RemoteHost;
    end;
  except
  end;
end;

function FreeServerConnection(num: Integer): Boolean; stdcall;
begin
  try
    Connections[num].Open := True;
    Connections[num].Server.ServerSock.Free;
    Connections[num].Server.Free;

    if (num = Length(Connections) - 1) then
      SetLength(Connections, num);
    Result := True;
  except
    Result := False;
  end;
end;

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 5;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
      begin
        ProcAddr := @CreateServerConnection;
        StrPCopy(ProcDef, 'function CreateServerConnection(port: Integer): Integer;');
      end;
    1:
      begin
        ProcAddr := @ReadServerData;
        StrPCopy(ProcDef, 'function ReadServerData(num: Integer): TMessArr;');
      end;
    2:
      begin
        ProcAddr := @SendServerData;
        StrPCopy(ProcDef, 'function SendServerData(num: Integer; host, data: string): Boolean;');
      end;
    3:
      begin
        ProcAddr := @GetServerClients;
        StrPCopy(ProcDef, 'function GetServerClients(num: Integer): TStringArray;');
      end;
    4:
      begin
        ProcAddr := @FreeServerConnection;
        StrPCopy(ProcDef, 'function FreeServerConnection(num: Integer): Boolean;');
      end;
  else
    x := -1;
  end;
  Result := x;
end;

function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 2;
end;

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TMessage';
        sTypeDef := 'record host, mess: string; end;';
      end;
    1:
      begin
        sType := 'TMessArr';
        sTypeDef := 'array of TMessage;';
      end;
  else
    x := -1;
  end;
  Result := x;
end;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;
end.