Simba: Socket Support.

Units/MMLAddon/PSInc/Wrappers/internets.inc

@@ -56,3 +56,63 @@ procedure ps_SetProxy(Client : Integer; pHost, pPort : String); extdecl;
 begin
   CurrThread.MInternet.GetHTTPClient(client).SetProxy(pHost, pPort);
 end;
+
+function ps_RecvSocketStr(Client: integer): string;
+begin
+  Result := CurrThread.Socks.GetSocket(Client).RecvString;
+end;
+
+function ps_RecvSocket(Client: integer): string;
+begin
+  Result := CurrThread.Socks.GetSocket(Client).Recv;
+end;
+
+function ps_RecvSocketEx(Client, Length: integer): string;
+begin
+  Result := CurrThread.Socks.GetSocket(Client).RecvBufferStr(Length);
+end;
+
+procedure ps_SendSocket(Client: integer; Data: string);
+begin
+  CurrThread.Socks.GetSocket(Client).Send(Data);
+end;
+
+procedure ps_ConnectSocket(Client: integer; IP, Port: string);
+begin
+  CurrThread.Socks.GetSocket(Client).Connect(IP, Port);
+end;
+
+procedure ps_CloseSocket(Client: integer);
+begin
+  CurrThread.Socks.GetSocket(Client).Close;
+end;
+
+procedure ps_SetSocketTimeout(Client, Time: integer);
+begin
+  CurrThread.Socks.GetSocket(Client).SetTimeout(Time);
+end;
+
+procedure ps_BindSocket(Client: integer; IP, Port: string);
+begin
+  CurrThread.Socks.GetSocket(Client).Bind(IP, Port);
+end;
+
+procedure ps_ListenSocket(Client: integer);
+begin
+  CurrThread.Socks.GetSocket(Client).Listen;
+end;
+
+function ps_AcceptSocket(Client: integer): integer;
+begin
+  Result := CurrThread.Socks.CreateSocketEx(CurrThread.Socks.GetSocket(Client).Accept);
+end;
+
+function ps_CreateSocket: integer; extdecl;
+begin
+  Result := CurrThread.Socks.CreateSocket();
+end;
+
+procedure ps_FreeSocket(Client: integer); extdecl;
+begin;
+  CurrThread.Socks.FreeSocket(Client);
+end;

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -263,6 +263,23 @@ AddFunction(@ps_GetRawHeaders,'function GetRawHeaders(Client: Integer): string;'
 AddFunction(@ps_SetProxy,'procedure SetProxy(Client : Integer; pHost, pPort : String);');
 {$ENDIF}
 
+{socket}
+{$IFNDEF MML_EXPORT_THREADSAFE}
+SetCurrSection('Socket');
+AddFunction(@ps_CreateSocket, 'function CreateSocket: integer;');
+AddFunction(@ps_FreeSocket, 'procedure FreeSocket(Index: integer);');
+AddFunction(@ps_ConnectSocket, 'procedure ConnectSocket(Client: integer; IP, Port: string);');
+AddFunction(@ps_BindSocket, 'procedure BindSocket(Client: integer; IP, Port: string);');
+AddFunction(@ps_ListenSocket, 'procedure ListenSocket(Client: integer);');
+AddFunction(@ps_AcceptSocket, 'function AcceptSocket(Client: integer): integer;');
+AddFunction(@ps_CloseSocket, 'procedure CloseSocket(Client: integer);');
+AddFunction(@ps_RecvSocket, 'function RecvSocket(Client: integer): string;');
+AddFunction(@ps_RecvSocketStr, 'function RecvSocketStr(Client: integer): string;');
+AddFunction(@ps_RecvSocketEx, 'function RecvSocketEx(Client, Length: integer): string;');
+AddFunction(@ps_SendSocket, 'procedure SendSocket(Client: integer; Data: string);');
+AddFunction(@ps_SetSocketTimeout, 'procedure SetTimeout(Client, Time: integer);');
+{$ENDIF}
+
 { Color Conversions and Speed }
 SetCurrSection('Color Convert');
 AddFunction(@ps_ColorToRGB, 'procedure ColorToRGB(Color: integer; var r, g, b: Integer);');

Units/MMLAddon/internets.pas

@@ -5,14 +5,12 @@ unit internets;
 interface
 
 uses
-  Classes, SysUtils,httpsend,MufasaTypes;
+  Classes, SysUtils, httpsend, blcksock, MufasaTypes, math;
 
 function GetPage(URL: String): String;
 
 type
-
   { THTTPClient }
-
   THTTPClient = class(TObject)
   private
     HTTPSend : THTTPSend;
@@ -32,6 +30,7 @@ type
     constructor Create(Owner : TObject; HandleCookies : boolean = true);
     destructor Destroy;override;
   end;
+
   { TMInternet }
   TMInternet = class(TObject)
   protected
@@ -48,6 +47,41 @@ type
     destructor Destroy;override;
   end;
 
+  { TSock }
+  TSock = class(TObject)
+  private
+    Sock: TTCPBlockSocket;
+    Timeout: integer;
+    Client: TObject;
+  public
+    function RecvBufferStr(Length: integer): string;
+    function RecvString: string;
+    function Recv: string;
+    procedure Send(Data: string);
+    procedure Connect(IP, Port: string);
+    procedure Close;
+    procedure SetTimeout(Time: integer);
+    procedure Bind(IP, Port: string);
+    procedure Listen;
+    function Accept: TTCPBlockSocket;
+    constructor Create(Owner: TObject; Socket: TTCPBlockSocket = nil);
+    destructor Destroy; override;
+  end;
+
+  { TSocks }
+  TSocks = class(TObject)
+  protected
+    Client: TObject;
+    SockList: TList;
+  public
+    function CreateSocket: integer;
+    function CreateSocketEx(Socket: TTCPBlockSocket): integer;
+    function GetSocket(Index: integer): TSock;
+    procedure FreeSocket(Index: integer);
+    constructor Create(Owner : TObject);
+    destructor Destroy; override;
+  end;
+
 var
   ProxyHost, ProxyPort : String;
 implementation
@@ -262,4 +296,145 @@ begin
   inherited Destroy;
 end;
 
-end.
+{ TSocks }
+
+function TSocks.CreateSocket: integer;
+begin;
+  Result := SockList.Add(TSock.Create(Client));
+end;
+
+function TSocks.CreateSocketEx(Socket: TTCPBlockSocket): integer;
+begin;
+  Result := SockList.Add(TSock.Create(Client, Socket));
+end;
+
+function TSocks.GetSocket(Index: integer): TSock;
+begin
+  if (not (InRange(Index, 0, SockList.Count))) then
+    raise exception.CreateFmt('GetSocket: Trying to acces an index(%d) that is out of range', [index]);
+  if (SockList[index] = nil) then
+    raise exception.CreateFmt('GetSocket: Trying to acces an index(%d) that is freed', [index]);
+  Result := TSock(SockList[Index]);
+end;
+
+procedure TSocks.FreeSocket(Index: Integer);
+begin
+  if (not (InRange(Index, 0, SockList.Count))) then
+    raise exception.CreateFmt('GetSocket: Trying to free an index(%d) that is out of range', [index]);
+  if (SockList[index] = nil) then
+    raise exception.CreateFmt('GetSocket: Trying to free an index(%d) that is already freed', [index]);
+  TSock(SockList[Index]).Free;
+  SockList[Index] := nil;
+end;
+
+constructor TSocks.Create(Owner : TObject);
+begin
+  inherited Create;
+  Client := Owner;
+  SockList := TList.Create;
+end;
+
+destructor TSocks.Destroy;
+var
+  i: integer;
+begin
+  for i := SockList.Count - 1 downto 0 do
+    if SockList[i] <> nil then
+    begin
+      TSock(SockList[i]).Free;
+      TClient(Client).WriteLn(Format('Socket[%d] has not been freed in the script, freeing it now.',[i]));
+    end;
+  SockList.Free;
+  inherited Destroy;
+end;
+
+{ TSock }
+
+function TSock.RecvBufferStr(Length: integer): string;
+begin
+  Result := Sock.RecvBufferStr(Length, Timeout);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+function TSock.RecvString: string;
+begin
+  Result := Sock.RecvString(Timeout);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+function TSock.Recv: string;
+begin
+  Result := Sock.RecvPacket(Timeout);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+procedure TSock.Send(Data: string);
+begin
+  Sock.SendString(Data);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+procedure TSock.Connect(IP, Port: string);
+begin
+  Sock.Connect(IP, Port);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+procedure TSock.Close;
+begin
+  Sock.CloseSocket;
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+procedure TSock.SetTimeout(Time: integer);
+begin
+  Timeout := Time;
+end;
+
+procedure TSock.Bind(IP, Port: string);
+begin
+  Sock.Bind(IP, Port);
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+procedure TSock.Listen;
+begin
+  Sock.Listen;
+end;
+
+function TSock.Accept: TTCPBlockSocket;
+var
+  Socket: TTCPBlockSocket;
+begin
+  Socket := TTCPBlockSocket.Create;
+  Socket.Socket := Sock.Accept;
+  Result := Socket;
+  if (Sock.LastError <> 0) then
+     raise Exception.Create('Socket Error ' + IntToStr(Sock.LastError) + ': ' + Sock.LastErrorDesc);
+end;
+
+constructor TSock.Create(Owner: TObject; Socket: TTCPBlockSocket = nil);
+begin
+  inherited Create;
+  Client := Owner;
+  Timeout := 1500;
+  if (Socket <> nil) then
+    Sock := Socket
+  else
+    Sock := TTCPBlockSocket.Create;
+end;
+
+destructor TSock.Destroy;
+begin
+  Sock.Free;
+  inherited Destroy;
+end;
+
+end.