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

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

Почему возникает исключение? Использую такую конструкцию:

Страницы:   < 1 2 >

EgorovAlex ©   (2005-11-15 09:29:00) 


procedure Proc1;
begin
 try
   CoInitializeEx(nil, COINIT_MULTITHREADED);
   // работа с ADSI
   CoUninitialize;
 except
   // exception1
 end;
end;

procedure Proc2;
begin
 try
   ...
   Proc1;
 except
   // exception2
 end;
end;

Если я вызываю Proc2 из программы, то всё работает нормально, если же я вызываю Proc2 из потока сервиса, то возникает исключение exception2.

Но если я меняю эту конструкцию на такую:

procedure Proc1;
begin
 try
   // работа с ADSI
 except
   // exception1
 end;
end;

procedure Proc2;
begin
 try
   CoInitializeEx(nil, COINIT_MULTITHREADED);
   ...
   Proc1;
   CoUninitialize;
 except
   // exception2
 end;
end;

То вызов Proc2 проходит нопмально даже из потока сервиса.

Почему такое может возникать?

---

EgorovAlex   (2005-11-16 08:13:00) [21]

Спасибо, отладить попробую - до этого ни разу так не пробовал отлаживать сервис.
Насчёт COINIT_MULTITHREADED - к этой процедуре предполагается одновременный доступ нескольких клиентов и он в таких случаях будет выполняться в разных потоках. А какой флаг предпочтительней? Я пробовал и CoInitialize(nil), но это мало помогает.

---

Набережных С.   (2005-11-16 06:53:00) [22]

> Найди в списке свой серверный процесс

В смысле - сервисный, процесс сервиса.

---

Набережных С.   (2005-11-16 06:52:00) [23]

> EgorovAlex ©

Скомпилируй с отладочной инфой, разреши временно взаимодействие с рабочим столом, расставь точки останова и запусти сервис из компонента консоли.
В Delphi выбери Project/attach to process. Найди в списке свой серверный процесс и подключись к нему. Теперь подключай клиента и смотри, что там делается.

И попутно - а каков сакральный смысл в использовании флага COINIT_MULTITHREADED? Что-то в коде не просматривается...

---

EgorovAlex   (2005-11-15 15:54:00) [24]

Там есть вызов UserInGroupSidStr (я её приводил), a из неё уже вызывается UserInGroup

---

Digitman   (2005-11-15 14:38:00) [25]

я не понял - где в [12] вызов ф-ции UserInGroup() (там где собственно и происходит, судя по твоему тексту, вызов якобы проблемной CoUninitialize) ?

---

EgorovAlex   (2005-11-15 14:12:00) [26]

Точно, чтобы небыло неясностей вот эта процедура:
тут для записи получаем список разрешённых пользователей и групп и после этого проверяем у пользователя разрешения для этой записи:

function CheckPermission(Id: Cardinal; UserName, DomainName: string; var Security: Cardinal): Boolean;
var
 S, S2: TMemoryStream;
 Count, Sec: Cardinal;
 SRec: TSecurityRec;
 I: Integer;
 UserSid: string;
 Found: Boolean;
