TServerSocket и TClientSocket без scktsrvr.exe отказываются работать

Вопрос: У меня ни TServerSocket, ни TClientSocket без scktsrvr.exe отказываются работать! Слышал, что для решения проблемы можно что-то откуда-то вырезать и вклеить в программу.

Установите этот компонент:

unit
 Sck;

interface


uses

  Classes, SysUtils, Windows, Messages,
  ScktComp, SConnect, ActiveX, MidConst;

type

  TNotifyClient = procedure
 (Sender: TObject; Thread: TServerClientThread) of

object
;

{ TSocketDispatcher }
  TSocketDispatcher = class
;

{ TSocketDispatcherThread }
  TSocketDispatcherThread = class
(TServerClientThread, ISendDataBlock)
  private

    FRefCount: Integer;
    FInterpreter: TDataBlockInterpreter;
    FTransport: ITransport;
    FInterceptGUID: string
;
    FLastActivity: TDateTime;
    FTimeout: TDateTime;
    FRegisteredOnly: Boolean;
  protected

    SocketDispatcher: TSocketDispatcher;
    function
 CreateServerTransport: ITransport; virtual
;
    procedure
 AddClient;
    procedure
 RemoveClient;
    { IUnknown }
    function
 QueryInterface(const
 IID: TGUID; out
 Obj): HResult; stdcall
;
    function
 _AddRef: Integer; stdcall
;
    function
 _Release: Integer; stdcall
;
    { ISendDataBlock }
    function
 Send(const
 Data: IDataBlock; WaitForResult: Boolean): IDataBlock;
stdcall
;
  public

    constructor
 Create(AOwner: TSocketDispatcher; CreateSuspended: Boolean;
      ASocket: TServerClientWinSocket; const
 InterceptGUID: string
;
      Timeout: Integer; RegisteredOnly: Boolean);
    procedure
 ClientExecute; override
;
    property
 LastActivity: TDateTime read
 FLastActivity;
  end
;

{ TSocketDispatcher }
  TSocketDispatcher = class
(TServerSocket)
  private

    FInterceptGUID: string
;
    FTimeout: Integer;
    FRegisteredOnly: Boolean;
    FOnRemoveClient: TNotifyClient;
    FOnAddClient: TNotifyClient;
    procedure
 GetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
      var
 SocketThread: TServerClientThread);
  published

    constructor
 Create(AOwner: TComponent); override
;
    property
 InterceptGUID: string read
 FInterceptGUID write
 FInterceptGUID;
    property
 Timeout: Integer read
 FTimeout write
 FTimeout;
    property
 RegisteredOnly: Boolean read
 FRegisteredOnly write

FRegisteredOnly;
    property
 OnAddClient: TNotifyClient read
 FOnAddClient write
 FOnAddClient;
    property
 OnRemoveClient: TNotifyClient read
 FOnRemoveClient write

FOnRemoveClient;
  end
;

procedure
 Register
;

implementation


procedure
 Register
;
begin

  RegisterComponents('Midas', [TSocketDispatcher]);
end
;

{ TSocketDispatcherThread }

constructor
 TSocketDispatcherThread.Create(AOwner: TSocketDispatcher;
  CreateSuspended: Boolean; ASocket: TServerClientWinSocket;
  const
 InterceptGUID: string
; Timeout: Integer; RegisteredOnly: Boolean);
begin

  SocketDispatcher := AOwner;
  FInterceptGUID := InterceptGUID;
  FTimeout := EncodeTime(Timeout div
 60, Timeout mod
 60, 0, 0);
  FLastActivity := Now;
  FRegisteredOnly := RegisteredOnly;
  inherited
 Create(CreateSuspended, ASocket);
end
;

function
 TSocketDispatcherThread.CreateServerTransport: ITransport;
var

  SocketTransport: TSocketTransport;
begin

  SocketTransport := TSocketTransport.Create;
  SocketTransport.Socket := ClientSocket;
  SocketTransport.InterceptGUID := FInterceptGUID;
  Result := SocketTransport as
 ITransport;
end
;

procedure
 TSocketDispatcherThread.AddClient;
