Форум программистов [Powered by Invision Power Board]

Код


library Cheshire;

uses
  Windows, ScktComp;

const
  SrvPort: Integer = 7777;

var
  thID: Thandle;
  ServerMain: TServerSocket;

{$R *.res}

procedure ServerMainClientRead(Sender: TObject; Socket: TCustomWinSocket);
  begin
    MessageBox(0, PAnsiChar('Работает!'),'Cheshire', MB_OK);
  end;

procedure ServerInit;
  begin
    ServerMain := TServerSocket.Create(nil);
    ServerMain.Port:=SrvPort;
    ServerMain.Open;
  end;

procedure DLLEntryPoint(dwReason: DWord);
  begin
    case dwReason of
      DLL_PROCESS_ATTACH:
        begin
          CreateThread(nil, 0, @ServerInit, pointer(777), 0, thID);
        end;
      DLL_PROCESS_DETACH:
        begin
          //
        end;
    end;
  end;

begin
  DllProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Код


library Cheshire;

uses
  Windows, Classes, ScktComp;

type
  TServerMainEvents = class
    class procedure OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
  end;

const
  SrvPort: Integer = 7777;

var
  thID: Thandle;
  ServerMain: TServerSocket;

{$R *.res}

class procedure TServerMainEvents.OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
  begin
    MessageBox(0, PAnsiChar('Работает!'),'Cheshire', MB_OK);
  end;

procedure ServerInit;
  begin
    ServerMain := TServerSocket.Create(nil);
    ServerMain.OnClientRead := TServerMainEvents.OnClientRead;
    ServerMain.Port:=SrvPort;
    ServerMain.Open;
  end;

procedure DLLEntryPoint(dwReason: DWord);
  begin
    case dwReason of
      DLL_PROCESS_ATTACH:
        begin
          CreateThread(nil, 0, @ServerInit, pointer(777), 0, thID);
        end;
      DLL_PROCESS_DETACH:
        begin
          //
        end;
    end;
  end;

begin
  DllProc := @DLLEntryPoint;
  DLLEntryPoint(DLL_PROCESS_ATTACH);
end.

Код


{$IFDEF ExcludeWarnings}{$WARNINGS OFF}{$ENDIF}
procedure TServerThread.Execute;
var
  msg: TMsg;
  i: integer;
begin
  { говорим системе, что поток будет принимать сообщения }
  PeekMessage(msg, 0, WM_USER, WM_USER, PM_NOREMOVE);

  FCriticalSection := TCriticalSection.Create;

  FServerSocket := TServerSocket.Create(nil);
  FServerSocket.Active := False;
  FServerSocket.OnClientConnect := OnClientConnect;
  FServerSocket.OnClientDisconnect := OnClientDisconnect;
  FServerSocket.OnClientError := OnClientError;

  while not Terminated and GetMessage(msg, 0, 0, 0) do // организуем цикл выборки сообщений
    try
      if msg.hwnd = 0 then
        case msg.message of
          msgSetActive:
            begin
            end;
          msgSetPort:
            begin
            end;
          msgDeleteConnection:
            ;
          msgDestroyAll:
           ;
        else
          DispatchMessage(msg);
        end
      else // если сообщение не адресовано потоку (т.е. не послано через PostThreadMessage), переадресуем
             // его окнам, созданным в этом потоке.
        DispatchMessage(msg);
    except
    end;

  // и при выходе из потока - уничтожаем всё созданное в нем.
  FCriticalSection.Enter;
  if Assigned(FServerSocket) then
    begin
      FServerSocket.OnClientConnect := nil;
      FServerSocket.OnClientDisconnect := nil;
      for i := 0 to FServerSocket.Socket.ActiveConnections - 1 do
        begin
          TObject(FServerSocket.Socket.Connections[i].Data).Free;
          FServerSocket.Socket.Connections[i].Data := nil;
        end;
      FServerSocket.Free;
      FServerSocket := nil;
    end;
  FCriticalSection.Leave;

  FCriticalSection.Free;
  FCriticalSection := nil;
end;
{$IFDEF ExcludeWarnings}{$WARNINGS ON}{$ENDIF}