Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

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

Delphi , Интернет и Сети , Сокеты

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

Встpечаются девушка и молодой человек, знакомые лишь виртуально. Молодой человек, смотpя на девушку:
- Так вот почему с тобой было так интеpесно говоpить - все остальное с тобой делать пpосто беcполезно.

Вопрос: У меня ни 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.


Похоже, у вас возникли проблемы с TServerSocket и TClientSocket, не имея scktsrvr.exe.

До того, как мы начнем искать решение, хотел бы уточнить, что scktsrvr.exe - это Windows-сервис, ответственный за обработку соединений сокетов. Без него ваши сокеты не будут работать.

Почему вы испытываете трудности с TServerSocket и TClientSocket, не имея scktsrvr.exe, потому что VCL (Visual Component Library) использует этот сервис для обработки сетевого общения.

Чтобы решить этоissue, у вас есть несколько вариантов:

  1. Установка scktsrvr.exe: вы можете установить scktsrvr.exe на свой компьютер, скачав и установив Windows SDK или используя третьепартийное решение,such как Microsoft Visual Studio.
  2. Использование альтернативной библиотеки сокетов: есть другие библиотеки, которые не зависят от scktsrvr.exe. Например, вы можете использовать Indy (Internet Direct) или Synapse (библиотека Delphi для сокетов).
  3. Создание собственного сервера сокетов: вы можете создать custom socket server, используя вызовы WinSock API (например, socket, bind, listen, accept) и обрабатывать соединения вручную.

В вашем коде вы используете TServerSocket и TClientSocket из VCL, которые зависят от scktsrvr.exe. Если вы хотите продолжать использовать эти компоненты, вам нужно установить scktsrvr.exe.

Если вы заинтересованы в исследовании альтернативных вариантов или создании собственного сервера сокетов, я с радостью помогу вам с этим!

Текст статьи описывает проблемы с использованием компонентов TServerSocket и TClientSocket без запуска scktsrvr.exe в Delphi.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Сокеты ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-11-02 20:45:42/0.011898040771484/0