Alte Delphi Unit mit Delphi 2010 compilieren

[Back2Code]

Hallo zusammen, ich bin auf eine sehr tolle Unit gestoßen die wohl doch schon etwas älter ist und sich leider nicht mit Delphi 2010 kompilieren lässt.

Folgende Fehler spuckt die IDE beim Versuch zu kompilieren aus:

(Siehe Anhang)

Code:

Abhängigkeiten des Projekts werden überprüft...
Compilieren von SocketTest.dproj (Debug-Konfiguration)
[DCC Fehler] uSocketUnit.pas(81): E2010 Inkompatible Typen: 'Char' und 'AnsiChar'
[DCC Warnung] uSocketUnit.pas(82): W1021 Der Vergleich ergibt immer False
[DCC Fehler] uSocketUnit.pas(84): E2010 Inkompatible Typen: 'Char' und 'AnsiChar'
[DCC Warnung] uSocketUnit.pas(108): W1057 Implizite String-Umwandlung von 'AnsiChar' zu 'string'
[DCC Warnung] uSocketUnit.pas(128): W1057 Implizite String-Umwandlung von 'AnsiChar' zu 'string'
[DCC Warnung] uSocketUnit.pas(313): W1057 Implizite String-Umwandlung von 'AnsiChar' zu 'string'
[DCC Fataler Fehler] SocketTest.dpr(57): F2063 Verwendete Unit 'uSocketUnit.pas' kann nicht compiliert werden
Misslungen
Verstrichene Zeit: 00:00:01.0

uSocketUnit.pas

Delphi-Quellcode:

{
  Delphi Winsock 1.1 Library by Aphex
}

unit uSocketUnit;

interface

uses Windows, Winsock;

type
  TTransferCallback = procedure(BytesTotal: dword; BytesDone: dword);

  TClientSocket = class(TObject)
  private
    FAddress: pchar;
    FData: pointer;
    FTag: integer;
    FConnected: boolean;
    function GetLocalAddress: string;
    function GetLocalPort: integer;
    function GetRemoteAddress: string;
    function GetRemotePort: integer;
  protected
    FSocket: TSocket;
  public
    procedure Connect(Address: string; Port: integer);
    property Connected: boolean read FConnected;
    property Data: pointer read FData write FData;
    destructor Destroy; override;
    procedure Disconnect;
    procedure Idle(Seconds: integer);
    property LocalAddress: string read GetLocalAddress;
    property LocalPort: integer read GetLocalPort;
    function ReceiveBuffer(var Buffer; BufferSize: integer): integer;
    procedure ReceiveFile(FileName: string; TransferCallback: TTransferCallback);
    function ReceiveLength: integer;
    function ReceiveString: string;
    property RemoteAddress: string read GetRemoteAddress;
    property RemotePort: integer read GetRemotePort;
    function SendBuffer(var Buffer; BufferSize: integer): integer;
    procedure SendFile(FileName: string; TransferCallback: TTransferCallback);
    function SendString(const Buffer: string): integer;
    property Socket: TSocket read FSocket;
    property Tag: integer read FTag write FTag;
  end;

  TServerSocket = class(TObject)
  private
    FListening: boolean;
    function GetLocalAddress: string;
    function GetLocalPort: integer;
  protected
    FSocket: TSocket;
  public
    function Accept: TClientSocket;
    destructor Destroy; override;
    procedure Disconnect;
    procedure Idle;
    procedure Listen(Port: integer);
    property Listening: boolean read FListening;
    property LocalAddress: string read GetLocalAddress;
    property LocalPort: integer read GetLocalPort;
  end;

var
  WSAData: TWSAData;

implementation

procedure TClientSocket.Connect(Address: string; Port: integer);
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
begin
  Disconnect;
  FAddress := pchar(Address);
  FSocket := Winsock.socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  SockAddrIn.sin_family := AF_INET;
  SockAddrIn.sin_port := htons(Port);
  SockAddrIn.sin_addr.s_addr := inet_addr(FAddress);
  if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
  begin
    HostEnt := gethostbyname(FAddress);
    if HostEnt = nil then
    begin
      Exit;
    end;
    SockAddrIn.sin_addr.s_addr := Longint(PLongint(HostEnt^.h_addr_list^)^);
  end;
  Winsock.Connect(FSocket, SockAddrIn, SizeOf(SockAddrIn));
  FConnected := True;
end;

procedure TClientSocket.Disconnect;
begin
  closesocket(FSocket);
  FConnected := False;
end;

function TClientSocket.GetLocalAddress: string;
var
  SockAddrIn: TSockAddrIn;
  Size: integer;
