Delphi 7 zu XE2

[Briand]

Hi Delphianer

Wenn ich das unten stehende Project mit den 2 Units auf meinem Windows XP Rechner auf dem noch Delphi 7 läuft compiliere läuft er einwandfre.
Aber sobald ich den Code auf meinem Win 7 Rechner mit Delphi XE2 Compiliere geht er nicht mehr. Ob er dann auf XP oder 7 läuft ist egal er funktioniert einfach nicht mehr sobald er mit XE2
Compiliert wurde.

Die beiden Units werden im Server und im Client mit Uses eingebunden.
Kann mir da jemand auf die Sprünge helfen warumm das mit 7 zu Xe so ne sache ist?

Viele Grüsse Brian

CLIENT

Delphi-Quellcode:

program pClient;

{$APPTYPE CONSOLE}

uses
  Windows,
  Winsock,
  SocketUnit,
  ThreadUnit;

type
  TFileInfo = packed record
    FileName: string[50];
    FileSize: DWORD;
  end;

procedure SendFile(lpFileName: string; Socket1: TClientSocket);
var
  F: file;
  FileInfo: TFileInfo;
  dwFileSize, dwBytesRead: DWORD;
  Buffer: array[0..4096] of Char;
begin
  {$I-}
  AssignFile(F, lpFileName);
  Reset(F, 1);
  dwFileSize := FileSize(F);
  FileInfo.FileName := lpFileName;
  FileInfo.FileSize := dwFileSize;
  Socket1.SendBuffer(FileInfo, SizeOf(FileInfo));
  repeat
    FillChar(Buffer, SizeOf(Buffer), 0);
    BlockRead(F, Buffer, SizeOf(Buffer), dwBytesRead);
    Socket1.SendBuffer(Buffer, dwBytesRead);
  until (dwBytesRead = 0);
  CloseFile(F);
  {$I+}
end;

procedure Client(Thread: TThread);
var
  ClientSocket: TClientSocket;
begin
  ClientSocket := TClientSocket.Create;
  ClientSocket.Connect('localhost', 1500);
  if ClientSocket.Connected then
  begin
    SendFile('IMG_0022.AVI', ClientSocket);
  end;
end;

var
  Msg: TMsg;

begin
  CreateMutex(nil, True, 'pClient');
  if GetLastError = ERROR_ALREADY_EXISTS then Halt(0);
  TThread.Create(@Client, 0);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

Server

Delphi-Quellcode:

program pServer;

{$APPTYPE CONSOLE}

uses
  Windows,
  Winsock,
  SocketUnit,
  ThreadUnit;

type
  TFileInfo = packed record
    FileName: string[50];
    FileSize: DWORD;
  end;

const
  ServerPort: integer = 1500;

var
  ServerSocket: TServerSocket;

procedure ReceiveFile(Socket1: TClientSocket);
var
  F: file;
  lpFileName: string;
  FileInfo: TFileInfo;
  dwFileSize, dwBytesRead: DWORD;
  Buffer: array[0..4096] of Char;
begin
  Socket1.ReceiveBuffer(FileInfo, SizeOf(TFileInfo));
  lpFileName := FileInfo.FileName;
  dwFileSize := FileInfo.FileSize;
  {$I-}
  AssignFile(F, lpFileName);
  ReWrite(F, 1);
  repeat
    FillChar(Buffer, SizeOf(Buffer), 0);
    dwBytesRead := Socket1.ReceiveBuffer(Buffer, SizeOf(Buffer));
    BlockWrite(F, Buffer, dwBytesRead);
    Dec(dwFileSize, dwBytesRead);
  until (dwFileSize <= 0);
  CloseFile(F);
  {$I+}
end;

procedure Client(Thread: TThread);
var
  ClientSocket: TClientSocket;
begin
  Thread.Lock;
  try
    ClientSocket := ServerSocket.Accept;
  finally
    Thread.Unlock;
  end;
  ReceiveFile(ClientSocket);
  MessageBeep($FFFFFFFF);
