home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD89038122000.psc / basSessionController.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-12  |  3.8 KB  |  117 lines
  1. Attribute VB_Name = "basSessionController"
  2.  
  3. Public Const TEMPO_INICIAL_DE_TIMEOUT As Integer = 30  ' 30 minutos
  4.  
  5. Public dbdLog As Database
  6. Public tbLog As Recordset
  7. Public strTabDesc(1 To 5) As String
  8. Public strTabDescE(1 To 5) As String
  9. Public strtabDescP(1 To 5) As String
  10. Public strLanguage As String
  11. Global Const PortuguΩs As String = "P", English As String = "E"
  12. Public intTempoTimeOut As Integer
  13. Public strMsgErro01 As String
  14.  
  15. Public Declare Function RasEnumConnections Lib "RasApi32.dll" Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long, lpcConnections As Long) As Long
  16. Public Declare Function RasGetConnectStatus Lib "RasApi32.dll" Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus As Any) As Long
  17. Public Declare Function RasHangUp Lib "RasApi32.dll" Alias "RasHangUpA" (ByVal hRasCon As Long) As Long
  18.  
  19.  
  20. Public blnConnected As Boolean
  21. Public AlterouTimeout As Boolean
  22. Public intTimeOut As Integer
  23. Public blnEncerraConexπo As Boolean
  24. Declare Function ExitWindowsEx& Lib "user32" (ByVal uFlags&, ByVal wReserved&)
  25. Global Const EWX_FORCE = 4 'constants needed for exiting Windows
  26. Global Const EWX_LOGOFF = 0
  27. Global Const EWX_REBOOT = 2
  28. Global Const EWX_SHUTDOWN = 1
  29. '* Variaveis utilizadas para a funτπo que coloca o
  30. '* form no Topo ou retira essa opτπo
  31. Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  32. Global Const SWP_NOMOVE = 2
  33. Global Const SWP_NOSIZE = 1
  34. Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  35. Global Const HWND_TOPMOST = -1
  36. Global Const HWND_NOTOPMOST = -2
  37.  
  38.  
  39. Public Const RAS95_MaxEntryName = 256
  40. Public Const RAS95_MaxDeviceType = 16
  41. Public Const RAS95_MaxDeviceName = 32
  42. '
  43. Public RetCode As Long
  44.  
  45.  
  46. Public Type RASCONN95
  47.     dwSize As Long
  48.     hRasCon As Long
  49.     szEntryName(RAS95_MaxEntryName) As Byte
  50.     szDeviceType(RAS95_MaxDeviceType) As Byte
  51.     szDeviceName(RAS95_MaxDeviceName) As Byte
  52. End Type
  53. '
  54. Public Type RASCONNSTATUS95
  55.     dwSize As Long
  56.     RasConnState As Long
  57.     dwError As Long
  58.     szDeviceType(RAS95_MaxDeviceType) As Byte
  59.     szDeviceName(RAS95_MaxDeviceName) As Byte
  60. End Type
  61.  
  62. Public TRasCon(255) As RASCONN95
  63.  
  64. Public Function AlteraPosiτπoDoForm(frm As Form, Posiτπo As String)
  65.     Select Case Posiτπo
  66.        Case "Topo"
  67.           'To set Form1 as a TopMost form, do the following:
  68.           AlteraPosiτπoDoForm = SetWindowPos(frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  69.        Case "Normal"
  70.          'To turn off topmost (make the form act normal again):
  71.          AlteraPosiτπoDoForm = SetWindowPos(frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  72.     End Select
  73. End Function
  74. Public Function IsConnected() As Boolean
  75. 'Dim TRasCon(255) As RASCONN95
  76. Dim lg As Long
  77. Dim lpcon As Long
  78. Dim RetVal As Long
  79. Dim Tstatus As RASCONNSTATUS95
  80. '
  81. TRasCon(0).dwSize = 412
  82. lg = 256 * TRasCon(0).dwSize
  83.  
  84. RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
  85. If RetVal <> 0 Then
  86.    MsgBox "SessionController.900I " & strMsgErro01 & RetVal
  87.    Exit Function
  88. End If
  89. '
  90. Tstatus.dwSize = 160
  91. RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
  92. If blnEncerraConexπo And Not IsMissing(RetCode) Then
  93.     RetCode = Tstatus.RasConnState
  94. End If
  95. If Tstatus.RasConnState = &H2000 Then
  96.    IsConnected = True
  97. Else
  98.    IsConnected = False
  99. End If
  100.  
  101. End Function
  102.  
  103.  
  104. Public Sub InsereEventoNoLog(Id As Long)
  105.         Dim datDate As Date
  106.         datDate = Now
  107.         tbLog.AddNew
  108.         tbLog!Id = Id
  109.         tbLog!Desc = strTabDesc(Id)
  110.         tbLog!DateTime = datDate
  111.         tbLog!dia = Format(datDate, "dd")
  112.         tbLog.Update
  113.         frmSessionController.List1.AddItem strTabDesc(Id) & Format(datDate, "dd/mm/yyyy hh:mm:ss")
  114.         frmSessionController.List1.ListIndex = frmSessionController.List1.NewIndex
  115.  
  116. End Sub
  117.