unit newinternets; {$mode objfpc}{$H+} interface uses Classes, SysUtils; type { Record to hold the information of a $_POST variable and value. } TPostVariable = record variable, value: String; end; { Store the internet connection information } TInternetConnection = class(TObject) protected //url of the connection ConnURL: String; //contains post paramaters and vars PostVars: TList; private function createPostVariable(variable, value: String): TPostVariable; public constructor Create(URL: String); destructor Destroy; override; //$_POST variable functions for PHP transmission procedure AddPostVariable(theVar, theValue: String); procedure DelPostVariable(theVar: String); procedure ReplacePostVariable(searchVar, replaceVar, value: String); function PostHTTP(out dataStream: TStream): Boolean; end; TMufasaInternet = class(TObject) protected // TList storing all of the connection infos ConnList : TList; public function ConnectionOpen(URL: String): Integer; function ConnectionClose(ConnInd: Integer): Boolean; destructor Destroy; override; //$_POST variable functions for PHP procedure AddPostVariable(connInd: Integer; theVar, theValue: String); procedure DelPostVariable(connInd: Integer; theVar: String); procedure ReplacePostVariable(connInd: Integer; searchVar, replaceVar, value: String); function PostHTTP(connInd: Integer; out dataStream: TStream): Boolean; end; function GetPage(URL: String): String; implementation uses httpsend, synacode; 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 := EncodeURL(URL); Self.PostVars.Create; end; procedure TInternetConnection.Destroy; overload; begin inherited; // ADD CLOSING OF CONNECTION // Clear it up PostVars.Clear; end; procedure TInternetConnect.AddPostVariable(theVar, theValue: String); var currentIndex: Integer; begin theVar := EncodeURLElement(theVar); theValue := EncodeURLElement(theValue); Self.PostVars.Add(createPostVariable(theVar, theValue)); { with Self do begin if (FreeSpotsHigh = -1) then begin setLength(PostVars, PostVarsHigh + 2); inc(PostVarsHigh); currentIndex := PostVarsHigh; end else begin currentIndex := PostFreeSpots[FreeSpotsHigh]; dec(FreeSpotsHigh); end; PostVars[currentIndex].variable := theVar; PostVars[currentIndex].value := theValue; end; } end; procedure TInternetConnection.DelPostVariable(theVar: String); var i: Integer; tempPostVar: TPostVariable; begin for i := (Self.PostVars.Count - 1) downto 0 do begin if (theVar = Self.PostVars.Items[i].variable) then begin tempPostVar := PostVars.Items[i]; Self.PostVars.Remove(tempPostVar); break; end; end; end; procedure TInternetConnection.ReplacePostVariable(searchVar, replaceVar, theValue: String); var i: Integer; tempPostVar: TPostVariable; begin with Self do begin for i := (PostVars.Count - 1) downto 0 do begin tempPostVar := PostVars.Items[i]; if (searchVar = tempPostVar.variable) then begin tempPostVar.variable := replaceVar; tempPostVar.value := theValue; break; end; end; end; end; function TInternetConnection.PostHTTP(out dataStream: TStream): Boolean; var // holds the vars when they are placed together URLData: String; tempPostVar: TPostVariable; begin try with Self do begin //ADD Connection stuffs for i := (PostVars.Count - 1) downto 0 do begin tempPostVar := PostVars.Items[i]; if (tempPostVar.variable <> '') then begin URLData := URLData + format('%d=%d+', [tempPostVar.variable, tempPostVar.value]); end; end; Delete(URLData, Length(URLData) - 1, 1); {I DONT KNOW (TStream), this should work since we don't reuse it after.} dataStream := TStream.Create; HttpPostURL(ConnURL, URLData, dataStream); // Lets remove all Post Variable data so fresh start next time. PostVars.Clear; end; except raise Exception.createFMT('TInternetConnection.PostHTTP: Something went wrong, could not complete. URL: %d', URLData); exit(false); end; result := true; end; { TMufasaInternet } { Allocate space in the ConnArray, then open the connection. } function TMufasaInternet.ConnectionOpen(URL: String): Integer; var currentIndex: Integer; begin try Result := Self.ConnList.Add(TInternetConnection.Create(URL)); except raise Exception.createFMT('TInternetArray.ConnectionClose: Could not close connection %d URL: %d', [theInd, ConnURL]); end; end; { Close the connection, add the index to the FreeSpots. } function TMufasaInternet.ConnectionClose(theInd: Integer): Boolean; var tempConn: TInternetConnection; begin try tempConn := Self.ConnList.Items[theInd]; Self.ConnList.Remove(tempConn); tempConn.Destroy; { 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, ConnList.Items[theInd].ConnURL]); exit(false); end; result := True; end; { Wrapper for the TInternetConnection.PostVariableAdd procedure which accepts a connection index. } procedure TMufasaInternet.PostVariableAdd(connInd: Integer; theVar, theValue: String); begin try ConnList.Items[commInd].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 TMufasaInternet.PostVariableDel(connInd: Integer; theVar: String); begin try ConnList.Items[commInd].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 TMufasaInternet.PostVariableReplace(connInd: Integer; searchVar, replaceVar, value: String); begin try ConnList.Items[commInd].PostVariableAdd(searchVar, replaceVar, value); except raise Exception.createFMT('TInternetArray.PostVariableReplace: %d is not in the ConnArray', [connInd]); end; end; function TMufasaInternet.PostHTTP(connInd: Integer; out dataStream: TStream): Boolean; begin try result := ConnList.Items[commInd].PostHTTP(dataStream); except raise Exception.createFMT('TInternetArray.PostHTTP: %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.