Форум: "Сети";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];
ВнизМногопоточный сервер на чистом API Найти похожие ветки
← →
+koha (2008-08-22 12:49) [0]Прошу модераторов не банить ветку как эту http://delphimaster.net/view/6-1218807638/.
Просто перед хотел фраернуться перед кентами. Ну, вот скажите зачем трою нужен сервер да еще и мульти поточный? глупость.
Увидел мини веб-сервер размером 10кб. http://miniwebsvr.sourceforge.net решил что-нибудь подобное сотворить на Delphi, а то говорят, что на нем такие миниатюрные вещи нельзя сотворить, ну типа нужен только СИ. Хочу опровергнуть это Делфа нихрена не хуже.
Немного усовершенствовал код, но все же будет вопрос:
Действительно ли вызов функции BeginThread() в Delphi приводит к утечке памяти?
И в этом приведенном коде она возможна?
Ну може кто еще чего подскажет?
unit TCP;
interface
Uses Windows, SysUtils, WinSock, SockErr, MsgLog;
Type
PClientInfo = ^TClientInfo;
TClientInfo = Record
ClientSocket : TSocket;
ClientAddr : sockaddr_in;
hClientThr : THandle;
ClientThrId : Integer;
end;
Type TThrCmd = (TC_READ, TC_WRITE, TC_STOP_SERVER, TC_STOP_CLIENT, TC_ERROR);
Function StartTCPServer(Port: Integer): Boolean;
Function StopTCPServer: Boolean;
Procedure TCPThreadProc(Param: Pointer);
Procedure TCPClientThreadProc(Param: Pointer);
Procedure AcceptProc(Param: Pointer);
Var
hTCPThread : Thandle;
TCPThreadId : LongWord;
WData : TWSAData;
SockListen : TSocket;
LocalAddr : sockaddr_in;
hAcceptThr : THandle;
AcceptThrId : LongWord;
ClientInfoArray : array of PClientInfo;
MultipleThrArray : Array[1..MAXIMUM_WAIT_OBJECTS] of Thandle;
CS_REC : TRTLCriticalSection;
Const
WM_NULL = $0000;
WM_APP = $8000;
PM_NOREMOVE = 0;
NET_MESSAGE = WM_USER+1;
implementation
function DeleteClientInfo(Num: integer): Integer;
var
Count: integer;
begin
try
EnterCriticalSection(CS_REC);
Count := length(ClientInfoArray);
if (Num < 0) or (Num > Count) then Exit;
Dispose(ClientInfoArray[num]);
System.Move(ClientInfoArray[num+1],ClientInfoArray[num],(Count-num)*SizeOf(Pointer));
SetLength(ClientInfoArray, Pred(Num));
finally
LeaveCriticalSection(CS_REC);
end;
end;
Function StartTCPServer(Port: Integer): Boolean;
Var
Err: Integer;
begin
Result := True;
if Not WSAStartup(MakeWord(1,1),WData) = 0 then begin
SendDebugMsg("Err: (WSAStartup <> 0) WSAGetLastError: "+SockErrToStr(WSAGetLastError));
Result := false;
Exit;
end;
SockListen := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
if SockListen = INVALID_SOCKET then begin
SendDebugMsg("Error: Socket > WSAGetLastError: "+SockErrToStr(WSAGetLastError));
Result := false;
Exit;
end;
LocalAddr.sin_addr.S_addr := htonl(INADDR_ANY);
LocalAddr.sin_family := AF_INET;
LocalAddr.sin_port := htons(Port);
if bind(SockListen, LocalAddr, sizeOf(LocalAddr)) = SOCKET_ERROR then begin
SendDebugMsg("bind() Error: "+SockErrToStr(WSAGetLastError));
Result := false;
Exit;
end;
if Listen(SockListen,MAXIMUM_WAIT_OBJECTS) = SOCKET_ERROR then begin
SendDebugMsg("Listen() Error: " + SockErrToStr(WSAGetLastError));
Result := false;
Exit;
end;
hTCPThread := BeginThread(Nil,0, Addr(TCPThreadProc), 0,0, TCPThreadId);
if hTCPThread = 0 then begin
SendDebugMsg("Error: hTCPThread = 0 GLE: "+IntToStr(GetLastError));
Result := False;
Exit;
end;
end;
Function StopTCPServer: Boolean;
begin
Result:=false;
if hTCPThread = Nil then Exit;
PostThreadMessage(hTCPThread,NET_MESSAGE,integer(TC_STOP_SERVER),0);
//Пока Без доп. проверки действительно ли остановился сервер или вышел таймаут
while WaitForSingleObject(hTCPThread,600000) = WAIT_TIMEOUT do begin
Sleep(50);
end;
Result:=True;
end;
Procedure TCPThreadProc(Param: Pointer);
Var
Msg: TMsg;
begin
try
InitializeCriticalSection(CS_REC);
hAcceptThr:=BeginThread(Nil,0,Addr(AcceptProc),Pointer(SockListen),0,AcceptThrId );
if hAcceptThr = 0 then begin
SendDebugMsg("Error: (hProc = 0) GLE: "+IntToStr(GetLastError));
Exit;
end;
While true do begin
if PeekMessage(Msg,hTCPThread, WM_NULL, WM_APP, PM_NOREMOVE) then begin
GetMessage(Msg, 0, 0, 0);
DispatchMessage(msg);
Case TThrCmd(MSG.wParam) of
TC_WRITE : SendDebugMsg("MSG.wParam = TC_WRITE");
TC_STOP_SERVER : SendDebugMsg("MSG.wParam = TC_STOP_SERVER");
TC_STOP_CLIENT : SendDebugMsg("MSG.wParam = TC_STOP_CLIENT");
TC_ERROR : SendDebugMsg("MSG.wParam = TC_ERROR");
end;
end;
Sleep(50);
end;
finally
DeleteCriticalSection(CS_REC);
end;
end;
Procedure TCPClientThreadProc(Param: Pointer);
Var
Err : Integer;
Buff : Array[1..1024] of Char;
Command : String;
begin
While True do begin
FillChar(Buff, 1024, 0);
Err := Recv(PClientInfo(Param).ClientSocket, Buff, 1024, 0);
if Err = SOCKET_ERROR then begin
SendDebugMsg(IntToStr(PClientInfo(Param).ClientThrId)
+" Err: TCPClientThreadProc Recv = "+SockErrToStr(WSAGetLastError));
PostThreadMessage(TCPThreadId, NET_MESSAGE, Integer(TC_ERROR),PClientInfo(Param)^.ClientThrId);
Exit;
end;
Command := StrPas(PChar(@Buff));
if Command = "" then begin
CloseSocket(PClientInfo(Param)^.ClientSocket);
Exit;
end;
SendDebugMsg("ComStr = "+Command+" "+IntToStr(Length(Command)));
{=================================
Command section
=================================}
if Command = "CLOSE_SESSION" then
PostThreadMessage(hTCPThread, NET_MESSAGE, Integer(TC_STOP_CLIENT), PClientInfo(Param).ClientSocket);
end;
end;
Procedure AcceptProc(Param: Pointer);
Var
Size : Integer;
ClientThrId : Cardinal;
hClientThr : THandle;
ClientAddr : SockAddr_in;
ClientInfo : PClientInfo;
Num : Integer;
begin
While True do begin
New(ClientInfo);
FillChar(ClientInfo^,SizeOf(TClientInfo), 0);
Size := SizeOf(ClientAddr);
ClientInfo.ClientSocket := accept(TSocket(Param),@ClientAddr, @Size);
if ClientInfo.ClientSocket = INVALID_SOCKET then begin
SendDebugMsg("Err: accept WSA_GLE: "+SockErrToStr(WSAGetLastError));
PostThreadMessage(TCPThreadId,NET_MESSAGE,Integer(TC_ERROR),0);
CloseSocket(ClientInfo.ClientSocket);
Dispose(ClientInfo);
Continue;
end;
try
EnterCriticalSection(CS_REC);
Num := Length(ClientInfoArray);
SetLength(ClientInfoArray, Num+1);
ClientInfo.ClientAddr := ClientAddr;
hClientThr := BeginThread(Nil,0,Addr(TCPClientThreadProc),ClientInfoArray[Num],CREATE_SUSPENDE D,ClientThrId);
if hClientThr = 0 then begin
SendDebugMsg("BeginThread err:"+IntToStr(GetLastError));
CloseSocket(ClientInfo^.ClientSocket);
Dispose(ClientInfo);
SetLength(ClientInfoArray, num);
Continue;
end;
ClientInfo.hClientThr := hClientThr;
ClientInfo.ClientThrId := ClientThrId;
ClientInfoArray[Num] := ClientInfo;
ResumeThread(ClientInfo.hClientThr);
finally
LeaveCriticalSection(CS_REC);
end;
end;
end;
end.
← →
Сергей М. © (2008-08-22 12:56) [1]Конечно приводит.
И именно в приведенном коде.
Ты объект-поток создал ? Создал.
Хэндл объекта-потока получил ? Получил.
А уничтожать этот объект - закрывать полученный при создании хэндл - кто за тебя будет, Пушкин ?
← →
Сергей М. © (2008-08-22 13:01) [2]
> на чистом API
Какой же это "чистый API" ?
Ты же SysUtils используешь, значит уже испачкался)
> Хочу опровергнуть это Делфа нихрена не хуже.
Поздравляю, ты открыл Америку)
← →
+koha (2008-08-22 13:06) [3]
> Сергей М. © (22.08.08 13:01) [2]
SysUtils Для отладки, ну пока только используется IntTostr затем я удалю SysUtils, а некоторые его функции перетяну в отдельный модуль или заменю на API
← →
+koha (2008-08-22 13:12) [4]> А уничтожать этот объект - закрывать полученный при создании хэндл - кто за > тебя будет, Пушкин ?
Хедлы потоков-клиентов закрывать будет поток TCPThreadProc по полученнымPostThreadMessage(hTCPThread, NET_MESSAGE, Integer(TC_STOP_CLIENT), PClientInfo(Param).ClientSocket)
от клиентов сообщениям или самостоятельно при своем завершении. Просто код не влазит в размер 7168 бт. так на форуме определено, я код допишу и покажу.
← →
Сергей М. © (2008-08-22 13:24) [5]
> некоторые его функции перетяну в отдельный модуль или заменю
> на API
Упаришься перетягивать)
На нем завязан объект Exception.
Поковыряешься-попаришься со своей собственной SEH-оболочкой, плюнешь на это гнилое дело и повернешь оглобли назад в сторону Exception-объекта)
Ну и собссно по теме - еще одна утечка у тебя в ClientInfoArray, потому как простые указательные типы не являются типами с управляемым компилятором временем жизни.
> PeekMessage(Msg,hTCPThread
> PostThreadMessage(hTCPThread
Это работать не будет.
← →
+koha (2008-08-22 13:30) [6]Меня вот еще это интересует. Есть ли тут какие-нибуть нарекания?
function DeleteClientInfo(Num: integer): Integer;
var
Count: integer;
begin
try
EnterCriticalSection(CS_REC);
Count := length(ClientInfoArray);
if (Num < 0) or (Num > Count) then Exit;
Dispose(ClientInfoArray[num]);
System.Move(ClientInfoArray[num+1],ClientInfoArray[num],(Count-num)*SizeOf(Pointer));
SetLength(ClientInfoArray, Pred(Num));
finally
LeaveCriticalSection(CS_REC);
end;
end;
← →
Сергей М. © (2008-08-22 13:30) [7]
> if Command = "CLOSE_SESSION" then
Это тоже работать не обязано.
← →
Сергей М. © (2008-08-22 13:39) [8]
> Есть ли тут какие-нибуть нарекания?
Нибуть есть.
И довольно серьезные.
1. Неверная логика использования защитного try-блока.
2.
> System.Move(ClientInfoArray[num+1],ClientInfoArray[num],
> (Count-num)*SizeOf(Pointer));
Пусть в массиве Count = 3 элемента.
Пусть ты удаляешь средний (Num=1) элемент.
Тогда мувом ты должен перенести один элемент, а ты почему-то переносишь 2 элемента (Count - Num = 2)
Кстати, и что же ты, "фраер", парил мозги "кентам", что твои мув-эксперименты не имеют отношения к забаненой ветке, где ты "фраерился" про "нового троянца" ?
Ай как некузяво получается)
← →
+koha (2008-08-22 13:42) [9]
> +koha (22.08.08 13:30) [6]
ClientInfoArray[num] Содержит нэдл потока и сокет, наверное предварительно нужно пропустить через Closehandle СloseSocket? А если уже поток остановился сокет = ERROR_SOCKET все равно их нужно пропустить через Closehandle СloseSocket?
← →
Сергей М. © (2008-08-22 13:45) [10]
> +koha (22.08.08 13:42) [9]
Что и через кого ты там будешь "пропускать" - это ты сам решай.
Правило одно : получил новый хэндл объекта (неважно какого) ? Изволь по окончании работы с объектом закрыть этот хэндл !
← →
+koha (2008-08-22 13:51) [11]
> Сергей М. © (22.08.08 13:39) [8]что твои мув-эксперименты
> не имеют отношения к забаненой ветке, где ты "фраерился"
> про "нового троянца"
Да потому, что тема, ни та ни эта ничего общего с "троянцами" не имеет. ее так забанили за сам факт этого слова, как я думаю, за что извиняюсь, глупо поступил. А можно как-нибуть свой логин вернуть, это я так меж делом спрашиваю, а то задолбался писать с приставками +-_ свой логин
← →
Сергей М. © (2008-08-22 13:53) [12]
> можно как-нибуть свой логин вернуть
Нибуть можно.
Но это не ко мне, а к терапевту)
← →
+koha (2008-08-22 14:01) [13]
> Сергей М. © (22.08.08 13:53) [12]
а вы с терапевтам рядом не сидите случаем или около того, а то может передали бы мою просьбу :-)
← →
+koha (2008-08-22 14:03) [14]
> Сергей М. © (22.08.08 13:24) [5]Упаришься перетягивать)Поковыряешься-
> попаришься со своей собственной SEH-оболочкой, плюнешь на
> это гнилое дело и повернешь оглобли назад в сторону Exception-
> объекта)
Ничего наше дело молодое, зато многое в голове осядет.
← →
Сергей М. © (2008-08-22 14:06) [15]
> +koha (22.08.08 14:01) [13]
Не, не сижу)
А что, у тебя терапевты логин отобрали разве ?
По-моему только ветку забанили ..
← →
Anatoly Podgoretsky © (2008-08-22 14:14) [16]> +koha (22.08.2008 13:30:06) [6]
(Num < 0) or (Num > Count)
А это что за муть?
← →
DVM © (2008-08-22 16:30) [17]
> +koha (22.08.08 12:49)
> Увидел мини веб-сервер размером 10кб. http://miniwebsvr.
> sourceforge.net решил что-нибудь подобное сотворить на Delphi
Наш ответ tinyweb:
http://www.ritlabs.com/en/products/tinyweb/
Кстати, на делфи.
← →
DVM © (2008-08-22 16:31) [18]
> Наш ответ tinyweb:
57 кб exe файл.
← →
+koha (2008-08-22 20:30) [19]
> DVM © (22.08.08 16:30) [17]
Да "протащился" вполне от увиденного, штука классная, еще и исходники впридачу.
← →
Сергей М. © (2008-08-22 20:48) [20]
> +koha (22.08.08 20:30) [19]
Как был ты "протащилкиным", так ты в местной памяти и останешься - "потащившимся фраером")
В след.раз, дитятко, "следи за базаром".
← →
+koha (2008-08-22 21:35) [21]
> Сергей М. © (22.08.08 20:48) [20]
А что вы от меня ожидали? Что вам не понравилось слово "протащился"? Да, я малограмотный, институтов не "кинчивал" степеней не имею, говорю по народному, вас это смущает? Ну извините детство трудное было. Вот это меня тоже достало когда постоянно тыкают, что мало грамотен я и сам об этом знаю. Так вот скажу все кто жил в моем дворе из мох ровестников все давно испились или половину сидят и уже не вылезут из этого никогда, район наш весь разломали половина домов сгорела вообще и сталось их чуть беле десятка, и народ в них в основном пьют да дерутся, так вот я еще более менее держусь хоть чем то занимаюсь у меня интересы есть в программировании это хобби у меня, а мог бы махнуть рукой и беспробудно бухать как все и превратиться в очередного "древолоса" или стать полным быдлом. Не убивайте во мне последнюю надежду.
← →
Сергей М. © (2008-08-22 21:52) [22]
> малограмотный
> не "кинчивал"
> не имею
> по народному
> детство трудное
> достало
> мало грамотен я и сам
> жил в моем дворе
> пьют да дерутся
> бухать
Ты сюда хныкать явился, да ?
Меж прочим, никто тебя за "фраерский" язык не тянул.
> Не убивайте во мне последнюю надежду
Никто ее в тебе не убивает.
Просто заканчивай сраное дворовое полууголовное детство)
← →
+koha (2008-08-22 22:15) [23]
> Сергей М. © (22.08.08 21:52) [22]
Я слышал, конечно же, что у людей с неустойчивой психикой, по крайней мере весной и осенью, бывают обострения или слишком весна затянулась или осень рано началась, что на вас влияет больше? Я такого не видывал, что бы от пару слов каких то и даже не ругательных человек приходил в такую жуткую взвинченность. В одном посте ваш "базар" уже удалили http://delphimaster.net/view/6-1218807638/ но вы как вы думаете такой рьяный борец за чистоту разговора на самом деле ни сколько того не лучше. Я бы от модераторов еще потребовал, чтобы и этот пост удалили Сергей М. © (22.08.08 21:52) [22] Так как это не по теме, и к тому же оскорбляет.
← →
Сергей М. © (2008-08-22 22:47) [24]
> +koha (22.08.08 22:15) [23]
Помощь нужна тебе ?
Ты это уже забыл, психоустойчивый ты наш "фраер" ?)
Страницы: 1 вся ветка
Форум: "Сети";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];
Память: 0.6 MB
Время: 0.08 c