Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
                                       (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, _
                                       ByVal wReturnLength As Integer, ByVal hCallback As Integer) As Long
                                                   
Public Sub Ejecte()

mciSendString "Set CDAudio Door Open Wait", 0&, 0, 0

End Sub

Public Function LecteurAvecCD() As String

    Dim fso As FileSystemObject, lecteur As Drive
    Dim strPath As String, strLecteurCD As String
   
    Set fso = New FileSystemObject
           
    For Each lecteur In fso.Drives
        If lecteur.DriveType = 4 Then
            On Error GoTo suite
            strPath = Dir(lecteur.path)
            strLecteurCD = lecteur.path
            Exit For
        End If
suite:
    Next

    Set fso = Nothing
    LecteurAvecCD = strLecteurCD
   
End Function

Public Function TypeLecteur(ByVal drvpath) As String

    Dim fs As FileSystemObject, d As drive, t As String
   
    Set fs = New FileSystemObject
   
    On Error GoTo fail
    Set d = fs.GetDrive(drvpath)
   
    Select Case d.DriveType
        Case 0: t = "Inconnu"
        Case 1: t = "Amovible"
        Case 2: t = "Fixe"
        Case 3: t = "Réseau"
        Case 4: t = "CD-ROM"
        Case 5: t = "Disque RAM"
    End Select
   
fin:
    TypeLecteur = t
    Exit Function

fail:
    t = "Introuvable"
    Resume fin
   
End Function

MsgBox TypeLecteur("c")

Dim fso As FileSystemObject [Lucifer]
Dim d As Drive 

Set fso = New FileSystemObject 

For Each d In fso.Drives 
    MsgBox d.DriveLetter    
Next d 

Set fso = Nothing

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)

Dim MS As MEMORYSTATUS
Dim chaine As String

MS.dwLength = Len(MS)
GlobalMemoryStatus MS
   
chaine = "Pourcentage RAM utilisé : " & Format$(MS.dwMemoryLoad, "###,###,###,###") & "  %" & vbCrLf
' On divise toutes les valeurs par 1024 pour les convertir en kilooctets
chaine = chaine & "Taille de la mémoire physique totale : " & _
                      Format$(MS.dwTotalPhys / 1024, "###,###,###,###") & " Ko" & vbCrLf
chaine = chaine & "Mémoire physique disponible : " & _
                      Format$(MS.dwAvailPhys / 1024, "###,###,###,###") & "  Ko" & vbCrLf
chaine = chaine & "Mémoire virtuelle totale : " & _
                      Format$(MS.dwTotalVirtual / 1024, "###,###,###,###") & " Ko" & vbCrLf
chaine = chaine & "Mémoire virtuelle disponible : " & _
                      Format$(MS.dwAvailVirtual / 1024, "###,###,###,###") & " Ko" & vbCrLf

MsgBox Environ("COMPUTERNAME")

Public Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _
                                        (ByVal lpBuffer As String, nSize As Long) As Long

Private Function NomOrdinateur() As String

Dim sComputerName As String
Dim iSize As Long

' Un premier appel pour avoir le nombre de caractères nécessaires pour sComputerName
GetComputerName sComputerName, iSize

' On met sComputerName à la bonne taille
sComputerName = Space(iSize)

' Appel final
GetComputerName sComputerName, iSize
NomOrdinateur = sComputerName
  
' P.-S. : on aurait aussi pu déclarer sComputerName avec une taille assez grande :
'     (dim sComputerName as string*32).
'     Un seul appel de GetComputerName aurait alors suffi

End Function

'Définition des constantes
Private Const MAX_PREFERRED_LENGTH As Long = -1
Private Const NERR_SUCCESS As Long = 0&
Private Const ERROR_MORE_DATA As Long = 234&
Private Const SV_TYPE_ALL As Long = &HFFFFFFFF
Private Const SV_PLATFORM_ID_OS2 As Long = 400
Private Const SV_PLATFORM_ID_NT As Long = 500

