THRIFT-3788 Compatibility improvements and Win64 support
Client: Delphi
Patch: Jens Geyer

Revised previous patch.
diff --git a/lib/delphi/src/Thrift.Transport.pas b/lib/delphi/src/Thrift.Transport.pas
index c0f3111..e005d4f 100644
--- a/lib/delphi/src/Thrift.Transport.pas
+++ b/lib/delphi/src/Thrift.Transport.pas
@@ -16,19 +16,11 @@
  * specific language governing permissions and limitations
  * under the License.
  *)
-
-{$SCOPEDENUMS ON}
-{$IF CompilerVersion >= 23.0}
-  {$LEGACYIFEND ON}
-{$IFEND}
-
-{$IF CompilerVersion < 28.0}
-  {$DEFINE OLD_SOCKETS}   // TODO: add socket support for CompilerVersion >= 28.0
-{$IFEND}
-
-
 unit Thrift.Transport;
 
+{$I Thrift.Defines.inc}
+{$SCOPEDENUMS ON}
+
 interface
 
 uses
@@ -36,16 +28,16 @@
   SysUtils,
   Math,
   Generics.Collections,
-{$IF CompilerVersion < 23.0}
-  ActiveX, msxml, WinSock, Sockets,
-{$ELSE}
-  Winapi.ActiveX, Winapi.msxml, Winapi.WinSock,
-  {$IF CompilerVersion < 28.0}
-    Web.Win.Sockets,
+  {$IFDEF OLD_UNIT_NAMES}
+    ActiveX, msxml, WinSock, Sockets,
   {$ELSE}
-    System.Win.ScktComp,
-  {$IFEND}
-{$IFEND}
+    Winapi.ActiveX, Winapi.msxml, Winapi.WinSock,
+    {$IFDEF OLD_SOCKETS}
+	    Web.Win.Sockets,
+	  {$ELSE}
+	    System.Win.ScktComp,
+    {$ENDIF}
+  {$ENDIF}
   Thrift.Collections,
   Thrift.Utils,
   Thrift.Stream;
@@ -333,9 +325,10 @@
         function GetTransport( const ATrans: ITransport): ITransport; override;
       end;
 
-{$IF CompilerVersion >= 21.0}
+	  {$IFDEF HAVE_CLASS_CTOR}
     class constructor Create;
-{$IFEND}
+    {$ENDIF}
+	
     constructor Create; overload;
     constructor Create( const ATrans: ITransport); overload;
     destructor Destroy; override;
@@ -349,9 +342,9 @@
     procedure Flush; override;
   end;
 
-{$IF CompilerVersion < 21.0}
+{$IFNDEF HAVE_CLASS_CTOR}
 procedure TFramedTransportImpl_Initialize;
-{$IFEND}
+{$ENDIF}
 
 const
   DEFAULT_THRIFT_TIMEOUT = 5 * 1000; // ms
@@ -363,7 +356,7 @@
 
 procedure TTransportImpl.Flush;
 begin
-
+  // nothing to do
 end;
 
 function TTransportImpl.Peek: Boolean;
@@ -377,14 +370,11 @@
   ret : Integer;
 begin
   got := 0;
-  while ( got < len) do
-  begin
+  while got < len do begin
     ret := Read( buf, off + got, len - got);
-    if ( ret <= 0 ) then
-    begin
-      raise TTransportException.Create( 'Cannot read, Remote side has closed' );
-    end;
-    got := got + ret;
+    if ret > 0 
+	then Inc( got, ret)
+	else raise TTransportException.Create( 'Cannot read, Remote side has closed' );    
   end;
   Result := got;
 end;
@@ -414,19 +404,18 @@
 var
   pair : TPair<string,string>;
 begin
-{$IF CompilerVersion >= 21.0}
+  {$IF CompilerVersion >= 21.0}
   Result := CoXMLHTTP.Create;
-{$ELSE}
+  {$ELSE}
   Result := CoXMLHTTPRequest.Create;
