K210.ORG

The following code will allow logging into local network connections:

function NetServerGetInfo (serverName : PWideChar; level : Integer;

        var bufptr : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';

function NetApiBufferFree (buffer : Pointer) : Cardinal; stdcall; external 'NETAPI32.DLL';

 

type

  SERVER_INFO_503 = record

    sv503_sessopens : Integer;

    sv503_sessvcs : Integer;

    sv503_opensearch : Integer;

    sv503_sizreqbuf : Integer;

    sv503_initworkitems : Integer;

    sv503_maxworkitems : Integer;

    sv503_rawworkitems : Integer;

    sv503_irpstacksize : Integer;

    sv503_maxrawbuflen : Integer;

    sv503_sessusers : Integer;

    sv503_sessconns : Integer;

    sv503_maxpagedmemoryusage : Integer;

    sv503_maxnonpagedmemoryusage : Integer;

    sv503_enablesoftcompat :BOOL;

    sv503_enableforcedlogoff :BOOL;

    sv503_timesource :BOOL;

    sv503_acceptdownlevelapis :BOOL;

    sv503_lmannounce :BOOL;

    sv503_domain : PWideChar;

    sv503_maxcopyreadlen : Integer;

    sv503_maxcopywritelen : Integer;

    sv503_minkeepsearch : Integer;

    sv503_maxkeepsearch : Integer;

    sv503_minkeepcomplsearch : Integer;

    sv503_maxkeepcomplsearch : Integer;

    sv503_threadcountadd : Integer;

    sv503_numblockthreads : Integer;

    sv503_scavtimeout : Integer;

    sv503_minrcvqueue : Integer;

    sv503_minfreeworkitems : Integer;

    sv503_xactmemsize : Integer;

    sv503_threadpriority : Integer;

    sv503_maxmpxct : Integer;

    sv503_oplockbreakwait : Integer;

    sv503_oplockbreakresponsewait : Integer;

    sv503_enableoplocks : BOOL;

    sv503_enableoplockforceclose : BOOL;

    sv503_enablefcbopens : BOOL;

    sv503_enableraw : BOOL;

    sv503_enablesharednetdrives : BOOL;

    sv503_minfreeconnections : Integer;

    sv503_maxfreeconnections : Integer;

  end;

  PSERVER_INFO_503 = ^SERVER_INFO_503;

 

function Get_User_Name: string;

var

  dwlen: DWORD;

begin

  dwlen := MAX_COMPUTERNAME_LENGTH + 1;

  Setlength(Result, dwlen);

  GetUserName(pchar(Result), dwlen);

  Result := StrPas(pchar(Result));

end;

 

function Get_Computer_Name: string;

var

  dwlen: DWORD;

begin

  dwlen := MAX_COMPUTERNAME_LENGTH + 1;

  Setlength(Result, dwlen);

  GetComputerName(pchar(Result), dwlen);

  Result := StrPas(pchar(Result));

end;

 

function GetDomainName : string;

var

  err : Integer;

  buf : pointer;

  fDomainName: string;

  wServerName : WideString;

begin

  wServerName := Get_Computer_Name;

  err := NetServerGetInfo (PWideChar (wServerName), 503, buf);

  if err = 0 then

  try

    fDomainName := PSERVER_INFO_503 (buf)^.sv503_domain;

  finally

    NetAPIBufferFree (buf)

  end;

  result := fDomainName;

end;

 

procedure TfrmLogininfo.FormCreate(Sender: TObject);

begin

  edtUserID.text := Get_User_Name;

  edtDomain.text := GetDomainName;

end;

 

procedure TfrmLogininfo.BitBtn1Click(Sender: TObject);

var

  adderr: dword;

  fNetResource: TNetResource;

  fUserID: string;

  fDomain: string;

  fpassword: string;

  fCursor: TCursor;

begin

  BitBtn1.enabled := false;

  fCursor := screen.cursor;

  screen.cursor := crhourGlass;

  try

    application.processmessages;

    fUserID := trim(edtUserID.text);

    fDomain := trim(edtDomain.text);

    if fDomain<>'' then

      fUserID := fDomain+'\'+fUserID;

    fPassword := trim(edtPassword.text);

    fillchar(fNetResource,sizeof(fNetResource),0);

    fNetResource.dwScope := RESOURCE_GLOBALNET;

    fNetResource.dwType := RESOURCETYPE_DISK;

    fNetResource.dwUsage := RESOURCEUSAGE_CONNECTABLE;

    fNetResource.lpRemoteName := pchar(fUNCPath);

    adderr := WNetAddConnection2(fNetResource,

       pchar(fPassword), pchar(fUserID), CONNECT_UPDATE_PROFILE);

    if adderr <> NOERROR then

      begin

        modalresult := mrNone;

        ShowMessage(SysErrorMessage(GetLastError));

      end

    else

      Modalresult := mrOk;

  finally

    BitBtn1.enabled := true;

    screen.cursor := fCursor;

  end;

end;

object frmLogininfo: TfrmLogininfo

  Left = 331

  Top = 154

  BorderIcons = [biHelp]

  BorderStyle = bsDialog

  Caption = 'Enter Network Login'

  ClientHeight = 115

  ClientWidth = 330

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  Position = poScreenCenter

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object lblUserID: TLabel

    Left = 16

    Top = 19

    Width = 58

    Height = 13

    Caption = 'Connect As:'

  end

  object lblPassword: TLabel

    Left = 16

    Top = 51

    Width = 49

    Height = 13

    Caption = 'Password:'

  end

  object lblDomain: TLabel

    Left = 16

    Top = 84

    Width = 39

    Height = 13

    Caption = 'Domain:'

  end

  object edtUserID: TEdit

    Left = 80

    Top = 16

    Width = 150

    Height = 21

    TabOrder = 0

  end

  object edtPassword: TEdit

    Left = 80

    Top = 48

    Width = 150

    Height = 21

    PasswordChar = '*'

    TabOrder = 1

  end

  object edtDomain: TEdit

    Left = 80

    Top = 80

    Width = 150

    Height = 21

    TabOrder = 2

  end

  object BitBtn1: TBitBtn

    Left = 244

    Top = 16

    Width = 75

    Height = 25

    TabOrder = 3

    OnClick = BitBtn1Click

    Kind = bkOK

  end

  object BitBtn2: TBitBtn

    Left = 244

    Top = 48

    Width = 75

    Height = 25

    TabOrder = 4

    Kind = bkCancel

  end

end

Dennis Passmore
Ultimate Software, Inc


"If you cannot conceive the idea you
will never achieve the desired results"