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.