Se déconnecter d'Internet avec AOL
Mellati
-
30 janv. 2001 à 21:37
LolPiratas Messages postés 80 Date d'inscription mardi 13 août 2002 Statut Membre Dernière intervention 15 décembre 2010 - 11 oct. 2002 à 21:12
LolPiratas Messages postés 80 Date d'inscription mardi 13 août 2002 Statut Membre Dernière intervention 15 décembre 2010 - 11 oct. 2002 à 21:12
4 réponses
Moi je peux peut etre t'aider :) !
Deja fais une form ! Ensuite crée un module et tape sa dedans :
Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As Any, ByVal lsString As Any, _
ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As String, ByVal lpDefault As _
String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As _
String) As Long
'========Get Url==========
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const conSwNormal = 1
Une fois ce module créé ben refais en un autre:) et refais un grand copier coller !!
Option Explicit
Declare Sub ReleaseCapture Lib "user32" ()
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As Any, ByVal lsString As Any, _
ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As String, ByVal lpDefault As _
String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As _
String) As Long
Public sPlayList() As String
Public gbPlaylist As Boolean
Global lstindex As Integer
Global bitr4text
Global whatLayer
Global listpath As Boolean
Global EQ As Boolean
Global minList As Boolean
Global minEq As Boolean
Public Sub FormDrag(TheForm As Form)
ReleaseCapture
Call SendMessage(TheForm.hwnd, &HA1, 2, 0&)
End Sub
Voila ! plus qu'un seul module a faire !
refais en encore un :
Option Explicit
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal Length As Long)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub ChatSend(Chat As String)
Dim Room As Long, AORich As Long, AORich2 As Long
Room& = FindRoom&
AORich& = FindWindowEx(Room, 0&, "RICHCNTL", vbNullString)
AORich2& = FindWindowEx(Room, AORich, "RICHCNTL", vbNullString)
Call SendMessageByString(AORich2, WM_SETTEXT, 0&, Chat$)
Call SendMessageLong(AORich2, WM_CHAR, ENTER_KEY, 0&)
End Sub
Sub TimeOut(mili)
Dim timeon
timeon = Timer
Do While (mili / 1000) >= Timer - timeon
DoEvents
Loop
End Sub
OUFFFFF PLUS DE MODULE !! FINI !! MAIS IL RESTE LE CODE A ECRIRE !
le code : ( fais un bouton et double klike decu )
et tape ca :
ShellExecute hwnd, "open", "aol://2719:2-2-w4rez%20toolz", vbNullString, vbNullString, conSwNormal
TimeOut 10000
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
Voila le prog et fini et ca e deco ! le proncipe et tres simple ! car enfaiet sa ouver un salon et ca envoi plein de donner en 1 millieme ! ce qui fais que AOL te deco ! voila c tout con !
Deja fais une form ! Ensuite crée un module et tape sa dedans :
Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As Any, ByVal lsString As Any, _
ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As String, ByVal lpDefault As _
String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As _
String) As Long
'========Get Url==========
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const conSwNormal = 1
Une fois ce module créé ben refais en un autre:) et refais un grand copier coller !!
Option Explicit
Declare Sub ReleaseCapture Lib "user32" ()
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Long) As Long
Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As Any, ByVal lsString As Any, _
ByVal lplFilename As String) As Long
Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" _
(ByVal lpApplicationName As String, ByVal _
lpKeyName As String, ByVal lpDefault As _
String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As _
String) As Long
Public sPlayList() As String
Public gbPlaylist As Boolean
Global lstindex As Integer
Global bitr4text
Global whatLayer
Global listpath As Boolean
Global EQ As Boolean
Global minList As Boolean
Global minEq As Boolean
Public Sub FormDrag(TheForm As Form)
ReleaseCapture
Call SendMessage(TheForm.hwnd, &HA1, 2, 0&)
End Sub
Voila ! plus qu'un seul module a faire !
refais en encore un :
Option Explicit
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (destination As Any, source As Any, ByVal Length As Long)
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public 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
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Public Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function SendMessageLong& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Public Declare Function SendMessageByString Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Sub ChatSend(Chat As String)
Dim Room As Long, AORich As Long, AORich2 As Long
Room& = FindRoom&
AORich& = FindWindowEx(Room, 0&, "RICHCNTL", vbNullString)
AORich2& = FindWindowEx(Room, AORich, "RICHCNTL", vbNullString)
Call SendMessageByString(AORich2, WM_SETTEXT, 0&, Chat$)
Call SendMessageLong(AORich2, WM_CHAR, ENTER_KEY, 0&)
End Sub
Sub TimeOut(mili)
Dim timeon
timeon = Timer
Do While (mili / 1000) >= Timer - timeon
DoEvents
Loop
End Sub
OUFFFFF PLUS DE MODULE !! FINI !! MAIS IL RESTE LE CODE A ECRIRE !
le code : ( fais un bouton et double klike decu )
et tape ca :
ShellExecute hwnd, "open", "aol://2719:2-2-w4rez%20toolz", vbNullString, vbNullString, conSwNormal
TimeOut 10000
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
TimeOut 50
ChatSend ("DeKo MoDe")
Voila le prog et fini et ca e deco ! le proncipe et tres simple ! car enfaiet sa ouver un salon et ca envoi plein de donner en 1 millieme ! ce qui fais que AOL te deco ! voila c tout con !
Salut et merci pour ta réponse Benjileptiot.
Mais voila, il m'affiche un message d'erreur pour ceci:
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
"Type défini par l'utilisateur non défini"
Qqn peut m'aider ??
Merci
Mais voila, il m'affiche un message d'erreur pour ceci:
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
"Type défini par l'utilisateur non défini"
Qqn peut m'aider ??
Merci
LolPiratas
Messages postés
80
Date d'inscription
mardi 13 août 2002
Statut
Membre
Dernière intervention
15 décembre 2010
11 oct. 2002 à 21:12
11 oct. 2002 à 21:12
Yo ManaM oY QUELQU'un a fait ce module et il va tres bien essais tu verras
colle dans un module
Public Const MAX_PATH = 260
Public Const TH32CS_SNAPPROCESS = 2&
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Type PROCESSENTRY32
lSize As Long
lUsage As Long
lProcessId As Long
lDefaultHeapId As Long
lModuleId As Long
lThreads As Long
lParentProcessId As Long
lPriClassBase As Long
lFlags As Long
sExeFile As String * MAX_PATH
End Type
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hprocess As Long, lpExitCode As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hprocess As Long, ByVal uExitCode As Long) As Long
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const RAS_MAXENTRYNAME As Integer = 256
Private Const RAS_MAXDEVICETYPE As Integer = 16
Private Const RAS_MAXDEVICENAME As Integer = 128
Private Const RAS_RASCONNSIZE As Integer = 412
Private ReturnCode As Long
Private gstrISPName As String
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Private taken As New Collection
Private forbid As New Collection
Private Const GWL_ID = (-12)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_CLOSE = &H10
Private hWnds() As Long
Private Sub main()
Dim hwnd As Long
hwnd = FindWindowLike(hWnds(), 0, "AOL", "*", Null)
rep = MsgBox("Cliquez OK pour fermer AOL", vbOKOnly, "Goebish's AOL Killer")
forbid.Add "aoltray.EXE", "aoltray.EXE"
forbid.Add "WAOL.EXE", "WAOL.EXE"
Do
DoEvents
Set taken = Nothing
retourne_processus
For i = 1 To taken.Count Step 2
If existe(UCase(taken.Item(i))) Then
Dim lgHwnd As Long, lgRep As Long
lgHwnd = FindWindow(vbNullString, "aol")
lgRep = PostMessage(lgHwnd, WM_CLOSE, vbNull, vbNull)
InternetDeconnexion
End If
Next i
DoEvents
Sleep (1000)
hwnd = FindWindowLike(hWnds(), 0, "AOL", "*", Null)
Loop Until hwnd = 0
rep = MsgBox("AOL à été fermé", vbOKOnly, "Goebish's AOL Killer")
rep = MsgBox("© goebish@hotmail.com", vbOKOnly, "© VFX Softwares")
End
End Sub
Private Function retourne_exe(Valeur As String) As String
Dim ind As Integer
Dim ancien As Integer
ancien = 0
i = Len(Valeur)
Do
ind = InStr(ancien + 1, Valeur, "", vbBinaryCompare)
If ind <> 0 Then
ancien = ind
Else
Exit Do
End If
Loop
retourne_exe = Right(Valeur, i - ancien)
End Function
Private Sub retourne_processus()
Dim cpt As Integer
Dim strNomExe As String
Dim strProcessID As String
Dim lngSnapShot As Long
Dim r As Long
Dim uProcess As PROCESSENTRY32
lngSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lngSnapShot <> 0 Then
uProcess.lSize = Len(uProcess)
r = ProcessFirst(lngSnapShot, uProcess)
Do While r
strNomExe = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
If retourne_exe(strNomExe) <> App.EXEName Then
taken.Add retourne_exe(strNomExe), retourne_exe(strNomExe) & cpt 'plusieurs instances du même EXE possible
cpt = cpt + 1
taken.Add CStr(uProcess.lProcessId), CStr(uProcess.lProcessId)
End If
r = ProcessNext(lngSnapShot, uProcess)
Loop
CloseHandle (lngSnapShot)
End If
End Sub
Private Sub ferme_process(Valeur As String)
Dim ID_proc As Long
Dim hprocess As Long
Dim nRet As Long
Dim tache As String
Dim cpt As Integer
ID_proc = CLng(Valeur)
hprocess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ID_proc)
GetExitCodeProcess hprocess, nRet
Call TerminateProcess(hprocess, nRet)
Call CloseHandle(hprocess)
End Sub
Private Function existe(Valeur As String) As Boolean
Dim i As Integer
i = 1
While i < forbid.Count And forbid.Item(i) <> Valeur
i = i + 1
Wend
If forbid.Item(i) = Valeur Then
existe = True
Else
existe = False
End If
End Function
Private Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As Long, WindowText As String, Classname As String, ID) As Long
Dim hwnd As Long
Dim foundHwnd As Long
Dim r As Long
Static level As Long
Static iFound As Long
Dim sWindowText As String
Dim sClassname As String
Dim sID
If level = 0 Then
iFound = 0
ReDim hWndArray(0 To 0) If hWndStart 0 Then hWndStart GetDesktopWindow()
End If
level = level + 1
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
DoEvents
sWindowText = Space(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
If GetParent(hwnd) <> 0 Then
r = GetWindowLW(hwnd, GWL_ID)
sID = CLng("&H" & Hex(r))
Else
sID = Null
End If
If sWindowText Like WindowText And sClassname Like Classname Then
If IsNull(ID) Then
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
ElseIf Not IsNull(sID) Then
If CLng(sID) = CLng(ID) Then
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
End If
End If
foundHwnd = hwnd
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
level = level - 1
FindWindowLike = foundHwnd
End Function
Private Sub InternetDeconnexion()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function
pas de form utile seulement le module
propriété du projet sub_main au demarrage et voila c tt tu es deconnecté ca marche meme sur aol6 aol7 et AOL8 lol et oui ca fonctionne tester moi meme voila a plucheeeee
colle dans un module
Public Const MAX_PATH = 260
Public Const TH32CS_SNAPPROCESS = 2&
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Type PROCESSENTRY32
lSize As Long
lUsage As Long
lProcessId As Long
lDefaultHeapId As Long
lModuleId As Long
lThreads As Long
lParentProcessId As Long
lPriClassBase As Long
lFlags As Long
sExeFile As String * MAX_PATH
End Type
Public Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, ByVal lProcessId As Long) As Long
Public Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Public Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hprocess As Long, lpExitCode As Long) As Long
Public Declare Function TerminateProcess Lib "kernel32" (ByVal hprocess As Long, ByVal uExitCode As Long) As Long
Private Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Private Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Private Const ERROR_SUCCESS = 0&
Private Const RAS_MAXENTRYNAME As Integer = 256
Private Const RAS_MAXDEVICETYPE As Integer = 16
Private Const RAS_MAXDEVICENAME As Integer = 128
Private Const RAS_RASCONNSIZE As Integer = 412
Private ReturnCode As Long
Private gstrISPName As String
Private Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Private Type RasConn
dwSize As Long
hRasConn As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
szDeviceType(RAS_MAXDEVICETYPE) As Byte
szDeviceName(RAS_MAXDEVICENAME) As Byte
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindowLW Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long
Private taken As New Collection
Private forbid As New Collection
Private Const GWL_ID = (-12)
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_CLOSE = &H10
Private hWnds() As Long
Private Sub main()
Dim hwnd As Long
hwnd = FindWindowLike(hWnds(), 0, "AOL", "*", Null)
rep = MsgBox("Cliquez OK pour fermer AOL", vbOKOnly, "Goebish's AOL Killer")
forbid.Add "aoltray.EXE", "aoltray.EXE"
forbid.Add "WAOL.EXE", "WAOL.EXE"
Do
DoEvents
Set taken = Nothing
retourne_processus
For i = 1 To taken.Count Step 2
If existe(UCase(taken.Item(i))) Then
Dim lgHwnd As Long, lgRep As Long
lgHwnd = FindWindow(vbNullString, "aol")
lgRep = PostMessage(lgHwnd, WM_CLOSE, vbNull, vbNull)
InternetDeconnexion
End If
Next i
DoEvents
Sleep (1000)
hwnd = FindWindowLike(hWnds(), 0, "AOL", "*", Null)
Loop Until hwnd = 0
rep = MsgBox("AOL à été fermé", vbOKOnly, "Goebish's AOL Killer")
rep = MsgBox("© goebish@hotmail.com", vbOKOnly, "© VFX Softwares")
End
End Sub
Private Function retourne_exe(Valeur As String) As String
Dim ind As Integer
Dim ancien As Integer
ancien = 0
i = Len(Valeur)
Do
ind = InStr(ancien + 1, Valeur, "", vbBinaryCompare)
If ind <> 0 Then
ancien = ind
Else
Exit Do
End If
Loop
retourne_exe = Right(Valeur, i - ancien)
End Function
Private Sub retourne_processus()
Dim cpt As Integer
Dim strNomExe As String
Dim strProcessID As String
Dim lngSnapShot As Long
Dim r As Long
Dim uProcess As PROCESSENTRY32
lngSnapShot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
If lngSnapShot <> 0 Then
uProcess.lSize = Len(uProcess)
r = ProcessFirst(lngSnapShot, uProcess)
Do While r
strNomExe = Left(uProcess.sExeFile, InStr(1, uProcess.sExeFile, vbNullChar) - 1)
If retourne_exe(strNomExe) <> App.EXEName Then
taken.Add retourne_exe(strNomExe), retourne_exe(strNomExe) & cpt 'plusieurs instances du même EXE possible
cpt = cpt + 1
taken.Add CStr(uProcess.lProcessId), CStr(uProcess.lProcessId)
End If
r = ProcessNext(lngSnapShot, uProcess)
Loop
CloseHandle (lngSnapShot)
End If
End Sub
Private Sub ferme_process(Valeur As String)
Dim ID_proc As Long
Dim hprocess As Long
Dim nRet As Long
Dim tache As String
Dim cpt As Integer
ID_proc = CLng(Valeur)
hprocess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ID_proc)
GetExitCodeProcess hprocess, nRet
Call TerminateProcess(hprocess, nRet)
Call CloseHandle(hprocess)
End Sub
Private Function existe(Valeur As String) As Boolean
Dim i As Integer
i = 1
While i < forbid.Count And forbid.Item(i) <> Valeur
i = i + 1
Wend
If forbid.Item(i) = Valeur Then
existe = True
Else
existe = False
End If
End Function
Private Function FindWindowLike(hWndArray() As Long, ByVal hWndStart As Long, WindowText As String, Classname As String, ID) As Long
Dim hwnd As Long
Dim foundHwnd As Long
Dim r As Long
Static level As Long
Static iFound As Long
Dim sWindowText As String
Dim sClassname As String
Dim sID
If level = 0 Then
iFound = 0
ReDim hWndArray(0 To 0) If hWndStart 0 Then hWndStart GetDesktopWindow()
End If
level = level + 1
hwnd = GetWindow(hWndStart, GW_CHILD)
Do Until hwnd = 0
DoEvents
sWindowText = Space(255)
r = GetWindowText(hwnd, sWindowText, 255)
sWindowText = Left(sWindowText, r)
sClassname = Space(255)
r = GetClassName(hwnd, sClassname, 255)
sClassname = Left(sClassname, r)
If GetParent(hwnd) <> 0 Then
r = GetWindowLW(hwnd, GWL_ID)
sID = CLng("&H" & Hex(r))
Else
sID = Null
End If
If sWindowText Like WindowText And sClassname Like Classname Then
If IsNull(ID) Then
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
ElseIf Not IsNull(sID) Then
If CLng(sID) = CLng(ID) Then
iFound = iFound + 1
ReDim Preserve hWndArray(0 To iFound)
hWndArray(iFound) = hwnd
End If
End If
foundHwnd = hwnd
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
level = level - 1
FindWindowLike = foundHwnd
End Function
Private Sub InternetDeconnexion()
Dim i As Long
Dim lpRasConn(255) As RasConn
Dim lpcb As Long
Dim lpcConnections As Long
Dim hRasConn As Long
lpRasConn(0).dwSize = RAS_RASCONNSIZE
lpcb = RAS_MAXENTRYNAME * lpRasConn(0).dwSize
lpcConnections = 0
ReturnCode = RasEnumConnections(lpRasConn(0), lpcb, lpcConnections)
If ReturnCode = ERROR_SUCCESS Then
For i = 0 To lpcConnections - 1
If Trim(ByteToString(lpRasConn(i).szEntryName)) = Trim(gstrISPName) Then
hRasConn = lpRasConn(i).hRasConn
ReturnCode = RasHangUp(ByVal hRasConn)
End If
Next i
End If
End Sub
Public Function ByteToString(bytString() As Byte) As String
Dim i As Integer
ByteToString = ""
i = 0
While bytString(i) = 0&
ByteToString = ByteToString & Chr(bytString(i))
i = i + 1
Wend
End Function
pas de form utile seulement le module
propriété du projet sub_main au demarrage et voila c tt tu es deconnecté ca marche meme sur aol6 aol7 et AOL8 lol et oui ca fonctionne tester moi meme voila a plucheeeee