' ' ras_wrap.bas ' ' Ras Services wrapper functions. ' ' 000824 translated to pb/dll by k.l. '- Conditionally, this can be compiled as a DLL, ' set the constant below to be non-zero if you ' wish to have a DLL. ' '%COMPILE_AS_DLL = 0 '$IF %COMPILE_AS_DLL ' ' $COMPILE DLL "ras32.dll" ' '- This is the only API call required, so I don't bother including ' ' win32api.inc if we're doing a DLL ' ' ' %False = 0 ' %True = -1 ' DECLARE SUB apiSleep LIB "KERNEL32.DLL" ALIAS "Sleep" (BYVAL dwMilliseconds AS LONG) ' '$ENDIF #INCLUDE "RAS32.INC" DECLARE CALLBACK FUNCTION username_password_callback AS LONG DECLARE FUNCTION rsActiveConnections AS LONG GLOBAL hDlgUP AS LONG GLOBAL rDial AS RASDIALPARAMS ' ' load_ras_entries NOT EXPORTED ' ' Fills the given array with the entries in the ras phone book. ' The array rEntry is 1-based. ' Returns the number of entries in the array. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION load_ras_entries(rEntry() AS RASENTRYNAME) AS LONG DIM iRet AS LONG DIM iBufSize AS LONG DIM iNumEntries AS LONG REDIM rEntry(1 TO 1) AS RASENTRYNAME iBufSize = SIZEOF(rEntry(1)) rEntry(1).dwSize = SIZEOF(rEntry(1)) iRet = RasEnumEntries(BYVAL 0, BYVAL 0, rEntry(1), iBufSize, iNumEntries) '- If we have more than one entry, we'll need ' to increase the size of the array. ' IF iRet = %ERROR_BUFFER_TOO_SMALL THEN REDIM rEntry(1 TO iNumEntries) AS RASENTRYNAME iBufSize = SIZEOF(rEntry(1)) * iNumEntries rEntry(1).dwSize = SIZEOF(rEntry(1)) iRet = RasEnumEntries(BYVAL 0, BYVAL 0, rEntry(1), iBufSize, iNumEntries) END IF IF iRet <> 0 THEN FUNCTION = 0 ELSE FUNCTION = iNumEntries END IF END FUNCTION ' ' hangup_and_wait NOT EXPORTED ' ' This routine hangs up a ras connection. Because it takes the program time ' to disconnect, we need to wait until the ras handle is invalidated. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ SUB hangup_and_wait(BYVAL hRas AS LONG) DIM iRet AS LONG DIM rStatus AS RASCONNSTATUS STATIC time AS DWORD LOCAL tekst AS STRING RasHangUp hRas time = timeGetTime IF ISFALSE rsActiveConnections THEN EXIT SUB 'we're not connceted anymore DO rStatus.dwSize = SIZEOF(rStatus) iRet = RasGetConnectStatus(hRas, rStatus) apiSleep 5 IF timeGetTime - time > 5000 THEN 'this should never occur tekst = "An error occured while disconnecting" + CHR$(13) tekst = "Please disconnect manually" MSGBOX tekst EXIT LOOP END IF LOOP UNTIL iRet <> 0 END SUB ' ' collect_active NOT EXPORTED ' ' Takes an array of structures to fill with information ' about the active connections. ' Returns the number of connections found and zero on error. ' FUNCTION collect_active(rConn() AS RASCONN) AS LONG DIM iBufSize AS LONG DIM iNumConn AS LONG DIM iRet AS LONG DIM rConn(1 TO 100) AS RASCONN 'assuming never more than 100 'active connections (safe for now!) iBufSize = SIZEOF(rConn(1)) * UBOUND(rConn) rConn(1).dwSize = SIZEOF(rConn(1)) iRet = RasEnumConnections(rConn(1), iBufSize, iNumConn) IF iRet = 0 THEN FUNCTION =iNumConn ELSE FUNCTION = %False END IF END FUNCTION ' ' rsAvailableEntries ' ' Returns a count of the available entries '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsAvailableEntries ALIAS "rsAvailableEntries" EXPORT AS LONG DIM rEntry(1) AS RASENTRYNAME FUNCTION = load_ras_entries(rEntry()) END FUNCTION ' ' rsGetEntryName ' ' Returns a RAS entry by name based in it's number ' as returned by rsAvailableEntries ' '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsGetEntryName ALIAS "rsGetEntryName" (BYVAL iEntry AS LONG) EXPORT AS STRING DIM iCount AS LONG DIM rEntry(1) AS RASENTRYNAME iCount = load_ras_entries(rEntry()) IF (iEntry < 1) OR (iEntry > iCount) THEN FUNCTION = "" ELSE FUNCTION = TRIM$(rEntry(iEntry).szEntryName) END IF END FUNCTION ' ' rsDialEntry ' ' Dials a RAS Connection ' Returns non-zero RAS Handle On success ' %False On Failure '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsDialEntry ALIAS "rsDialEntry" (BYVAL iEntry AS LONG) EXPORT AS LONG DIM hRas AS LONG DIM iRet AS LONG DIM iCount AS LONG DIM iPassword AS LONG DIM rEntry(1) AS RASENTRYNAME DIM rDialEx AS RASDIALEXTENSIONS DIM rStatus AS RASCONNSTATUS ' LOCAL hDlg AS LONG LOCAL tekst AS STRING '- Find the entry we want iCount = load_ras_entries(rEntry()) IF (iCount < 1) OR (iEntry < 1) OR (iEntry > iCount) THEN FUNCTION = %False ELSE '- Get it's dialing parameters rDial.dwSize = SIZEOF(rDial) rDial.szEntryName = TRIM$(rEntry(iEntry).szEntryName) iRet = RasGetEntryDialParams(BYVAL 0, rDial, iPassword) IF iRet <> 0 THEN MSGBOX "failed getting dialentryparams" FUNCTION = %False ELSE IF rDial.szUsername="" OR rDial.szPassWord="" THEN tekst= "Dialup" DIALOG NEW %HWND_DESKTOP,tekst,1,1,200,200 TO hDlgUP tekst = "Please give your username and password for "+rsGetEntryname(iEntry) CONTROL ADD LABEL, hDlgUP,-1,tekst,3,3,200,16 tekst = "Username:" CONTROL ADD LABEL, hDlgUP,-1,tekst,3,32,80,16 tekst = rDial.szUsername CONTROL ADD TEXTBOX, hDlgUP,1, tekst,40,32,120,12 tekst = "Password:" CONTROL ADD LABEL, hDlgUP,-1,tekst,3,50,80,16 tekst =rDial.szPassWord CONTROL ADD TEXTBOX, hDlgUP,2, tekst,40,50,120,12,%ES_PASSWORD OR %ES_LEFT,%WS_EX_CLIENTEDGE tekst = "Connect" CONTROL ADD BUTTON, hDlgUP,3, tekst,80,80,40,16, CALL username_password_callback DIALOG SHOW MODAL hDlgUP END IF 'OR ISFALSE rDial. '- Make the connection rDial.dwSize = SIZEOF(rDial) rDialEx.dwSize = SIZEOF(rDialEx) iRet = RasDial ( rDialEx, BYVAL 0, rDial, 0, 0, hRas ) '- Check for an error IF iRet <> 0 THEN hangup_and_wait hRas FUNCTION = %False ELSE '- Get the connections status rStatus.dwSize = SIZEOF(rStatus) IF RasGetConnectStatus(hRas, rStatus) <> 0 THEN hangup_and_wait hRas FUNCTION = %False ELSE IF rStatus.rasconnstate = %RASCS_CONNECTED THEN FUNCTION = hRas ELSE hangup_and_wait hRas FUNCTION = %False END IF END IF END IF END IF END IF END FUNCTION ' 'callback function for the dialog that asks the username and password ' CALLBACK FUNCTION username_password_callback AS LONG CONTROL GET TEXT hDlgUP,1 TO rDial.szUsername CONTROL GET TEXT hDlgUP,2 TO rDial.szPassword IF rDial.szUsername="" OR rDial.szPassWord="" THEN MSGBOX "Please fill in your username and password" EXIT FUNCTION END IF DIALOG END hDlgUP END FUNCTION ' ' rsActiveConnections ' ' Returns a count of active connections '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsActiveConnections ALIAS "rsActiveConnections" EXPORT AS LONG DIM rConn(1 TO 100) AS RASCONN FUNCTION = collect_active(rConn()) END FUNCTION ' ' rsGetConnectionName ' ' Returns the entry name of an active connection based on it's "number" ' as returned by rsActiveConnections ' FUNCTION rsGetConnectionName ALIAS "rsGetConnectionName" ( BYVAL iConnection AS LONG ) EXPORT AS STRING DIM iNumConn AS LONG DIM rConn(1 TO 100) AS RASCONN 'assuming never more than 100 'active connections (safe for now!) iNumConn = collect_active(rConn()) IF (iConnection < 1) OR (iConnection > iNumConn) THEN FUNCTION = "" ELSE FUNCTION = TRIM$(rConn(1).szEntryName) END IF END FUNCTION ' ' rsGetConnectionHandle ' ' Returns the hRas handle to the active connection based on it's "number" ' as specified by rsActiveConnections. Returns Zero on error. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsGetConnectionHandle ALIAS "rsGetConnectionHandle" ( BYVAL iConnection AS LONG ) EXPORT AS LONG DIM iNumConn AS LONG DIM rConn(1 TO 100) AS RASCONN 'assuming never more than 100 'active connections (safe for now!) iNumConn = collect_active(rConn()) IF (iConnection < 1) OR (iConnection > iNumConn) THEN FUNCTION = 0 ELSE FUNCTION = rConn(1).hRasConn END IF END FUNCTION ' ' rsHangupConnection ' ' Hangs up a connection given it's handle and doesn't return ' until the connection is disconnected. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FUNCTION rsHangUpConnection ALIAS "rsHangUpConnection" ( BYVAL hRas AS LONG ) EXPORT AS LONG hangup_and_wait hRas END FUNCTION