::: 델파이 Tip&Trick :::

델파이 Tip&Trick 성격에 맞지 않는 광고,비방,질문의 글은 즉시 삭제하며
내용을 복사하여 사용할 경우 반드시 이곳(http://www.howto.pe.kr)을 출처로 명시하여 주세요


Category

  김영대(2008-11-04 11:59:10, Hit : 5699, Vote : 1347
 http://www.howto.pe.kr
 원도우즈 도메인 이름 구하기

unit ADSIHelpers;

interface

uses
   Classes;

function ListAvailableDomains(aList: TStrings): Integer;
function GetCurrentDomain: string;
function ADsValidateUser(const aDomainName, aUsername, aPassword:
WideString): Boolean;
function GetFullyQualifedUsername: string;
function GetComputerName: string;
function GetThreadUserName: string;

implementation

uses
   Windows, SysUtils, Registry, ActiveX;

type
   PWkstaInfo100 = ^TWkstaInfo100;
   _WKSTA_INFO_100 = record
     wki100_platform_id: DWORD;
     wki100_computername: LPWSTR;
     wki100_langroup: LPWSTR;
     wki100_ver_major: DWORD;
     wki100_ver_minor: DWORD;
   end;
   TWkstaInfo100 = _WKSTA_INFO_100;
   WKSTA_INFO_100 = _WKSTA_INFO_100;

   IADs = interface(IDispatch)
     ['{FD8256D0-FD15-11CE-ABC4-02608C9E7553}']
     function  Get_Name: WideString; safecall;
     function  Get_Class_: WideString; safecall;
     function  Get_GUID: WideString; safecall;
     function  Get_ADsPath: WideString; safecall;
     function  Get_Parent: WideString; safecall;
     function  Get_Schema: WideString; safecall;
     procedure GetInfo; safecall;
     procedure SetInfo; safecall;
     function  Get(const bstrName: WideString): OleVariant; safecall;
     procedure Put(const bstrName: WideString; vProp: OleVariant); safecall;
     function  GetEx(const bstrName: WideString): OleVariant; safecall;
     procedure PutEx(lnControlCode: Integer; const bstrName: WideString; vProp: OleVariant); safecall;
     procedure GetInfoEx(vProperties: OleVariant; lnReserved: Integer); safecall;
     property Name: WideString read Get_Name;
     property Class_: WideString read Get_Class_;
     property GUID: WideString read Get_GUID;
     property ADsPath: WideString read Get_ADsPath;
     property Parent: WideString read Get_Parent;
     property Schema: WideString read Get_Schema;
   end;

procedure EnumDomains(List: TStrings);

   procedure EnumFunc(NetResource: PNetResource);
   var
     Enum: THandle;
     Count, BufferSize: DWORD;
     Buffer: array[0..16384 div SizeOf(TNetResource)] of TNetResource;
     i: Integer;
   begin
     if WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, NetResource, Enum) = NO_ERROR then
     try
       Count := $FFFFFFFF;
       BufferSize := SizeOf(Buffer);
       while WNetEnumResource(Enum, Count, @Buffer, BufferSize) = NO_ERROR do
         for i := 0 to Count - 1 do begin
           if Buffer[i].dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN then
             List.Add(Buffer[i].lpRemoteName)
           else if (Buffer[i].dwUsage and RESOURCEUSAGE_CONTAINER) > 0 then
             EnumFunc(@Buffer[i]);
         end;
     finally
       WNetCloseEnum(Enum);
     end;
   end;

begin
   EnumFunc(nil);
end;

function NetWkstaGetInfo(Servername: PChar; Level: Cardinal; out BufPtr:
Pointer): Cardinal; stdcall;
type
   TNetWkstaGetInfo = function(Servername: PChar; Level: Cardinal; out
BufPtr: Pointer): Cardinal; stdcall;
var
   hLib: THandle;
   lNetWkstaGetInfo: TNetWkstaGetInfo;
begin
   Result := ERROR_NOT_SUPPORTED;

   hLib := GetModuleHandle('netapi32.dll');
   if hLib > 0 then begin
     lNetWkstaGetInfo := GetProcAddress(hLib, 'NetWkstaGetInfo');

     if Assigned(lNetWkstaGetInfo) then
       Result := lNetWkstaGetInfo(Servername, Level, BufPtr);
   end;
end;

function _GetCurrentDomain: string;
var
   Reg: TRegistry;
   pWI: PWkstaInfo100;
begin
   Result := '';

   if Win32Platform = VER_PLATFORM_WIN32_NT then begin
     if NetWkstaGetInfo(nil, 100, Pointer(pWI)) = 0 then
       Result := string(pWI.wki100_langroup);
   end else begin
     Reg := TRegistry.Create(KEY_READ);
     try
       Reg.RootKey := HKEY_LOCAL_MACHINE;
       if Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\MSNP32\NetworkProvider') then begin
         if Reg.ValueExists('AuthenticatingAgent') then
           Result := Reg.ReadString('AuthenticatingAgent');
         Reg.CloseKey;
       end;

       if (Result = '') and Reg.OpenKeyReadOnly('\System\CurrentControlSet\Services\VXD\VNETSUP') then begin
         if Reg.ValueExists('Workgroup') then
           Result := Reg.ReadString('Workgroup');
         Reg.CloseKey;
       end;
     finally
       Reg.Free;
     end;
   end;
end;

function ListAvailableDomains(AList: TStrings): Integer;
var
   Current: string;
begin
   AList.Clear;

   try
     EnumDomains(AList);
   except
   end;

   Current := GetCurrentDomain;

   if Current <> '' then begin
     Result := AList.IndexOf(Current);
     if Result = -1 then // shouldn't happen, but just in case
       Result := AList.Add(Current);
   end else
     Result := -1;
end;

function GetCurrentDomain: string;
begin
   try
     Result := _GetCurrentDomain;
   except
     Result := '';
   end;
end;

function ADsValidateUser(const aDomainName, aUsername, aPassword:
WideString): Boolean;
const
   ADsLibName = 'activeds.dll';
   ADS_SECURE_AUTHENTICATION = $00000001;
type
   TADsOpenObject = function (
     lpszPathName: PWideChar;
     lpszUserName: PWideChar;
     lpszPassword: PWideChar;
     dwReserved: DWORD;
     const riid: TGUID;
     out pObject
   ): HRESULT; stdcall;
var
   hLib: THandle;
   lADsOpenObject: TADsOpenObject;
   Obj: IADs;
   Ret: HRESULT;
begin
   Result := False;

   hLib := LoadLibrary(PChar(ADsLibName));
   if hLib = 0 then
     raise Exception.CreateFmt('Unable to load required library %s.', [ADsLibName]);
   try
     lADsOpenObject := GetProcAddress(hLib, 'ADsOpenObject');
     if not Assigned(lADsOpenObject) then
       raise Exception.Create('Unable to find required ADSI api.');

     CoInitialize(nil);
     try
       Ret := lADsOpenObject(
         PWideChar('LDAP://' + aDomainName),
         PWideChar(aUsername),
         PWideChar(aPassword),
         ADS_SECURE_AUTHENTICATION,
         IADs,
         Obj
       );
       Obj := nil;

       Result := Succeeded(Ret);
     finally
       CoUninitialize;
     end;
   finally
     FreeLibrary(hLib);
   end;
end;

function GetComputerName: string;
var
   Buffer: PChar;
   BufferSize: DWORD;
begin
   BufferSize := MAX_COMPUTERNAME_LENGTH + 1;
   Buffer := AllocMem(BufferSize);
   try
     Windows.GetComputerName(Buffer, BufferSize);
     Result := string(Buffer);
   finally
     FreeMem(Buffer);
   end;
end;

function GetThreadUserName: string;
var
   Buffer: PChar;
   BufferSize: DWORD;
begin
   BufferSize := 128;
   Buffer := AllocMem(BufferSize);
   try
     Windows.GetUserName(Buffer, BufferSize);
     Result := string(Buffer);
   finally
     FreeMem(Buffer);
   end;
end;

function GetFullyQualifedUsername: string;
type
   TGetUserNameEx = function (NameFormat: Integer; lpNameBuffer: PChar; var nSize: Cardinal): LongBool; stdcall;
const
   NAME_SAM_COMPATIBLE = 2;
   SecurLib = 'secur32.dll';
var
   Buffer: PChar;
   BufferSize: DWORD;
   lGetUserNameEx: TGetUserNameEx;
   hLib: THandle;
   I: Integer;
begin
   Result := '';

   lGetUserNameEx := nil;
   hLib := LoadLibrary(PChar(SecurLib));
   if hLib > 0 then
     lGetUserNameEx := GetProcAddress(hLib, 'GetUserNameExA'); // this only exists in Win2k+

   if (hLib > 0) and Assigned(lGetUserNameEx) then begin
     // use provided api to retrieve formatted name
     try
       BufferSize := 128;
       Buffer := AllocMem(BufferSize);
       try
         for I := 1 to 2 do // maximum 2 attempts
           if not lGetUserNameEx(NAME_SAM_COMPATIBLE, Buffer, BufferSize) then begin
             if (GetLastError = ERROR_MORE_DATA) then
               ReallocMem(Buffer, BufferSize)
             else
               Break;
           end;

         Result := string(Buffer);
       finally
         FreeMem(Buffer);
       end;
     finally
       FreeLibrary(hLib);
     end;
   end else
     Result := GetComputerName + '\' + GetThreadUserName;
end;

end.





971   [윈도우즈 API] 작업 표시줄에 보이는 프로그램의 아이콘 정보  김영대 2008/12/09 5960 1438
970   [윈도우즈 API] 실행 파일의 아이콘 바꾸기  김영대 2008/11/27 7460 1382
969   [네트웍/인터넷] TClientSocket 에 Local IP 바인딩하기  김영대 2008/11/25 6254 1502
968   [알고리즘] Boyer-Moore-Horspool Text Searching  김영대 2008/11/24 5012 1349
967   [일반/컴포넌트] Tab, Shift+Tab 키 이벤트 사용하기  김영대 2008/11/21 4888 1386
966   [일반/컴포넌트] TStringList vs. THashedStringList  김영대 2008/11/04 5199 1371
965   [시스템] 프로세스가 원도우즈 원격 터미널에서 실행중인지 검사  김영대 2008/11/04 5175 1477
  [시스템] 원도우즈 도메인 이름 구하기  김영대 2008/11/04 5699 1347
963   [시스템] 사용중인 USB 포트의 장치정보 구하기  김영대 2008/11/04 11664 1459
962   [일반/컴포넌트] Treeview의 수평 스크롤바 감추고 스크롤 막기  김영대 2006/03/22 5429 1235
961   [윈도우즈 API] 바탕화면의 모든 창 최소화하기  김영대 2006/02/28 5371 1286
960   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageBox  김영대 2006/02/28 6411 1599
959   [시스템] System의 Idle 상태를 알아내는 API  김영대 2006/02/28 6043 1441
958   [일반/컴포넌트] ListBox에 Edit 올려 항목 편집하기  김영대 2006/02/28 4759 1206
957   [일반/컴포넌트] 폼 흔들기  김영대 2006/02/28 5228 1194
956   [일반/컴포넌트] 마우스로 ProgressBar의 Position 바꾸기  김영대 2006/02/28 4806 1249
955   [일반/컴포넌트] ListBox 드래그하여 아이템 이동하기  김영대 2006/02/28 4853 1181
954   [시스템] 폼의 Move/Resize 시작,종료 이벤트 감지하기  김영대 2006/02/28 5140 1354
953   [COM/OLE] IE의 속성을 변경하여 뛰우기  김영대 2006/02/28 5224 1226
952   [윈도우즈 API] 세로 글꼴 제거한 FontDialog  김영대 2006/02/28 5127 1344
951   [시스템] CPU 이름 구하기2  김영대 2005/09/13 5597 1343
950   [네트웍/인터넷] IP Helper API 를 이용한 네트워크 카드 Enable/Disable 시키기  김영대 2005/09/10 6019 1314
949   [일반/컴포넌트] 폼에 자석효과 주기 (Delphi 6 이하)  김영대 2005/08/04 5963 1292
948   [일반/컴포넌트] 객체의 valid검사 Assigned() 대체  김영대 2005/07/29 4718 1246
947   [시스템] 시스템 대기모드/화면 보호기/모니터 끄기 이벤트 감지하기  김영대 2005/07/21 6753 1482
946   [시스템] 윈도우즈 GUI 기본 폰트정보 구하기  김영대 2005/07/14 5429 1346
945   [시스템] 윈도우즈 입력도구모음의 한/영 토글하기  김영대 2005/06/24 5219 1372
944   [COM/OLE] ActiveForm의 OnDestroy 대용  김영대 2005/04/21 5238 1226
943   [일반/컴포넌트] ListView의 타이틀 폰트 바꾸기  김영대 2005/03/31 5153 1233
942   [일반/컴포넌트] 일정시간 경과후 없어지는 MessageDlg/ShowMessage  김영대 2005/03/26 5821 1268
941   [일반/컴포넌트] 프로그램의 bitmap을 MS 그림판으로 편집하여 다시 불러오기  김영대 2005/03/22 5153 1323
940   [일반/컴포넌트] RichEdit 2.0 줄간격 조정  김영대 2005/02/11 7192 1270
939   [COM/OLE] 탐색기에서 파일을 선택하여 ActiveX(ActiveFortm)에 Drag&Drop 하기  김영대 2005/01/06 7530 1267
938   [윈도우즈 API] TDownloadURL를 사용한 파일 다운받기  김영대 2004/12/26 6366 1262
937   [COM/OLE] TWebBrowser에 직접 HTML 소스코드 넣기  김영대 2004/12/26 6018 1266
936   [윈도우즈 API] 윈도우즈 시스템 전체에서 사용자의 마우스와 키보드 입력이 있는지 검사하기  김영대 2004/12/26 6038 1350
935   [일반/컴포넌트] 다이얼로그 박스가 이미 떠있는지 검사하여 강제로 닫기  김영대 2004/12/22 5031 1212
934   [윈도우즈 API] URLDownloadToFile()를 사용한 파일 다운받기  김영대 2004/12/15 7615 1383
933   [COM/OLE] 내 프로그램에서 선택한 text를 다른 프로그램에 Drag&Drop으로 주기  김영대 2004/12/10 5360 1099
932   [COM/OLE] 다른 프로그램에서 선택한 text를 내 프로그램에서 Drag&Drop으로 받기  김영대 2004/12/09 5503 1206

1 [2][3][4][5][6][7][8][9][10]..[25] [다음 10개]
 

Copyright 1999-2017 Zeroboard / skin by zero