david
d99a44999f
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@7 b6239004-a887-0f4b-9937-50029ccdca16
109 lines
3.4 KiB
ObjectPascal
109 lines
3.4 KiB
ObjectPascal
unit uROHTTPTools;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ RemObjects SDK Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 5 and up, Kylix 2 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the RemObjects SDK }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I RemObjects.inc}
|
|
|
|
interface
|
|
|
|
uses {$IFDEF REMOBJECTS_TRIAL}uROTrial,{$ENDIF}
|
|
{$IFDEF DOTNET}
|
|
Borland.Delphi.Classes,
|
|
{$ELSE}
|
|
Classes,
|
|
{$ENDIF}
|
|
uROClientIntf;
|
|
|
|
const
|
|
id_ContentLength = 'Content-Length';
|
|
id_ContentType = 'Content-Type';
|
|
id_Host = 'Host';
|
|
id_UserAgent = 'User-Agent';
|
|
|
|
HTTP_SESSION_ID_HEADER = 'RemObjects-SessionID';
|
|
|
|
HTTP_OK = 200;
|
|
HTTP_FAILED = 500;
|
|
|
|
function FindHeaderIndex(someHeaders : TStrings; const aName : string) : integer;
|
|
function GetHeaderValue(someHeaders : TStrings; const aName : string) : string; overload;
|
|
function GetHeaderValue(const iHeaders:string; const iName:string):string; overload;
|
|
procedure SetHeaderValue(someHeaders : TStrings; const aName, aValue : string);
|
|
|
|
procedure SetHTTPInfo(const aTransport : IROTransport; aDataFormat : TDataFormat);
|
|
|
|
implementation
|
|
|
|
uses {$IFDEF DOTNET}
|
|
Borland.Delphi.SysUtils,
|
|
{$ELSE}
|
|
SysUtils,
|
|
{$ENDIF}
|
|
uRORes;
|
|
|
|
function FindHeaderIndex(someHeaders : TStrings; const aName : string) : integer;
|
|
var i : integer;
|
|
begin
|
|
result := -1;
|
|
with someHeaders do
|
|
for i := 0 to (Count-1) do
|
|
if (Pos(aName+': ', Strings[i])=1) then begin
|
|
result := i;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function GetHeaderValue(const iHeaders:string; const iName:string):string;
|
|
var p:integer;
|
|
begin
|
|
result := '';
|
|
p := Pos(UpperCase(iName)+':',UpperCase(iHeaders));
|
|
if p > 0 then Begin
|
|
result := iHeaders;
|
|
Delete(result,1,p+Length(iName)+1);
|
|
result := Copy(result,1,Pos(#13,result)-1);
|
|
end
|
|
end;
|
|
|
|
function GetHeaderValue(someHeaders : TStrings; const aName : string) : string;
|
|
var idx : integer;
|
|
begin
|
|
idx := FindHeaderIndex(someHeaders, aName);
|
|
with someHeaders do
|
|
if (idx>=0) then result := Trim(Copy(Strings[idx], Pos(':', Strings[idx])+1, Length(Strings[idx])))
|
|
else result := '';
|
|
end;
|
|
|
|
procedure SetHeaderValue(someHeaders : TStrings; const aName, aValue : string);
|
|
var idx : integer;
|
|
begin
|
|
idx := FindHeaderIndex(someHeaders, aName);
|
|
with someHeaders do
|
|
if (idx>=0) then someHeaders[idx] := aName+': '+aValue
|
|
else someHeaders.Add(aName+': '+aValue);
|
|
end;
|
|
|
|
procedure SetHTTPInfo(const aTransport : IROTransport; aDataFormat : TDataFormat);
|
|
var http : IROHTTPTransport;
|
|
begin
|
|
{$IFDEF DOTNET}
|
|
{$ELSE}
|
|
if Supports(aTransport, IROHTTPTransport, http) then begin
|
|
http.ContentType := aDataFormat;
|
|
http.UserAgent := str_ProductName;
|
|
end;
|
|
{$ENDIF DOTNET}
|
|
end;
|
|
|
|
end.
|