end;

procedure Server(Thread: TThread);
begin
  ServerSocket := TServerSocket.Create;
  ServerSocket.Listen(ServerPort);
  while not Thread.Terminated do
  begin
    ServerSocket.Idle;
    TThread.Create(@Client, 0);
  end;
end;

var
  Msg: TMsg;

begin
  CreateMutex(nil, True, 'pServer');
  if GetLastError = ERROR_ALREADY_EXISTS then Halt(0);
  TThread.Create(@Server, 0);
  while GetMessage(Msg, 0, 0, 0) do
  begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  end;
end.

Socket Unit

Delphi-Quellcode:

unit SocketUnit;

interface

uses Winsock;

type
  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;
    constructor Create;
    destructor Destroy; override;
    procedure Disconnect;
    procedure Idle;
    property LocalAddress: string read GetLocalAddress;
    property LocalPort: integer read GetLocalPort;
    function ReceiveBuffer(var Buffer; BufferSize: integer): integer;
    function ReceiveLength: integer;
    function ReceiveString: string;
    property RemoteAddress: string read GetRemoteAddress;
    property RemotePort: integer read GetRemotePort;
    function SendBuffer(var Buffer; BufferSize: integer): integer;
    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;
    constructor Create;
    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

constructor TClientSocket.Create;
begin
  inherited Create;
  WSAStartUp(257, WSAData);
