unit1.pas

演示在Windows NT上登录和注销用户,包括显示对话框和不显示两种方式.

unit Unit1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    OKbtn: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    procedure OKbtnClick(Sender: TObject);
    Function GetWorkStationInfo(GetType:Word):String;
    Function GetDomainList:String;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 private
    { Private declarations }
  public
    { Public declarations }
  end;

Type TString=Array[0..255] of Char;
     PWksta_info_0=^TWksta_info_0;
     Twksta_info_0=Record
        wki0_reserved_1:Word;	        { reserved; must be zero }
        wki0_reserved_2:Longint;	{ reserved; must be zero }
        wki0_root:PChar;	        { path to network directory }
        wki0_computername:PChar;	{ name of computer }
        wki0_username:PChar;	        { name of user logged on }
        wki0_langroup:PChar;	        { name of workgroup }
        wki0_ver_major:Byte;	        { major version number }
        wki0_ver_minor:Byte;	        { minor version number }
        wki0_reserved_3:Longint;	{ reserved; must be zero }
        wki0_charwait:Word;	        { reserved; must be zero }
        wki0_chartime:Longint;	        { reserved; must be zero }
        wki0_charcount:Word;	        { reserved; must be zero }
        wki0_reserved_4:Word;	        { reserved; must be zero }
        wki0_reserved_5:Word;	        { reserved; must be zero }
        wki0_keepconn:Word;	        { maximum time to keep inactive connection }
        wki0_keepsearch:Word;	        { maximum time to keep inactive search }
        wki0_maxthreads:Word;	        { reserved; must be zero }
        wki0_maxcmds:Word;	        { maximum simultaneous network connections }
        wki0_reserved_6:Word;	        { reserved; must be zero }
        wki0_numworkbuf:Word;	        { internal work buffers }
        wki0_sizworkbuf:Word;	        { size of work buffer, in bytes }
        wki0_maxwrkcache:Word;	        { reserved; must be zero }
        wki0_sesstimeout:Word;	        { reserved; must be zero }
        wki0_sizerror:Word;	        { reserved }
        wki0_numalerts:Word;	        { reserved }
        wki0_numservices:Word;	        { reserved }
        wki0_errlogsz:Word;	        { reserved }
        wki0_printbuftime:Word;	        { reserved }
        wki0_numcharbuf:Word;	        { reserved }
        wki0_sizcharbuf:Word;	        { reserved }
        wki0_logon_server:PChar;	{ reserved }
        wki0_wrkheuristics:PChar;	{ reserved }
        wki0_mailslots:Word;	        { mailslot flag }
     End;
     PWksta_info_1=^TWksta_info_1;
     Twksta_info_1=Record
        wki1_reserved_1:Word;	        { reserved; must be zero }
        wki1_reserved_2:Longint;	{ reserved; must be zero }
        wki1_root:PChar;	        { path to network directory }
        wki1_computername:PChar;	{ name of computer }
        wki1_username:PChar;	        { name of user logged on }
        wki1_langroup:PChar;	        { name of workgroup }
        wki1_ver_major:Byte;	        { major version number }
        wki1_ver_minor:Byte;	        { minor version number }
        wki1_reserved_3:Longint;	{ reserved; must be zero }
        wki1_charwait:Word;	        { reserved; must be zero }
        wki1_chartime:Longint;	        { reserved; must be zero }
        wki1_charcount:Word;	        { reserved; must be zero }
        wki1_reserved_4:Word;	        { reserved; must be zero }
        wki1_reserved_5:Word;	        { reserved; must be zero }
        wki1_keepconn:Word;	        { maximum time to keep inactive connection }
        wki1_keepsearch:Word;	        { maximum time to keep inactive search }
        wki1_maxthreads:Word;	        { reserved; must be zero }
        wki1_maxcmds:Word;	        { maximum simultaneous network connections }
        wki1_reserved_6:Word;	        { reserved; must be zero }
        wki1_numworkbuf:Word;	        { internal work buffers }
        wki1_sizworkbuf:Word;	        { size of work buffer, in bytes }
        wki1_maxwrkcache:Word;	        { reserved; must be zero }
        wki1_sesstimeout:Word;	        { reserved; must be zero }
        wki1_sizerror:Word;	        { reserved }
        wki1_numalerts:Word;	        { reserved }
        wki1_numservices:Word;	        { reserved }
        wki1_errlogsz:Word;	        { reserved }
        wki1_printbuftime:Word;	        { reserved }
        wki1_numcharbuf:Word;	        { reserved }
        wki1_sizcharbuf:Word;	        { reserved }
        wki1_logon_server:PChar;	{ reserved }
        wki1_wrkheuristics:PChar;	{ reserved }
        wki1_mailslots:Word;	        { mailslot flag }
        wki1_logon_domain:PChar;	{ name of logon workgroup }
        wki1_oth_domains:Word;	        { reserved }
        wki1_numdgrambuf:Word;	        { reserved }
     End;
     PWkSta_info_10=^TWkSta_info_10;
     Twksta_info_10=Record
        wki10_computername:PChar;	{ name of computer }
        wki10_username:PChar;	        { name of logged on user}
        wki10_langroup:PChar;	        { name of workgroup}
        wki10_ver_major:Byte;	        { major version number}
        wki10_ver_minor:Byte;	        { minor version number }
        wki10_logon_domain:PChar;	{ name of logon workgroup}
        wki10_oth_domains:PChar;	{ reserved; must be zero  }
     End;
     Pserver_info_0=^Tserver_info_0;
     Tserver_info_0=Record
        sv0_name:pChar;
     end;
     Pserver_info_1=^Tserver_info_1;
     Tserver_info_1=Record
        sv1_name:pchar;
        sv1_version_major:pchar;
        sv1_version_minor:pchar;
        sv1_type:longint;
        sv1_comment:pchar;
     end;

