如何检查计算机是否为Win2000下的合法用户(100分)

用Delphi编程，检查一客户机是否是Win2K服务器上合法用户
（即用户名、密码能通过Win2K验证）

等待高人

高人快现身！

补充一下：由于在MTS服务器端使用Win2K服务器，若客户端使用无效的户名/密码，
则无法自动断开与MTS组件的连接，有什么办法？？？？

我只知道 w2k用户可以使用ipc$ 管道进行登录进行判断...不知道怎么实现 -_-

好象论坛(这里)有人用过delphi写过一个通过ipc$扫描NT用户的程序...

扫描NT用户很容易。用NetLocalGroupEnum,NetLocalGroupGetMembers就行了。
不过问题我没看明白，非法用户怎么登陆服务器？

看不明白这个问题说的是什么？

To NowCan: API？这两个函数是API函数?怎么调用？
To NowCan & Seagod07: 也就是说在客户端上登录网络时，
其用户名/密码可以通过Win2K服务器验证

WNetAddConnection2 这个可以。
DWORD WNetAddConnection2(
LPNETRESOURCE lpNetResource, // points to structure that specifies connection details
LPCTSTR lpPassword, // points to password string
LPCTSTR lpUsername, // points to user name string
DWORD dwFlags // set of bit flags that specify connection options
);

补充说明：是在广域网上！

广域网啊，不知道啦。

function IsAdmin: Boolean;var hAccessToken: THandle; ptgGroups: PTokenGroups; dwInfoBufferSize: DWORD; psidAdministrators: PSID; x: Integer; bSuccess: BOOL;begin Result := False; bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True, hAccessToken); if not bSuccess then begin if GetLastError = ERROR_NO_TOKEN then bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hAccessToken); end; if bSuccess then begin GetMem(ptgGroups, 1024); bSuccess := GetTokenInformation(hAccessToken, TokenGroups, ptgGroups, 1024, dwInfoBufferSize); CloseHandle(hAccessToken); if bSuccess then begin AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdministrators); {$R-} for x := 0 to ptgGroups.GroupCount - 1 do if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then begin Result := True; Break; end; {$R+} FreeSid(psidAdministrators); end; FreeMem(ptgGroups); end;end; procedure TForm1.Button1Click(Sender: TObject);begin if isAdmin then ShowMessage('Logged in as Administrator');end;

关注！

孤岛的代码能不能排版啊

帮你up

{
Code By Jingtao.2002,10.12.
This Delphi program is use the Windows Api+Res File Build,So Small!
lovejingtao@21cn.com
}
program SSPI;

uses
Windows,Messages,Sysutils,SSPIValidatePassword;

{$R Script1.res}

const
ID_DOMAIN = 10001;
ID_USER = 10002;
ID_PASSWORD = 10003;
ID_VERFIY = 10004;
ID_Exit = 10005;
MyAppName ='用户验证程序';
var
MainWin: HWND;

function My_Gettext(UIID:integer): string;
var
Textlength: Integer;
Text: PChar;
s: string;
begin
TextLength := GetWindowTextLength(GetDlgItem(MainWin, UIID));
GetMem(Text, TextLength + 1);
GetWindowText(GetDlgItem(MainWin, UIID), Text, TextLength + 1);
s := text;
FreeMem(Text, TextLength + 1);
Result := s;
end;
function ComputerName : String;
var
CNameBuffer : PChar;
fl_loaded : Boolean;
CLen : ^DWord;
begin
GetMem(CNameBuffer,255);
New(CLen);
CLen^:= 255;
fl_loaded := GetComputerName(CNameBuffer,CLen^);
if fl_loaded then
ComputerName := StrPas(CNameBuffer)
else
ComputerName := '不知道!';
FreeMem(CNameBuffer,255);
Dispose(CLen);
end;


function MainDialogProc(
DlgWin: hWnd;
DlgMessage: UINT;
DlgWParam: WPARAM;
DlgLParam: LPARAM
)
: integer; stdcall;
var
MyIcon: HICON;

