moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-27 19:42:22 -05:00
Code Issues Releases Wiki Activity

Simba: Socket Support.

Browse Source
This commit is contained in:
John P (Dgby714) 2010-12-18 14:38:29 -05:00
parent 932e4950d3
commit 3874776aab
3 changed files with 256 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
Units/MMLAddon/PSInc/Wrappers/internets.inc
View File

@ -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;

17
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -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);');

183
Units/MMLAddon/internets.pas
View File

@ -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.