Simba/Units/MMLAddon/newinternets.pas

unit newinternets;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

const
  POSTVARS_VARIABLE = 0;
  POSTVARS_VALUE    = 1;

type
  {
       Store the internet connection information
  }
  TInternetConnection = class(TObject)
  protected
    //url of the connection
    ConnURL: String;
    //contains post paramaters and vars
    PostVars: array [0..1] of TStringArray;
    PostFreeSpots: array of Integer;
    PostVarsLen, PostVarsHigh, FreeSpotsHigh, FreeSpotsLen : integer;
  public
    constructor Create(URL: String);
    destructor Destroy; override;
    //POST variable functions for PHP transmission
    procedure PostVariableAdd(theVar, theValue: String);
    procedure PostVariableDel(theVar: String);
    procedure PostVariableReplace(searchVar, replaceVar, value: String);
    function PostHTTP: Boolean;
  end;




  TInternetArray = class(TObject)
  protected
    FreeSpots: array of Integer;
    ConnArray: array of TInternetConnection;
    ConnHigh, FreeSpotsHigh, FreeSpotsLen : integer;

  public
    function ConnectionOpen(URL: String): Integer;
    function ConnectionClose(ConnInd: Integer): Boolean;
    destructor Destroy; override;
    //POST variable functions for PHP transmission
    procedure PostVariableAdd(connInd: Integer; theVar, theValue: String);
    procedure PostVariableDel(connInd: Integer; theVar: String);
    procedure PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
    function PostHTTP(connInd: Integer): Boolean;
  end;

function GetPage(URL: String): String;

implementation
uses
  httpsend;


function replace(sStr, rStr, iStr: String): String;
var
  ind: Integer;
begin
  ind := Pos(sStr, iStr);
  while (ind <> 0) do
  begin
    Delete(iStr, ind, Length(sStr));
    Insert(rStr, iStr, ind);
  end;
end;

{ TInternetConnection }

procedure TInternetConnection.Create(URL: String);
begin
  inherited;
  Self.ConnURL := URL;
end;

procedure TInternetConnection.Destroy; overload;
begin
  inherited;
  // ADD CLOSING OF CONNECTION

  // is this all necessary? Memory leaks etc trying to avoid them :p
  setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], 0);
  setLength(PostFreeSpots, 0);
  FreeSpotsHigh := -1;
  FreeSpotsLen := 0;
  PostVarsHigh := -1;
  PostVarsLen := 0;
end;

procedure TInternetConnect.PostVariableAdd(theVar, theValue: String);
var
  currentIndex: Integer;
begin
  theVar := replace(' ', '%20', theVar);        // more needs to be done, I only knew the ' ' replace.
  theValue := replace(' ', '%20', theValue);
  with Self do
  begin
    if (FreeSpotsHigh = -1) then
    begin
      setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], PostVarsHigh + 2);
      inc(PostVarsHigh);
      currentIndex := PostVarsHigh;
    end else
    begin
      currentIndex := PostFreeSpots[FreeSpotsHigh];
      dec(FreeSpotsHigh);
    end;
    PostVars[POSTVARS_VARIABLE][currentIndex] := theVar;
    PostVars[POSTVARS_VALUE][currentIndex] := theValue;
  end;
end;

procedure TInternetConnection.PostVariableDel(theVar: String);
var
  i: Integer;
begin
  for i := PostVarHigh downto 0 do
  begin
    if (theVar = Self.PostVars[POSTVARS_VARIABLE][i]) then
    begin
      with Self do
      begin
        PostVars[POSTVARS_VARIABLE][i] := '';
        PostVars[POSTVARS_VALUE][i] := '';
        if (FreeSpotsHigh = FreeSpotsLen) then
        begin
          FreeSpotsLen := FreeSpotsLen + 1;
          setLength(PostFreeSpots, FreeSpotsLen);
        end;
        PostFreeSpots[FreeSpotsHigh] := i;
      end;
    end;
  end;
end;

procedure TInternetConnection.PostVariableReplace(searchVar, replaceVar, value: String);
var
  i: Integer;;
begin
  with Self do
  begin
    for i := PostVarHigh downto 0 do
    begin
      if (searchVar = PostVars[POSTVARS_VARIABLE][i]) then
      begin
        PostVars[POSTVARS_VARIABLE][i] := replaceVar;
        PostVars[POSTVARS_VALUE][i] := value;
      end;
    end;
  end;