begin
Result := 0;
case DlgMessage of
WM_INITDIALOG:
begin
MyIcon := LoadIcon(hInstance, 'MainIcon');
SetClassLONG(DlgWin, GCL_HICON, MyIcon);
MainWin := DlgWin;

SendMessage(GetDlgItem(MainWin, ID_DOMAIN), WM_SETTEXT, 0, lParam(pChar(ComputerName)));
SetFocus(GetDlgItem(MainWin, ID_USER));
end;
WM_Close:
begin
PostQuitMessage(0);
Exit;
end;
WM_COMMAND:
case LOWORD(DlgWParam) of

ID_VERFIY:
begin
if (Trim(My_Gettext(ID_DOMAIN))='')or (Trim(My_Gettext(ID_USER))='')then
begin
MessageBox(MainWin,Pchar('主机名称,用户名称不能为空,请重新输入!'),MyAppName,MB_ICONERROR);
SetFocus(GetDlgItem(MainWin, ID_USER));
Exit;
end;
if SSPLogonUser(Trim(My_Gettext(ID_DOMAIN)),Trim(My_Gettext(ID_USER)),Trim(My_Gettext(ID_PASSWORD))) then
MessageBox(MainWin,Pchar('用户名,密码验证成功,或者Guest用户被设置为允许访问!'),MyAppName,MB_ICONINFORMATION)
else
MessageBox(MainWin,Pchar('用户名,密码验证失败!'),MyAppName,MB_ICONERROR);
end;
ID_Exit:
begin
PostQuitMessage(0);
Exit;
end;
end;
end;
end;
begin
DialogBox(hInstance, 'MAINFORM', 0, @MainDialogProc);
end.
//------------------------------------------------------------------
unit SSPIValidatePassword;

interface

uses Windows, SysUtils;

function SSPLogonUser (const DomainName, UserName, Password : string) : boolean;

implementation

const

//---------------------------------------------------------------------
// Define SSPI constants

SEC_WINNT_AUTH_IDENTITY_ANSI = $01;
SECPKG_CRED_INBOUND = $00000001;
SECPKG_CRED_OUTBOUND = $00000002;
SECPKG_CRED_BOTH = $00000003;
SECPKG_CRED_DEFAULT = $00000004;
SECPKG_CRED_RESERVED = $F0000000;

SECBUFFER_VERSION = 0;

SECBUFFER_EMPTY = 0; // Undefined, replaced by provider
SECBUFFER_DATA = 1; // Packet data
SECBUFFER_TOKEN = 2; // Security token
SECBUFFER_PKG_PARAMS = 3; // Package specific parameters
SECBUFFER_MISSING = 4; // Missing Data indicator
SECBUFFER_EXTRA = 5; // Extra data
SECBUFFER_STREAM_TRAILER = 6; // Security Trailer
SECBUFFER_STREAM_HEADER = 7; // Security Header
SECBUFFER_NEGOTIATION_INFO = 8; // Hints from the negotiation pkg
SECBUFFER_PADDING = 9; // non-data padding
SECBUFFER_STREAM = 10; // whole encrypted message

SECBUFFER_ATTRMASK = $F0000000;
SECBUFFER_READONLY = $80000000; // Buffer is read-only
SECBUFFER_RESERVED = $40000000;

SECURITY_NATIVE_DREP = $00000010;
SECURITY_NETWORK_DREP = $00000000;

SEC_I_CONTINUE_NEEDED = $00090312;
SEC_I_COMPLETE_NEEDED = $00090313;
SEC_I_COMPLETE_AND_CONTINUE = $00090314;

//---------------------------------------------------------------------
// Define SSPI types

type

TSecWinntAuthIdentity = packed record
User : PChar;
UserLength : DWORD;
Domain : PChar;
DomainLength : DWORD;
Password : PChar;
PasswordLength : DWORD;
Flags : DWORD
end;
PSecWinntAuthIdentity = ^TSecWinntAuthIdentity;

