求写一个VB6代码

alan347881

求大神写一个
写一个VB 6.0启动程序，
检测是否联网，如果联网则启动当前目录下文件X，启动X后自身退出，如果没有联网给一个提示文字，退出，

Defender

[PHP] 纯文本查看 复制代码

Option Explicit

Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long

Private Sub Form_Load()
    Dim isConnected As Long
    Dim ret As Long
    
    ' 调用函数检测是否联网
    ret = InternetGetConnectedState(isConnected, 0&)
    
    If ret <> 0 Then
        ' 联网，启动当前目录下的文件X（这里假设文件X是可执行文件，可根据实际情况修改启动方式）
        Shell App.Path & "\X.exe"
        Unload Me
    Else
        ' 未联网，给出提示文字
        MsgBox "当前未联网，请检查网络连接后重试。", vbExclamation
        Unload Me
    End If
End Sub

jyjjf

你是连互联网(或者说某个网址或者某个ip)？还是网卡本地连线？

alan347881

jyjjf 发表于 2024-11-13 10:33
你是连互联网(或者说某个网址或者某个ip)？还是网卡本地连线？

能连接到互联网，就行，看通过什么代码，或者通过连接百度网址也行

alan347881

Defender 发表于 2024-11-13 09:20
[mw_shl_code=php,true]Option Explicit

Private Declare Function InternetGetConnectedState Lib "win ...

大神，能不能将代码修改下，现在的代码只是检查网卡是否存在，如果断掉网线还是启动，需要真正接入互联才可以启动

Defender

alan347881 发表于 2024-11-13 11:46
大神，能不能将代码修改下，现在的代码只是检查网卡是否存在，如果断掉网线还是启动，需要真正接入互联才 ...

[PHP] 纯文本查看 复制代码

Option Explicit

' 引入必要的API函数声明
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long

Private Sub Form_Load()
    Dim isConnected As Long
    Dim urlToCheck As String
    Dim ret As Long

    ' 设置一个用于检测连接的网址，这里使用常见的谷歌网址，你也可以换成其他可靠的网址
    urlToCheck = "https://www.google.com"

    ' 调用函数检测是否能连接到指定网址，以此来判断是否真正接入互联网
    ret = InternetCheckConnection(urlToCheck, 0&, 0&)

    If ret <> 0 Then
        ' 已接入互联网，启动当前目录下的文件X（这里假设文件X是可执行文件，可根据实际情况修改启动方式）
        Shell App.Path & "\X.exe"
        Unload Me
    Else
        ' 未接入互联网，给出提示文字
        MsgBox "当前未接入互联网，请检查网络连接后重试。", vbExclamation
        Unload Me
    End If
End Sub

alan347881

Defender 发表于 2024-11-13 11:49
[mw_shl_code=php,true]Option Explicit

' 引入必要的API函数声明

这个代码，无论是否联网，都提示没有网路连接，无法启动文件，网址我更换了百度网址 和其他网址均如此，请再帮看下代码

Defender

[PHP] 纯文本查看 复制代码

Option Explicit

' 引入必要的API函数声明
Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long

Private Sub Form_Load()
    Dim isConnected As Long
    Dim urlToCheck As String
    Dim ret As Long

    ' 设置一个用于检测连接的国内网址，这里使用腾讯网网址，你也可以换成其他可靠的网址
    urlToCheck = "https://www.qq.com"

    ' 调用函数检测是否能连接到指定网址，以此来判断是否真正接入互联网
    ret = InternetCheckConnection(urlToCheck, 1, 0)

    If ret <> 0 Then
        ' 已接入互联网，启动当前目录下的文件X（这里假设文件X是可执行文件，可根据实际情况修改启动方式）
        Shell App.Path & "\X.exe"
        Unload Me
    Else
        ' 未接入互联网，给出提示文字
        MsgBox "当前未接入互联网，请检查网络连接后重试。", vbExclamation
        Unload Me
    End If
End Sub

在上述代码中：
依然使用 InternetCheckConnection 函数来检测与互联网的连接情况，通过尝试连接到指定的网址（这里设置为腾讯网的网址 https://www.qq.com）来判断是否真正接入了互联网。
在调用 InternetCheckConnection 函数时，将 dwFlags 参数设置为 1。这个参数的不同取值可以影响检测的方式和效果，设置为 1 可以在一定程度上更准确地检测到实际的网络连接状态，具体含义可以参考相关的 API 文档。
如果函数返回值不为 0，说明能够成功连接到指定网址，即已接入互联网，此时会按照要求启动当前目录下名为 X.exe 的文件（你需要根据实际要启动的文件进行相应修改），然后通过 Unload Me 卸载当前窗体，让程序自身退出。
如果函数返回值为 0，表示无法连接到指定网址，也就是未接入互联网，这时会弹出提示框告知用户当前未接入互联网，需要检查网络连接后重试，然后同样通过 Unload Me 卸载当前窗体退出程序。
请注意：
如果在你的网络环境下，即使网络正常但对所设置的检测网址（如腾讯网）存在访问限制等特殊情况，可能会导致误判为未联网。此时你可以尝试更换其他可靠且在你所在网络环境下能正常访问的网址进行检测。
确保 X.exe 文件确实存在于程序的当前目录下，并且具有可执行权限（如果是可执行文件的话）。

alan347881

Defender 发表于 2024-11-13 12:46
[mw_shl_code=php,true]Option Explicit

' 引入必要的API函数声明

多谢，多谢，！完美解决，我再加50CB，能不能再帮我加个代码，X.exe如果不存在，出一个提示文字，

Defender

[PHP] 纯文本查看 复制代码

Option Explicit

Private Declare Function InternetCheckConnection Lib "wininet.dll" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) As Long

Private Sub Form_Load()
    Dim isConnected As Long
    Dim urlToCheck As String
    Dim ret As Long
    urlToCheck = "https://www.qq.com"
    
    ret = InternetCheckConnection(urlToCheck, 1, 0)
    
    If ret <> 0 Then
        If Dir(App.Path & "\X.exe") <> "" Then
            Shell App.Path & "\X.exe"
            Unload Me
        Else
            MsgBox "文件X.exe不存在，请检查。", vbExclamation
            Unload Me
        End If
    Else
        MsgBox "当前未接入互联网，请检查网络连接后重试。", vbExclamation
        Unload Me
    End If
End Sub