************************************************************************** * Swaps a user profile from the current job from one user to another * * You MUST pass the user profile and password for that user to this * program in order to change the job to that user * ************************************************************************** * * To Create: CrtBndRPG(*LIBL/SWAPUSRPRF) * *************************************************************************** H DFTACTGRP(*NO) BNDDIR('QC2LE') D RtvProfile PR 10I 0 D userid 10A value D password 10A value * D SetUProf PR 10I 0 D handle 12A value * D Handle S 12A * D RC S 10I 0 D LC C 'abcdefghijklmnopqrstuvwxyz' D UC C 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' * **---------------------------------------------------------------- ** Get Profile Handle API ** ** Parameters: ** UserID = userid to retrieve a profile handle for ** Password = password of the user-id above ** Handle = the profile handle that's returned. ** ErrorCode = API error code, used to return any errors. ** **---------------------------------------------------------------- D GetProfile PR ExtPgm('QSYGETPH') D UserID 10A const D Password 10A const D Handle 12A D ErrorCode 32766A options(*varsize: *nopass) **---------------------------------------------------------------- ** Set User Profile API: ** ** Parms: ** Handle = User Profile handle (returned by QSYGETPH API) ** ErrorCode = standard API error code structure ** **---------------------------------------------------------------- D SetProfile PR ExtPgm('QWTSETP') D Handle 12A const D ErrorCode 32766A options(*varsize: *nopass) D ErrDs DS D BytesPrv 1 4I 0 INZ(256) D BytesAvl 5 8I 0 INZ(0) D ErrMsgID 9 15 D Reserved 16 16 D ErrMsgDta 17 256 DToUser S 10a DToPassWord S 10a * C *Entry Plist C Parm ToUser C Parm ToPassWord * * Retrieve the User Profile Handle c eval RC = RtvProfile(ToUser:ToPassWord) c If RC <> 0 * Now Set the Job Profile to a NEW User Profile c eval RC = SetUProf(handle) C Endif C Eval *Inlr = *On *=============================================================== * Get User Profile Handle SubProcedure *=============================================================== P RtvProfile B D RtvProfile PI 10I 0 D userid 10A Value D password 10A Value c Eval UserID = %Xlate(LC:UC:UserID) c Eval Password = %Xlate(LC:UC:Password) c callp GetProfile(UserID: Password: handle: ErrDS) c if BytesAvl > 0 c return 0 C Else c return 1 c endif P E *=============================================================== * Set User Profile To New User Profile SubProcedure *=============================================================== P SetUProf B D SetUProf PI 10I 0 D HandleIn 12A Value c callp SetProfile(handleIn: ErrDs) c if BytesAvl > 0 c return 0 C Else c return 1 c endif P E