nSocket.AddClient(AClient: TServerClientWinSocket); begin FListLock.Enter; try if FConnections.IndexOf(AClient) < 0 then FConnections.Add(AClient); finally FListLock.Leave; end; end;
procedure TServerWinSocket.RemoveClient(AClient: TServerClientWinSocket); begin FListLock.Enter; try FConnections.Remove(AClient); finally FListLock.Leave; end; end; procedure TServerWinSocket.Accept(Socket: TSocket); var ClientSocket: TServerClientWinSocket; ClientWinSocket: TSocket; Addr: TSockAddrIn; Len: Integer; OldOpenType, NewOpenType: Integer; begin Len := SizeOf(OldOpenType); if getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), Len) = 0 then try Len := SizeOf(Addr); ClientWinSocket := WinSock.accept(Socket, @Addr, @Len); if ClientWinSocket <> INVALID_SOCKET then begin ClientSocket := GetClientSocket(ClientWinSocket); if Assigned(FOnSocketEvent) then FOnSocketEvent(Self, ClientSocket, seAccept); end; finally Len := SizeOf(OldOpenType); setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE, PChar(@OldOpenType), Len); end; end; procedure TServerWinSocket.ClientEvent(Sender: TObject; Socket: TCustomWinSocket; SocketEvent: TSocketEvent); begin case SocketEvent of seAccept, seLookup, seConnecting, seListen: begin end; file://不作反应 seConnect: ClientConnect(Socket); file://触发相应事件 seDisconnect: ClientDisconnect(Socket); seRead: ClientRead(Socket); seWrite: ClientWrite(Socket); end; end;
procedure TServerWinSocket.ClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin ClientErrorEvent(Socket, ErrorEvent, ErrorCode); end;
function TServerWinSocket.GetActiveConnections: Integer; begin Result := FConnections.Count; end;
function TServerWinSocket.GetConnections(Index: Integer): TCustomWinSocket; begin Result := FConnections[Index]; end;
procedure TServerWinSocket.Listen(var Name, Address, Service: string; Port: Word; QueueSize: Integer); begin inherited Listen(Name, Address, Service, Port, QueueSize, ServerType = stnonBlocking); file://messagebox(0,0,''''ksdfaldkf'''',0); { if FConnected then begin FServerAcceptThread := TServerAcceptThread.Create(False, Self); end; } end;
procedure TServerWinSocket.SetServerType(Value: TServerType); begin if Value <> FServerType then if not FConnected then begin FServerType := Value; ASyncStyles := [asAccept]; end else raise ESocketError.CreateRes(@sCantChangeWhileActive); end;
function TServerWinSocket.GetClientSocket(Socket: TSocket): TServerClientWinSocket; begin Result := nil; if Assigned(FOnGetSocket) then FOnGetSocket(Self, Socket, Result); if Result = nil then Result := TServerClientWinSocket.Create(Socket, Self); end;
procedure TServerWinSocket.ClientConnect(Socket: TCustomWinSocket); begin if Assigned(FOnClientConnect) then FOnClientConnect(Self, Socket); end;
procedure TServerWinSocket.ClientDisconnect(Socket: TCustomWinSocket); begin if Assigned(FOnClientDisconnect) then FOnClientDisconnect(Self, Socket); if ServerType = stNonBlocking then Socket.DeferFree; end;
procedure TServerWinSocket.ClientRead(Socket: TCustomWinSocket); begin if Assigned(FOnClientRead) then FOnClientRead(Self, Socket); end;
procedure TServerWinSocket.ClientWrite(Socket: TCustomWinSocket); begin if Assigned(FOnClientWrite) then FOnClientWrite(Self, Socket); end;
procedure TServerWinSocket.ClientErrorEvent(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin if Assigned(FOnClientError) then FOnClientError(Self, Socket, ErrorEvent, ErrorCode); end;
{ TAbstractSocket }
procedure TMAbstractSocket.DoEvent(Sender: TObject; Socket: TCustomWinSocket; SocketEvent: TSocketEvent); begin Event(Socket, SocketEvent); end;
procedure TMAbstractSocket.DoError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin Error(Socket, ErrorEvent, ErrorCode); end;
procedure TMAbstractSocket.SetActive(Value: Boolean); begin if Value <> FActive then begin if (csDesigning in ComponentState) or (csLoading in ComponentState) then FActive := Value; if not (csLoading in ComponentState) then DoActivate(Value); end; end;
procedure TMAbstractSocket.InitSocket(Socket: TCustomWinSocket); begin Socket.OnSocketEvent := DoEvent; Socket.OnErrorEvent := DoError; end;
procedure TMAbstractSocket.Loaded; begin inherited Loaded; DoActivate(FActive); end;
procedure TMAbstractSocket.SetAddress(Value: string); begin if CompareText(Value, FAddress) <> 0 then begin if not (csLoading in ComponentState) and FActive then raise ESocketError.CreateRes(@sCantChangeWhileActive); FAddress := Value; end; end;
procedure TMAbstractSocket.SetHost(Value: string); begin if CompareText(Value, FHost) <> 0 then begin if not (csLoading in ComponentState) and FActive then raise ESocketError.CreateRes(@sCantChangeWhileActive); FHost := Value; end; end;
procedure TMAbstractSocket.SetPort(Value: Integer); begin if FPort <> Value then begin if not (csLoading in ComponentState) and FActive then raise ESocketError.CreateRes(@sCantChangeWhileActive); FPort := Value; end; end;
procedure TMAbstractSocket.SetService(Value: string); begin if CompareText(Value, FService) <> 0 then begin if not (csLoading in ComponentState) and FActive then raise ESocketError.CreateRes(@sCantChangeWhileActive); FService := Value; end; end;
procedure TMAbstractSocket.Open; begin Active := True; end;
procedure TMAbstractSocket.Close; begin Active := False; end;
{ TCustomSocket }
procedure TMCustomSocket.Event(Socket: TCustomWinSocket; SocketEvent: TSocketEvent); begin case SocketEvent of seLookup: if Assigned(FOnLookup) then FOnLookup(Self, Socket); seConnecting: if Assigned(FOnConnecting) then FOnConnecting(Self, Socket); seConnect: begin FActive := True; if Assigned(FOnConnect) then FOnConnect(Self, Socket); end; seListen: begin FActive := True; if Assigned(FOnListen) then FOnListen(Self, Socket); end; seDisconnect: begin FActive := False; if Assigned(FOnDisconnect) then FOnDisconnect(Self, Socket); end; seAccept: if Assigned(FOnAccept) then FOnAccept(Self, Socket); seRead: if Assigned(FOnRead) then FOnRead(Self, Socket); seWrite: if Assigned(FOnWrite) then FOnWrite(Self, Socket); end; end;
procedure TMCustomSocket.Error(Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin if Assigned(FOnError) then FOnError(Self, Socket, ErrorEvent, ErrorCode); end;
{ TMClientSocket }
constructor TMClientSocket.Create(AOwner: TComponent); begin inherited Create(AOwner); FClientSocket := TClientWinSocket.Create(INVALID_SOCKET); InitSocket(FClientSocket); end;
destructor TMClientSocket.Destroy; begin FClientSocket.Free; inherited Destroy; end;
procedure TMClientSocket.DoActivate(Value: Boolean); begin if (Value <> FClientSocket.Connected) and not (csDesigning in ComponentState) then begin if FClientSocket.Connected then 上一页 [1] [2] [3] [4] [5] [6] [7] 下一页 [Sql Server]改进的ASP备份SQL Server数据库
|