TSecHandle = packed record
dwLower : DWORD;
dwUpper : DWORD
end;
PSecHandle = ^TSecHandle;

TSecBuffer = packed record
cbBuffer : DWORD;
BufferType : DWORD; // Type of the buffer (below)
pvBuffer : pointer;
end;
PSecBuffer = ^TSecBuffer;

TSecBufferDesc = packed record
ulVersion,
cBuffers : DWORD; // Number of buffers
pBuffers : PSecBuffer
end;
PSecBufferDesc = ^TSecBufferDesc;

TCredHandle = TSecHandle;
PCredHandle = PSecHandle;

TCtxtHandle = TSecHandle;
PCtxtHandle = PSecHandle;

TAuthSeq = packed record
_fNewConversation : BOOL;
_hcred : TCredHandle;
_fHaveCredHandle : BOOL;
_fHaveCtxtHandle : BOOL;
_hctxt : TSecHandle;
end;
PAuthSeq = ^TAuthSeq;

PNode = ^TNode;
TNode = record
dwKey : DWORD;
pData : pointer;
pNext : PNode
end;

TSecPkgInfo = record
fCapabilities : DWORD; // Capability bitmask
wVersion : WORD; // Version of driver
wRPCID : WORD; // ID for RPC Runtime
cbMaxToken : DWORD; // Size of authentication token (max)
Name : PChar;
Comment : PChar; // Comment
end;
PSecPkgInfo = ^TSecPkgInfo;

TSecurityStatus = LongInt;

ENUMERATE_SECURITY_PACKAGES_FN_A = function (var cPackages : DWORD; var PackageInfo : PSecPkgInfo) : TSecurityStatus; stdcall;
QUERY_SECURITY_PACKAGE_INFO_FN_A = function (packageName : PChar; var info : PSecPkgInfo) : TSecurityStatus; stdcall;
QUERY_CREDENTIALS_ATTRIBUTES_FN_A = function (phCredential : pCredHandle; ulAttribute : DWORD; buffer : pointer) : TSecurityStatus; stdcall;
EXPORT_SECURITY_CONTEXT_FN = function (hContext : pCtxtHandle; flags : DWORD; pPackedContext : PSecBuffer; var token : pointer) : TSecurityStatus;
SEC_GET_KEY_FN = procedure (Arg, Principal : pointer; KeyVer : DWORD; var Key : pointer; var status : TSecurityStatus);

ACQUIRE_CREDENTIALS_HANDLE_FN_A = function (
pszPrincipal : PChar;
pszPackage : PChar;
fCredentialUse : DWORD;
pvLogonID : pointer;
pAuthData : pointer;
pGetKeyFn : SEC_GET_KEY_FN;
pvGetKeyArgument : pointer;
var phCredential : TCredHandle;
var ptsExpiry : TTimeStamp) : TSecurityStatus; stdcall;

FREE_CREDENTIALS_HANDLE_FN = function (credHandle : PCredHandle) : TSecurityStatus; stdcall;

INITIALIZE_SECURITY_CONTEXT_FN_A = function (
phCredential : PCredHandle;
phContent : PCtxtHandle;
pszTargetName : PChar;
fContextReq,
Reserved1,
TargetDataRep : DWORD;
pInput : PSecBufferDesc;
Reserved2 : DWORD;
phNewContext : PCtxtHandle;
pOutput : PSecBufferDesc;
var pfContextAttr : DWORD;
var ptsExpiry : TTimeStamp) : TSecurityStatus; stdcall;

ACCEPT_SECURITY_CONTEXT_FN = function (
phCredential : PCredHandle;
phContext : PCtxtHandle;
pInput : PSecBufferDesc;
fContextReq,
TargetDataRep : DWORD;
phNewContext : PCtxtHandle;
pOutput : PSecBufferDesc;
var pfContextAttr : DWORD;
var ptsExpiry : TTimeStamp) : TSecurityStatus; stdcall;