Type pserverarray = ^serverarray;
     serverarray = array[1..50] of TSERVER_INFO_0;
     pstring = ^qstring;
     qstring = array[0..1024] of char;

var
  Form1             : TForm1;
  psa               : pServerArray;
  pw                : tServer_Info_0;
  reserved,
  domain,
  username,
  password,
  parms,
  domainc           : pChar;
  pser              : pString;
  usLogoffForce,
  sLevel,
  NumDomains,
  X                 : Integer;
  pbBuffer          : pChar;
  cbBuffer          : Word;
  pcbTotalAvail     : PWord;

Const WNBD_CONN_UNKNOWN       =0;
      WNBD_CONN_DISKTREE      =1;
      WNBD_CONN_PRINTQ        =3;
      WNBD_MAX_LENGTH         =$80;
      NERR_SUCCESS  =0;

      WKSTAINFO_COMPUTER       = 0;
      WKSTAINFO_USER           = 1;
      WKSTAINFO_LOGON_DOMAIN   = 2;
      WKSTAINFO_LANGROUP       = 3;
      SV_TYPE_DOMAIN_ENUM      = $80000000;
      SIZE                     = 64000;

implementation

{$R *.DFM}

Function NetWkstaGetInfo( pszServer:PChar;
                          sLevel:Integer;
                          pbBuffer:PChar;
                          cbBuffer:Word;
                          pcbTotalAvail:PWord):Word; far; external 'NETAPI';

function NetWkstaSetUID2( pszReserved,
                          pszDomain,
                          pszUserName,
                          pszPassword,
                          pszParms: pChar;
                          usLogoffForce,
                          sLevel:Integer;
                          pbBuffer:pChar;
                          cbBuffer:Word;
                          pcbTotalAvail: PWord):Integer; far; external 'NETAPI';

function NetServerEnum2(  pszServer:pChar;
                          sLevel:Integer;
                          pbBuffer:pString;
                          cbBuffer:word;
                          pcEntriesRead,
                          pcTotalAvail:pWord;
                          flServerType:longint;
                          pszDomain:pchar):Integer; far; external 'NETAPI';

Function TForm1.GetWorkStationInfo(GetType:Word):String;
Var TotalSize,Res:Word;
    Pw:PChar;
Begin
  GetMem(pw,Size);
  Res:=NetWkstaGetInfo(nil,10,pw,Size,@TotalSize);
  try
    if Res=NERR_SUCCESS Then
    Begin
      Case GetType of
         WKSTAINFO_COMPUTER: Result:=StrPas(PWksta_info_10(PW)^.wki10_ComputerName);
         WKSTAINFO_USER    : Result:=StrPas(PWksta_info_10(PW)^.wki10_UserName);
         WKSTAINFO_LOGON_DOMAIN    : Result:=StrPas(PWksta_info_10(PW)^.wki10_logon_domain);
         WKSTAINFO_LANGROUP     : Result:=StrPas(PWksta_info_10(PW)^.wki10_langroup);
      End;
    End
  finally
    FreeMem(pw,Size);
  end;
End;

Function TForm1.GetDomainList:String;
Var
   TotalSize,Res,numcount,numexist:Word;
   I,CharCount:integer;
Begin
  GetMem(pser,Size);
  domainC:=strAlloc(32);
  Res:=NetServerEnum2(nil,0,pser,size,@numcount,@numexist,SV_TYPE_DOMAIN_ENUM,nil);
    if Res=NERR_SUCCESS Then
    Begin
         CharCount:=0;
         For X := 1 to numcount do
         begin
              for I := CharCount to CharCount+16 do
              Begin
                  domainC[I - CharCount] := pser^[I];
              end;
              CharCount:=CharCount+16;
              ComboBox1.Items.Add(strpas(domainC));
         end;
    End
    else showmessage(IntToStr(res));
    FreeMem(pser,Size);
    StrDispose(domainC);
End;

procedure TForm1.OKbtnClick(Sender: TObject);
Var TotalSize,Res:Word;
    Pw:PChar;
begin
     if (Edit1.Text <> '') and ( Edit2.Text <> '' )then begin
     Domain := strAlloc( 64 );
     username := strAlloc( 64 );
     password := strAlloc( 64 );
     ComboBox1.Text := GetWorkstationInfo(2);
     strPcopy( domain, UpperCase(ComboBox1.Text) );        { must be uppercase!!!!  }
     strPcopy( username, UpperCase(Edit1.Text) );          { ditto                  }
     strPcopy( password, UpperCase(Edit2.Text) );          { ditto                  }
     GetMem(pw,Size);
     res := NetWkstaSetUID2( nil,
                             nil,
                             nil,
                             nil,
                             nil,
                             3,
                             1,
                             pw,
                             Size,
                             @TotalSize);    { log the user off first if already logged on }
     res := NetWkstaSetUID2( nil,
                             domain,
                             username,
                             password,
                             nil,
                             3,
                             1,
                             pw,
                             Size,
                             @TotalSize); { log the user on }
     strDispose(domain);
     strDispose(username);
     strDispose(password);
     FreeMem(pw,Size);
     Application.Terminate;
     end else ShowMessage('Please enter a logon name and password');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     If ParamStr(1) = '/ac' then Button1.Hide;
     GetDomainList;
     ComboBox1.Text := ComboBox1.Items[0];
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
     Application.Terminate;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
     CanClose:=False;
end;

end.