找了很多判断是否上网的代码,都没找到,这里有一VB 写的,绝对可以,有谁可把它写成DELPHI的,有现成代码也可 ( 积分: 0 )

  • 主题发起人 主题发起人 我要学
  • 开始时间 开始时间
我

我要学

Unregistered / Unconfirmed
GUEST, unregistred user!
Dim eR As EIGCInternetConnectionState
Dim sMsg As String
Dim sName As String
Dim bConnected As Boolean

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, _
ByVal lpszConnectionName As String, ByVal dwNameLen As Long, _
ByVal dwReserved As Long) As Long

Private Enum EIGCInternetConnectionState
INTERNET_CONNECTION_MODEM = &H1&
INTERNET_CONNECTION_LAN = &H2&
INTERNET_CONNECTION_PROXY = &H4&
INTERNET_RAS_INSTALLED = &H10&
INTERNET_CONNECTION_OFFLINE = &H20&
INTERNET_CONNECTION_CONFIGURED = &H40&
End Enum

Private Function InternetConnected(Optional ByRef eConnectionInfo _
As EIGCInternetConnectionState, Optional ByRef _
sConnectionName As String) As Boolean

Dim dwFlags As Long
Dim sNameBuf As String
Dim lR As Long
Dim iPos As Long

sNameBuf = String$(513, 0)
lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
eConnectionInfo = dwFlags
iPos = InStr(sNameBuf, vbNullChar)
If iPos > 0 Then
sConnectionName = Left$(sNameBuf, iPos - 1)
ElseIf Not sNameBuf = String$(513, 0) Then
sConnectionName = sNameBuf
End If
InternetConnected = (lR = 1)
End Function
Private Sub Command1_Click()
Dim A
A = Shell("C:/WINDOWS/system32/notepad.exe", 1)
End Sub

Private Sub Command10_Click()
Dim X
X = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1")
End Sub

Private Sub Command11_Click()
Dim A

A = Shell("C:/Program Files/LongMaster/UC/UC.exe", 1)
End Sub

Private Sub Command12_Click()
Dim A

A = Shell("C:/Program Files/Adobe/Photoshop 7.0/Photoshop.exe", 1)
End Sub

Private Sub Command13_Click()
Dim A
A = Shell(App.Path & "/我的邮箱.EXE", 1)
End Sub

Private Sub Command14_Click()
Dim PathtoOpen$
PathtoOpen = "E:/电影/"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command15_Click()
Open "D:/系统管理/最好/重要的文件/B.TXT" For Input As #1
Input #1, X
Command15.Caption = X
Close #1

End Sub

Private Sub Command16_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/VB 制作(重要)"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command17_Click()
Dim PathtoOpen$
PathtoOpen = "D:/编程书"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command18_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/工具"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command19_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command2_Click()
Dim X
X = Shell("rundll32.exe shell32.dll,Control_RunDLL")
End Sub

Private Sub Command20_Click()
Dim PathtoOpen$
PathtoOpen = "E:/公文包"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command21_Click()
Dim PathtoOpen$
PathtoOpen = "D:/扫描仪"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command22_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/最好"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command23_Click()
Dim PathtoOpen$
PathtoOpen = "E:/游戏"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command24_Click()
Dim PathtoOpen$
PathtoOpen = "C:/Program Files"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command25_Click()
End
End Sub

Private Sub Command26_Click()
Form2.Show
End Sub

Private Sub Command27_Click()

Dim X
X = Shell("D:/Program Files/win32/CUSTOM.EXE", 1)
End Sub

Private Sub Command28_Click()
Dim A
A = Shell(App.Path & "/网上银行.EXE", 1)
End Sub

Private Sub Command29_Click()
Dim A
A = Shell("E:/游戏/HFGame3/GameClient.EXE", 1)
End Sub

Private Sub Command3_Click()
Dim A
A = Shell("D:/系统管理/VB 制作(重要)/常用复制/1.EXE", 1)
End Sub

Private Sub Command30_Click()
Dim A
A = Shell("D:/系统管理/最好/重点工具/金山快译2002/KingTrans.exe", 1)
End Sub

Private Sub Command31_Click()
Dim A
A = Shell(App.Path & "/淘宝.EXE", 1)
End Sub

Private Sub Command32_Click()
Dim A
A = Shell("regedit.exe", 1)
End Sub

Private Sub Command4_Click()
Dim A
A = Shell(App.Path & "/TV888.EXE", 1)
End Sub

Private Sub Command5_Click()
Dim A
A = Shell("C:/Program Files/短信袋鼠/EQClient.exe", 1)
End Sub

Private Sub Command6_Click()
Dim A
A = Shell("C:/Program Files/ScanDrv5/ScanDrv.exe", 1)
End Sub

Private Sub Command7_Click()
Dim A
A = Shell("C:/Program Files/五笔打字员/wbdzy.exe", 1)
End Sub

Private Sub Command8_Click()
Dim A

A = Shell("C:/Program Files/Super Rabbit/MagicSet/MagicSet.exe", 1)
End Sub

Private Sub Command9_Click()
Dim A
A = Shell("E:/3dsmax6/3dsmax.exe", 1)
End Sub

Private Sub Form_Load()

End Sub

Private Sub Label1_Click()

Form1.Left = 7455
Form1.Top = 105

Form1.Height = 7335
Timer1.Enabled = True
'Form3.Show
'Form1.Show
End Sub

Private Sub Timer1_Timer()
Dim A
A = Text1.Text
A = A + 1
Text1.Text = A
If A = 8 Then

Timer1.Enabled = False
Text1.Text = 0
Form1.Left = 10050
Form1.Top = 105

Form1.Height = 550
Unload Form3
End If
End Sub

Private Sub Timer2_Timer()
'检测是否已经以及使用什么方法连接到Internet
bConnected = InternetConnected(eR, sName)

'根据获得的结果输出
If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
sMsg = sMsg & "使用modem连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
sMsg = sMsg & "使用内部网连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
sMsg = sMsg & "通过代理服务器连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
sMsg = sMsg & "现在连接处于离线状态." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
sMsg = sMsg & "连接已经被设定." & vbCrLf
Else
sMsg = sMsg & "没有设定好的连接." & vbCrLf
End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
sMsg = sMsg & "本机已经安装了远程访问服务功能." & vbCrLf
End If

'显示连接名称
If bConnected Then

Text3.Text = Str(Day(Date))
Dim E
E = Text3.Text
If E = 22 Then
Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Output As #1
Print #1, 0
End If
Close #1
Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Input As #1
Input #1, C
Text2.Text = C
Close #1
Dim PP
Dim W
PP = Text2.Text
W = PP + 2

Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Output As #1
Print #1, W
Close #1
Dim TIM
Dim L As Integer
TIM = Text2.Text
L = TIM / 60

Label1.Caption = "正在上网" ' 本月用了" ; L ; "分钟"; '到Internet，连接名称: " & sName & vbCrLf & vbCrLf & sMsg
Label2.Caption = L
Label3.Caption = "分钟"

Else
Label1.Caption = Time$ ' "没有连接到Internet，连接名称: " & sName & vbCrLf & vbCrLf & sMsg
End If

End Sub






//原代码,用VB 编译没问题,
 
Dim eR As EIGCInternetConnectionState
Dim sMsg As String
Dim sName As String
Dim bConnected As Boolean

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" _
Alias "InternetGetConnectedStateExA" (ByRef lpdwFlags As Long, _
ByVal lpszConnectionName As String, ByVal dwNameLen As Long, _
ByVal dwReserved As Long) As Long

Private Enum EIGCInternetConnectionState
INTERNET_CONNECTION_MODEM = &H1&
INTERNET_CONNECTION_LAN = &H2&
INTERNET_CONNECTION_PROXY = &H4&
INTERNET_RAS_INSTALLED = &H10&
INTERNET_CONNECTION_OFFLINE = &H20&
INTERNET_CONNECTION_CONFIGURED = &H40&
End Enum

Private Function InternetConnected(Optional ByRef eConnectionInfo _
As EIGCInternetConnectionState, Optional ByRef _
sConnectionName As String) As Boolean

Dim dwFlags As Long
Dim sNameBuf As String
Dim lR As Long
Dim iPos As Long

sNameBuf = String$(513, 0)
lR = InternetGetConnectedStateEx(dwFlags, sNameBuf, 512, 0&)
eConnectionInfo = dwFlags
iPos = InStr(sNameBuf, vbNullChar)
If iPos > 0 Then
sConnectionName = Left$(sNameBuf, iPos - 1)
ElseIf Not sNameBuf = String$(513, 0) Then
sConnectionName = sNameBuf
End If
InternetConnected = (lR = 1)
End Function
Private Sub Command1_Click()
Dim A
A = Shell("C:/WINDOWS/system32/notepad.exe", 1)
End Sub

Private Sub Command10_Click()
Dim X
X = Shell("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1")
End Sub

Private Sub Command11_Click()
Dim A

A = Shell("C:/Program Files/LongMaster/UC/UC.exe", 1)
End Sub

Private Sub Command12_Click()
Dim A

A = Shell("C:/Program Files/Adobe/Photoshop 7.0/Photoshop.exe", 1)
End Sub

Private Sub Command13_Click()
Dim A
A = Shell(App.Path & "/我的邮箱.EXE", 1)
End Sub

Private Sub Command14_Click()
Dim PathtoOpen$
PathtoOpen = "E:/电影/"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command15_Click()
Open "D:/系统管理/最好/重要的文件/B.TXT" For Input As #1
Input #1, X
Command15.Caption = X
Close #1

End Sub

Private Sub Command16_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/VB 制作(重要)"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command17_Click()
Dim PathtoOpen$
PathtoOpen = "D:/编程书"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command18_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/工具"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command19_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command2_Click()
Dim X
X = Shell("rundll32.exe shell32.dll,Control_RunDLL")
End Sub

Private Sub Command20_Click()
Dim PathtoOpen$
PathtoOpen = "E:/公文包"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command21_Click()
Dim PathtoOpen$
PathtoOpen = "D:/扫描仪"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command22_Click()
Dim PathtoOpen$
PathtoOpen = "D:/系统管理/最好"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command23_Click()
Dim PathtoOpen$
PathtoOpen = "E:/游戏"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command24_Click()
Dim PathtoOpen$
PathtoOpen = "C:/Program Files"
Shell "explorer.exe " & PathtoOpen, vbNormalFocus
End Sub

Private Sub Command25_Click()
End
End Sub

Private Sub Command26_Click()
Form2.Show
End Sub

Private Sub Command27_Click()

Dim X
X = Shell("D:/Program Files/win32/CUSTOM.EXE", 1)
End Sub

Private Sub Command28_Click()
Dim A
A = Shell(App.Path & "/网上银行.EXE", 1)
End Sub

Private Sub Command29_Click()
Dim A
A = Shell("E:/游戏/HFGame3/GameClient.EXE", 1)
End Sub

Private Sub Command3_Click()
Dim A
A = Shell("D:/系统管理/VB 制作(重要)/常用复制/1.EXE", 1)
End Sub

Private Sub Command30_Click()
Dim A
A = Shell("D:/系统管理/最好/重点工具/金山快译2002/KingTrans.exe", 1)
End Sub

Private Sub Command31_Click()
Dim A
A = Shell(App.Path & "/淘宝.EXE", 1)
End Sub

Private Sub Command32_Click()
Dim A
A = Shell("regedit.exe", 1)
End Sub

Private Sub Command4_Click()
Dim A
A = Shell(App.Path & "/TV888.EXE", 1)
End Sub

Private Sub Command5_Click()
Dim A
A = Shell("C:/Program Files/短信袋鼠/EQClient.exe", 1)
End Sub

Private Sub Command6_Click()
Dim A
A = Shell("C:/Program Files/ScanDrv5/ScanDrv.exe", 1)
End Sub