COMPLETE_AUTH_TOKEN_FN = function (phContext : PCtxtHandle; pToken : PSecBufferDesc) : TSecurityStatus; stdcall;
DELETE_SECURITY_CONTEXT_FN = function (phContext : PCtxtHandle) : TSecurityStatus; stdcall;
APPLY_CONTROL_TOKEN_FN = function (phContext : PCtxtHandle; pInput : PSecBufferDesc) : TSecurityStatus; stdcall;
QUERY_CONTEXT_ATTRIBUTES_FN_A = function (phContext : PCtxtHandle; alAttribute : DWORD; pBuffer : pointer) : TSecurityStatus; stdcall;
IMPERSONATE_SECURITY_CONTEXT_FN = function (phContext : PCtxtHandle) : TSecurityStatus; stdcall;
REVERT_SECURITY_CONTEXT_FN = function (phContext : PCtxtHandle) : TSecurityStatus; stdcall;
MAKE_SIGNATURE_FN = function (phContext : PCtxtHandle; fQOP : DWORD; pMessage : PSecBufferDesc; MessageSeqNo : DWORD) : TSecurityStatus; stdcall;
VERIFY_SIGNATURE_FN = function (phContext : PCtxtHandle; pMessage : PSecBufferDesc; MessageSeqNo : DWORD; var fQOP : DWORD) : TSecurityStatus; stdcall;
FREE_CONTEXT_BUFFER_FN = function (contextBuffer : pointer) : TSecurityStatus; stdcall;
IMPORT_SECURITY_CONTEXT_FN_A = function (pszPackage : PChar; pPackedContext : PSecBuffer; Token : pointer; phContext : PCtxtHandle) : TSecurityStatus; stdcall;

ADD_CREDENTIALS_FN_A = function (
hCredentials : PCredHandle;
pszPrincipal,
pszPackage : PChar;
fCredentialUse : DWORD;
pAuthData : pointer;
pGetKeyFn : SEC_GET_KEY_FN;
pvGetKeyArgument : pointer;
var ptsExpiry : TTimeStamp) : TSecurityStatus; stdcall;

QUERY_SECURITY_CONTEXT_TOKEN_FN = function (phContext : PCtxtHandle; var token : pointer) : TSecurityStatus; stdcall;
ENCRYPT_MESSAGE_FN = function (phContext : PCtxtHandle; fQOP : DWORD; pMessage : PSecBufferDesc; MessageSeqNo : DWORD) : TSecurityStatus; stdcall;
DECRYPT_MESSAGE_FN = function (phContext : PCtxtHandle; pMessage : PSecBufferDesc; MessageSeqNo : DWORD; fQOP : DWORD) : TSecurityStatus; stdcall;

TSecurityFunctionTable = record
dwVersion : LongInt;
EnumerateSecurityPackagesA : ENUMERATE_SECURITY_PACKAGES_FN_A;
QueryCredentialsAttributesA : QUERY_CREDENTIALS_ATTRIBUTES_FN_A;
AcquireCredentialsHandleA : ACQUIRE_CREDENTIALS_HANDLE_FN_A;
FreeCredentialHandle : FREE_CREDENTIALS_HANDLE_FN;
Reserved2 : FARPROC;
InitializeSecurityContextA : INITIALIZE_SECURITY_CONTEXT_FN_A;
AcceptSecurityContext : ACCEPT_SECURITY_CONTEXT_FN;
CompleteAuthToken : COMPLETE_AUTH_TOKEN_FN;
DeleteSecurityContext : DELETE_SECURITY_CONTEXT_FN;
ApplyControlToken : APPLY_CONTROL_TOKEN_FN;
QueryContextAttributesA : QUERY_CONTEXT_ATTRIBUTES_FN_A;
ImpersonateSecurityContext : IMPERSONATE_SECURITY_CONTEXT_FN;
RevertSecurityContext : REVERT_SECURITY_CONTEXT_FN;
MakeSignature : MAKE_SIGNATURE_FN;
VerifySignature : VERIFY_SIGNATURE_FN;
FreeContextBuffer : FREE_CONTEXT_BUFFER_FN;
QuerySecurityPackageInfoA : QUERY_SECURITY_PACKAGE_INFO_FN_A;
Reserved3 : FARPROC;
Reserved4 : FARPROC;
ExportSecurityContext : EXPORT_SECURITY_CONTEXT_FN;
ImportSecurityContextA : IMPORT_SECURITY_CONTEXT_FN_A;
AddCredentialsA : ADD_CREDENTIALS_FN_A;
Reserved8 : FARPROC;
QuerySecurityContextToken : QUERY_SECURITY_CONTEXT_TOKEN_FN;
EncryptMessage : ENCRYPT_MESSAGE_FN;
DecryptMessage : DECRYPT_MESSAGE_FN;
end;
PSecurityFunctionTable = ^TSecurityFunctionTable;