end;

function TInternetConnection.PostHTTP: Boolean;
var
  // holds the vars when they are placed together
  URLData: String;
  theStream: TStream;
begin
  try
    with Self do
    begin
      //ADD Connection stuffs

      for i := PostVarsHigh downto 0 do
      begin
        if (PostVars[POSTVARS_VARIABLE] <> '') then
        begin
          URLData := URLData + format('%d=%d+', [PostVars[POSTVARS_VARIABLE][i],
                                                 PostVars[POSTVARS_VALUE][i]]);
        end;
      end;
      Delete(URLData, Length(URLData) - 1, 1);

      {I DONT KNOW (TStream), this should work since we don't reuse it after.}
      HttpPostURL(ConnURL, URLData, theStream);

      // Lets remove all Post Variable data so fresh start next time.
      setLength(PostVars[POSTVARS_VARIABLE], PostVars[POSTVARS_VALUE], 0);
      setLength(PostFreeSpots, 0);
      FreeSpotsHigh := -1;
      FreeSpotsLen := 0;
      PostVarsHigh := -1;
      PostVarsLen := 0;
    end;
  except
    raise Exception.createFMT('TInternetConnection.PostHTTP: Something went wrong, could not complete. (%d)', URLData);
    exit(false);
  end;
  result := true;
end;

{ TInternetArray }

{
  Allocate space in the ConnArray, then open the connection.
}
function TInternetArray.ConnectionOpen(URL: String): Integer;
var
  currentIndex: Integer;
begin
  with Self do
  begin
    if (FreeSpotsHigh = -1) then
    begin
      setLength(ConnArray, ConnHigh + 2);
      inc(ConnHigh);
      currentIndex := ConnHigh;
    end else
    begin
      currentIndex := FreeSpots[FreeSpotsHigh];
      dec(FreeSpotsHigh);
    end;
    ConnArray[currentIndex].Create(URL);
  end;
end;

{
  Close the connection, add the index to the FreeSpots.
}
function TInternetArray.ConnectionClose(theInd: Integer): Boolean;
begin
  try
    with Self do
    begin
      ConnArray[theInd].Destroy;
      if (FreeSpotsHigh = FreeSpotsLen) then
      begin
        FreeSpotsLen := FreeSpotsLen + 1;
        setLength(FreeSpots, FreeSpotsLen);
      end;
      FreeSpots[FreeSpotsHigh] := theInd;
    end;
  except
    raise Exception.createFMT('TInternetArray.ConnectionClose: Could not close connection %d URL: %d',
                               [theInd, ConnArray[theInd].ConnURL]);
    exit(false);
  end;
  result := True;
end;

{
  Wrapper for the TInternetConnection.PostVariableAdd procedure which accepts
  a connection index.
}
procedure TInternetArray.PostVariableAdd(connInd: Integer; theVar, theValue: String);
begin
  try
    result := ConnArray[connInd].PostVariableAdd(theVar, theValue);
  except
    raise Exception.createFMT('TInternetArray.PostVariableAdd: %d is not in the ConnArray',
                               [connInd]);
  end;
end;

{
  Wrapper for the TInternetConnection.PostVariableDel procedure which accepts
  a connection index.
}
procedure TInternetArray.PostVariableDel(connInd: Integer; theVar: String);
begin
  try
    result := ConnArray[connInd].PostVariableAdd(theVar);
  except
    raise Exception.createFMT('TInternetArray.PostVariableDel: %d is not in the ConnArray',
                               [connInd]);
  end;
end;

{
  Wrapper for the TInternetConnection.PostVariableReplace procedure which accepts
  a connection index.
}
procedure TInternetArray.PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String);
begin
  try
    result := ConnArray[connInd].PostVariableAdd(searchVar, replaceVar, value);
  except
    raise Exception.createFMT('TInternetArray.PostVariableReplace: %d is not in the ConnArray',
                               [connInd]);
  end;
end;

{ OTHER }
function GetPage(URL: String): String;
var
  s: TStringList;
begin
  s:=TStringList.Create;
  HttpGetText(URL, s);
  result := String(s.GetText);
  s.Free;
end;

end.