' Masque pour obtenir la version OS Majeure à partir de la variable version globale
Private Const MAJOR_VERSION_MASK As Long = &HF

Private Type SERVER_INFO_100
    sv100_platform_id As Long
    sv100_name As Long
End Type

Private Declare Function NetServerEnum Lib "netapi32" _
  (ByVal servername As Long, ByVal level As Long, buf As Any, _
   ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, _
   ByVal servertype As Long, ByVal domain As Long, resume_handle As Long) As Long

Private Declare Function NetApiBufferFree Lib "netapi32" (ByVal Buffer As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  (pTo As Any, uFrom As Any, ByVal lSize As Long)
   
Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long

Public Function GetServers(sDomain As String) As String

    ' Liste de tous les serveurs dans un domaine
    
    Dim bufptr          As Long
    Dim dwEntriesread   As Long
    Dim dwTotalentries  As Long
    Dim dwResumehandle  As Long
    Dim se100           As SERVER_INFO_100
    Dim success         As Long
    Dim nStructSize     As Long
    Dim cnt             As Long
    Dim resultat        As String
    
    nStructSize = LenB(se100)
    ' La liste des noms est obtenue avec la fonction NetServerEnum
    success = NetServerEnum(0&, 100, bufptr, MAX_PREFERRED_LENGTH, dwEntriesread, _
                           dwTotalentries, SV_TYPE_ALL, 0&, dwResumehandle)

    If success = NERR_SUCCESS And _
          success <> ERROR_MORE_DATA Then 'si tout se passe bien
     
        For cnt = 0 To dwEntriesread - 1
            CopyMemory se100, ByVal bufptr + (nStructSize * cnt), nStructSize
            ' On scanne le buffer en memoire et pour chaque entrée, conversion en String
            resultat = resultat & GetPointerToByteStringW(se100.sv100_name) & "|"
        Next
     
   End If
   
  ' Nettoyage du buffer que le système a réservé pour la liste des noms
   Call NetApiBufferFree(bufptr)
   
  ' On retourne le string contenant les noms séparés par des "|"
   GetServers = resultat

End Function

Public Function GetPointerToByteStringW(ByVal dwData As Long) As String
 
    ' Fonction auxiliaire qui reçoit un pointeur vers une chaîne dans un buffer interne
    ' Windows et la convertit en String exploitable en VB
 
    Dim tmp() As Byte
    Dim tmplen As Long
    
    If dwData <> 0 Then    
        tmplen = lstrlenW(dwData) * 2        
        If tmplen <> 0 Then        
            ReDim tmp(0 To (tmplen - 1)) As Byte
            CopyMemory tmp(0), ByVal dwData, tmplen
            GetPointerToByteStringW = tmp         
        End If     
    End If
   
End Function

Dim maliste as String
maliste=GetServers(vbNullString)

Private Const NCBASTAT As Long = &H33
Private Const NCBNAMSZ As Long = 16
Private Const HEAP_ZERO_MEMORY As Long = &H8
Private Const HEAP_GENERATE_EXCEPTIONS As Long = &H4
Private Const NCBRESET As Long = &H32

Private Type NET_CONTROL_BLOCK
    ' Définition du type net control Block
    ncb_command    As Byte
    ncb_retcode    As Byte
    ncb_lsn        As Byte
    ncb_num        As Byte
    ncb_buffer     As Long
    ncb_length     As Integer
    ncb_callname   As String * NCBNAMSZ
    ncb_name       As String * NCBNAMSZ
    ncb_rto        As Byte
    ncb_sto        As Byte
    ncb_post       As Long
    ncb_lana_num   As Byte
    ncb_cmd_cplt   As Byte
    ncb_reserve(9) As Byte
    ncb_event      As Long
End Type

Private Type ADAPTER_STATUS
    ' Définition du type pour définir le statut de l'adaptateur réseau
    adapter_address(5) As Byte
    rev_major         As Byte
    reserved0         As Byte
    adapter_type      As Byte
    rev_minor         As Byte
    duration          As Integer
    frmr_recv         As Integer
    frmr_xmit         As Integer
    iframe_recv_err   As Integer
    xmit_aborts       As Integer
    xmit_success      As Long
    recv_success      As Long
    iframe_xmit_err   As Integer
    recv_buff_unavail As Integer
    t1_timeouts       As Integer
    ti_timeouts       As Integer
    Reserved1         As Long
    free_ncbs         As Integer
    max_cfg_ncbs      As Integer
    max_ncbs          As Integer
    xmit_buf_unavail  As Integer
    max_dgram_size    As Integer
    pending_sess      As Integer
    max_cfg_sess      As Integer
    max_sess          As Integer
    max_sess_pkt_size As Integer
    name_count        As Integer
End Type
   
Private Type NAME_BUFFER
    name        As String * NCBNAMSZ
    name_num    As Integer
    name_flags  As Integer
End Type

Private Type ASTAT
    adapt          As ADAPTER_STATUS
    NameBuff(30)   As NAME_BUFFER
End Type

Private Declare Function Netbios Lib "netapi32" (pncb As NET_CONTROL_BLOCK) As Byte
     
Private Declare Sub CopyMemory Lib "kernel32" _
     Alias "RtlMoveMemory" (hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
     
Private Declare Function GetProcessHeap Lib "kernel32" () As Long

Private Declare Function HeapAlloc Lib "kernel32" _
    (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
     
Private Declare Function HeapFree Lib "kernel32" _
    (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long

Public Function GetMACAddress() As String

    Dim tmp As String
    Dim pASTAT As Long
    Dim NCB As NET_CONTROL_BLOCK
    Dim AST As ASTAT
   
    NCB.ncb_command = NCBRESET
    Call Netbios(NCB)
     
    NCB.ncb_callname = "*               "
    NCB.ncb_command = NCBASTAT
     
    NCB.ncb_lana_num = 0
    NCB.ncb_length = Len(AST)
    ' Allocation de la mémoire dans le tas du processus
    pASTAT = HeapAlloc(GetProcessHeap(), HEAP_GENERATE_EXCEPTIONS Or _
                       HEAP_ZERO_MEMORY, NCB.ncb_length)
             
    If pASTAT = 0 Then
        Debug.Print "Pas assez de mémoire!" 'Bon, y a peu de chance que ça arrive :o)
        Exit Function
    End If
     
    NCB.ncb_buffer = pASTAT
    ' Appel de la fonction NetBIOS qui va nous donner les stats de la carte
    '   (dont l'adresse MAC)
    Call Netbios(NCB)
     
    CopyMemory AST, NCB.ncb_buffer, Len(AST)
     
    tmp = Right$("00" & Hex(AST.adapt.adapter_address(0)), 2) & " " & _
          Right$("00" & Hex(AST.adapt.adapter_address(1)), 2) & " " & _
          Right$("00" & Hex(AST.adapt.adapter_address(2)), 2) & " " & _
          Right$("00" & Hex(AST.adapt.adapter_address(3)), 2) & " " & _
          Right$("00" & Hex(AST.adapt.adapter_address(4)), 2) & " " & _
          Right$("00" & Hex(AST.adapt.adapter_address(5)), 2)
    ' Désallocation de la mémoire...
    HeapFree GetProcessHeap(), 0, pASTAT
     
    GetMACAddress = tmp

End Function

Public Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hwnd As Long, _
                                                            ByVal dwType As Long) As Long
Public Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hwnd As Long, _
                                                            ByVal dwType As Long) As Long
Public Const RESOURCETYPE_DISK = &H1, RESOURCETYPE_PRINT = &H2

Dim x As Long

' Connecter un lecteur réseau
x = WNetConnectionDialog(Me.hwnd, RESOURCETYPE_DISK)

' Déconnecter un lecteur réseau
x = WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_DISK)

