Soyez le premier à donner votre avis sur cette source.
Snippet vu 10 093 fois - Téléchargée 30 fois
Option Explicit Private Enum udeSW SW_HIDE = 0 SW_NORMAL = 1 SW_MAXIMIZE = 3 SW_MINIMIZE = 6 End Enum Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type STARTUPINFO cb As Long lpReserved As String lpDesktop As String lpTitle As String dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Byte hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Enum udePriority_Class NORMAL_PRIORITY_CLASS = &H20 IDLE_PRIORITY_CLASS = &H40 HIGH_PRIORITY_CLASS = &H80 End Enum Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As SECURITY_ATTRIBUTES, lpThreadAttributes As SECURITY_ATTRIBUTES, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long Sub DisplayODBCManager() Dim SysDir As String, Ret As Long SysDir = Space(255) Ret = GetSystemDirectory(SysDir, 255) SysDir = Left$(SysDir, Ret) & "\" 'Retourne zéro en cas d'erreur If NewProcess(SysDir & "rundll32.exe", "shell32.dll,Control_RunDLL odbccp32.cpl", SW_NORMAL, IDLE_PRIORITY_CLASS) Then 'Le formulaire ODBC a été ouvert et fermé. Après vérification en base de registre 'de son existence, le DSN peut être utilisé pour tenter d'ouvrir une connexion. Else 'Echec de l'ouverture du formulaire ODBC End If End Sub Private Function NewProcess(AppPath As String, Arg As String, ByVal SW_Stat As udeSW, ByVal Priority_Class As udePriority_Class) As Long Dim PClass As Long Dim CmdLine As String Dim SInfo As STARTUPINFO Dim PInfo As PROCESS_INFORMATION Dim Sec1 As SECURITY_ATTRIBUTES Dim Sec2 As SECURITY_ATTRIBUTES Dim hDC As Long Const HORZRES = 8 Const VERTRES = 10 Const INFINITE = &HFFFF Const WAIT_TIMEOUT As Long = 258& Const STARTF_USESHOWWINDOW = &H1 Const STARTF_USEPOSITION = &H4 Sec1.nLength = Len(Sec1) Sec2.nLength = Len(Sec2) hDC = GetDC(GetActiveWindow()) With SInfo .cb = Len(SInfo) .dwX = GetDeviceCaps(hDC, HORZRES) \ 2 .dwY = GetDeviceCaps(hDC, VERTRES) \ 2 .dwFlags = STARTF_USEPOSITION Or STARTF_USESHOWWINDOW .wShowWindow = SW_Stat End With PClass = Priority_Class CmdLine = AppPath If (Len(Trim$(Arg)) > 0) Then CmdLine = CmdLine & " " & Arg End If NewProcess = CreateProcess(AppPath, CmdLine, Sec1, Sec2, False, PClass, 0&, CurDir$(), SInfo, PInfo) If NewProcess Then 'Sans rafraîchissement du formulaire parent 'WaitForSingleObject pinfo.hProcess, INFINITE 'Avec rafraîchissement du formulaire parent Do While WaitForSingleObject(PInfo.hProcess, 10) = WAIT_TIMEOUT DoEvents Loop Call CloseHandle(PInfo.hProcess) Call CloseHandle(PInfo.hThread) End If End Function
19 sept. 2006 à 10:39
Une fois la source de données ODBC créée, il suffit de lire le fichier texte pour récupérer la chaîne de connexion.
17 août 2005 à 12:56
5 août 2005 à 10:35
http://www.microsoft.com/belux/fr/msdn/community/columns/ldoc/multithread1.mspx
3 août 2005 à 17:29
--------------------------------------------------------
WaitForSingleObject pinfo.hProcess, Timeout
--------------------------------------------------------
par
--------------------------------------------------------
Do While WaitForSingleObject(pinfo.hProcess, 10) = WAIT_TIMEOUT
DoEvents
Loop
--------------------------------------------------------
2 août 2005 à 10:39
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.