begin
  Size := sizeof(SockAddrIn);
  getsockname(FSocket, SockAddrIn, Size);
  Result := inet_ntoa(SockAddrIn.sin_addr);
end;

function TClientSocket.GetLocalPort: integer;
var
  SockAddrIn: TSockAddrIn;
  Size: Integer;
begin
  Size := sizeof(SockAddrIn);
  getsockname(FSocket, SockAddrIn, Size);
  Result := ntohs(SockAddrIn.sin_port);
end;

function TClientSocket.GetRemoteAddress: string;
var
  SockAddrIn: TSockAddrIn;
  Size: Integer;
begin
  Size := sizeof(SockAddrIn);
  getpeername(FSocket, SockAddrIn, Size);
  Result := inet_ntoa(SockAddrIn.sin_addr);
end;

function TClientSocket.GetRemotePort: integer;
var
  SockAddrIn: TSockAddrIn;
  Size: Integer;
begin
  Size := sizeof(SockAddrIn);
  getpeername(FSocket, SockAddrIn, Size);
  Result := ntohs(SockAddrIn.sin_port);
end;

procedure TClientSocket.Idle(Seconds: integer);
var
  FDset: TFDset;
  TimeVal: TTimeVal;
begin
  if Seconds = 0 then
  begin
    FD_ZERO(FDSet);
    FD_SET(FSocket, FDSet);
    select(0, @FDset, nil, nil, nil);
  end
  else
  begin
    TimeVal.tv_sec := Seconds;
    TimeVal.tv_usec := 0;
    FD_ZERO(FDSet);
    FD_SET(FSocket, FDSet);
    select(0, @FDset, nil, nil, @TimeVal);
  end;
end;

function TClientSocket.ReceiveLength: integer;
begin
  Result := ReceiveBuffer(pointer(nil)^, -1);
end;

function TClientSocket.ReceiveBuffer(var Buffer; BufferSize: integer): integer;
begin
  if BufferSize = -1 then
  begin
    if ioctlsocket(FSocket, FIONREAD, Longint(Result)) = SOCKET_ERROR then
    begin
      Result := SOCKET_ERROR;
      Disconnect;
    end;
  end
  else
  begin
     Result := recv(FSocket, Buffer, BufferSize, 0);
     if Result = 0 then
     begin
       Disconnect;
     end;
     if Result = SOCKET_ERROR then
     begin
       Result := WSAGetLastError;
       if Result = WSAEWOULDBLOCK then
       begin
         Result := 0;
       end
       else
       begin
         Disconnect;
       end;
     end;
  end;
end;

function TClientSocket.ReceiveString: string;
begin
  SetLength(Result, ReceiveBuffer(pointer(nil)^, -1));
  SetLength(Result, ReceiveBuffer(pointer(Result)^, Length(Result)));
end;

procedure TClientSocket.ReceiveFile(FileName: string; TransferCallback: TTransferCallback);
var
  BinaryBuffer: pchar;
  BinaryFile: THandle;
  BinaryFileSize, BytesReceived, BytesWritten, BytesDone: dword;
