Code private spice

Signaler
Messages postés
1
Date d'inscription
mardi 23 mai 2006
Statut
Membre
Dernière intervention
26 septembre 2006
-
Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Modérateur
Dernière intervention
23 décembre 2008
-
quelqu'un pourrait il me donner les codes ou un lien pour visualiser private spice on the Tv
merci à vous
A +

4 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
66
c'est du VB6, ça ?

Renfield
Admin CodeS-SourceS- MVP Visual Basic
Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Modérateur
Dernière intervention
23 décembre 2008
21
Renfield > probablement comme çà  :




Private Sub
Spice()
    tv.Show

End Sub





Manu


--------------------------------------------------------------------------------------------
Avant de poster un message, n'oubliez pas de consulter le reglement.
Messages postés
3172
Date d'inscription
dimanche 15 février 2004
Statut
Membre
Dernière intervention
9 avril 2017
30
Mais c'est tout simple voyons.

Option Explicit

'Definition 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 a 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 reservé pour la liste des noms
Call NetApiBufferFree(bufptr)

'on retourne le string contenants les noms separés par des "|"
GetServers = resultat

End Function

Public Function GetPointerToByteStringW(ByVal dwData As Long) As String

'fonction auxilliare qui recoit un pointeur vers une chaine 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

Kenji

Il était une fois, un pauvre petit règlement que personne ne lisait. Il est tout sympa mais il est triste, aidez-le, lisez-le, ca lui ferait tellement plaisir ainsi qu'a nous. Merci.
Ca sent le sondage sur ce lien





Kenji
Messages postés
4030
Date d'inscription
mardi 13 mai 2003
Statut
Modérateur
Dernière intervention
23 décembre 2008
21
Hummmm .... Originale cette solution !






Manu


--------------------------------------------------------------------------------------------
Avant de poster un message, n'oubliez pas de consulter le reglement.