' Connecter une imprimante
x = WNetConnectionDialog(Me.hwnd, RESOURCETYPE_PRINT)

' Déconnecter une imprimante
x = WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_PRINT)

Private Declare Function EnumPorts Lib "winspool.drv" Alias "EnumPortsA" _
                                   (ByVal pName As String, ByVal nLevel As Long, _
                                    lpbPorts As Any, ByVal cbBuf As Long, _
                                    pcbNeeded As Long, pcReturned As Long) As Long

Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As Long
Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long

Private Const SIZEOFPORT_INFO_2 = 20

Private Type PORT_INFO_2
    pPortName    As Long
    pMonitorName As Long
    pDescription As Long
    fPortType    As Long
    Reserved     As Long
End Type

Private Enum PortTypes
    PORT_TYPE_WRITE = &H1
    PORT_TYPE_READ = &H2
    PORT_TYPE_REDIRECTED = &H4
    PORT_TYPE_NET_ATTACHED = &H8
End Enum

Private Function GetStrFromPtrA(lpszA As Long) As String
    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
End Function

Public Function GetPorts() As String

    Dim pcbNeeded As Long, pcReturned  As Long, Boucle As Integer
    Dim PortI2() As PORT_INFO_2
    Dim StrPortType As String, ret As String
   
    EnumPorts vbNullString, 2, 0, 0, pcbNeeded, pcReturned
    If pcbNeeded Then
        ReDim PortI2((pcbNeeded / SIZEOFPORT_INFO_2))
        If EnumPorts(vbNullString, 2, PortI2(0), pcbNeeded, pcbNeeded, pcReturned) Then
            For Boucle = 0 To (pcReturned - 1)
                With PortI2(Boucle)
                    StrPortType = ""
                    If (.fPortType And PORT_TYPE_WRITE) Then StrPortType = "write "
                    If (.fPortType And PORT_TYPE_READ) Then StrPortType = StrPortType & "read "
                    If (.fPortType And PORT_TYPE_REDIRECTED) Then StrPortType = StrPortType & "redirected "
                    If (.fPortType And PORT_TYPE_NET_ATTACHED) Then StrPortType = StrPortType & "network"
                    ret = ret & GetStrFromPtrA(.pPortName) & " (" & StrPortType & ")" & "|"
                End With
            Next
        End If
    End If
   
    If Len(ret) > 0 Then ret = Left(ret, Len(ret) - 1)
    GetPorts = ret
   