const
head : TNode = (dwKey:$ffffffff; pData:Nil; pNext:Nil); // List of RPC entries

(*----------------------------------------------------------------------*
| function GetEntry : boolean |
| |
| Get entry in RPC list |
*----------------------------------------------------------------------*)
function GetEntry (dwKey : DWORD; var pData : pointer) : boolean;
var
pCurrent : PNode;
begin
result := False;
pCurrent := Head.pNext;
while Assigned (pCurrent) do
begin
if pCurrent^.dwKey = dwKey then
begin
pData := pCurrent^.pData;
result := True;
break
end;

pCurrent := pCurrent^.pNext
end
end;

(*----------------------------------------------------------------------*
| function AddEntry : boolean |
| |
| Add entry to RPC list |
*----------------------------------------------------------------------*)
function AddEntry (dwKey : DWORD; pData : pointer) : boolean;
var
pTemp : PNode;

begin
GetMem (pTemp, sizeof (TNode));
if Assigned (pTemp) then
begin
pTemp^.dwKey := dwKey;
pTemp^.pData := pData;
pTemp^.pNext := Head.pNext;
Head.pNext := pTemp;

result := True
end
else
result := False
end;

(*----------------------------------------------------------------------*
| function DeleteEntry : boolean |
| |
| Delete entry from RPC list |
*----------------------------------------------------------------------*)
function DeleteEntry (dwKey : DWORD; var ppData : pointer) : boolean;
var
pCurrent, pTemp : PNode;

begin
result := False;
pTemp := @head;
pCurrent := Head.pNext;

while pCurrent <> Nil do
begin
if dwKey = pCurrent^.dwKey then
begin
pTemp^.pNext := pCurrent^.pNext;
ppData := pCurrent^.pData;
FreeMem (pCurrent);
result := True;
break
end
else
begin
pTemp := pCurrent;
pCurrent := pCurrent^.pNext
end
end
end;

(*----------------------------------------------------------------------*
| InitSession |
| |
| Initialize RPC session |
*----------------------------------------------------------------------*)
function InitSession (dwKey : DWORD) : boolean;
var
pAS : PAuthSeq;
begin
result := False;
GetMem (pAS, sizeof (TAuthSeq));

if Assigned (pAS) then
try
pAS^._fNewConversation := TRUE;
pAS^._fHaveCredHandle := FALSE;
pAS^._fHaveCtxtHandle := FALSE;

if not AddEntry (dwKey, pAS) then
FreeMem (pAS)
else
result := True
except
FreeMem (pAS);
raise
end
end;

(*----------------------------------------------------------------------*
| InitPackage |
| |
| Initialize the NTLM security package |
*----------------------------------------------------------------------*)
function InitPackage (var cbMaxMessage : DWORD; var funcs : PSecurityFunctionTable) : THandle;
type
INIT_SECURITY_ENTRYPOINT_FN_A = function : PSecurityFunctionTable;
var
pInit : INIT_SECURITY_ENTRYPOINT_FN_A;
ss : TSecurityStatus;
pkgInfo : PSecPkgInfo;

begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
result := LoadLibrary ('security.dll')
else
result := LoadLibrary ('Secur32.dll');

if result <> 0 then
try
pInit := GetProcAddress (result, 'InitSecurityInterfaceA');

if not Assigned (pInit) then
raise Exception.CreateFmt ('Couldn''t get sec init routine: %d', [GetLastError]);

funcs := pInit;

if not Assigned (funcs) then
raise Exception.Create ('Couldn''t init package');

ss := funcs^.QuerySecurityPackageInfoA ('NTLM', pkgInfo);
if ss < 0 then
raise Exception.CreateFmt ('Couldn''t query package info for NTLM, error %d/n', [ss]);

cbMaxMessage := pkgInfo^.cbMaxToken;

funcs^.FreeContextBuffer (pkgInfo)
except
if result <> 0 then
FreeLibrary (result);
raise
end
end;

(*----------------------------------------------------------------------*
| GenClientContext |
*----------------------------------------------------------------------*)
function GenClientContext (
funcs : PSecurityFunctionTable;
dwKey : DWORD;
Auth : PSecWINNTAuthIdentity;
pIn : PBYTE;
cbIn : DWORD;
pOut : PBYTE;
var cbOut : DWORD;
var fDone : boolean) : boolean;
var
ss : TSecurityStatus;
lifeTime : TTimeStamp;
OutBuffDesc : TSecBufferDesc;
OutSecBuff : TSecBuffer;
InBuffDesc : TSecBufferDesc;
InSecBuff : TSecBuffer;
ContextAttributes : DWORD;
pAS : PAuthSeq;
phctxt : PCtxtHandle;
pBuffDesc : PSecBufferDesc;

begin
result := False;
if GetEntry (dwKey, pointer (pAS)) then
try
if pAS^._fNewConversation then
begin
ss := funcs^.AcquireCredentialsHandleA (
Nil, // principal
'NTLM',
SECPKG_CRED_OUTBOUND,
Nil, // LOGON id
Auth, // auth data
Nil, // get key fn
Nil, // get key arg
pAS^._hcred,
Lifetime
);

if ss < 0 then
raise Exception.CreateFmt ('AquireCredentials failed %d', [ss]);

pAS^._fHaveCredHandle := TRUE
end;

OutBuffDesc.ulVersion := 0;
OutBuffDesc.cBuffers := 1;
OutBuffDesc.pBuffers := @OutSecBuff;

OutSecBuff.cbBuffer := cbOut;
OutSecBuff.BufferType := SECBUFFER_TOKEN;
OutSecBuff.pvBuffer := pOut;

// prepare input buffer
//

if not pAS^._fNewConversation then
begin
InBuffDesc.ulVersion := 0;
InBuffDesc.cBuffers := 1;
InBuffDesc.pBuffers := @InSecBuff;

InSecBuff.cbBuffer := cbIn;
InSecBuff.BufferType := SECBUFFER_TOKEN;
InSecBuff.pvBuffer := pIn
end;

if pAS^._fNewConversation then
begin
pBuffDesc := Nil;
phctxt := Nil
end
else
begin
phctxt := @pAS^._hctxt;
pBuffDesc := @InBuffDesc
end;

ss :=funcs^.InitializeSecurityContextA (
@pAS^._hcred,
phctxt,
'AuthSamp',
0, // context requirements
0, // reserved1
SECURITY_NATIVE_DREP,
pBuffDesc,
0, // reserved2
@pAS^._hctxt,
@OutBuffDesc,
ContextAttributes,
Lifetime
);

if ss < 0 then
raise Exception.CreateFmt ('Init context failed: %d', [ss]);

pAS^._fHaveCtxtHandle := TRUE;

if (ss = SEC_I_COMPLETE_NEEDED) or (ss = SEC_I_COMPLETE_AND_CONTINUE) then
begin
if Assigned (funcs^.CompleteAuthToken) then
begin
ss := funcs^.CompleteAuthToken (@pAS^._hctxt, @OutBuffDesc);
if ss < 0 then
raise Exception.CreateFmt ('Complete failed: %d', [ss])
end
end;

