Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

---|Ветка была без названия|---


Страницы:   1 2 3 4 5 6 7

h0use ©   (2003-10-30 12:28:00) 

Уважаемые мастера,
есть проблема, используется компонета indy idTCPServer отладил на обыкновенной аппликации процес соединения и передачи данных клиенту, затем перенес этот код в Сервис. НО, теперь клиент не может достучаться до сервера. Видимо теперь сервер стартует с правами System. А как сделать так, чтоб он стартовал с правами хотя бы администратора? Или вообще как сделать, чтоб клиент таки достучался до сервера в сервисе?

h0use   (2003-10-31 17:12:00) [21]


function TBAService.ServerStart:Boolean;
var
Binding : TIdSocketHandle;
begin
TCPServer:=TIdTCPServer.Create(Self);
AntiFreeze:=TIdAntiFreeze.Create(Self);
MessageBox(0, "", "Server create", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
AntiFreeze.Active:=True;
TCPServer.Bindings.Clear;
try
TCPServer.DefaultPort:=StrToInt(ServerPort);
If flByName then
begin
Binding:=TCPServer.Bindings.Add;
Binding.Port:=StrToInt(ServerPort);
end
else
begin
Binding:=TCPServer.Bindings.Add;
Binding.IP:=ServerIP;
Binding.Port:=StrToInt(ServerPort);
end;
TCPServer.Active:=True;
SaveLog(2,"+ Server is started.");
MessageBox(0, "", "Server is started.", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
flServerStat:=True;
If flLogNet then
begin
// TCPServer.Intercept.Init:= NetLogEvent;
NetLogEvent.Active:=True;
end
else
begin
NetLogEvent.Active:=False;
// TCPServer.Intercept:=nil;
end;
Clients:=TList.Create;
Result:=True;
except
on E : Exception do
begin
SaveLog(2,"- Server isn""t started.");
MessageBox(0, "Исключение !", PChar("Server isn""t started."), MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
SaveLog(2,"! Error: "+E.Message);
Result:=False;
end;
end;
end;
//------------------------------------------------------------------------------
function TBAService.BaseStart:Boolean;
begin
try
BADBCon:=TADOConnection.Create(Self);
BADBCon.Connected:=True;
SaveLog(4,"+ Database is started.");
Result:=True;
except
on E : Exception do
begin
SaveLog(4,"- Database is""nt started.");
SaveLog(4,"! Error: "+E.Message);
Result:=False;
end;
end;
end;
//------------------------------------------------------------------------------
function TBAService.ServerStop:Boolean;
begin
Result:=True;
try
FreeAndNil(AntiFreeze);
FreeAndNil(NetLogEvent);
FreeAndNil(TCPServer);
FreeAndNil(Clients);
flServerStat:=False;
SaveLog(2, "+ Server is stopped.");
except
on E : Exception do
begin
SaveLog(2,"- Server isn""t stopped.");
SaveLog(2,"! Error: "+E.Message);
Result:=False;
end;
end;
end;
//------------------------------------------------------------------------------
function TBAService.BaseStop:Boolean;
begin
try
BADBCon.Connected:=False;
FreeAndNil(BADBCon);
SaveLog(4,"+ Database is stopped.");
Result:=True;
except
on E : Exception do
begin
SaveLog(4,"- Database is""nt stopped.");
SaveLog(4,"! Error: "+E.Message);
Result:=False;
end;
end;
end;

Digitman   (2003-10-31 17:10:00) [22]

тела ф-ций, упомянутых в

if ServerStart and BaseStart then ...

на хирург.стол !!

h0use   (2003-10-31 17:00:00) [23]


> Digitman © (31.10.03 16:38) [100]
>
> > h0use © (31.10.03 16:31) [98]
> >
> > ThreadMgr: TIdThreadMgrDefault;
> >
> > TCPServer.ThreadMgr:=ThreadMgr;
>
>
> эт чего ? это где ?


Это ответ на вопрос [97]

h0use   (2003-10-31 16:58:00) [24]


procedure TBAService.ServiceStart(Sender: TService; var Started: Boolean);
begin
flServerStat := False;
flBaseStat := False;
flViewLaunch := False;
flHasChanges := False;
flUserConnected := False;
flByName := True;
flAutostart := False;
flAutoSelectLast:= True;
flLogNet := True;
flShowIcon := True;
flAllreadyShow := False;
// if not assigned (CS) then CS := TCriticalSection.Create;
StartLogging;
If not LoadFromReg then LoadDefaults;
if flAutoStart then
if ServerStart and BaseStart then SaveLog(1, "+ Successefully started.")
else SaveLog(1, "- Started with any errors.");

Started := True;
MessageBox(0, "", PChar("Service started "+BoolToStr(Started)), MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
end;
//------------------------------------------------------------------------------
procedure TBAService.ServiceStop(Sender: TService; var Stopped: Boolean);
var
f1,f2:Boolean;
begin
f1:=True;f2:=True;
if flBaseStat then f2:=BaseStop;
if flServerStat then f1:=ServerStop;
If f1 and f2 then SaveLog(1, "+ Successefully stopped.")
else SaveLog(1, "- Stopped with any errors.");
StopLogging;
// if assigned(CS) then FreeAndNil(CS);
// ServiceThread.Terminate;
Stopped := True;
end;
//------------------------------------------------------------------------------
procedure TBAService.ServiceContinue(Sender: TService;
var Continued: Boolean);
var
f1,f2:Boolean;
begin
f1:=True;f2:=True;
if not flServerStat then f1:=ServerStart;
if not flBaseStat then f2:=BaseStart;
If f1 and f2 then SaveLog(1, "+ Successefully restarted.")
else SaveLog(1, "- Restarted with any errors.")
end;
//------------------------------------------------------------------------------
procedure TBAService.ServicePause(Sender: TService; var Paused: Boolean);
var
f1:Boolean;
begin
try
f1:=True;
if flServerStat then f1:=ServerStop;
If f1 then SaveLog(1, "+ Successefully paused.")
else SaveLog(1, "- Paused with any errors.");
Paused:=True;
except
end;
end;
//------------------------------------------------------------------------------
procedure TBAService.ServiceShutdown(Sender: TService);
begin
// ServiceStop(Sender,True);

end;

procedure TBAService.ServiceExecute(Sender: TService);
begin
Stream := TMemoryStream.Create;
try

while not Terminated do
begin
ServiceThread.ProcessRequests(True);
Sleep(10);
end;
finally
Stream.Free;
end;
end;

Digitman   (2003-10-31 16:43:00) [25]

давай сюда тела обработчиков TService

OnStart
OnExecute
OnStop

Digitman   (2003-10-31 16:38:00) [26]


> h0use © (31.10.03 16:31) [98]
>
> ThreadMgr: TIdThreadMgrDefault;
>
> TCPServer.ThreadMgr:=ThreadMgr;


эт чего ? это где ?

Digitman   (2003-10-31 16:33:00) [27]


> Reindeer Moss Eater


все может быть)
хотя автор упорно продолжает утверждать , что событие Клиент.OnConnect возбуждается)

еще двух таких дней я не вынесу) ... прямая дорога на погост)