-{$IFEND}
+  {$IFEND}
 
   Result.open('POST', FUri, False, '', '');
   Result.setRequestHeader( 'Content-Type', 'application/x-thrift');
   Result.setRequestHeader( 'Accept', 'application/x-thrift');
   Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient');
 
-  for pair in FCustomHeaders do
-  begin
+  for pair in FCustomHeaders do begin
     Result.setRequestHeader( pair.Key, pair.Value );
   end;
 end;
@@ -469,7 +458,7 @@
 
 procedure THTTPClientImpl.Open;
 begin
-
+  // nothing to do
 end;
 
 function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;
@@ -500,8 +489,7 @@
   try
     a := FOutputStream.ToArray;
     len := Length(a);
-    if len > 0 then
-    begin
+    if len > 0 then begin
       ms.WriteBuffer( Pointer(@a[0])^, len);
     end;
     ms.Position := 0;
@@ -574,11 +562,11 @@
   FOwnsServer := True;
   FServer := TThriftTcpServer.Create( nil );
   FServer.BlockMode := bmBlocking;
-{$IF CompilerVersion >= 21.0}
+  {$IF CompilerVersion >= 21.0}
   FServer.LocalPort := AnsiString( IntToStr( FPort));
-{$ELSE}
+  {$ELSE}
   FServer.LocalPort := IntToStr( FPort);
-{$IFEND}
+  {$IFEND}
 end;
 
 destructor TServerSocketImpl.Destroy;
@@ -640,10 +628,8 @@
     try
       FServer.Active := True;
     except
-      on E: Exception do
-      begin
-        raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
-      end;
+      on E: Exception 
+	  do raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);
     end;
   end;
 end;
@@ -778,11 +764,9 @@
   buf : TBytes;
   len : Integer;
 begin
-  if IsOpen then
-  begin
+  if IsOpen then begin
     len := FWriteBuffer.Size;
-    if len > 0 then
-    begin
+    if len > 0 then begin
       SetLength( buf, len );
       FWriteBuffer.Position := 0;
       FWriteBuffer.Read( Pointer(@buf[0])^, len );
@@ -801,7 +785,7 @@
 
 procedure TBufferedStreamImpl.Open;
 begin
-
+  // nothing to do
 end;
 
 function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;
@@ -811,12 +795,11 @@
 begin
   inherited;
   Result := 0;
-  if IsOpen then
-  begin
+  
+  if IsOpen then begin
     while count > 0 do begin
 
-      if FReadBuffer.Position >= FReadBuffer.Size then
-      begin
+      if FReadBuffer.Position >= FReadBuffer.Size then begin
         FReadBuffer.Clear;
         SetLength( tempbuf, FBufSize);
         nRead := FStream.Read( tempbuf, 0, FBufSize );
@@ -826,8 +809,7 @@
         FReadBuffer.Position := 0;
       end;
 
-      if FReadBuffer.Position < FReadBuffer.Size then
-      begin
+      if FReadBuffer.Position < FReadBuffer.Size then begin
         nRead  := Min( FReadBuffer.Size - FReadBuffer.Position, count);
         Inc( Result, FReadBuffer.Read( Pointer(@buffer[offset])^, nRead));
         Dec( count, nRead);
@@ -838,20 +820,17 @@
 end;
 
 function TBufferedStreamImpl.ToArray: TBytes;
-var
-  len : Integer;
+var len : Integer;
 begin
   len := 0;
 
-  if IsOpen then
-  begin
+  if IsOpen then begin
     len := FReadBuffer.Size;
   end;
 
   SetLength( Result, len);
 
-  if len > 0 then
-  begin
+  if len > 0 then begin
     FReadBuffer.Position := 0;
     FReadBuffer.Read( Pointer(@Result[0])^, len );
   end;
@@ -860,13 +839,10 @@
 procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);
 begin
   inherited;