begin
 Result := False;
 S := TMemoryStream.Create;
 try
   if (DomainName = '') then
     UserSid := UserToSidStr(UserName)
   else
     UserSid := UserToSidStr(DomainName + '\' + UserName);

   GetPermissions(Id, Count, S);
   if (Count = 0) then
   begin
     S.Clear;
     SRec.Name    := UserSid;
     SRec.RecType := SecOwner or SecWrite or SecRead;
     S.Write(SRec, SizeOf(SRec));
     EditPermissions(Id, 1, S);
     Count := 1;
   end;
   S.Position := 0;
   Security := 0;
   Sec := 0;
   Found := False;
   for I := 0 to Count - 1 do
   begin
     S.Read(SRec, SizeOf(SRec));
     Sec := Sec or SRec.RecType;
     if ((SRec.RecType and SecGroup) = 0) then
     begin
       if (UserSid = SRec.Name) then
       begin
         Security := Security or SRec.RecType;
         Result := True;
         Found := True;
       end;
     end
     else
       if UserInGroupSidStr(DomainName, UserName, SRec.Name) then
       begin
         Security := Security or SRec.RecType;
         Result := True;
       end;
   end;
   // åñëè íå íàéäåíî íè îäíîãî âëàäåëüöà
   if (Sec and SecOwner = 0) then
   begin
     if Found then
     begin
       S2 := TMemoryStream.Create;
       try
         S.Position := 0;
         for I := 0 to Count - 1 do
         begin
           S.Read(SRec, SizeOf(SRec));
           if (UserSid = SRec.Name) then
             SRec.RecType := SRec.RecType or SecOwner or SecWrite or SecRead;
           S2.Write(SRec, SizeOf(SRec));
         end;
         EditPermissions(Id, Count, S2);
       finally
         S2.Free;
       end;
     end
     else
     begin
       SRec.Name := UserToSidStr(UserName);
       SRec.RecType := SRec.RecType or SecOwner or SecWrite or SecRead;
       S.Write(SRec, SizeOf(SRec));
       EditPermissions(Id, Count + 1, S);
     end;
   end;
 finally
   S.Free;
 end;
end;


---

Digitman   (2005-11-15 11:38:00) [27]

так ...

и AV-исключение, насколько я понимаю, возникает при исполнении строчки

if CheckPermission(Id, UserName, DomainName, Security) then

?

---

EgorovAlex   (2005-11-15 11:30:00) [28]

Да, там от клиента сервис получает сообщение запрос на проверку вхождения и ему возвращается результат:

procedure TDataThread.ClientExecute;
var
 Msg, Id, ParentId, Count, Mode, Index, Security, Port, cId: Cardinal;
 SS   : TWinSocketStream;
 Rec  : TDataRecord;
 WS, S: TMemoryStream;
 Size : Longint;
 UserName, DomainName, DBPassword, Computer, aLogin, aComputer, Reg: string250;
 MaxSize, Left: Integer;
 Crypt, Client: Boolean;
 S1, S2, S3: string100;

 procedure WriteMsg(Msg: Cardinal);
 begin
   WS.Write(Msg, SizeOf(Msg));
 end;

begin
 SS := TWinSocketStream.Create(ClientSocket, 1200000);
 S := TMemoryStream.Create;
 try
   try
     if ReadBuffer(SS, Msg, SizeOf(Msg), 0) then
     begin
       WS := TMemoryStream.Create;
       // ïîëó÷àåì çàãîëîâîê
       if ReadBuffer(SS, Client, SizeOf(Client), MSG_CONNECT) and
          ReadBuffer(SS, cId, SizeOf(cId), MSG_CONNECT) then
       begin
         // ïîëó÷àåì äàííûå
         case Msg of
           MSG_CHECK_PERMISSION:
             if ReadBuffer(SS, Id, SizeOf(Id), MSG_CHECK_PERMISSION) and
                ReadBuffer(SS, UserName, SizeOf(UserName), MSG_CHECK_PERMISSION) and
                ReadBuffer(SS, DomainName, SizeOf(DomainName), MSG_CHECK_PERMISSION) then
               if CheckPermission(Id, UserName, DomainName, Security) then
               begin
                 WriteMsg(MSG_PERMISSION_CHECKED);
                 WS.Write(Security, SizeOf(Security));
               end
               else
                 WriteMsg(MSG_ERR_CHECK_PERMISSION)
             else
               WriteMsg(MSG_ERR_READ_DATA);
         end;
       end;
       WS.Position := 0;
       ClientSocket.SendStream(WS);
     end;
   except
     WriteErr(20, '');
   end;
 finally
   S.Free;
   SS.Free;
 end;
end;

В CheckPermission есть список пользователей и групп, который проверяется и там используется эта UserInGroupSidStr

---

Digitman   (2005-11-15 11:03:00) [29]

и все эти чудеса, видимо, происходят в контексте TDataThread.ClientExecute ?

---

EgorovAlex   (2005-11-15 10:44:00) [30]

У меня сервис на API написан, ничего особенного, этот код работает уже долго:

program pService;

uses
 Windows, WinSvc, SysUtils, ScktComp, Registry, Classes,
 uThread, uProcs, uRecords, uTypes;

type
 TSvcServerSocket = class(TServerSocket)
   procedure ServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
     var SocketThread: TServerClientThread);
 end;

