Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Сети";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];

Вниз

Сетевая программа на чистом WinSock   Найти похожие ветки 

 
Бульдозер ©   (2005-01-13 22:19) [0]

Как сделать сетевую программу (чат или что-нибудь простое) через чистый WinSock.
Зараннее спасибо


 
Verg ©   (2005-01-13 22:43) [1]

Чт0-нибудь пр0стое:

program EchoServer;

{$APPTYPE CONSOLE}

uses
 Windows,
 Winsock,
 Classes,
 SysUtils;

var
WSAData : TWSAData;
SSocket : TSocket;
LAddr   : TSockAddrIn;
Fds,
Rfds : TFDSet;
I : integer;

function ToOem(const S : string):string;
begin
 Result := S;
 if Result<>"" then
   CharToOemBuff(pchar(Result), pchar(Result), length(Result));
end;

procedure PrintErr(Err : DWORD; Wt : boolean);
begin
 Writeln(ToOem(SysErrorMessage(Err)));
 if Wt then ReadLn;
end;

procedure ExitErr;
begin
 if (WSAGetLastError<>NO_ERROR) and
    (WSAGetLastError<>WSAENOTSOCK) and
    (WSAGetLastError<>WSAEINTR) then
   PrintErr(WSAGetLastError, true);
 if SSocket<> INVALID_SOCKET then
   CloseSocket(SSocket);
 if WSAData.wVersion <> 0 then
   WSACleanup;
 halt(0);
end;

function checksocket(Ret : integer):integer;
begin
 Result := Ret;
 if Result = SOCKET_ERROR then
   ExitErr
end;

procedure DoClose( S : TSocket );
begin
 if S = INVALID_SOCKET then exit;
 FD_CLR(S, Fds);
 if CloseSocket(S) = SOCKET_ERROR then
   PrintErr(WSAGetLastError, false);
end;

procedure DoAccept( S : TSocket );
begin
 if S <> INVALID_SOCKET then
 begin
   if Fds.fd_count < FD_SETSIZE then
     FD_SET( S, Fds )
   else
     if CloseSocket(S) = SOCKET_ERROR then
       PrintErr(WSAGetLastError, false);
 end else
   PrintErr(WSAGetLastError, false);
end;

procedure DoRead(S : TSocket);
var Res : integer;
   Buffer : array[0..255] of byte;
begin
 Res := recv(S, Buffer[0], sizeof(Buffer), 0);
 if Res > 0 then
   Res := send(S, Buffer[0], Res, 0);
 if Res <= 0 then
 begin
   if Res < 0 then
     PrintErr(WSAGetLastError, false);
   DoClose(S);
 end;
end;

var PH : PHostEnt;
   Adr : ^PInAddr;
begin
 SSocket := socket(PF_INET, SOCK_STREAM, 0);
 if SSocket = INVALID_SOCKET then ExitErr;
 FillChar(LAddr, sizeof(LAddr), 0);
 LAddr.sin_family := AF_INET;
 LADDR.sin_port   := htons(8088);
 LAddr.sin_addr.S_addr := htonl(INADDR_ANY);
 checksocket( bind(SSocket, LAddr, sizeof(LAddr)) );
 checksocket( listen(SSocket, SOMAXCONN) );
 FD_ZERO( Fds );
 FD_SET( SSocket, Fds );
 Repeat
   RFds := Fds;
   checksocket( select(0, @RFds, nil, nil, nil) );
   for I:=0 to RFds.fd_count -1 do
   begin
     if RFDs.fd_array[I] = SSocket then
       DoAccept( accept( SSocket, nil, nil ) )
     else
       DoRead(RFDs.fd_array[I]);
   end;
 until False;
end.


:))))


 
Бульдозер ©   (2005-01-14 21:57) [2]

Спасибо, это работает (только зачем PH и Adr?), но как сделать сервера?



Страницы: 1 вся ветка

Форум: "Сети";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.45 MB
Время: 0.038 c
14-1109784182
Гарри Поттер
2005-03-02 20:23
2005.03.20
Газпром + Роснефть = ?


14-1109767969
snake_r
2005-03-02 15:52
2005.03.20
BSClient


1-1109762421
Leech
2005-03-02 14:20
2005.03.20
Переход с D6 на D7


3-1108633079
kblc
2005-02-17 12:37
2005.03.20
Access and LoginScreen


1-1110184011
Flic
2005-03-07 11:26
2005.03.20
Image





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский