| View previous topic :: View next topic |
| Author |
Message |
sajadkk
مهمون يكي دو روزه
Joined: 11 Jul 2005
Posts: 18
|
 Posted: Sun Aug 07, 2005 11:57 pm Post subject: یه تابع برای قطع کردن اینترنتneeded |
 |
|
به یک عدد تابع برای [size=18]قطع کردن اینترنت[/size] نیاز مندم.
thanks 
sajad |
|
| Back to top |
|
 |
vahid
بي تو هرگز
Joined: 26 Nov 2004
Posts: 3067
Location: Tehran
|
| Posted: Mon Aug 08, 2005 9:34 pm Post subject: |
|
|
يه MSComm control به فرمت اضافه كن به نام MSComm1 . بعدش هم بهش مقدار زير رو بده .
| MSComm1.Output = "ATH" + vbCr
MScomm1.portopen=false |
|
|
| Back to top |
|
|
sajadkk
مهمون يكي دو روزه
Joined: 11 Jul 2005
Posts: 18
|
| Posted: Tue Aug 09, 2005 9:04 am Post subject: |
|
|
دستخوش داداش
ولی این خطای 8018 رامیگیرد
operation valid only the port is open.
نمی دانم ولی شاید شماره پورت غلط باشد؟
) |
|
| Back to top |
|
|
unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
| Posted: Tue Aug 09, 2005 12:02 pm Post subject: |
|
|
برو زندگی کنا...
برای قطع کردن از HangUp استفاده کن
| Option Explicit
' Registry APIs.
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const ERROR_SUCCESS = 0&
Public Const APINULL = 0&
Public Const MAX_STRING_LENGTH As Integer = 256
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
' Remote Access Services (RAS) APIs.
Public Const RAS_MAXENTRYNAME As Integer = 256
Public Const RAS_MAXDEVICETYPE As Integer = 16
Public Const RAS_MAXDEVICENAME As Integer = 128
Public Const RAS_RASCONNSIZE As Integer = 412
Public Type RasEntryName
dwSize As Long
szEntryName(RAS_MAXENTRYNAME) As Byte
End Type
Public 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
Public Declare Function RasEnumConnections Lib "rasapi32.dll" Alias "RasEnumConnectionsA" (lpRasConn As Any, lpcb As Long, lpcConnections As Long) As Long
Public Declare Function RasHangUp Lib "rasapi32.dll" Alias "RasHangUpA" (ByVal hRasConn As Long) As Long
Public gstrISPName As String
Public ReturnCode As Long
'Returns True if a DUN connection is present
Public Function Connected_To_ISP() As Boolean
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As Long
Dim lpcbData As Long
Connected_To_ISP = False
lpSubKey = "System\CurrentControlSet\Services\RemoteAccess"
ReturnCode = RegOpenKey(HKEY_LOCAL_MACHINE, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Remote Connection"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
ByVal lpData, lpcbData)
lpcbData = Len(lpData)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, lpType, _
lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
If lpData = 0 Then
' Not Connected
Else
' Connected
Connected_To_ISP = True
End If
End If
RegCloseKey (hKey)
End If
End Function
Public Sub HangUp()
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
' It takes about 3 seconds to drop the connection.
Wait (3)
While Connected_To_ISP
Wait (1)
Wend
End Sub
'waits a number of seconds
Public Sub Wait(sngSeconds As Single)
Dim sngEndTime As Single
sngEndTime = Timer + sngSeconds
While Timer < sngEndTime
DoEvents
Wend
End Sub
'Convert a string in byte format (usually from a DLL call)
'to a string of text.
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
'Returns the name of the Internet Service Provider,
'as it is in Windows Dial Up Networking settings
Public Function Get_ISP_Name() As String
Dim hKey As Long
Dim lpSubKey As String
Dim phkResult As Long
Dim lpValueName As String
Dim lpReserved As Long
Dim lpType As Long
Dim lpData As String
Dim lpcbData As Long
Get_ISP_Name = ""
If Connected_To_ISP Then
lpSubKey = "RemoteAccess"
ReturnCode = RegOpenKey(HKEY_CURRENT_USER, lpSubKey, phkResult)
If ReturnCode = ERROR_SUCCESS Then
hKey = phkResult
lpValueName = "Default"
lpReserved = APINULL
lpType = APINULL
lpData = APINULL
lpcbData = APINULL
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
lpType, ByVal lpData, lpcbData)
lpData = String(lpcbData, 0)
ReturnCode = RegQueryValueEx(hKey, lpValueName, lpReserved, _
lpType, ByVal lpData, lpcbData)
If ReturnCode = ERROR_SUCCESS Then
' Chop off the end-of-string character.
Get_ISP_Name = Left(lpData, lpcbData - 1)
End If
RegCloseKey (hKey)
End If
End If
End Function |
|
|
| Back to top |
|
|
sajadkk
مهمون يكي دو روزه
Joined: 11 Jul 2005
Posts: 18
|
| Posted: Tue Aug 09, 2005 12:26 pm Post subject: |
|
|
این دیگه واقعا دستخوش MERCY MR AMIR
sajad
|
|
| Back to top |
|
|
unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
| Posted: Tue Aug 09, 2005 4:29 pm Post subject: |
|
|
قابلی نداره
ولی سعی کن کدش رو یاد بگیری |
|
| Back to top |
|
|
sajadkk
مهمون يكي دو روزه
Joined: 11 Jul 2005
Posts: 18
|
| Posted: Tue Aug 09, 2005 7:26 pm Post subject: |
|
|
ولی خودمونیم ها این code کمی احتیاج به توضیح داره ، این
hang up را چطوری به کار ببــــــــــــریِِِّّــم؟؟؟؟؟
یه کمی دربارش توضیح بده بعد حتما یادش می گیرم.
راستی دارم روی یه برنامه که هزینهُ تلفن اینترنتو حساب می کنه کار میکنم 70% کارش تموم شده .
در مورد اون سوال که قبلا پرسیده بودم(همون قضیه فرمول وtextbox ) یه برنامه پیدا کردم
برات ای میلش تا ببینی اساس کار اون textbox که فرمولو می گیره چطوریه
اگه بشه ازش یه ماژول درست بشه چی میشه.
sajad) |
|
| Back to top |
|
|
unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
| Posted: Wed Aug 10, 2005 9:02 am Post subject: |
|
|
متاسفم دیگه وقت توضیح دادن کدا رو ندارم.
در ضمن سیا بود......
همینش هم که می بینید جواب سوال ها رو می دم به خاطر رفاقت با مدیر سایته. فقط همین
در ضمن برنامه ای که برام میل کردی هم دیدم.
خیلی مبتدیانه بود. در ضمن مشکل فونت فارسی هم داشت.
بعدش هم من احتیاجی ندارم ببینم اساس کار برنامه تان چیه بهتره خودتون این کارو بکنین |
|
| Back to top |
|
|
sajadkk
مهمون يكي دو روزه
Joined: 11 Jul 2005
Posts: 18
|
| Posted: Wed Aug 10, 2005 12:30 pm Post subject: |
|
|
باید بگم ببخشید ها اون برنامه من نبود مال یکی دیگه بود.
sajad |
|
| Back to top |
|
|
unknown
مدير بخش ويژوال بيسيك
Joined: 05 Dec 2004
Posts: 439
Location: Tehran
|
| Posted: Wed Aug 10, 2005 5:20 pm Post subject: |
|
|
| می دونم برای همینم می گم شما اساس کارش رو مطالعه کنید به درد من نمی خوره |
|
| Back to top |
|
|
vahid
بي تو هرگز
Joined: 26 Nov 2004
Posts: 3067
Location: Tehran
|
| Posted: Wed Aug 10, 2005 8:28 pm Post subject: |
|
|
| unknown wrote: | | می دونم برای همینم می گم شما اساس کارش رو مطالعه کنید به درد من نمی خوره |
اقا دست شما درد نكنه ... لطف فرموديد . |
|
| Back to top |
|
|
|
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