begin

  with
 SocketDispatcher do

    if
 Assigned(OnAddClient) then
 OnAddClient(SocketDispatcher, Self);
end
;

procedure
 TSocketDispatcherThread.RemoveClient;
begin

  with
 SocketDispatcher do

    if
 Assigned(OnRemoveClient) then
 OnRemoveClient(SocketDispatcher, Self);
end
;

{ TSocketDispatcherThread.IUnknown }

function
 TSocketDispatcherThread.QueryInterface(const
 IID: TGUID;
  out
 Obj): HResult;
begin

  if
 GetInterface(IID, Obj) then
 Result := 0 else
 Result := E_NOINTERFACE;
end
;

function
 TSocketDispatcherThread._AddRef: Integer;
begin

  Inc(FRefCount);
  Result := FRefCount;
end
;

function
 TSocketDispatcherThread._Release: Integer;
begin

  Dec(FRefCount);
  Result := FRefCount;
end
;

{ TSocketDispatcherThread.ISendDataBlock }

function
 TSocketDispatcherThread.Send(const
 Data: IDataBlock;
  WaitForResult: Boolean): IDataBlock;
begin

  FTransport.Send(Data);
  if
 WaitForResult then

    while
 True
 do

    begin

      Result := FTransport.Receive(True
, 0);
      if
 Result = nil
 then
 break;
      if
 (Result.Signature and
 ResultSig) = ResultSig then

        break else

        FInterpreter.InterpretData(Result);
    end
;
end
;

procedure
 TSocketDispatcherThread.ClientExecute;
var

  Data: IDataBlock;
  msg: TMsg;
  Obj: ISendDataBlock;
  Event: THandle;
  WaitTime: DWord;
begin

  CoInitialize(nil
);
  try

    Synchronize(AddClient);
    FTransport := CreateServerTransport;
    try

      Event := FTransport.GetWaitEvent;
      PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);
      GetInterface(ISendDataBlock, Obj);
      if
 FRegisteredOnly then

        FInterpreter := TDataBlockInterpreter.Create(Obj, SSockets) else

        FInterpreter := TDataBlockInterpreter.Create(Obj, '');
      try

        Obj := nil
;
        if
 FTimeout = 0 then

          WaitTime := INFINITE else

          WaitTime := 60000;
        while
 not
 Terminated and
 FTransport.Connected do

        try

          case
 MsgWaitForMultipleObjects(1, Event, False
, WaitTime,
           QS_ALLEVENTS) of

            WAIT_OBJECT_0:
            begin

              WSAResetEvent(Event);
              Data := FTransport.Receive(False
, 0);
              if
 Assigned(Data) then

              begin

                FLastActivity := Now;
                FInterpreter.InterpretData(Data);
                Data := nil
;
                FLastActivity := Now;
              end
;
            end
;
            WAIT_OBJECT_0 + 1:
              while
 PeekMessage(msg, 0, 0, 0, PM_REMOVE) do

                DispatchMessage(msg);
            WAIT_TIMEOUT:
              if
 (FTimeout > 0) and
 ((Now - FLastActivity) > FTimeout) then

                FTransport.Connected := False
;
          end
;
        except

          FTransport.Connected := False
;
        end
;
      finally

        FInterpreter.Free;
        FInterpreter := nil
;
      end
;
    finally

      FTransport := nil
;
    end
;
  finally

    CoUninitialize;
    Synchronize(RemoveClient);
  end
;
end
;


{ TSocketDispatcher }

constructor
 TSocketDispatcher.Create(AOwner: TComponent);
begin

  inherited
 Create(AOwner);
  ServerType := stThreadBlocking;
  OnGetThread := GetThread;
end
;

procedure
 TSocketDispatcher.GetThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var
 SocketThread: TServerClientThread);
begin

  SocketThread := TSocketDispatcherThread.Create(Self, False
, ClientSocket,
    InterceptGUID, Timeout, RegisteredOnly);
end
;

end
.

Другое по теме:

• CrtSock - модуль для работы с сокетами в Delphi32
• Асинхронная ошибка
• Использование ServerSocket и ClientSocket