End Function

ResolutionEcran 800, 600

Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" _
   (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean

Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" _
   (lpDevMode As Any, ByVal dwflags As Long) As Long

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const DM_WIDTH = &H80000
Private Const DM_HEIGHT = &H100000

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
     dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Public Sub ResolutionEcran(sgWidth As Long, sgHeight As Long)

Dim blTMP As Boolean, lgTMP As Long, dmEcran As DEVMODE, res As Long

lgTMP = 0
Do
    blTMP = EnumDisplaySettings(0, lgTMP, dmEcran)
    lgTMP = lgTMP + 1
Loop While blTMP <> 0

dmEcran.dmFields = DM_WIDTH Or DM_HEIGHT
dmEcran.dmPelsWidth = sgWidth
dmEcran.dmPelsHeight = sgHeight
lgTMP = ChangeDisplaySettings(dmEcran, 0)

End Sub

Private Sub Form_Load()

    ' Remplace la procédure de fenêtre par défaut par notre propre procédure
    oldWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
   
End Sub

Private Sub Form_Unload(Cancel As Integer)

    ' Remet la procédure de fenêtre par défaut
    SetWindowLong hwnd, GWL_WNDPROC, oldWndProc
   
End Sub

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
                                      (ByVal hwnd As Long, ByVal nIndex As Long, _
                                       ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC = (-4)
Public oldWndProc As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
                                        (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
                                         ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_DISPLAYCHANGE = &H7E

Public Function WindowProc(ByVal hwnd As Long, ByVal msg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long

    If msg = WM_DISPLAYCHANGE Then
        ' La résolution a changé
    End If
   
    ' Appelle la procédure de fenêtre par défaut pour que Windows puisse traiter l'événement
    WindowProc = CallWindowProc(oldWndProc, hwnd, msg, wParam, lParam)

End Function

Private Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal locale As Long, _
    ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long

Private Const LOCALE_IDATE = &H21          ' Format de date courte : 0 = M-J-A, 1 = J-M-A, 2 = A-M-J
Private Const LOCALE_ILDATE = &H22         ' Format de date longue
Private Const LOCALE_SCOUNTRY = &H6        ' Pays en toutes lettres
Private Const LOCALE_SNATIVELANGNAME = &H4 ' Langue, en toutes lettres
Private Const LOCALE_STHOUSAND = &HF       ' Séparateur des milliers
Private Const LOCALE_SDECIMAL = &HE        ' Séparateur décimal

Private Function ParametreRegional(parametre As Long) As String

Dim lngResultat As Long
Dim buffer As String
Dim pos As Integer
Dim locale As Long

' Récupère l'identifiant de l'information locale de type utilisateur
locale = GetUserDefaultLCID()

' Renvoie le nombre de caractères nécessaires pour recevoir la valeur du paramètre demandé
lngResultat = GetLocaleInfo(locale, parametre, buffer, 0)

buffer = String(lngResultat, 0)
GetLocaleInfo locale, parametre, buffer, lngResultat
pos = InStr(buffer, Chr(0))
If pos > 0 Then ParametreRegional = Left(buffer, pos - 1)
End Function

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sleep 2000

Private Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer
 
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Private Type OSVERSIONINFO
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
End Type
 
Public Function VersionWindows(ByRef sp As String) As String

    Dim os As OSVERSIONINFO
           
    os.dwOSVersionInfoSize = Len(os)
    GetVersionExA os
    sp = ""
   
    With os
        Select Case .dwPlatformId
            Case VER_PLATFORM_WIN32_WINDOWS
                Select Case .dwMinorVersion
                    Case 0
                        VersionWindows = "95"
                    Case 10
                        VersionWindows = "98"
                    Case 90
                        VersionWindows = "Me"
                End Select
            Case VER_PLATFORM_WIN32_NT
                Select Case .dwMajorVersion
                    Case 3
                        VersionWindows = "NT 3.51"
                    Case 4
                        VersionWindows = "NT 4.0"
                    Case 5
                        If .dwMinorVersion = 0 Then
                            VersionWindows = "2000"
                        Else
                            VersionWindows = "XP"
                        End If
                    Case 6                         
VersionWindows = "VISTA"
                End Select
        End Select
       
        If InStr(.szCSDVersion, Chr(0)) > 0 Then
            sp = Left(.szCSDVersion, InStr(.szCSDVersion, Chr(0)) - 1)
        End If
    End With
   
End Function

Environ$(Expression)

Msgbox Environ$("PATH")

Private Const RESOURCETYPE_ANY = &H0
Private Const RESOURCE_CONNECTED = &H1
Private Type NETRESOURCE
    dwScope As Long
    dwType As Long
    dwDisplayType As Long
    dwUsage As Long
    lpLocalName As Long
    lpRemoteName As Long
    lpComment As Long
    lpProvider As Long
End Type
Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, _
 ByVal dwUsage As Long, lpNetResource As Any, lphEnum As Long) As Long
Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, _
 lpBuffer As Any, lpBufferSize As Long) As Long
Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Any) As Long
Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long
Function LetterToUNC(DriveLetter As String) As String
    Dim hEnum As Long
    Dim NetInfo(1023) As NETRESOURCE
    Dim entries As Long
    Dim nStatus As Long
    Dim LocalName As String
    Dim UNCName As String
    Dim i As Long
    Dim r As Long

    ' Begin the enumeration
    nStatus = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, 0&, ByVal 0&, hEnum)

    LetterToUNC = DriveLetter

    ' Check for success from open enum
    If ((nStatus = 0) And (hEnum <> 0)) Then
        ' Set number of entries
        entries = 1024

        ' Enumerate the resource
        nStatus = WNetEnumResource(hEnum, entries, NetInfo(0), CLng(Len(NetInfo(0))) * 1024)

        ' Check for success
        If nStatus = 0 Then
            For i = 0 To entries - 1
                ' Get the local name
                LocalName = ""
                If NetInfo(i).lpLocalName <> 0 Then
                    LocalName = Space(lstrlen(NetInfo(i).lpLocalName) + 1)
                    r = lstrcpy(LocalName, NetInfo(i).lpLocalName)
                End If

                ' Strip null character from end
                If Len(LocalName) <> 0 Then
                    LocalName = Left(LocalName, (Len(LocalName) - 1))
                End If

                If UCase$(LocalName) = UCase$(DriveLetter) Then
                    ' Get the remote name
                    UNCName = ""
                    If NetInfo(i).lpRemoteName <> 0 Then
                        UNCName = Space(lstrlen(NetInfo(i).lpRemoteName) + 1)
                        r = lstrcpy(UNCName, NetInfo(i).lpRemoteName)
                    End If

                    ' Strip null character from end
                    If Len(UNCName) <> 0 Then
                        UNCName = Left(UNCName, (Len(UNCName) - 1))
                    End If

                    ' Return the UNC path to drive
                    '  added the [] to seperate on printout only
                    LetterToUNC = UNCName

                    ' Exit the loop
                    Exit For
                End If
            Next i
        End If
    End If

    ' End enumeration
    nStatus = WNetCloseEnum(hEnum)
