diff options
Diffstat (limited to 'src/jaegertracing/thrift/lib/delphi/src/Thrift.Transport.MsxmlHTTP.pas')
-rw-r--r-- | src/jaegertracing/thrift/lib/delphi/src/Thrift.Transport.MsxmlHTTP.pas | 268 |
1 files changed, 268 insertions, 0 deletions
diff --git a/src/jaegertracing/thrift/lib/delphi/src/Thrift.Transport.MsxmlHTTP.pas b/src/jaegertracing/thrift/lib/delphi/src/Thrift.Transport.MsxmlHTTP.pas new file mode 100644 index 000000000..c666e7fed --- /dev/null +++ b/src/jaegertracing/thrift/lib/delphi/src/Thrift.Transport.MsxmlHTTP.pas @@ -0,0 +1,268 @@ +(* + * Licensed to the Apache Software Foundation (ASF) under one + * or more contributor license agreements. See the NOTICE file + * distributed with this work for additional information + * regarding copyright ownership. The ASF licenses this file + * to you under the Apache License, Version 2.0 (the + * "License"); you may not use this file except in compliance + * with the License. You may obtain a copy of the License at + * + * http://www.apache.org/licenses/LICENSE-2.0 + * + * Unless required by applicable law or agreed to in writing, + * software distributed under the License is distributed on an + * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY + * KIND, either express or implied. See the License for the + * specific language governing permissions and limitations + * under the License. + *) +unit Thrift.Transport.MsxmlHTTP; + +{$I Thrift.Defines.inc} +{$SCOPEDENUMS ON} + +interface + +uses + Classes, + SysUtils, + Math, + Generics.Collections, + {$IFDEF OLD_UNIT_NAMES} + ActiveX, msxml, + {$ELSE} + Winapi.ActiveX, Winapi.msxml, + {$ENDIF} + Thrift.Collections, + Thrift.Transport, + Thrift.Exception, + Thrift.Utils, + Thrift.Stream; + +type + TMsxmlHTTPClientImpl = class( TTransportImpl, IHTTPClient) + private + FUri : string; + FInputStream : IThriftStream; + FOutputStream : IThriftStream; + FDnsResolveTimeout : Integer; + FConnectionTimeout : Integer; + FSendTimeout : Integer; + FReadTimeout : Integer; + FCustomHeaders : IThriftDictionary<string,string>; + + function CreateRequest: IXMLHTTPRequest; + protected + function GetIsOpen: Boolean; override; + procedure Open(); override; + procedure Close(); override; + function Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; override; + procedure Write( const pBuf : Pointer; off, len : Integer); override; + procedure Flush; override; + + procedure SetDnsResolveTimeout(const Value: Integer); + function GetDnsResolveTimeout: Integer; + procedure SetConnectionTimeout(const Value: Integer); + function GetConnectionTimeout: Integer; + procedure SetSendTimeout(const Value: Integer); + function GetSendTimeout: Integer; + procedure SetReadTimeout(const Value: Integer); + function GetReadTimeout: Integer; + function GetSecureProtocols : TSecureProtocols; + procedure SetSecureProtocols( const value : TSecureProtocols); + + function GetCustomHeaders: IThriftDictionary<string,string>; + procedure SendRequest; + + property DnsResolveTimeout: Integer read GetDnsResolveTimeout write SetDnsResolveTimeout; + property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout; + property SendTimeout: Integer read GetSendTimeout write SetSendTimeout; + property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout; + property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders; + public + constructor Create( const AUri: string); + destructor Destroy; override; + end; + + +implementation + + +{ TMsxmlHTTPClientImpl } + +constructor TMsxmlHTTPClientImpl.Create(const AUri: string); +begin + inherited Create; + FUri := AUri; + + // defaults according to MSDN + FDnsResolveTimeout := 0; // no timeout + FConnectionTimeout := 60 * 1000; + FSendTimeout := 30 * 1000; + FReadTimeout := 30 * 1000; + + FCustomHeaders := TThriftDictionaryImpl<string,string>.Create; + FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True); +end; + +function TMsxmlHTTPClientImpl.CreateRequest: IXMLHTTPRequest; +var + pair : TPair<string,string>; + srvHttp : IServerXMLHTTPRequest; +begin + {$IF CompilerVersion >= 21.0} + Result := CoServerXMLHTTP.Create; + {$ELSE} + Result := CoXMLHTTPRequest.Create; + {$IFEND} + + // setting a timeout value to 0 (zero) means "no timeout" for that setting + if Supports( result, IServerXMLHTTPRequest, srvHttp) + then srvHttp.setTimeouts( DnsResolveTimeout, ConnectionTimeout, SendTimeout, ReadTimeout); + + Result.open('POST', FUri, False, '', ''); + Result.setRequestHeader( 'Content-Type', THRIFT_MIMETYPE); + Result.setRequestHeader( 'Accept', THRIFT_MIMETYPE); + Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient'); + + for pair in FCustomHeaders do begin + Result.setRequestHeader( pair.Key, pair.Value ); + end; +end; + +destructor TMsxmlHTTPClientImpl.Destroy; +begin + Close; + inherited; +end; + +function TMsxmlHTTPClientImpl.GetDnsResolveTimeout: Integer; +begin + Result := FDnsResolveTimeout; +end; + +procedure TMsxmlHTTPClientImpl.SetDnsResolveTimeout(const Value: Integer); +begin + FDnsResolveTimeout := Value; +end; + +function TMsxmlHTTPClientImpl.GetConnectionTimeout: Integer; +begin + Result := FConnectionTimeout; +end; + +procedure TMsxmlHTTPClientImpl.SetConnectionTimeout(const Value: Integer); +begin + FConnectionTimeout := Value; +end; + +function TMsxmlHTTPClientImpl.GetSendTimeout: Integer; +begin + Result := FSendTimeout; +end; + +procedure TMsxmlHTTPClientImpl.SetSendTimeout(const Value: Integer); +begin + FSendTimeout := Value; +end; + +function TMsxmlHTTPClientImpl.GetReadTimeout: Integer; +begin + Result := FReadTimeout; +end; + +procedure TMsxmlHTTPClientImpl.SetReadTimeout(const Value: Integer); +begin + FReadTimeout := Value; +end; + +function TMsxmlHTTPClientImpl.GetSecureProtocols : TSecureProtocols; +begin + Result := []; +end; + +procedure TMsxmlHTTPClientImpl.SetSecureProtocols( const value : TSecureProtocols); +begin + raise TTransportExceptionBadArgs.Create('SetSecureProtocols: Not supported with '+ClassName); +end; + +function TMsxmlHTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>; +begin + Result := FCustomHeaders; +end; + +function TMsxmlHTTPClientImpl.GetIsOpen: Boolean; +begin + Result := True; +end; + +procedure TMsxmlHTTPClientImpl.Open; +begin + FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True); +end; + +procedure TMsxmlHTTPClientImpl.Close; +begin + FInputStream := nil; + FOutputStream := nil; +end; + +procedure TMsxmlHTTPClientImpl.Flush; +begin + try + SendRequest; + finally + FOutputStream := nil; + FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True); + ASSERT( FOutputStream <> nil); + end; +end; + +function TMsxmlHTTPClientImpl.Read( const pBuf : Pointer; const buflen : Integer; off: Integer; len: Integer): Integer; +begin + if FInputStream = nil then begin + raise TTransportExceptionNotOpen.Create('No request has been sent'); + end; + + try + Result := FInputStream.Read( pBuf, buflen, off, len) + except + on E: Exception + do raise TTransportExceptionUnknown.Create(E.Message); + end; +end; + +procedure TMsxmlHTTPClientImpl.SendRequest; +var + xmlhttp : IXMLHTTPRequest; + ms : TMemoryStream; + a : TBytes; + len : Integer; +begin + xmlhttp := CreateRequest; + + ms := TMemoryStream.Create; + try + a := FOutputStream.ToArray; + len := Length(a); + if len > 0 then begin + ms.WriteBuffer( Pointer(@a[0])^, len); + end; + ms.Position := 0; + xmlhttp.send( IUnknown( TStreamAdapter.Create( ms, soReference ))); + FInputStream := nil; + FInputStream := TThriftStreamAdapterCOM.Create( IUnknown( xmlhttp.responseStream) as IStream); + finally + ms.Free; + end; +end; + +procedure TMsxmlHTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer); +begin + FOutputStream.Write( pBuf, off, len); +end; + + + +end. + |