From 3874776aabad994ca38a413a69c8a1529a108e5d Mon Sep 17 00:00:00 2001 From: "John P (Dgby714)" Date: Sat, 18 Dec 2010 14:38:29 -0500 Subject: [PATCH] Simba: Socket Support. --- Units/MMLAddon/PSInc/Wrappers/internets.inc | 60 +++++++ Units/MMLAddon/PSInc/psexportedmethods.inc | 17 ++ Units/MMLAddon/internets.pas | 183 +++++++++++++++++++- 3 files changed, 256 insertions(+), 4 deletions(-) diff --git a/Units/MMLAddon/PSInc/Wrappers/internets.inc b/Units/MMLAddon/PSInc/Wrappers/internets.inc index 913382f..3b97ea0 100644 --- a/Units/MMLAddon/PSInc/Wrappers/internets.inc +++ b/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; diff --git a/Units/MMLAddon/PSInc/psexportedmethods.inc b/Units/MMLAddon/PSInc/psexportedmethods.inc index fc1dcc1..2aa055c 100644 --- a/Units/MMLAddon/PSInc/psexportedmethods.inc +++ b/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);'); diff --git a/Units/MMLAddon/internets.pas b/Units/MMLAddon/internets.pas index d947891..7cfd1d6 100644 --- a/Units/MMLAddon/internets.pas +++ b/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. \ No newline at end of file +{ 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.