cbOut := OutSecBuff.cbBuffer;

if pAS^._fNewConversation then
pAS^._fNewConversation := FALSE;

fDone := (ss <> SEC_I_CONTINUE_NEEDED) and (ss <> SEC_I_COMPLETE_AND_CONTINUE);

result := True
except
end
end;

(*----------------------------------------------------------------------*
| GenServerContext |
*----------------------------------------------------------------------*)
function GenServerContext (
funcs : PSecurityFunctionTable;
dwKey : DWORD;
pIn : PByte;
cbIn : DWORD;
pOut : PByte;
var cbOut : DWORD;
var fDone : boolean) : boolean;
var
ss : TSecurityStatus;
Lifetime : TTimeStamp;
OutBuffDesc, InBuffDesc : TSecBufferDesc;
InSecBuff, OutSecBuff : TSecBuffer;
ContextAttributes : DWORD;
pAS : PAuthSeq;
phctxt : PCtxtHandle;

begin
result := False;
if GetEntry (dwKey, pointer (pAS)) then
try
if pAS^._fNewConversation then
begin
ss := funcs^.AcquireCredentialsHandleA (
Nil, // principal
'NTLM',
SECPKG_CRED_INBOUND,
Nil, // LOGON id
Nil, // auth data
Nil, // get key fn
Nil, // get key arg
pAS^._hcred,
Lifetime
);
if ss < 0 then
raise Exception.CreateFmt ('AcquireCreds failed %d', [ss]);

pAS^._fHaveCredHandle := TRUE
end;


// prepare output buffer
//
OutBuffDesc.ulVersion := 0;
OutBuffDesc.cBuffers := 1;
OutBuffDesc.pBuffers := @OutSecBuff;

OutSecBuff.cbBuffer := cbOut;
OutSecBuff.BufferType := SECBUFFER_TOKEN;
OutSecBuff.pvBuffer := pOut;

// prepare input buffer
//
InBuffDesc.ulVersion := 0;
InBuffDesc.cBuffers := 1;
InBuffDesc.pBuffers := @InSecBuff;

InSecBuff.cbBuffer := cbIn;
InSecBuff.BufferType := SECBUFFER_TOKEN;
InSecBuff.pvBuffer := pIn;

if pAS^._fNewConversation then
phctxt := Nil
else
phctxt := @pAS^._hctxt;

ss := funcs^.AcceptSecurityContext (
@pAS^._hcred,
phctxt,
@InBuffDesc,
0, // context requirements
SECURITY_NATIVE_DREP,
@pAS^._hctxt,
@OutBuffDesc,
ContextAttributes,
Lifetime
);
if ss < 0 then
raise Exception.CreateFmt ('init context failed: %d', [ss]);

pAS^._fHaveCtxtHandle := TRUE;

// Complete token -- if applicable
//
if (ss = SEC_I_COMPLETE_NEEDED) or (ss = SEC_I_COMPLETE_AND_CONTINUE) then
begin
if Assigned (funcs^.CompleteAuthToken) then
begin
ss := funcs^.CompleteAuthToken (@pAS^._hctxt, @OutBuffDesc);
if ss < 0 then
raise Exception.CreateFmt ('complete failed: %d', [ss]);
end
else
raise Exception.Create ('Complete not supported.');
end;

cbOut := OutSecBuff.cbBuffer;

if pAS^._fNewConversation then
pAS^._fNewConversation := FALSE;

fDone := (ss <> SEC_I_CONTINUE_NEEDED) and (ss <> SEC_I_COMPLETE_AND_CONTINUE);

result := True
except
end
end;