var
 DispatchTable: array [0..1] of _SERVICE_TABLE_ENTRYA;
 SvcStatus    : SERVICE_STATUS;
 hSvc         : SERVICE_STATUS_HANDLE;

 Port         : Integer;
 ServerSocket : TSvcServerSocket;

procedure TSvcServerSocket.ServerSocketGetThread(Sender: TObject; ClientSocket: TServerClientWinSocket;
 var SocketThread: TServerClientThread);
begin
 try
   SocketThread := TDataThread.Create(False, ClientSocket);
 except
   WriteErr(204, '');
 end;
end;

procedure LoadServerSettings;
begin
 try
   with TRegistry.Create do
   try
     RootKey := HKEY_LOCAL_MACHINE;
     if OpenKey(PMRegPath, True) then
       if ValueExists('Port') then
         Port := ReadInteger('Port')
       else
         Port := DefaultPort;
   finally
     Free;
   end;
 except
   WriteErr(206, '');
 end;
end;

procedure SetSvcStatus(CurrentState, ExitCode, CheckPoint, WaitHint: Cardinal);
begin
 SvcStatus.dwCurrentState  := CurrentState;
 SvcStatus.dwWin32ExitCode := ExitCode;
 SvcStatus.dwCheckPoint    := CheckPoint;
 SvcStatus.dwWaitHint      := WaitHint;
 SetServiceStatus(hSvc, SvcStatus);
end;

procedure ServiceCtrlHandler(Opcode: Cardinal); stdcall;
begin
 case Opcode of
   SERVICE_CONTROL_STOP,
   SERVICE_CONTROL_SHUTDOWN:
     begin
       SetSvcStatus(SERVICE_STOP_PENDING, 0, 1, 2000);
       SetEvent(hStopEvent);
     end;
   SERVICE_CONTROL_INTERROGATE:
     SetSvcStatus(SvcStatus.dwCurrentState, 0, 0, 0);
 end;
end;

procedure ServiceMain(argc: Cardinal; var argv: array of PChar); stdcall;
begin
 hSvc := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);
 if (hSvc <> 0) then
 try
   SvcStatus.dwServiceType             := SERVICE_WIN32;
   SvcStatus.dwControlsAccepted        := SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_SHUTDOWN;
   SvcStatus.dwServiceSpecificExitCode := 0;

   SetSvcStatus(SERVICE_START_PENDING, 0, 1, 2000);
   if CreateStorage then
     LoadRecords
   else
   begin
     WriteErr(72, '');
     Exit;
   end;

   SetSvcStatus(SERVICE_START_PENDING, 0, 2, 2000);
   LoadServerSettings;
   if (RegInfo <> '') then
   begin
     MaxConnections := StrToInt(Copy(RegInfo, 0, Pos(#13#10, RegInfo) - 1));
     RegInfo := Copy(RegInfo, Pos(#13#10, RegInfo) + 2, Length(RegInfo));
   end;

   SetSvcStatus(SERVICE_START_PENDING, 0, 3, 2000);
   try
     ServerSocket := TSvcServerSocket.Create(nil);
     ServerSocket.ServerType  := stThreadBlocking;
     ServerSocket.OnGetThread := ServerSocket.ServerSocketGetThread;
     ServerSocket.Port        := Port;
     ServerSocket.Active      := True;

     SetSvcStatus(SERVICE_RUNNING, 0, 0, 0);
   except
     WriteErr(202, '');
   end;

   hStopEvent := CreateEvent(nil, True, False, nil);
   WaitForSingleObject(hStopEvent, INFINITE);
   CloseHandle(hStopEvent);

   SetSvcStatus(SERVICE_STOP_PENDING, 0, 2, 2000);
   ServerSocket.Free;
   FreeStorage;

   SetSvcStatus(SERVICE_STOP_PENDING, 0, 3, 2000);
   if not BadPassword then
     CopyFile(PChar(DataPath + 'Records.dat'), PChar(DataPath + 'Records.bak'), False);
 finally
   SetSvcStatus(SERVICE_STOPPED, 0, 0, 0);
 end
 else
   WriteErr(70, '');
end;

begin
 LoadGlobalSettings;
 try
   DispatchTable[0].lpServiceName := ServiceName;
   DispatchTable[0].lpServiceProc := @ServiceMain;
   DispatchTable[1].lpServiceName := nil;
   DispatchTable[1].lpServiceProc := nil;

   if not StartServiceCtrlDispatcher(DispatchTable[0]) then
     WriteErr(88, '');
 except
   WriteErr(200, '');
 end;
end.


---

Digitman   (2005-11-15 10:31:00) [31]

приведи полный код обработчиков событий объекта TService OnCreate, onDestroy, OnStart, OnStop, OnExecute

---

EgorovAlex   (2005-11-15 10:26:00) [32]

Нет, я трассировку выполнения кода ставил (после каждой строки кода велась запись в лог файл). При этом если всё оставить как было в самом первом варианте, но закомментировать строку CoUninitialize; то исключение в Proc2 не возникает, но после этого сервис не останавливается.

Вот полный код этих функций: происходит проверка вхождения пользователя в группу (проверяются и все вложенные группы):

function UserInGroup(UserDomain, UserName, GroupDomain, GroupName: WideString): Boolean;
var
 Groups: TStringList;

 procedure GetGroupsForGroup(AdsPath, GroupName: WideString);
 var
   Connection, Command, Res: Variant;
   Group: IADsGroup;
   varMembers: OleVariant;
   varGroup, varType: WideString;
   I, N, L: Integer;
 begin
   if (AdsPath = '') then
   begin
     Connection := CreateOleObject('ADODB.Connection');
     Command := CreateOleObject('ADODB.Command');
     try
       Connection.Provider := 'ADsDSOObject';
       Connection.Open('Active Directory Provider');

       Command.ActiveConnection := Connection;
       Command.Properties('Page Size') := 1000;
       Command.Properties('Searchscope') := ADS_SCOPE_SUBTREE;
       Command.CommandText := 'SELECT distinguishedName FROM ''LDAP://' + UserDomain +
                              ''' WHERE objectCategory=''group'' AND sAMAccountName=''' + GroupName + '''';
       try
         Res := Command.Execute;
         if not Res.EOF then
           AdsPath := Res.Fields[0].Value;
       except
       end;
       Res := NULL;
     finally
       Command := NULL;
       Connection.Close;
       Connection := NULL;
     end;
   end;
   if (AdsPath <> '') then
   try
     ADsGetObject(PWideChar('LDAP://' + AdsPath), IADsGroup, Group);
     varMembers := Group.GetEx('MemberOf');
     for I := 0 to VarArrayHighBound(varMembers, 1) do
     begin
       varGroup := varMembers[I];
       N := Pos('CN=', varGroup);
       Delete(varGroup, 1, N + 2);
       varType := varGroup;
       N := Pos(',', varGroup);
       L := Length(varGroup);
       Delete(varGroup, N, L);
       if (Groups.IndexOf(varGroup) = -1) then
       begin
         Groups.Add(varGroup);
         N := Pos('CN=', varType);
         if (N > 0) then
         begin
           Delete(varType, 1, N + 2);
           N := Pos(',', varType);
           Delete(varType, N, L);
           if not SameText(varType, 'Builtin') then
             GetGroupsForGroup(varMembers[I], '');
         end
         else
           GetGroupsForGroup(varMembers[I], '');
       end;
     end;
   except
   end;
 end;

var
 Enum: IEnumVariant;
 User: IADsUser;
 Group, LGroup: IAdsGroup;
 varMember: OleVariant;
 Temp: LongWord;
 I: Integer;
 ADs: IADs;
 LocalComputer: WideString;
begin
 Result := False;
 try
   CoInitializeEx(nil, COINIT_MULTITHREADED);
   Groups := TStringList.Create;
   try
     LocalComputer := GetLocalHostName;
     if SameText(UserDomain, LocalComputer) then
     begin
       if SameText(GroupDomain, LocalComputer) then
       begin
         ADsGetObject(PWideChar('WinNT://' + UserDomain + '/' + UserName), IADsUser, User);
         Enum := User.Groups._NewEnum as IEnumVariant;
         if Assigned(Enum) then
           while (Enum.Next(1, varMember, Temp) = S_OK) do
           begin
             Group := IDispatch(varMember) as IAdsGroup;
             Groups.Add(Group.Name);
             VariantClear(varMember);
           end;
         for I := 0 to Groups.Count - 1 do
           if SameText(GroupName, Groups[I]) then
           begin
             Result := True;
             Break;
           end;
       end;
     end
     else
     begin
       ADsGetObject(PWideChar('WinNT://' + UserDomain + '/' + UserName), IADsUser, User);
       Enum := User.Groups._NewEnum as IEnumVariant;
       if Assigned(Enum) then
         while (Enum.Next(1, varMember, Temp) = S_OK) do
         try
           Group := IDispatch(varMember) as IAdsGroup;
           Groups.Add(Group.Name);
           GetGroupsForGroup('', Group.Name);
         finally
           VariantClear(varMember);
         end;
       if SameText(GroupDomain, LocalComputer) then
       begin
         ADsGetObject(PWideChar('WinNT://' + GroupDomain + '/' + GroupName), IADsGroup, LGroup);
         Enum := LGroup.Members._NewEnum as IEnumVariant;
         if Assigned(Enum) then
           while (Enum.Next(1, varMember, Temp) = S_OK) do
           try
             ADs := IDispatch(varMember) as IADs;
             if SameText(ADs.Class_, 'User') then
             begin
               User := IDispatch(varMember) as IAdsUser;
               if SameText(UserName, User.Name) then
               begin
                 Result := True;
                 Break;
               end;
             end
             else
             if SameText(ADs.Class_, 'Group') then
             begin
               Group := IDispatch(varMember) as IAdsGroup;
               for I := 0 to Groups.Count - 1 do
                 if SameText(Group.Name, Groups[I]) then
                 begin
                   Result := True;
                   Break;
                 end;
               if Result then
                 Break;
             end;
           finally
             VariantClear(varMember);
           end;
       end
       else
         for I := 0 to Groups.Count - 1 do
           if SameText(GroupName, Groups[I]) then
           begin
             Result := True;
             Break;
           end;
     end;
   finally
     Groups.Free;
     CoUninitialize;
   end;
 except
   WriteErr(0, 'UserInGroup');
 end;
end;

function UserInGroupSidStr(UserDomain, UserName, GroupSidStr: WideString): Boolean;
var
 GroupName, GroupDomain: WideString;
 N: Integer;
begin
 Result := False;
 try
   GroupName := SidStrToUser(GroupSidStr);
   GroupDomain := GroupName;
   N := Pos('\', GroupName);
   if (N > 0) then
   begin
     Delete(GroupName, 1, N);
     Delete(GroupDomain, N, Length(GroupDomain));
     if SameText(GroupDomain, 'BUILTIN') then
       GroupDomain := GetLocalHostName;
     Result := UserInGroup(UserDomain, UserName, GroupDomain, GroupName);
   end;
 except
   WriteErr(0, 'UserInGroupSidStr');
 end;
end;


---

Digitman   (2005-11-15 10:19:00) [33]

значит исключение возникает

procedure Proc2;
begin
try
  ... // <- здесь
  Proc1;
except
  // exception2
end;
end;

---

EgorovAlex   (2005-11-15 10:12:00) [34]

exception1 вообще никогда не возникает

---

Digitman   (2005-11-15 10:09:00) [35]

а exception1 какого класса ?

и как ты обрабатываешь exception1 в случае его возникновения ?

---

EgorovAlex   (2005-11-15 10:02:00) [36]

EAccessViolation

---

Digitman   (2005-11-15 09:41:00) [37]

> возникает исключение exception2


класс исключения какой ?

---

Страницы:   < 1 2 >

Наверх