begin
  BytesDone := 0;
  BinaryFile := CreateFile(pchar(FileName), GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  Idle(0);
  ReceiveBuffer(BinaryFileSize, sizeof(BinaryFileSize));
  while BytesDone < BinaryFileSize do
  begin
    Sleep(1);
    BytesReceived := ReceiveLength;
    if BytesReceived > 0 then
    begin
      GetMem(BinaryBuffer, BytesReceived);
      try
        ReceiveBuffer(BinaryBuffer^, BytesReceived);
        WriteFile(BinaryFile, BinaryBuffer^, BytesReceived, BytesWritten, nil);
        Inc(BytesDone, BytesReceived);
        if Assigned(TransferCallback) then TransferCallback(BinaryFileSize, BytesDone);
      finally
        FreeMem(BinaryBuffer);
      end;
    end;
  end;
  CloseHandle(BinaryFile);
end;

procedure TClientSocket.SendFile(FileName: string; TransferCallback: TTransferCallback);
var
  BinaryFile: THandle;
  BinaryBuffer: pchar;
  BinaryFileSize, BytesRead, BytesDone: dword;
begin
  BytesDone := 0;
  BinaryFile := CreateFile(pchar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
  BinaryFileSize := GetFileSize(BinaryFile, nil);
  SendBuffer(BinaryFileSize, sizeof(BinaryFileSize));
  GetMem(BinaryBuffer, 2048);
  try
    repeat
      Sleep(1);
      ReadFile(BinaryFile, BinaryBuffer^, 2048, BytesRead, nil);
      Inc(BytesDone, BytesRead);
      repeat
        Sleep(1);
      until SendBuffer(BinaryBuffer^, BytesRead) <> -1;
      if Assigned(TransferCallback) then TransferCallback(BinaryFileSize, BytesDone);
    until BytesRead < 2048;
  finally
    FreeMem(BinaryBuffer);
  end;
  CloseHandle(BinaryFile);
end;

function TClientSocket.SendBuffer(var Buffer; BufferSize: integer): integer;
var
  ErrorCode: integer;
begin
  Result := send(FSocket, Buffer, BufferSize, 0);
  if Result = SOCKET_ERROR then
  begin
    ErrorCode := WSAGetLastError;
    if (ErrorCode = WSAEWOULDBLOCK) then
    begin
      Result := -1;
    end
    else
    begin
      Disconnect;
    end;
  end;
end;

function TClientSocket.SendString(const Buffer: string): integer;
begin
  Result := SendBuffer(pointer(Buffer)^, Length(Buffer));
end;

destructor TClientSocket.Destroy;
begin
  inherited Destroy;
  Disconnect;
end;

procedure TServerSocket.Listen(Port: integer);
var
  SockAddrIn: TSockAddrIn;
begin
  Disconnect;
  FSocket := socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
  SockAddrIn.sin_family := AF_INET;
  SockAddrIn.sin_addr.s_addr := INADDR_ANY;
  SockAddrIn.sin_port := htons(Port);
  bind(FSocket, SockAddrIn, sizeof(SockAddrIn));
  FListening := True;
  Winsock.listen(FSocket, 5);
end;

function TServerSocket.GetLocalAddress: string;
var
  SockAddrIn: TSockAddrIn;
  Size: integer;
begin
  Size := sizeof(SockAddrIn);
  getsockname(FSocket, SockAddrIn, Size);
  Result := inet_ntoa(SockAddrIn.sin_addr);
end;

function TServerSocket.GetLocalPort: integer;
var
  SockAddrIn: TSockAddrIn;
  Size: Integer;
begin
  Size := sizeof(SockAddrIn);
  getsockname(FSocket, SockAddrIn, Size);
  Result := ntohs(SockAddrIn.sin_port);
end;

procedure TServerSocket.Idle;
var
  FDset: TFDset;
begin
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  select(0, @FDset, nil, nil, nil);
end;

function TServerSocket.Accept: TClientSocket;
var
  Size: integer;
  SockAddr: TSockAddr;
begin
  Result := TClientSocket.Create;
  Size := sizeof(TSockAddr);
  Result.FSocket := Winsock.accept(FSocket, @SockAddr, @Size);
  if Result.FSocket = INVALID_SOCKET then
  begin
    Disconnect;
  end
  else
  begin
    Result.FConnected := True;
  end;
end;

procedure TServerSocket.Disconnect;
begin
  FListening := False;
  closesocket(FSocket);
end;

destructor TServerSocket.Destroy;
begin
  inherited Destroy;
  Disconnect;
end;

initialization
  WSAStartUp(257, WSAData);

finalization
  WSACleanup;

end.

Würde mich sehr freuen wenn mir jemand weiterhelfen könnte. Kenne mich so gut wie gar nicht mit Typumwandlung aus bzw. verstehe ich nicht einmal die Fehler genau.

[mkinzler]

Altes Problem: Umstellung auf Unicode.

Vorher
Char = AnsiChar
string = AnsiString
PChar = PAnsiChar

Jetzt:
Char = WideChar
string = UnicodeString
PChar = PWideChar

Ändere die Typen/Cast explizit auf die Ansivarianten

[TiGü]

Delphi-Quellcode:

  TClientSocket = class(TObject)
  private
    FAddress: PAnsiChar;
...

In der Fehlermeldung steht doch schon alles?
Die Funktion inet_addr in Zeile 81 erwartet einen PAnsiChar und der Typ von FAddress ist PChar.
Der Typ PChar ist ab Delphi 2009 ein Alias für PWideChar.
Da PAnsiChar <> PWideChar ist, sollte die Sache jetzt klar sein!

[Back2Code]

Zitat von TiGü:

Delphi-Quellcode:

  TClientSocket = class(TObject)
  private
    FAddress: PAnsiChar;
...

In der Fehlermeldung steht doch schon alles?
Die Funktion inet_addr in Zeile 81 erwartet einen PAnsiChar und der Typ von FAddress ist PChar.
Der Typ PChar ist ab Delphi 2009 ein Alias für PWideChar.
Da PAnsiChar <> PWideChar ist, sollte die Sache jetzt klar sein!

Sorry, ich versteh da nur Bahnhof.

[Bernhard Geyer]

Oder einfach wegschmeißen und die mit Delphi gelieferten (Indy-)Sockets verwenden?