(*----------------------------------------------------------------------*
| TermSession |
| |
| Tidy up RPC session |
*----------------------------------------------------------------------*)
function TermSession (funcs : PSecurityFunctionTable; dwKey : DWORD) : boolean;
var
pAS : PAuthSeq;
begin
result := False;
if DeleteEntry (dwKey, pointer (pAS)) then
begin
if pAS^._fHaveCtxtHandle then
funcs^.DeleteSecurityContext (@pAS^._hctxt);

if pAS^._fHaveCredHandle then
funcs^.FreeCredentialHandle (@pAS^._hcred);

freemem (pAS);

result := True
end
end;

(*----------------------------------------------------------------------*
| SSPLogonUser |
| |
| Validate password for user/domain. Returns true if the password is |
| valid. |
*----------------------------------------------------------------------*)
function SSPLogonUser (const DomainName, UserName, Password : string) : boolean;
var
done : boolean;
cbOut, cbIn : DWORD;
AuthIdentity : TSecWINNTAuthIdentity;
session0OK, session1OK : boolean;
packageHandle : THandle;

pClientBuf : PByte;
pServerBuf : PByte;
cbMaxMessage : DWORD;
funcs : PSecurityFunctionTable;

begin
result := False;
try
done := False;

session1OK := False;
packageHandle := 0;
pClientBuf := Nil;
pServerBuf := Nil;
cbMaxMessage := 0;

session0OK := InitSession (0);
try
session1OK := InitSession (1);
packageHandle := InitPackage (cbMaxMessage, funcs);

if session0OK and session1OK and (packageHandle <> 0) then
begin
GetMem (pClientBuf, cbMaxMessage);
GetMem (pServerBuf, cbMaxMessage);
FillChar (AuthIdentity, sizeof(AuthIdentity), 0);

if DomainName <> '' then
begin
AuthIdentity.Domain := PChar (DomainName);
AuthIdentity.DomainLength := Length (DomainName)
end;

if UserName <> '' then
begin
AuthIdentity.User := PChar (UserName);
AuthIdentity.UserLength := Length (UserName);
end;

if Password <> '' then
begin
AuthIdentity.Password := PChar (Password);
AuthIdentity.PasswordLength := Length (Password)
end;

AuthIdentity.Flags := SEC_WINNT_AUTH_IDENTITY_ANSI;

//
// Prepare client message (negotiate).
//
cbOut := cbMaxMessage;

if not GenClientContext (funcs,
0,
@AuthIdentity,
pServerBuf,
0,
pClientBuf,
cbOut,
done) then
raise Exception.Create ('GenClientContext Failed');

cbIn := cbOut;
cbOut := cbMaxMessage;
if not GenServerContext (funcs,
1,
pClientBuf,
cbIn,
pServerBuf,
cbOut,
done) then
raise Exception.Create ('GenServerContext Failed');

cbIn := cbOut;
//
// Prepare client message (authenticate).
//
cbOut := cbMaxMessage;
if not GenClientContext (funcs,
0,
@AuthIdentity,
pServerBuf,
cbIn,
pClientBuf,
cbOut,
done) then
raise Exception.Create ('GenClientContext failed');

cbIn := cbOut;
//
// Prepare server message (authentication).
//
cbOut := cbMaxMessage;
if not GenServerContext (funcs,
1,
pClientBuf,
cbIn,
pServerBuf,
cbOut,
done) then
raise Exception.Create ('GenServerContext failed');

result := True
end
finally
if Session0OK then
TermSession(funcs, 0);

if Session1OK then
TermSession(funcs, 1);

if packageHandle <> 0 then
FreeLibrary (PackageHandle);

ReallocMem (pClientBuf, 0);
ReallocMem (pServerBuf, 0);
end
except
end
end;


end.

TO jingtao:能将Demo发到我的邮箱吗？谢谢！
xianguochen@21cn.com

TO jingtao:我也想要一份来研究，谢谢 wwwvw@etang.com

http://tty.yyun.net/lovejingtao/ssapi.zip

TO jingtao:
怎么都是提示"用户名,密码验证失败!"?
另外源程序中没有 .dfm文件?