end;

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(pansichar(FAddress));
  if SockAddrIn.sin_addr.s_addr = INADDR_NONE then
  begin
    HostEnt := gethostbyname(Pansichar(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;
var
  FDset: TFDset;
begin
  FD_ZERO(FDSet);
  FD_SET(FSocket, FDSet);
  select(0, @FDset, nil, nil, nil);
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;

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;
  WSACleanup;
end;

constructor TServerSocket.Create;
begin
  inherited Create;
  WSAStartUp(257, WSAData);
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;
  WSACleanup;
end;

end.

Thread Unit

Delphi-Quellcode:

unit ThreadUnit;

interface

uses Windows;

type
  TThread = class;

  TThreadProcedure = procedure(Thread: TThread);

  TThread = class
  private
    FThreadHandle: longword;
    FThreadID: longword;
    FExitCode: longword;
    FTerminated: boolean;
    FExecute: TThreadProcedure;
    FData: pointer;
  protected
  public
    constructor Create(ThreadProcedure: TThreadProcedure; CreationFlags: Cardinal);
    destructor Destroy; override;
    procedure Lock;
    procedure Unlock;
    property Terminated: boolean read FTerminated;
    property ThreadHandle: longword read FThreadHandle;
    property ThreadID: longword read FThreadID;
    property ExitCode: longword read FExitCode;
    property Data: pointer read FData write FData;
  end;

implementation

var
  ThreadLock: TRTLCriticalSection;

procedure ThreadWrapper(Thread: TThread);
var
  ExitCode: dword;
begin
  Thread.FTerminated := False;
  try
    Thread.FExecute(Thread);
  finally
    GetExitCodeThread(Thread.FThreadHandle, ExitCode);
    Thread.FExitCode := ExitCode;
    Thread.FTerminated := True;
    ExitThread(ExitCode);
  end;
end;

constructor TThread.Create(ThreadProcedure: TThreadProcedure; CreationFlags: Cardinal);
begin
  inherited Create;
  FExitCode := 0;
  FExecute := ThreadProcedure;
  FThreadHandle := BeginThread(nil, 0, @ThreadWrapper, Pointer(Self), CreationFlags, FThreadID);
end;

destructor TThread.Destroy;
begin
  inherited;
  CloseHandle(FThreadHandle);
end;

procedure TThread.Lock;
begin
  EnterCriticalSection(ThreadLock);
end;

procedure TThread.Unlock;
begin
  LeaveCriticalSection(ThreadLock);
end;

initialization
  InitializeCriticalSection(ThreadLock);

finalization
  DeleteCriticalSection(ThreadLock);

end.

[himitsu]

Du weißt aber, daß 2009 das Delphi auf Unicode umgestellt wurde?

String, Char, PChar sind nur Aliase für die aktuellen Typen des jeweiligen Compilers.
bis D2007: AnsiString, AnsiChar, PAnsiChar
ab D2009: UnicodeString, WideChar, PWideChar

Genauso wie Integer das mal war ... Jetzt ein LongInt (32 Bit) und in Delphi 1 noch ein SmallInt (16 Bit).
OK, beim Integer hatten sich Intel und Co. entschlossen den einzufrieren und für Win64 was Neues zu erfinden. (In Delphi der NativeInt)

Also überall wo Daten gespeichert/übertragen werden durften und dürfen niemals String, Char verwendet werden.



Fazit: Mach daraus schnell ein AnsiString/AnsiChar und schon verändern sich diese Schnittstellen nicht mehr, im neuen Compiler.

Alternativ solltest du dein Protokoll so umstellen, das es eventuell auch mit Unicode (UCS2 oder UTF16) klarkommen, oder zumindestens mit UTF-8, oder ddaß im Protokoll angegeben wird, was aktiell verwendet wird, wo sich der Empfänger dann darauf einstellen kann.
Aber hierfür müssen auch alle Altprogramme angepasst werden.



PS: SendBuffer(pointer(Buffer)^, Length(Buffer));
Rate mal, wie lang der Puffer nun wirklich ist, wenn jetzt jedes Zeichen aus je 2 Bytes besteht.


[add]

Zitat von mkinzler:

ShortString ist immer Ansi.

Damit meint er vorallem den string[50] , denn String /AnsiString /UnicodeString (LongString) <> string[x] /ShortString (ShortString)

[mkinzler]

Char/PChar unterscheiden sich zwischen D7 und XE2. Auf D7 ist ein Char ein AnsiChar ( 8Bit pro Zeichen) auf XE2 Unicode ( 16 Bit pro Zeichen). ShortString ist immer Ansi.

[Bernhard Geyer]

Ich vermute mal das es dutzende Warnmeldungen bezüglich dem Problem String/Ansistring gibt.
Diese sollte man auch mal nachgehen und nicht einfach ignorieren ...

[Headbucket]

Und wenn man ein wenig sucht, findet man auch schnell noch die passende Lektüre zu dem "Problem":
Anwendungen für Unicode anpassen
Unicode in RAD Studio

[Briand]

Ok werd mich da mal durchlesen.
Was ich allerdings noch wissen wollte das SocketUnit was ich benutze ist das von Aphex muss ich da auch noch änderungen machen damit dies unter XE2 läuft oder funktioniert das
kennt sich jemand mit dem Unit aus?

Grüsse Brain

[jaenicke]

Auf den ersten Blick scheint die so geschrieben zu sein, dass sie auch unter XE2 läuft.

[himitsu]

Die neuste Version, welche ich fand war von 2010.

Da ist auch nichts drin, was, auf den ersten Blick, so aussieht, als könnte es rummotzen.
Und vom Datum her könnte es es auch mit Delphi 2009+ (Unicode) getestet sein.



Notfalls kannst du auch auf die Indy (im Delphi dabei) oder was Anderes umsteigen.

[Briand]

Hi Delphianer's

Nach langer Zeit herumprobieren und Anpassungsversuchen hab ich es nicht geschaft den Code von D7 auf XE2 zu migrieren.
Vieleicht kennt sich ja jemand mit migration von D7 zu Xe aus und kann mir da helfen.
Ich werde den alten D7 code einfach mal anhängen.

Bin dankabar für jede hilfe.




Grüsse Brian

[hathor]

Soll das ein schlechter Scherz sein?
Deine AVI ist eine EXE !!!