Source for AS400 Check Password Function

H DFTACTGRP(*NO) BNDDIR('QC2LE')
**********************************************************************
* This program uses the QSYGETPH API to validate a user/password
* combination.
* If the API returns an error, the message ID and the message data are
* returned to the calling program.
* As profile handles are a limited ressource, the QSYRLSPH API is
* called to release the profile handle.
*---------------------------------------------------------------------
* Interface:
* Input: User
* The login name of the AS400 user profile
*
* Input: Password
* The password to validate
*
* Output: ErrorID
* The message ID returned by the API - a blank ErrorID is returned
* when the user/password validation was successful
*---------------------------------------------------------------------
* Disclaimer:
* Please note that this is just an example program showing one way to
* use the AS400 login system to validate a user/password combination.
* The solution has not been tested for production, and it has not been
* checked whether any authorization/locking or other problems can
* occur.
* If you want to use this solution for anything but example purposes
* you must investigate these issues further.
* Please refer to the documentation of the QSYGETPH and QSYRLSPH
* API's for more information.
*---------------------------------------------------------------------
* Created: 27.12.2007
**********************************************************************
D LC C 'abcdefghijklmnopqrstuvwxyz'
D UC C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'

D GetProfile PR ExtPgm('QSYGETPH')
D User 10A const
D Password 10A const
D Handle 12A
D ErrorCode 32766A options(*varsize: *nopass)
D PassLength 10I 0 const options(*nopass)
D PassCCSID 10I 0 const options(*nopass)

D ReleaseProfile PR ExtPgm('QSYRLSPH')
D Handle 12A
D ErrorCode 32766A options(*varsize: *nopass)

D ErrDs DS
D BytesProvided 1 4I 0 INZ(256)
D BytesAvail 5 8I 0 INZ(0)
D ErrMsgID 9 15
D Reserved 16 16
D ErrMsgDta 17 256

D Handle S 12A

D User S 10A
D Password S 10A
D ErrorID S 7A

C *Entry Plist
C Parm User
C Parm PassWord
C Parm ErrorID

C eval ErrorID = ''

C eval User = %Xlate(LC:UC:User)
C eval Password = %Xlate(LC:UC:Password)

C callp GetProfile(User:
C Password:
C Handle:
C ErrDS:
C 10:
C 0)

C if ( BytesAvail > 0 )
C eval ErrorID = ErrMsgID
C else
C callp ReleaseProfile(Handle)
C endif

C return