End Function

LetterToUNC("E:")

Const SOCKET_ERROR = 0
Private Type WSAdata
    wVersion As Integer
    wHighVersion As Integer
    szDescription(0 To 255) As Byte
    szSystemStatus(0 To 128) As Byte
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type
Private Type Hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Private Type IP_OPTION_INFORMATION
    TTL As Byte
    Tos As Byte
    Flags As Byte
    OptionsSize As Long
    OptionsData As String * 128
End Type
Private Type IP_ECHO_REPLY
    Address(0 To 3) As Byte
    Status As Long
    RoundTripTime As Long
    DataSize As Integer
    Reserved As Integer
    data As Long
    Options As IP_OPTION_INFORMATION
End Type
Private Declare Function GetHostByName Lib "wsock32.dll" Alias "gethostbyname" (ByVal HostName As String) As Long
Private Declare Function WSAStartup Lib "wsock32.dll" (ByVal wVersionRequired&, lpWSAdata As WSAdata) As Long
Private Declare Function WSACleanup Lib "wsock32.dll" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long
Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal HANDLE As Long) As Boolean
Private Declare Function IcmpSendEcho Lib "ICMP" (ByVal IcmpHandle As Long, ByVal DestAddress As Long,  _
ByVal RequestData As String, _
 ByVal RequestSize As Integer, RequestOptns As IP_OPTION_INFORMATION, ReplyBuffer As IP_ECHO_REPLY, _
  ByVal ReplySize As Long, ByVal TimeOut As Long) As Boolean
