IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)



Le nom de ma machine et de la session
auteur : Morsi
Des fois, nous aurons besoin des nom de machines pour les fichiers log par exemple ou pour tracer un traitement.

Coller ce code après Options Explicit.

Private Const MAX_COMPUTERNAME_LENGTH As Long = 31 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'--Déterminer le nom de la machine Private Function recherche_name() As String Dim dwLen As Long Dim strString As String Dim strUserName As String dwLen = MAX_COMPUTERNAME_LENGTH + 1 strString = String(dwLen, "X") strUserName = String(100, Chr$(0)) GetComputerName strString, dwLen GetUserName strUserName, 100 strUserName = Left$(strUserName, InStr(strUserName, Chr$(0)) - 1) txt_ip.Value = strUserName strString = Left(strString, dwLen) recherche_name = strString End Function
Une autre méthode proposé par Thierry AIM

Dim strComputerName As String Dim strUserName As String strComputerName = Environ("COMPUTERNAME") strUserName = Environ("USERNAME")

Déterminer mon adresse IP
auteur : Morsi
Dans un module et juste aprés option explicite, coller la déclaration de ces variables:

Const MAX_IP = 5 ' --créer un buffer ... je pense pas que vous en avez plus que 5 Type IPINFO dwAddr As Long ' -- adresse IP dwIndex As Long dwMask As Long dwBCastAddr As Long dwReasmSize As Long unused1 As Integer unused2 As Integer End Type Type MIB_IPADDRTABLE dEntrys As Long mIPInfo(MAX_IP) As IPINFO End Type Type IP_Array mBuffer As MIB_IPADDRTABLE BufferLen As Long End Type Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, Source As Any, ByVal Length As Long) Public Declare Function GetIpAddrTable Lib "IPHlpApi" (pIPAdrTable As Byte, pdwSize As Long, ByVal Sort As Long) As Long
' --convertion d'un Long vers un string Public Function ConvertAddressToString(longAddr As Long) As String Dim myByte(3) As Byte Dim Cnt As Long CopyMemory myByte(0), longAddr, 4 For Cnt = 0 To 3 ConvertAddressToString = ConvertAddressToString + CStr(myByte(Cnt)) + "." Next Cnt ConvertAddressToString = Left$(ConvertAddressToString, Len(ConvertAddressToString) - 1) End Function
Maintenant, sur l'évenement click du bouton IP:

' --Déterminer l'adresse IP Public Function Get_IP_Click() As String Dim Ret As Long, Tel As Long Dim bBytes() As Byte Dim TempList() As String Dim TempIP As String Dim Tempi As Long Dim Listing As MIB_IPADDRTABLE Dim L3 As String On Error GoTo END1 GetIpAddrTable ByVal 0&, Ret, True If Ret <= 0 Then Exit Function ReDim bBytes(0 To Ret - 1) As Byte ReDim TempList(0 To Ret - 1) As String GetIpAddrTable bBytes(0), Ret, False CopyMemory Listing.dEntrys, bBytes(0), 4 For Tel = 0 To Listing.dEntrys - 1 CopyMemory Listing.mIPInfo(Tel), bBytes(4 + (Tel * Len(Listing.mIPInfo(0)))), Len(Listing.mIPInfo(Tel)) TempList(Tel) = ConvertAddressToString(Listing.mIPInfo(Tel).dwAddr) Next Tel TempIP = TempList(0) For Tempi = 0 To Listing.dEntrys - 1 L3 = Left(TempList(Tempi), 3) If L3 <> "169" And L3 <> "127" And L3 <> "192" Then TempIP = TempList(Tempi) End If Next Tempi GetWanIP = TempIP 'Return The TempIP Exit Function END1: GetWanIP = "" End Function

Déterminer la famille de mon processeur
auteur : Morsi
Ajouter ce code aprés Options Explicites:

Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Private Type SYSTEM_INFO dwOemID As Long dwPageSize As Long lpMinimumApplicationAddress As Long lpMaximumApplicationAddress As Long dwActiveProcessorMask As Long dwNumberOrfProcessors As Long dwProcessorType As Long dwAllocationGranularity As Long dwReserved As Long End Type
Ensuite faite appel à getsysinfo()

Private Sub getsysinfo() Dim SInfo As SYSTEM_INFO GetSystemInfo SInfo MsgBox "Processeur de type " & str$(SInfo.dwProcessorType) End Sub

Déterminer la taille de la RAM
auteur : Morsi
Ajouter ce code juste aprés Options Explicites dans un nouveau module:

Private 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 Private Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As MEMORYSTATUS)
Faite appel maintenat à memoireinfo() pour avoir les informations sur la RAM

Sub memoireinfo() Dim MemStat As MEMORYSTATUS GlobalMemoryStatus MemStat MsgBox "Vous avez " & (MemStat.dwTotalPhys / 1024) / 1024 & " Mo de RAM" MsgBox "Vous avez " & (MemStat.dwAvailPhys / 1024) / 1024 & " Mo de RAM disponible" End Sub