ну не хочет думать человек !

давно бы уж, б.., исходники нашел и оттрассировал бы логику потрохов Инди ! вкупе со своей приклеенной)

я ж вот не поленился кучу времени потратить на него и даже исх-ки скачать(

h0use   (2003-10-31 16:31:00) [28]


ThreadMgr: TIdThreadMgrDefault;

TCPServer.ThreadMgr:=ThreadMgr;

Digitman   (2003-10-31 16:27:00) [29]

чему равно и как явно используется св-во ThreadMgr ?

Reindeer Moss Eater   (2003-10-31 16:24:00) [30]

Через пару дней выяснится, что вообще
TCPServer.Active = False

h0use   (2003-10-31 16:16:00) [31]


> ты скажи лучше, почему ты OnException не обрабатываешь на
> сервере ?

Да потому что он не вызывается, только что поставил обработчик...пусто...как будто и не ставил.

Digitman   (2003-10-31 16:12:00) [32]

я ему про фому, он мне все про ерему таддычит)))

что ты снова тычешь свой код ?
не выполняется же он ! ни одно событие ! выяснили же ...
или уже с какого-то перепугу события начали возбуждаться ?

тебе последний раз говорю - ГДЕ У ТЕБЯ ОБРАБОТКА OnException() ?

все, больше тянуть из тебя не намерен, у меня своей работы полно, еще няньчиться с тобой

h0use   (2003-10-31 16:07:00) [33]

Вот как у меня сейчас:

procedure TBAService.TCPServerExecute(AThread: TIdPeerThread);
var
Client : TSimpleClient;
Msg : String;
St : String[15];
begin
MessageBox(0, "", "TCPServerExecute", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
If AThread.Data=nil then Exit;
Msg:= AThread.Connection.ReadLn;
MessageBox(0, "",PChar( "New text "+Msg), MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
If Msg="" then
begin
AThread.Connection.WriteLn("@Error:Empty String");
exit;
end;
{ Get the clients package info }
Client := Pointer(AThread.Data);
{ Check to see if the clients name has been assigned yet }
if Client.Name = "Logging In" then
begin
{ if not, assign the name and announce the client }
MessageBox(0, "", "New Client", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
Client.Name := Msg;
if flBaseStat then Client.Permission:=1;
If Client.Permission<>1 then
begin
MessageBox(0, "", "Disconnect", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
TCPServerDisconnect(AThread);
Exit;
end;
Athread.Connection.WriteLn("HELLO");
Case Client.Permission of
4: St:="Administrator";
3: St:="Developer";
2: St:="Saler"
end;
SaveLog(2,"+ User "+Client.Name+" from "+Client.DNS + " was logging in as "+St+".");
end;
end;
//------------------------------------------------------------------------------
procedure TBAService.TCPServerDisconnect(AThread: TIdPeerThread);
var
Client : TSimpleClient;
begin
try
Client := Pointer(AThread.Data);
If Client=nil then Exit;
Clients.Delete(Client.ListLink);
If Client.Permission<>1 then
begin
SaveLog(2,"+ User "+Client.Name+" from "+Client.DNS + " was logging out by server.");
Athread.Connection.WriteLn("@LOGOUT:Server stopped");
end
else
begin
SaveLog(2,"- User "+Client.Name+" from "+Client.DNS + " was kicked out by server.");
SaveLog(2,"! Error: User "+Client.Name+" has no access rights.");
Athread.Connection.WriteLn("@DENY:Database not started");
end;
Client.Free;
AThread.Data := nil;
UpdateClientList;
MessageBox(0, "", "Success", MB_OK or MB_SETFOREGROUND or MB_TOPMOST);
If Clients.Count<1 then flUserConnected:=False;
except
on E: Exception do
begin
SaveLog(2,"! Error: "+e.Classname + " " + e.Message);
MessageBox(0, "

Digitman   (2003-10-31 16:02:00) [34]


> Я Intercept не трогал, я пытался, но не копилится, поэтому
> у меня этот код убран вообще


уже не верю ничему, после того как ты детский лепет тут развел с "жирной строкой" - то тот исходник, то не тот ... в бирюльки чтоль играешься ?

Digitman   (2003-10-31 16:00:00) [35]

не знаю уж, что ты там "трогал" или не "трогал", но - вот ориг.код :


procedure TIdListenerThread.Run;
var
Peer: TIdTCPServerConnection;
Thread: TIdPeerThread;
i : Integer;
begin
FBindingList.Clear;
for i:= 0 to Server.Bindings.Count - 1 do begin
FBindingList.Add(TObject(Server.Bindings[i].Handle));
end;
if GStack.WSSelect(FBindingList, nil, nil, AcceptWait) > 0 then begin
if not Terminated then begin
for i := 0 to FBindingList.Count - 1 do begin
Peer := TIdTCPServerConnection.Create(Server);
with Peer do begin
Binding.Accept(TIdStackSocketHandle(FBindingList[i])); // в этот момент твой клиент получает OnConnect-событие
// LastRcvTimeStamp := Now; // Added for session timeout support
// ProcessingTimeout := False;
if Assigned(Server.Intercept) then begin
try
Peer.Intercept := Server.Intercept.Accept(Binding);
Peer.InterceptEnabled := True;
except
FreeAndNil(Peer); // а в этот твой клиент вываливается, ибо здесь закрывается соединение с ним
end;
end;
end;
if Peer <> nil then begin //после чего эта строчка не выполняется, поток не стартует, и , соотв-но, никаких событий ты не видишь на сервере
// Create Thread
Thread := TIdPeerThread(Server.ThreadMgr.GetThread);
Thread.FConnection := Peer;
Server.Threads.Add(Thread);
Thread.Start;
end;
end;
end;
end;
end;


ты скажи лучше, почему ты OnException не обрабатываешь на сервере ?

для Пушкина что ль событие это ? для тебя !!! что бы ты в сомнительных ситуациях видел, что в ходе работы сервера привело к исключительной ситтуации !!

h0use   (2003-10-31 15:46:00) [36]

Я Intercept не трогал, я пытался, но не копилится, поэтому у меня этот код убран вообще!

Digitman   (2003-10-31 15:35:00) [37]


> Reindeer Moss Eater


ладно, дальше все ясно


> h0use ©


последние штрихи к "портрету твоего кода" :

после коннекта транспортный тред не будет задействован (и, соответственно, ты не получишь ни одно из событий OnConnect/OnExecute/OnDisconnect), если ты напортачил со св-вом Intercept. При возникновении там исключения никакого трансп.потока и никаких событий ты не получишь, и коннект будет тут же автоматом разорван сервером, что и наблюдается.

Вот тебе и вся сказка твоя.

А ты - "сервис, сервис" !!

h0use   (2003-10-31 15:29:00) [38]

TBAService.TCPServerConnect , аналогично даже не входит в процедуру! Я уж не говорю об отсутствии ексепшинов и сакцессов.

Reindeer Moss Eater   (2003-10-31 15:27:00) [39]

и я - про него !
про обработчик TidTCPServer.OnExecute !

Все, что я говорил, было:

Когда завершается TidTCPServer.OnExecute (когда завершается обработчик) TCP сервер не рвет коннект.

Digitman   (2003-10-31 15:25:00) [40]

так...

TBAService.TCPServerConnect у тебя вызывается ?

если - да, ищи там исключение.

если оно там происходит, то до OnExecute, разумеется, дело не дойдет !

вот и весь фокус

Страницы:   1 2 3 4 5 6 7

Наверх

Титульная страница Поиск, карта сайта Написать письмо