線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:1416
推到 Plurk!
推到 Facebook!

如何獲取網域

答題得分者是:christie
chhy515
一般會員


發表:3
回覆:9
積分:2
註冊:2008-08-27

發送簡訊給我
#1 引用回覆 回覆 發表時間:2009-07-23 10:43:30 IP:221.224.xxx.xxx 訂閱
vb里可以通過ActiveDs獲取公司的網域:
Dim aa As New ActiveDs.ADSystemInfo

DomainName = aa.DomainDNSName

在delphi里已經將activeds library引入了,可不知道如何使用!望各位不吝賜教!
christie
資深會員


發表:30
回覆:299
積分:475
註冊:2005-03-25

發送簡訊給我
#2 引用回覆 回覆 發表時間:2009-07-24 09:51:33 IP:59.125.xxx.xxx 未訂閱
ADD A Button, ADD A ListBox
unit GetDomainU;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ListBox1: TListBox;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
TlHelp32;
{$R *.dfm}
type
PTOKEN_USER = ^TOKEN_USER;
_TOKEN_USER = record
User: TSidAndAttributes;
end;
TOKEN_USER = _TOKEN_USER;
function GetUserAndDomainFromPID(ProcessId: DWORD;
var User, Domain: string): Boolean;
var
hToken: THandle;
cbBuf: Cardinal;
ptiUser: PTOKEN_USER;
snu: SID_NAME_USE;
ProcessHandle: THandle;
UserSize, DomainSize: DWORD;
bSuccess: Boolean;
begin
Result := False;
ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessId);
if ProcessHandle <> 0 then
begin
// EnableProcessPrivilege(ProcessHandle, 'SeSecurityPrivilege', True);
if OpenProcessToken(ProcessHandle, TOKEN_QUERY, hToken) then
begin
bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf);
ptiUser := nil;
while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do
begin
ReallocMem(ptiUser, cbBuf);
bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf);
end;
CloseHandle(hToken);
if not bSuccess then
begin
Exit;
end;
UserSize := 0;
DomainSize := 0;
LookupAccountSid(nil, ptiUser.User.Sid, nil, UserSize, nil, DomainSize, snu);
if (UserSize <> 0) and (DomainSize <> 0) then
begin
SetLength(User, UserSize);
SetLength(Domain, DomainSize);
if LookupAccountSid(nil, ptiUser.User.Sid, PChar(User), UserSize,
PChar(Domain), DomainSize, snu) then
begin
Result := True;
User := StrPas(PChar(User));
Domain := StrPas(PChar(Domain));
end;
end;
if bSuccess then
begin
FreeMem(ptiUser);
end;
end;
CloseHandle(ProcessHandle);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
hProcSnap: THandle;
pe32: TProcessEntry32;
Domain, User: string;
s: string;
begin
hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPALL, 0);
if hProcSnap = INVALID_HANDLE_VALUE then Exit;
pe32.dwSize := SizeOf(ProcessEntry32);
if Process32First(hProcSnap, pe32) = True then
while Process32Next(hProcSnap, pe32) = True do
begin
if GetUserAndDomainFromPID(pe32.th32ProcessID, User, Domain) then
begin
s := Format('%s User: %s ; Domain: %s',[StrPas(pe32.szExeFile), User, Domain]);
Listbox1.Items.Add(s);
end else
Listbox1.Items.Add(StrPas(pe32.szExeFile));
end;
CloseHandle(hProcSnap);
end;
end.

------
What do we live for if not to make life less difficult for each other?
chhy515
一般會員


發表:3
回覆:9
積分:2
註冊:2008-08-27

發送簡訊給我
#3 引用回覆 回覆 發表時間:2009-07-24 11:17:27 IP:221.224.xxx.xxx 訂閱
謝謝回覆!我試了下,是可以的!我找到一種通過注冊表獲取的方法更簡便!
uses Registry;

function TForm1.Get_LAN():string;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
Reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon');
Result := Reg.ReadString('DefaultDomainName');
Reg.CloseKey;
Reg.Destroy;
end;
系統時間:2024-05-17 2:16:02
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!