THRIFT-4841 THTTPTransport relies on activeX component
Client: Delphi
Patch: Jens Geyer
This closes #1778
diff --git a/lib/delphi/src/Thrift.Transport.WinHTTP.pas b/lib/delphi/src/Thrift.Transport.WinHTTP.pas
new file mode 100644
index 0000000..aac2aea
--- /dev/null
+++ b/lib/delphi/src/Thrift.Transport.WinHTTP.pas
@@ -0,0 +1,335 @@
+(*
+ * 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.WinHTTP;
+
+{$I Thrift.Defines.inc}
+{$SCOPEDENUMS ON}
+
+interface
+
+uses
+ Classes,
+ SysUtils,
+ Math,
+ Generics.Collections,
+ Thrift.Collections,
+ Thrift.Transport,
+ Thrift.Exception,
+ Thrift.Utils,
+ Thrift.WinHTTP,
+ Thrift.Stream;
+
+type
+ TWinHTTPClientImpl = class( TTransportImpl, IHTTPClient)
+ private
+ FUri : string;
+ FInputStream : IThriftStream;
+ FOutputMemoryStream : TMemoryStream;
+ FDnsResolveTimeout : Integer;
+ FConnectionTimeout : Integer;
+ FSendTimeout : Integer;
+ FReadTimeout : Integer;
+ FCustomHeaders : IThriftDictionary<string,string>;
+
+ function CreateRequest: IWinHTTPRequest;
+
+ private type
+ THTTPResponseStream = class( TThriftStreamImpl)
+ private
+ FRequest : IWinHTTPRequest;
+ protected
+ procedure Write( const pBuf : Pointer; offset: Integer; count: Integer); override;
+ function Read( const pBuf : Pointer; const buflen : Integer; offset: Integer; count: Integer): Integer; override;
+ procedure Open; override;
+ procedure Close; override;
+ procedure Flush; override;
+ function IsOpen: Boolean; override;
+ function ToArray: TBytes; override;
+ public
+ constructor Create( const aRequest : IWinHTTPRequest);
+ destructor Destroy; override;
+ end;
+
+ 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 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
+
+
+{ TWinHTTPClientImpl }
+
+constructor TWinHTTPClientImpl.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;
+ FOutputMemoryStream := TMemoryStream.Create;
+end;
+
+destructor TWinHTTPClientImpl.Destroy;
+begin
+ Close;
+ FreeAndNil( FOutputMemoryStream);
+ inherited;
+end;
+
+function TWinHTTPClientImpl.CreateRequest: IWinHTTPRequest;
+var
+ pair : TPair<string,string>;
+ session : IWinHTTPSession;
+ connect : IWinHTTPConnection;
+ url : IWinHTTPUrl;
+ sPath : string;
+begin
+ url := TWinHTTPUrlImpl.Create( FUri);
+
+ session := TWinHTTPSessionImpl.Create('Apache Thrift Delphi Client');
+ connect := session.Connect( url.HostName, url.Port);
+
+ sPath := url.UrlPath + url.ExtraInfo;
+ result := connect.OpenRequest( (url.Scheme = 'https'), 'POST', sPath, 'application/x-thrift');
+
+ // setting a timeout value to 0 (zero) means "no timeout" for that setting
+ result.SetTimeouts( DnsResolveTimeout, ConnectionTimeout, SendTimeout, ReadTimeout);
+
+ result.AddRequestHeader( 'Content-Type: application/x-thrift', WINHTTP_ADDREQ_FLAG_ADD);
+
+ for pair in FCustomHeaders do begin
+ Result.AddRequestHeader( pair.Key +': '+ pair.Value, WINHTTP_ADDREQ_FLAG_ADD);
+ end;
+end;
+
+function TWinHTTPClientImpl.GetDnsResolveTimeout: Integer;
+begin
+ Result := FDnsResolveTimeout;
+end;
+
+procedure TWinHTTPClientImpl.SetDnsResolveTimeout(const Value: Integer);
+begin
+ FDnsResolveTimeout := Value;
+end;
+
+function TWinHTTPClientImpl.GetConnectionTimeout: Integer;
+begin
+ Result := FConnectionTimeout;
+end;
+
+procedure TWinHTTPClientImpl.SetConnectionTimeout(const Value: Integer);
+begin
+ FConnectionTimeout := Value;
+end;
+
+function TWinHTTPClientImpl.GetSendTimeout: Integer;
+begin
+ Result := FSendTimeout;
+end;
+
+procedure TWinHTTPClientImpl.SetSendTimeout(const Value: Integer);
+begin
+ FSendTimeout := Value;
+end;
+
+function TWinHTTPClientImpl.GetReadTimeout: Integer;
+begin
+ Result := FReadTimeout;
+end;
+
+procedure TWinHTTPClientImpl.SetReadTimeout(const Value: Integer);
+begin
+ FReadTimeout := Value;
+end;
+
+function TWinHTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;
+begin
+ Result := FCustomHeaders;
+end;
+
+function TWinHTTPClientImpl.GetIsOpen: Boolean;
+begin
+ Result := True;
+end;
+
+procedure TWinHTTPClientImpl.Open;
+begin
+ FreeAndNil( FOutputMemoryStream);
+ FOutputMemoryStream := TMemoryStream.Create;
+end;
+
+procedure TWinHTTPClientImpl.Close;
+begin
+ FInputStream := nil;
+ FreeAndNil( FOutputMemoryStream);
+end;
+
+procedure TWinHTTPClientImpl.Flush;
+begin
+ try
+ SendRequest;
+ finally
+ FreeAndNil( FOutputMemoryStream);
+ FOutputMemoryStream := TMemoryStream.Create;
+ ASSERT( FOutputMemoryStream <> nil);
+ end;
+end;
+
+function TWinHTTPClientImpl.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 TWinHTTPClientImpl.SendRequest;
+var
+ http : IWinHTTPRequest;
+ pData : PByte;
+ len : Integer;
+begin
+ http := CreateRequest;
+
+ pData := FOutputMemoryStream.Memory;
+ len := FOutputMemoryStream.Size;
+
+ // send all data immediately, since we have it in memory
+ if not http.SendRequest( pData, len, 0)
+ then raise TTransportExceptionUnknown.Create('send request error');
+
+ // end request and start receiving
+ if not http.FlushAndReceiveResponse
+ then raise TTransportExceptionInterrupted.Create('flush/receive error');
+
+ FInputStream := THTTPResponseStream.Create(http);
+end;
+
+procedure TWinHTTPClientImpl.Write( const pBuf : Pointer; off, len : Integer);
+var pTmp : PByte;
+begin
+ pTmp := pBuf;
+ Inc(pTmp,off);
+ FOutputMemoryStream.Write( pTmp^, len);
+end;
+
+
+{ TWinHTTPClientImpl.THTTPResponseStream }
+
+constructor TWinHTTPClientImpl.THTTPResponseStream.Create( const aRequest : IWinHTTPRequest);
+begin
+ inherited Create;
+ FRequest := aRequest;
+end;
+
+destructor TWinHTTPClientImpl.THTTPResponseStream.Destroy;
+begin
+ try
+ Close;
+ finally
+ inherited Destroy;
+ end;
+end;
+
+procedure TWinHTTPClientImpl.THTTPResponseStream.Close;
+begin
+ FRequest := nil;
+end;
+
+procedure TWinHTTPClientImpl.THTTPResponseStream.Flush;
+begin
+ raise ENotImplemented(ClassName+'.Flush');
+end;
+
+function TWinHTTPClientImpl.THTTPResponseStream.IsOpen: Boolean;
+begin
+ Result := FRequest <> nil;
+end;
+
+procedure TWinHTTPClientImpl.THTTPResponseStream.Open;
+begin
+ // nothing to do
+end;
+
+procedure TWinHTTPClientImpl.THTTPResponseStream.Write(const pBuf : Pointer; offset, count: Integer);
+begin
+ inherited; // check pointers
+ raise ENotImplemented(ClassName+'.Write');
+end;
+
+function TWinHTTPClientImpl.THTTPResponseStream.Read(const pBuf : Pointer; const buflen : Integer; offset, count: Integer): Integer;
+var pTmp : PByte;
+begin
+ inherited; // check pointers
+
+ if count >= buflen-offset
+ then count := buflen-offset;
+
+ if count > 0 then begin
+ pTmp := pBuf;
+ Inc( pTmp, offset);
+ Result := FRequest.ReadData( pTmp, count);
+ ASSERT( Result >= 0);
+ end
+ else Result := 0;
+end;
+
+function TWinHTTPClientImpl.THTTPResponseStream.ToArray: TBytes;
+begin
+ raise ENotImplemented(ClassName+'.ToArray');
+end;
+
+
+end.