1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:

(*======================================================================*
 | SSPIValidatePassword                                                 |
 |                                                                      |
 | Validate NT passwords using the SSPI                                 |
 |                                                                      |
 | See MSDN article HOWTO: Validate User Credentials on Microsoft WinNT |
 | and Win95, and without Act As Part Of Operating System privilege     |
 |                                                                      |
 | nb.  Using this method is is analogous to calling the LogonUser API  |
 | with the LOGON32_LOGON_NETWORK logon type. The biggest downside to   |
 | this type of logon is that you cannot access remote network          |
 | resources after impersonating a network type logon.                  |
 |                                                                      |
 | Hence the function doesn't return an HTOKEN, like LogonUser does.    |
 |                                                                      |
 | Copyright (c) Colin Wilson 2001                                      |
 |                                                                      |
 | Version  Date        By    Description                               |
 | -------  ----------  ----  ------------------------------------------|
 | 1.0      01/03/2001  CPWW  Original                                  |
 *======================================================================*)

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.					

1:

 Head.pNext := pTemp;