CICA 1995 May/cica_0595_4.zip/cica_0595_4/UTIL/DMNPASS2/PASS_SRC.ZIP/PASSWORD.BAS

BASIC Source File | 1994-06-21 | 7KB | 189 lines

'PASSWORD.BAS
'============
Dim user10a() As user_info_10

Function FileExists (path$) As Integer
'----------------------------------------------------------
' Check for the existence of a file by attempting an OPEN.
'----------------------------------------------------------

    x = FreeFile

    On Error Resume Next
    Open path$ For Input As x
    If Err = 0 Then
        FileExists = True
    Else
        FileExists = False
    End If
    Close x

End Function

Function Getserver% ()
' Set CurrentServer to the domain controller for
' the CurrentDomain.
    Dim result%
    Dim ErrMsg$, newsvr$, svr$
    svr = ""
    newsvr = Space$(CNLEN + 3)   ' must be big enough to contain domain name
    Do
        result = NetGetDCName(svr, CurrentDomain, ByVal newsvr, Len(newsvr))
        If result <> 0 Then
            If CurrentDomain <> LogonDomain Then
                ErrMsg$ = "Error retrieving domain controller for domain " + CurrentDomain + ". Domain name will be set to the logon domain " + LogonDomain + "." + Chr$(13) + Chr$(13)
                ErrMsg$ = ErrMsg$ + "Error <" + Format$(result) + "> : " + LMError$(result)
                MsgBox ErrMsg$, MB_ICONEXCLAMATION, "Error Retrieving Domain Controller"
                CurrentDomain = LogonDomain  ' set currently selected domain to logon domain
            Else
                ErrMsg$ = "Error retrieving domain controller." + Chr$(13) + Chr$(13)
                ErrMsg$ = ErrMsg$ + "Error <" + Format$(result) + "> : " + LMError$(result)
                MsgBox ErrMsg$, MB_ICONEXCLAMATION, "Error Retrieving Domain Controller"
                newsvr = ""
                Exit Do
            End If
        End If
    Loop While result <> 0
    newsvr = LTrim$(newsvr)
    If newsvr <> "" Then
        CurrentServer = Mid$(newsvr, 1, InStr(newsvr, Chr$(0)) - 1)
    Else
        CurrentServer = ""
    End If
    Getserver = result
End Function

Function GetWindowsSysDir () As String
'---------------------------------------------------------
' Calls the windows API to get the windows\SYSTEM directory
'---------------------------------------------------------
    temp$ = String$(145, 0)                 ' Size Buffer
    x = GetSystemDirectory(temp$, 145)      ' Make API Call
    temp$ = Left$(temp$, x)                 ' Trim Buffer

    If Right$(temp$, 1) <> "\" Then         ' Add \ if necessary
        GetWindowsSysDir$ = temp$ + "\"
    Else
        GetWindowsSysDir$ = temp$
    End If

End Function

Function LMNetWkstaGetInfo_L10% (Server$, VB_WkstaInfo As wksta_info_10)

' Declare Function NetWkstaGetInfo% Lib "NETAPI.DLL" (ByVal pszServer$, ByVal sLevel%, ByVal pbBuffer&, ByVal cbBuffer%, pcbTotalAvail%)
                                        'NetWkstaGetInfo(Server, Level, BufferPointer, BufferSize, TotalBytesAvail)

' Wrapper:  LMNetWkstaGetInfo_L10
'    File:  WKSTA.BAS
' Purpose:  Returns information about the configuration
'           elements for a workstation.

'   Data Structure:  wksta_info_10
'            Level:  10
' Associated Files:  WKSTA.TXT
'                    VBLANMAN.TXT

' Parameters:  Server - the name of the server on which to execute the
'                       command. A NULL string specifies the local computer.

'              VB_WkstaInfo - wksta_info structure in which to store the
'                       returned data.


' Variables used in the NetWkstaGetInfo API call
    Dim Level As Integer                        ' information level
    Dim BufferPointer As Long                   ' pointer to LM buffer
    Dim BufferSize As Integer                   ' buffer size
    Dim TotalBytesAvail As Integer              ' total bytes available

' Other variables
    Dim result As Integer          ' return value for API call


    Level = 10  ' designates information level, cannot just change this
                ' value to change info level - structure name and constant
                ' name must also be changed (wksta_info_10 and
                ' FMT_wksta_info_10).  The function name
                ' (LMNetWkstaGetInfo_L10) should also be changed.

' Create LM buffer and get size in BufferSize
    BufferPointer = CreateLMBuffer(FMT_wksta_info_10, 1, BufferSize)

    If BufferPointer = 0& Then      ' error, unable to allocate buffer
        LMNetWkstaGetInfo_L10 = -1
        Exit Function
    End If

' Call LM API function NetWkstaGetInfo to get data
    result = NetWkstaGetInfo(Server, Level, BufferPointer, BufferSize, TotalBytesAvail)
' check for error return

    If result <> NERR_Success Then       ' error occurred
        LMNetWkstaGetInfo_L10 = result          ' set return for function
        result = FreeLMBuffer(BufferPointer)    ' free LM buffer
        Exit Function
    End If

' Copy data from LM buffer to wksta_info structure
    result = BufferToVBType(VB_WkstaInfo, Len(VB_WkstaInfo), BufferPointer, BufferSize, FMT_wksta_info_10)

' check if error
    If result = NERR_Success Then    ' return OK
        LMNetWkstaGetInfo_L10 = FreeLMBuffer(BufferPointer)  ' free memory for LM buffer
    Else                ' error occurred, set return value
        LMNetWkstaGetInfo_L10 = result
        result = FreeLMBuffer(BufferPointer)  ' free memory for LM buffer
    End If

End Function

Function MultiNetGetUser (UserName$) As Integer

' The following function determines the logged-in user in Windows for
   ' Workgroups:

      Dim hNetDrv As Integer
      Dim wRetEnum As Integer, ret As Integer
      Dim wRetGetUser As Integer
      Dim cb As Integer
      Dim Found As Integer

      Found = False
      ' Grab the 1st network:
      hNetDrv = 0
      wRetEnum = MNetNetworkEnum(hNetDrv)

      ' Loop while there are installed networks:
      While (wRetEnum = 0) And Not Found
         wfwUser$ = Space$(255)
         cb = Len(wfwUser$)

         ' Make sure correct network is accessed in next WNetGetUser call:
         ret = MNetSetNextTarget(hNetDrv)

         ' Get the user:
         wRetGetUser = WNetGetUser(wfwUser$, cb)

         ' Check for success:
         If wRetGetUser = 0 Then
            ' Just grab the relevant characters:
            UserName$ = Left$(wfwUser$, cb - 1)
            'MsgBox UserName$, , "WNetGetUser"
            Found = True
         End If

         ' Get the next network:
         wRetEnum = MNetNetworkEnum(hNetDrv)
      Wend
      If Not Found Then
         MsgBox "WNetGetUser not supported on any of the Multinet subnets"
      End If
      wfwUser$ = Left$(wfwUser$, cb - 1)
      MultiNetGetUser = Found


End Function