-  if count > 0 then
-  begin
-    if IsOpen then
-    begin
+  if count > 0 then begin
+    if IsOpen then begin
       FWriteBuffer.Write( Pointer(@buffer[offset])^, count );
-      if FWriteBuffer.Size > FBufSize then
-      begin
+      if FWriteBuffer.Size > FBufSize then begin
         Flush;
       end;
     end;
@@ -958,8 +934,7 @@
   FTransport.Close;
 end;
 
-constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport;
-  ABufSize: Integer);
+constructor TBufferedTransportImpl.Create( const ATransport: IStreamTransport;  ABufSize: Integer);
 begin
   inherited Create;
   FTransport := ATransport;
@@ -969,8 +944,7 @@
 
 procedure TBufferedTransportImpl.Flush;
 begin
-  if FOutputBuffer <> nil then
-  begin
+  if FOutputBuffer <> nil then begin
     FOutputBuffer.Flush;
   end;
 end;
@@ -987,12 +961,10 @@
 
 procedure TBufferedTransportImpl.InitBuffers;
 begin
-  if FTransport.InputStream <> nil then
-  begin
+  if FTransport.InputStream <> nil then begin
     FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize );
   end;
-  if FTransport.OutputStream <> nil then
-  begin
+  if FTransport.OutputStream <> nil then begin
     FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize );
   end;
 end;
@@ -1005,36 +977,34 @@
 function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;
 begin
   Result := 0;
-  if FInputBuffer <> nil then
-  begin
+  if FInputBuffer <> nil then begin
     Result := FInputBuffer.Read( buf, off, len );
   end;
 end;
 
 procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);
 begin
-  if FOutputBuffer <> nil then
-  begin
+  if FOutputBuffer <> nil then begin
     FOutputBuffer.Write( buf, off, len );
   end;
 end;
 
 { TFramedTransportImpl }
 
-{$IF CompilerVersion < 21.0}
+{$IFDEF HAVE_CLASS_CTOR}
+class constructor TFramedTransportImpl.Create;
+begin
+  SetLength( FHeader_Dummy, FHeaderSize);
+  FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
+end;
+{$ELSE}
 procedure TFramedTransportImpl_Initialize;
 begin
   SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize);
   FillChar( TFramedTransportImpl.FHeader_Dummy[0],
     Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0);
 end;
-{$ELSE}
-class constructor TFramedTransportImpl.Create;
-begin
-  SetLength( FHeader_Dummy, FHeaderSize);
-  FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);
-end;
-{$IFEND}
+{$ENDIF}
 
 constructor TFramedTransportImpl.Create;
 begin
@@ -1070,8 +1040,7 @@
 begin
   len := FWriteBuffer.Size;
   SetLength( buf, len);
-  if len > 0 then
-  begin
+  if len > 0 then begin
     System.Move( FWriteBuffer.Memory^, buf[0], len );
   end;
 
@@ -1118,13 +1087,12 @@
 var
   got : Integer;
 begin
-  if FReadBuffer <> nil then
-  begin
+  if FReadBuffer <> nil then begin
     if len > 0
     then got := FReadBuffer.Read( Pointer(@buf[off])^, len )
     else got := 0;
-    if got > 0 then
-    begin
+	
+    if got > 0 then begin
       Result := got;
       Exit;
     end;
@@ -1221,54 +1189,55 @@
 
   socket := FTcpClient.Handle;
 
-  if Assigned(ReadReady) then
-  begin
+  if Assigned(ReadReady) then begin
     ReadFdsptr := @ReadFds;
     FD_ZERO(ReadFds);
     FD_SET(socket, ReadFds);
   end
-  else
+  else begin
     ReadFdsptr := nil;
+  end;
 
-  if Assigned(WriteReady) then
-  begin
+  if Assigned(WriteReady) then begin
     WriteFdsptr := @WriteFds;
     FD_ZERO(WriteFds);
     FD_SET(socket, WriteFds);
   end
-  else
+  else begin
     WriteFdsptr := nil;
+  end;
 