Private Function Ping(HostName As String) As Integer
    Dim hFile As Long, lpWSAdata As WSAdata
    Dim hHostent As Hostent, AddrList As Long
    Dim Address As Long, rIP As String
    Dim OptInfo As IP_OPTION_INFORMATION
    Dim EchoReply As IP_ECHO_REPLY
    Call WSAStartup(&H101, lpWSAdata)
    If GetHostByName(HostName + String(64 - Len(HostName), 0)) <> SOCKET_ERROR Then
        CopyMemory hHostent.h_name, ByVal GetHostByName(HostName + String(64 - Len(HostName), 0)), Len(hHostent)
        CopyMemory AddrList, ByVal hHostent.h_addr_list, 4
        CopyMemory Address, ByVal AddrList, 4
    End If
    hFile = IcmpCreateFile()
    If hFile = 0 Then
        MsgBox "Unable to Create File Handle"
        Exit Function
    End If
    OptInfo.TTL = 255
    If IcmpSendEcho(hFile, Address, String(32, "A"), 32, OptInfo, EchoReply, Len(EchoReply) + 8, 2000) Then
        rIP = CStr(EchoReply.Address(0)) + "." + CStr(EchoReply.Address(1)) + "." + CStr(EchoReply.Address(2)) + "." + _
 CStr(EchoReply.Address(3))
    Else
        Ping = -1
    End If
    If EchoReply.Status = 0 Then
        Ping = EchoReply.RoundTripTime
    End If
    Call IcmpCloseHandle(hFile)
    Call WSACleanup