Private Sub Command7_Click()
Dim A
A = Shell("C:/Program Files/五笔打字员/wbdzy.exe", 1)
End Sub

Private Sub Command8_Click()
Dim A

A = Shell("C:/Program Files/Super Rabbit/MagicSet/MagicSet.exe", 1)
End Sub

Private Sub Command9_Click()
Dim A
A = Shell("E:/3dsmax6/3dsmax.exe", 1)
End Sub

Private Sub Form_Load()

End Sub

Private Sub Label1_Click()

Form1.Left = 7455
Form1.Top = 105

Form1.Height = 7335
Timer1.Enabled = True
'Form3.Show
'Form1.Show
End Sub

Private Sub Timer1_Timer()
Dim A
A = Text1.Text
A = A + 1
Text1.Text = A
If A = 8 Then

Timer1.Enabled = False
Text1.Text = 0
Form1.Left = 10050
Form1.Top = 105

Form1.Height = 550
Unload Form3
End If
End Sub

Private Sub Timer2_Timer()
'检测是否已经以及使用什么方法连接到Internet
bConnected = InternetConnected(eR, sName)

'根据获得的结果输出
If (eR And INTERNET_CONNECTION_MODEM) = INTERNET_CONNECTION_MODEM Then
sMsg = sMsg & "使用modem连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_LAN) = INTERNET_CONNECTION_LAN Then
sMsg = sMsg & "使用内部网连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_PROXY) = INTERNET_CONNECTION_PROXY Then
sMsg = sMsg & "通过代理服务器连接到Internet." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_OFFLINE) = INTERNET_CONNECTION_OFFLINE Then
sMsg = sMsg & "现在连接处于离线状态." & vbCrLf
End If
If (eR And INTERNET_CONNECTION_CONFIGURED) = INTERNET_CONNECTION_CONFIGURED Then
sMsg = sMsg & "连接已经被设定." & vbCrLf
Else
sMsg = sMsg & "没有设定好的连接." & vbCrLf
End If
If (eR And INTERNET_RAS_INSTALLED) = INTERNET_RAS_INSTALLED Then
sMsg = sMsg & "本机已经安装了远程访问服务功能." & vbCrLf
End If

'显示连接名称
If bConnected Then

Text3.Text = Str(Day(Date))
Dim E
E = Text3.Text
If E = 22 Then
Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Output As #1
Print #1, 0
End If
Close #1
Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Input As #1
Input #1, C
Text2.Text = C
Close #1
Dim PP
Dim W
PP = Text2.Text
W = PP + 2

Open "D:/系统管理/最好/重要的文件/上网时间.TXT" For Output As #1
Print #1, W
Close #1
Dim TIM
Dim L As Integer
TIM = Text2.Text
L = TIM / 60

Label1.Caption = "正在上网" ' 本月用了" ; L ; "分钟"; '到Internet，连接名称: " & sName & vbCrLf & vbCrLf & sMsg
Label2.Caption = L
Label3.Caption = "分钟"

Else
Label1.Caption = Time$ ' "没有连接到Internet，连接名称: " & sName & vbCrLf & vbCrLf & sMsg
End If

End Sub






//原代码,用VB 编译没问题,
 
中间有一些没用的东东,你们只管挑重点看吧
 
您必须登录或注册才可回复。

Similar threads

Y
给出一段VB6和代码，谁能帮转成DELPHI的？？（见内容）(20分)
回复
0
查看
248
yagas
Y
P
这边有用VB调用DLL的例子，但是我不懂VB那位翻译一下，谢谢！！(150分)
回复
6
查看
200
popboy
P
M
这篇文章也许对2000下想要自定义纸张大小的人有帮助(0分)
回复
0
查看
247
mickey4
M
H
难题：为什么delphi保存出来的ICO都是16色？如果你能解决，至少可以得到600分！！(300分)
2
回复
21
查看
458
hlsoft
H
C
哪位兄台能帮我把这段VB代码（不长）转为delphi中能运行的代码？通过就给分，不甚感谢 (100分)
回复
4
查看
272
chenjiong
C
后退
顶部