-  if Assigned(ExceptFlag) then
-  begin
+  if Assigned(ExceptFlag) then begin
     ExceptFdsptr := @ExceptFds;
     FD_ZERO(ExceptFds);
     FD_SET(socket, ExceptFds);
   end
-  else
+  else begin
     ExceptFdsptr := nil;
+  end;
 
-  if TimeOut >= 0 then
-  begin
+  if TimeOut >= 0 then begin
     tv.tv_sec := TimeOut div 1000;
     tv.tv_usec :=  1000 * (TimeOut mod 1000);
     Timeptr := @tv;
   end
-  else
+  else begin
     Timeptr := nil;  // wait forever
+  end;
 
   wsaError := 0;
   try
-{$IFDEF MSWINDOWS}
-  {$IF CompilerVersion < 23.0}
-    result := WinSock.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
-  {$ELSE}
-    result := Winapi.WinSock.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
-  {$IFEND}
-{$ENDIF}
-{$IFDEF LINUX}
-    result := Libc.select(socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
-{$ENDIF}
+    {$IFDEF MSWINDOWS}
+      {$IFDEF OLD_UNIT_NAMES}
+      result := WinSock.select(        socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+      {$ELSE}
+      result := Winapi.WinSock.select( socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+      {$ENDIF}
+    {$ENDIF}
+    {$IFDEF LINUX}
+      result := Libc.select(           socket + 1, ReadFdsptr, WriteFdsptr, ExceptFdsptr, Timeptr);
+    {$ENDIF}
+	
     if result = SOCKET_ERROR
     then wsaError := WSAGetLastError;
 
@@ -1277,9 +1246,11 @@
   end;
 
   if Assigned(ReadReady) then
-    ReadReady^ := FD_ISSET(socket, ReadFds);
+   ReadReady^ := FD_ISSET(socket, ReadFds);
+   
   if Assigned(WriteReady) then
     WriteReady^ := FD_ISSET(socket, WriteFds);
+  
   if Assigned(ExceptFlag) then
     ExceptFlag^ := FD_ISSET(socket, ExceptFds);
 end;
@@ -1289,6 +1260,8 @@
                                            var wsaError, bytesReady : Integer): TWaitForData;
 var bCanRead, bError : Boolean;
     retval : Integer;
+const 
+  MSG_PEEK = {$IFDEF OLD_UNIT_NAMES} WinSock.MSG_PEEK  {$ELSE} Winapi.WinSock.MSG_PEEK  {$ENDIF};
 begin
   bytesReady := 0;
 
@@ -1304,11 +1277,8 @@
 
   // recv() returns the number of bytes received, or -1 if an error occurred.
   // The return value will be 0 when the peer has performed an orderly shutdown.
-{$IF CompilerVersion < 23.0}
-  retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, WinSock.MSG_PEEK);
-{$ELSE}
-  retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, Winapi.WinSock.MSG_PEEK);
-{$IFEND}
+  
+  retval := recv( FTcpClient.Handle, pBuf^, DesiredBytes, MSG_PEEK);
   if retval <= 0
   then Exit( TWaitForData.wfd_Error);
 
@@ -1371,15 +1341,13 @@
   len : Integer;
 begin
   len := 0;
-  if IsOpen then
-  begin
+  if IsOpen then begin
     len := FTcpClient.BytesReceived;
   end;
 
   SetLength( Result, len );
 
-  if len > 0 then
-  begin
+  if len > 0 then begin
     FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len);
   end;
 end;
@@ -1401,8 +1369,10 @@
   if retval = SOCKET_ERROR
   then raise TTransportException.Create( TTransportException.TExceptionType.Unknown,
                                          SysErrorMessage(Cardinal(wsaError)));
+
   if (retval = 0)
   then raise TTransportException.Create( TTransportException.TExceptionType.TimedOut);
+
   if bError or not bCanWrite
   then raise TTransportException.Create( TTransportException.TExceptionType.Unknown);