TServerSocket и TClientSocket без scktsrvr.exe отказываются работать
Встpечаются девушка и молодой человек, знакомые лишь виртуально. Молодой человек, смотpя на девушку:
- Так вот почему с тобой было так интеpесно говоpить - все остальное с тобой делать пpосто беcполезно.
Вопрос: У меня ни TServerSocket, ни TClientSocket без scktsrvr.exe отказываются
работать! Слышал, что для решения проблемы можно что-то откуда-то вырезать и
вклеить в программу.
Установите этот компонент:
unit Sck;
interfaceuses
Classes, SysUtils, Windows, Messages,
ScktComp, SConnect, ActiveX, MidConst;
type
TNotifyClient = procedure (Sender: TObject; Thread: TServerClientThread) ofobject;
{ 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;
publicconstructor 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);
publishedconstructor 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;
procedureRegister;
implementationprocedureRegister;
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;
beginwith SocketDispatcher doif Assigned(OnAddClient) then OnAddClient(SocketDispatcher, Self);
end;
procedure TSocketDispatcherThread.RemoveClient;
beginwith SocketDispatcher doif Assigned(OnRemoveClient) then OnRemoveClient(SocketDispatcher, Self);
end;
{ TSocketDispatcherThread.IUnknown }function TSocketDispatcherThread.QueryInterface(const IID: TGUID;
out Obj): HResult;
beginif 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 thenwhileTruedobegin
Result := FTransport.Receive(True, 0);
if Result = nilthen 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;
whilenot Terminated and FTransport.Connected dotrycase MsgWaitForMultipleObjects(1, Event, False, WaitTime,
QS_ALLEVENTS) of
WAIT_OBJECT_0:
begin
WSAResetEvent(Event);
Data := FTransport.Receive(False, 0);
if Assigned(Data) thenbegin
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);
begininherited 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, у вас есть несколько вариантов:
Установка scktsrvr.exe: вы можете установить scktsrvr.exe на свой компьютер, скачав и установив Windows SDK или используя третьепартийное решение,such как Microsoft Visual Studio.
Использование альтернативной библиотеки сокетов: есть другие библиотеки, которые не зависят от scktsrvr.exe. Например, вы можете использовать Indy (Internet Direct) или Synapse (библиотека Delphi для сокетов).
Создание собственного сервера сокетов: вы можете создать 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
Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.