VB Tip: obter uso de memória RAM e de CPU

Olá.
Essa semana, pelos comentários, perguntaram como acessar o uso de memória RAM e de CPU no Visual Basic 6, uma vez que o MultiSystem Sidebar consegue tal feito. Ensinarei aqui o código necessário para acessar tais informações.


Primeiramente se deve saber de uma coisa: o funcionamento ou não do código dependerá do sistema operacional utilizado. Pelo menos aqui no Seven funciona, no Vista também funciona (já testei) e no XP, idem (foi lá onde desenvolvi o aplicativo). Sendo assim, o código deverá não funcionar em sistemas operacionais antigos como WinME ou Win98. Mas quem ainda usa esses sistemas operacionais hoje em dia?? Enfim.
Irei dividir em duas partes: a primeira tratará do uso de RAM e o outro tratará do uso de CPU.

Uso de RAM

Iremos precisar da API GlobalMemoryStatus da biblioteca kernel32 (onde a maioria das APIs são para acesso à seção de hardware. Beep é um exemplo.) cujo único parâmetro é uma referência do tipo MEMORYSTATUS.
Antes de começarmos, crie um novo projeto Standard EXE (pode ser também uma DLL).
Adicione ao projeto um módulo e uma classe. Chamaremos o módulo de mApi (mas pode-se colocar qualquer nome no módulo;a classe trataremos depois, portanto, não mexa nela).

Feito isso, adicione o seguinte código ao módulo:
Public Type MEMORYSTATUS dwLength As Long dwMemoryLoad As Long dwTotalPhys As Long dwAvailPhys As Long dwTotalPageFile As Long dwAvailPageFile As Long dwTotalVirtual As Long dwAvailVirtual As Long End Type Public Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Feita a declaração da API e do tipo necessários para a obtenção das informações desejadas, iremos criar uma função que retornará o valor de utilização da memória RAM.

Adicione a seguinte função abaixo das declarações do módulo:
Public Function UsoDeRAM() As String 'Aqui pode ser qualquer nome que desejar. Dim Mem As MEMORYSTATUS Mem.dwLength = Len(Mem) GlobalMemoryStatus Mem UsoDeRAM=CStr(Mem.dwMemoryLoad) 'Se alterar o nome da função, altere aqui também! End Function

Feito isso, você pode usar a função UsoDeRAM a qualquer momento, seja na atribuição à propriedade Caption de uma label ou à uma função Print de algum container.

Uso de CPU

A obtenção do uso de CPU requer uma classe. Utilizaremos a classe que criamos anteriormente. Nomeie-a de cCpu.

Nela, insira o seguinte código:

Option Explicit Private Const SYSTEM_BASICINFORMATION = 0& Private Const SYSTEM_PERFORMANCEINFORMATION = 2& Private Const SYSTEM_TIMEINFORMATION = 3& Private Const NO_ERROR = 0 Private Type LARGE_INTEGER dwLow As Long dwHigh As Long End Type Private Type SYSTEM_BASIC_INFORMATION dwUnknown1 As Long uKeMaximumIncrement As Long uPageSize As Long uMmNumberOfPhysicalPages As Long uMmLowestPhysicalPage As Long uMmHighestPhysicalPage As Long uAllocationGranularity As Long pLowestUserAddress As Long pMmHighestUserAddress As Long uKeActiveProcessors As Long bKeNumberProcessors As Byte bUnknown2 As Byte wUnknown3 As Integer End Type Private Type SYSTEM_PERFORMANCE_INFORMATION liIdleTime As LARGE_INTEGER dwSpare(0 To 75) As Long End Type Private Type SYSTEM_TIME_INFORMATION liKeBootTime As LARGE_INTEGER liKeSystemTime As LARGE_INTEGER liExpTimeZoneBias As LARGE_INTEGER uCurrentTimeZoneId As Long dwReserved As Long End Type Private Declare Function NtQuerySystemInformation Lib "ntdll" (ByVal dwInfoType As Long, ByVal lpStructure As Long, ByVal dwSize As Long, ByVal dwReserved As Long) As Long Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long) Private liOldIdleTime As LARGE_INTEGER Private liOldSystemTime As LARGE_INTEGER Public Sub Initialize() Dim SysTimeInfo As SYSTEM_TIME_INFORMATION Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION Dim Ret As Long Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while initializing the system's time!", vbCritical Exit Sub End If Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&) If Ret <> NO_ERROR Then Debug.Print "Error while initializing the CPU's idle time!", vbCritical Exit Sub End If liOldIdleTime = SysPerfInfo.liIdleTime liOldSystemTime = SysTimeInfo.liKeSystemTime End Sub Public Function Query() As Long Dim SysBaseInfo As SYSTEM_BASIC_INFORMATION Dim SysPerfInfo As SYSTEM_PERFORMANCE_INFORMATION Dim SysTimeInfo As SYSTEM_TIME_INFORMATION Dim dbIdleTime As Currency Dim dbSystemTime As Currency Dim Ret As Long Query = -1 Ret = NtQuerySystemInformation(SYSTEM_BASICINFORMATION, VarPtr(SysBaseInfo), LenB(SysBaseInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the number of processors!", vbCritical Exit Function End If Ret = NtQuerySystemInformation(SYSTEM_TIMEINFORMATION, VarPtr(SysTimeInfo), LenB(SysTimeInfo), 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the system's time!", vbCritical Exit Function End If Ret = NtQuerySystemInformation(SYSTEM_PERFORMANCEINFORMATION, VarPtr(SysPerfInfo), LenB(SysPerfInfo), ByVal 0&) If Ret <> NO_ERROR Then Debug.Print "Error while retrieving the CPU's idle time!", vbCritical Exit Function End If dbIdleTime = LI2Currency(SysPerfInfo.liIdleTime) - LI2Currency(liOldIdleTime) dbSystemTime = LI2Currency(SysTimeInfo.liKeSystemTime) - LI2Currency(liOldSystemTime) If dbSystemTime <> 0 Then dbIdleTime = dbIdleTime / dbSystemTime dbIdleTime = 100 - dbIdleTime * 100 / SysBaseInfo.bKeNumberProcessors + 0.5 Query = Int(dbIdleTime) liOldIdleTime = SysPerfInfo.liIdleTime liOldSystemTime = SysTimeInfo.liKeSystemTime End Function Private Function LI2Currency(liInput As LARGE_INTEGER) As Currency CopyMemory LI2Currency, liInput, LenB(liInput) End Function Public Sub Terminate() 'Nada a fazer. End Sub

Sim, o código é realmente extenso. Portanto, explicarei somente o necessário. No módulo que criamos, insira, abaixo da declaração "GlobalMemoryStatus", o seguinte código:

Dim cpusage as cCpu Sub InitCPU() Set cpusage = new cCpu 'Cria uma nova instância de cCpu End Sub Sub EndCPU() Set cpusage = Nothing ' Remove a instância de cCpu da memória End Sub Function GetCPU() As String GetCPU = CStr(Abs(cpusage.Query)) 'retorna o valor de uso da cpu End Function

A função Query retorna o valor de uso da cpu através da classe e de suas APIs internas.

Se quiser, pode baixar o exemplo pronto através do link https://skydrive.live.com/?cid=B278D5E7A71B5DCA&sc=documents#!/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA!152!cid=B278D5E7A71B5DCA&id=B278D5E7A71B5DCA!152 (pasta do SkyDrive).

É isso pessoal.
Até o próximo artigo!

VB Tip: Criando menu de modo fácil - MenuCreator

Olá.
Neste artigo irei disponibilizar uma nova classe/livraria que criei, chamada MenuCreator, cuja classe chama-se cMenu. O objetivo principal dele é criar e manipular menus de modo bem simples. O link dele é https://skydrive.live.com/?cid=b278d5e7a71b5dca&sc=documents&nl=1&uc=1&id=B278D5E7A71B5DCA%21146# (pasta do SkyDrive). Nele há cinco métodos, entre eles:

• Add (menuh as Long, Pos as Long, Text as String, [Flags as long, lpimage as stdpicture]): Adiciona um item à um menu existente.
  Menuh recebe o endereço handle do menu.
  Pos recebe um número que posteriormente será identificado por sua função, número este maior que 0.
  Text recebe o texto do item. Flags (opcional) recebe as opções do item, listadas abaixo (que podem ser combinadas com o operador binário OR):
  * MF_DISABLED = &H2& - Desabilita o item (mas não o torna cinza, veremos isso depois);
  * MF_GRAYED = &H1& - Torna o item cinza (mas não o torna desabilitado; para desabilitá-lo e torná-lo cinza, use (MF_DISABLED OR MF_GRAYED).);
  * MF_SEPARATOR = &H800& (NÃO COMBINÁVEL!) - Torna o item em uma barra horizontal de separação de itens.
  * MF_POPUP = &H10& - Inicia um novo menu ao lado.
  


• Count (menuh as Long) as Long: Retorna a quantidade de itens em um determinado menu. Menuh recebe o endereço handle do menu.


• Create () As Long: Cria um novo menu, e retorna seu handle para ser manipulado pelas outras quatro funções.


• Destroy (menuHandle as Long): remove um menu da memória, menu este determinado pelo endereço handle em menuHandle.


• Show (menuh as Long, owner as Long, x as Double, y as Double) as Long: Exibe um menu. Menuh recebe o endereço handle do menu, owner recebe o endereço handle do formulário pai (Me.hWnd), x e y recebem a posição absoluta (em pixels) do menu, na tela.

Para o valor de x e y no método show, usamos uma das duas APIs seguintes:
* ClientToScreen - Transforma uma coordenada local do formulário em uma coordenada absoluta da tela.
* GetCursorPos - Obtém a posição atual do cursor do mouse.

Ambos usam a estrutura POINTAPI, cujos elementos são X, como LONG, e Y, também LONG.

Abaixo vai um exemplo. Crie um form em um projeto do tipo Standard Exe, adicione um botão no topo esquerdo do form e adicione o seguinte código no formulário:
Private Type POINTAPI x As Long y As Long End Type Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Sub Command1_Click() Me.ScaleMode = vbPixels Dim pt As POINTAPI Dim r As Long Dim h As Long Dim m As New cMenu h = m.Create For i = 1 To 20 m.Add h, i, "Meu item " & CStr(i) Next i pt.x = Command1.Left pt.y = Command1.Top ClientToScreen Me.hwnd, pt r = m.Show(h, Me.hwnd, pt.x, pt.y) m.Destroy h Set m = Nothing Select Case r Case 1 To 20 MsgBox "Você selecionou o item " & CStr(r) Case Else MsgBox "Você não selecionou nenhum item" End Select End Sub
"h=m.create" cria um novo menu e atribui o endereço do novo menu ao h. m.add adiciona os itens de 1 a 20 no menu criado. pt.x, pt.y, e clienttoscreen transformam a posição do botão em coordenadas absolutas da tela.

"r=m.show" exibe o menu na tela e retorna o item selecionado, e, caso nenhum item for selecionado, retorna zero. Daí a necessidade dos itens adicionados terem identificação (Pos as long) maior que 0.
"m.destroy" e "set m=nothing" são necessários para liberar memória, tanto do menu (destroy h) quanto da classe cMenu (set m=nothing).

Para manipulações mais complexas como por exemplo, adição de linhas verticais no menu para dispô-los em colunas, deve-se usar APIs externas à classe, como SetMenuItemInfo e similares.

Com essa classe, você pode criar um menu customizado para um formulário borderless (BorderStyle=0), abaixo do que seria o título.
Enfim, você poderá usar essa classe para facilitar a programação com menus.
Em breve, nova versão do Multisystem com formulários renovados e com menus, com auxílio dessa nova classe por mim criada.
É isso, pessoal.
Até o próximo artigo!