Ручное создание чата без использования стандартных компонент Delp

← →
Куаныш (2002-10-07 16:34) [0]

Подскажите люди добрые как это делается.
Мне это очень нужно

← →
Фуримон (2002-10-07 19:22) [1]

Куаныш, привет. Если узнаешь - мне скажи.

← →
Rouse_ (2002-10-09 03:33) [2]

Создаешь клиент, потом сервер, и пишешь

Вот тебе пример

{комментариев мало, думаю что разберётесь. прога проверялась на 98,
ни разу не глюкнула, но АБСОЛЮТНО корректную работу не гарантирую.
очень много из неё повыдергано, т.е. осталось совсем немного, за
счёт чего ещё более уменьшился размер - оригинальная версия сервера
активно работает с DLL ну и ещё кое-какие прибамбасы содержит, но и
весит на 5 килов поболее... кому надо могу скинуть и её. ну в общем всё. удачи!}
program Small_socket_server;
{$M 16384,2097152}
uses
Windows,
Winsock,
SysUtils;

const
nport:smallint = 500;//порт - любой (я взял 500-й)
var
WSAData:TWSAData;
MySockAddr:sockaddr_in;
descriptor,srvsocket:TSocket;
res,thread_id:cardinal;
type MyPChar = array [0..255] of Char;
threadvar //тут переменные для потока
ColBytes: Cardinal;
thread_buffer: MyPChar;
_wsaerror,rcvd_bytes:Cardinal;
answer: MyPChar;
threadsocket:TSocket;

var F: Text;
procedure WriteS(S: PChar);
var n: integer;
begin
AssignFile(F, "logs.txt");
{$I-}
Append(F);
{$I+}
if IOResult <> 0 then ReWrite(F);
{ for n := 1 to rcvd_bytes do
Write(F,S[n-1]);
Writeln(F);
}
Writeln(F,S);
Close(F);
end;

procedure InitializeSrvSocket;
begin
res:=WSAStartup($0101,WSAData);
if res<>0 then Halt;
MySockAddr.sin_addr.S_addr:=INADDR_ANY;
MySockAddr.sin_port:=htons(nport);
MySockAddr.sin_family:=AF_INET;//это семейство протоколов кажется. их много...
descriptor:=socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);//пытаемся создать сокет - если он уже есть
//на данном порту - закрываемся
if descriptor=INVALID_SOCKET then Halt;
res:=bind(descriptor,MySockAddr,SizeOf(MySockAddr));
if res<>0 then Halt;
res:=listen(descriptor,SOMAXCONN);//SOMAXCONN - это вроде 5 клиентов максимум? поправьте если ошибаюсь
if res<>0 then Halt;
//при инициализации сокета никаких ошибок не выдаётся, что разумеется легко поправимо (если надо)
end;

procedure ThreadExecProc; //процедура потока
type MyCharArray = array [0..255] of Char;
RIOpenComm = record
FunNum: Byte;
InQueue: Word;
OutQueue: Word;
Size: Word;
ComName: MyCharArray;
end;
var OpenC: RIOpenComm;
NotRead: Boolean;
P: MyCharArray;
PCS: PChar;
POpenC : ^RIOpenComm;
V: OleVariant;
SS: AnsiString;
begin
threadsocket:= srvsocket;
// answer:="Соединено"+Chr(13)+Chr(10); //мессага клиенту
answer:="Connected"+Chr(13)+Chr(10); //мессага клиенту

send(threadsocket,answer,Length(answer),0); //отправляем ответ клиенту что усё ОК

while true do begin //поток выполняется пока не произойдёт дисконнект
thread_buffer:=""; //чистим буфер
{ ColBytes := StrLen(answer);}

rcvd_bytes:=recv(threadsocket,thread_buffer,Length(thread_buffer),0); //ждём данных от клиента - строку
// тут всё просто либо мы получаем данные, либо rcvd_bytes=0 (нормальный дисконнект) либо фатальный дисконнект -
//тогда смотрим код последней ошибки
_wsaerror:=WSAGetLastError; //тут мы его (код ошибки) и проверяем...
if (rcvd_bytes=0) or (_wsaerror=WSAECONNRESET) then begin //обрабатываем дисконнект
MessageBeep(0);
closesocket(threadsocket); //закрываем сокет
ExitThread(0); //выходим из потока
end;

// MessageBeep(0);
// answer:="Соединено"+Chr(13)+Chr(10); //мессага клиенту
Inc(Colbytes, 10);
SS := "Weigth = " + (IntToStr(ColBytes))+Chr(13)+Chr(10);
StrCopy(answer, PChar(ss));

send(threadsocket,answer,StrLen(answer),0); //отправляем ответ клиенту что усё ОК

// send(threadsocket,thread_buffer,Length(answer),0);
//# WriteS(thread_buffer);

// MessageBeep(0);

end; //end while

end;

begin
InitializeSrvSocket; //инициализируем сокет
while true do begin //крутим цикл
srvsocket:=accept(descriptor,nil,nil); //ждём соединения. именно просто ЖДЁМ - не жрём ресурсов проца
//(или по минимуму - таскинфо у меня показывал либо 0 либо 0.01% загрузки проца)
if srvsocket<>INVALID_SOCKET then begin //если всё успешно, то создаём поток для клиента
CreateThread(nil,0,@ThreadExecProc,nil,0,thread_id);
//далее ОТДЕЛЬНЫЙ поток работает с ОТДЕЛЬНЫМ клиентом, а прога снова ждёт коннекта другого клиента...
end;
end;
end.

Автор кода andrucco ©

Желаю успехов

Ручное создание чата без использования стандартных компонент Delp Найти похожие ветки