End Function

Public Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hwnd As Long, _
                                                            ByVal dwType As Long) As Long
Public Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hwnd As Long, _
                                                            ByVal dwType As Long) As Long
Public Const RESOURCETYPE_DISK = &H1, RESOURCETYPE_PRINT = &H2

Dim x As Long

' Connecter un lecteur réseau
x = WNetConnectionDialog(Me.hwnd, RESOURCETYPE_DISK)

' Déconnecter un lecteur réseau
x = WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_DISK)

' Connecter une imprimante
x = WNetConnectionDialog(Me.hwnd, RESOURCETYPE_PRINT)

' Déconnecter une imprimante
x = WNetDisconnectDialog(Me.hwnd, RESOURCETYPE_PRINT)

'***************** Code Start **********************
'
Private Declare Function apiGetSys Lib "user32" _
    Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long

Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1
Private Const SM_CXVSCROLL = 2
Private Const SM_CYHSCROLL = 3
Private Const SM_CYCAPTION = 4
Private Const SM_CXBORDER = 5
Private Const SM_CYBORDER = 6
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYDLGFRAME = 8
Private Const SM_CYVTHUMB = 9
Private Const SM_CXHTHUMB = 10
Private Const SM_CXICON = 11
Private Const SM_CYICON = 12
Private Const SM_CXCURSOR = 13
Private Const SM_CYCURSOR = 14
Private Const SM_CYMENU = 15
Private Const SM_CXFULLSCREEN = 16
Private Const SM_CYFULLSCREEN = 17
Private Const SM_CYKANJIWINDOW = 18
Private Const SM_MOUSEPRESENT = 19
Private Const SM_CYVSCROLL = 20
Private Const SM_CXHSCROLL = 21
Private Const SM_DEBUG = 22
Private Const SM_SWAPBUTTON = 23
Private Const SM_RESERVED1 = 24
Private Const SM_RESERVED2 = 25
Private Const SM_RESERVED3 = 26
Private Const SM_RESERVED4 = 27
Private Const SM_CXMIN = 28
Private Const SM_CYMIN = 29
Private Const SM_CXSIZE = 30
Private Const SM_CYSIZE = 31
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const SM_CXMINTRACK = 34
Private Const SM_CYMINTRACK = 35
Private Const SM_CXDOUBLECLK = 36
Private Const SM_CYDOUBLECLK = 37
Private Const SM_CXICONSPACING = 38
Private Const SM_CYICONSPACING = 39
Private Const SM_MENUDROPALIGNMENT = 40
Private Const SM_PENWINDOWS = 41
Private Const SM_DBCSENABLED = 42
Private Const SM_CMOUSEBUTTONS = 43
Private Const SM_CMETRICS = 44

Function Resol(strWhat As String) As String
Dim strRet As String
    Select Case LCase(strWhat)
        Case "resolution": strRet = apiGetSys(SM_CXSCREEN) & "x" _
                                        & apiGetSys(SM_CYSCREEN)
        Case "windowsize": strRet = apiGetSys(SM_CXFULLSCREEN) & "x" _
                                        & apiGetSys(SM_CYFULLSCREEN)
    End Select
    Resol = strRet
End Function

Dim test As String

test = "resolution"

MsgBox "Résolution de l'écran : " & Resol(test)

Private Sub Form_Load()
MSComm1.PortOpen = True     'ouverture du port
End Sub

Private Sub Form_Unload(Cancel As Integer)
MSComm1.PortOpen = False        'fermeture du port
End Sub

Private Sub MSComm1_OnComm()
   Dim InBuff As String
   Dim Lg As String
   Select Case MSComm1.CommEvent
' Erreurs
      Case comEventBreak   ' Un événement d'arrêt a été reçu.
      Case comEventCDTO    ' Expiration du délai CD (RLSD).
      Case comEventCTSTO   ' Expiration du délai CTS.
      Case comEventDSRTO   ' Expiration du délai DSR.
      Case comEventFrame   ' Erreur de trame.
      Case comEventOverrun ' Perte de données.
      Case comEventRxOver  ' Dépassement de capacité du tampon de réception.
      Case comEventRxParity   ' Erreur de parité.
      Case comEventTxFull  ' Tampon de transmission saturé.
      Case comEventDCB     ' Erreur inattendue lors de la récupération de DCB]
' Événements
      Case comEvCD   ' Modification dans la ligne CD.
      Case comEvCTS  ' Modification dans la ligne CTS.
      Case comEvDSR  ' Modification dans la ligne DSR.
      Case comEvRing ' Modification dans l'indicateur d'appel.
      Case comEvReceive ' Réception d'un nombre RThreshold de caractères.
         InBuff = MSComm1.Input        'lecture du tampon de stockage
         [b]Lg = Right(InBuff, 13)   'mon code pour enlever les caractères
         Lg = Left(Lg, 10)               ASCII envoyés au début et à la fin de
         Me!Texte1 = Lg                 l'émission[/b]
      Case comEvSend ' Un nombre Sthreshold de caractères se trouve dans le tampon de transmission.
      Case comEvEOF  ' Un caractère indiquant la fin du fichier (EOF) a été trouvé dans le flux d'entrée
   End Select
End Sub

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Public Const LOGPIXELSX=88
Public Const LOGPIXELSY=90

' Récupère le nombre de pixels par pouce
NbPointParPouceX = GetDeviceCaps(GetDC(0), 88)
NbPointParPouceY = GetDeviceCaps(GetDC(0), 90)

Private Declare Function FindWindowEx Lib "user32" Alias _
"FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, _
ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Const WM_CLOSE = &H10
 
Public Function IsCalcOpen() As Boolean
IsCalcOpen = (FindWindowEx(0&, 0&, "SciCalc", vbNullString) <> 0)
End Function
 
Public Sub CloseCalc()
Dim lHwnd As Long
lHwnd = FindWindowEx(0&, 0&, "SciCalc", vbNullString)
If lHwnd <> 0 Then SendMessage lHwnd, WM_CLOSE, 0, 0&
End Sub

Private Declare Function LockWorkStation Lib "user32.dll" () As Long 
Public Sub Verrouiller() 
LockWorkStation 
End Sub

Public Const EWX_LOGOFF = 0 
Public Const EWX_SHUTDOWN = 1 
Public Const EWX_REBOOT = 2 
Public Const EWX_FORCE = 4 
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long)

ExitWindowsEx(EWX_SHUTDOWN, 0)

ExitWindowsEx(EWX_SHUTDOWN OR EWX_FORCE, 0)

SysCmd(acSysCmdAccessDir)