[已解决]30元求助一ADSL自动拨号的批处理

samiking

具体报酬：30元人民币
支付方式：支付宝
联系方式：QQ25965079
有效期限：2013年09月10日之前。
需求描述：
想要一个ADSL自动拨号的批处理,可以设置多少分钟断线重拨,拨号成功后自动把ppp IP地址导入ip.txt ,(不成功则重拨,间隔5秒,重拨次数5次,还不成功,显示错误提示"拨号出错")每次断线重拨都要对比IP.txt文件里的IP,重复就断线重拨(间隔5秒),直到不重复为止. 批处理的开头先查看创建ip.txt的日期时间跟现在的日期时间对比,超过24小时,删除重建 (适用于xp/2003 系统)

batman

这个是批处理版的：

@echo off&setlocal enabledelayedexpansion
set "name=xxxx"
set "user=xxxx"
set "password=xxxxxx"
set /a times=10
echo,&set /p times=    请输入自动断网重连的时间，单位分钟，默认为10分钟：
cls&set /a s=times*60
if not exist ip.txt echo,IP列表>ip.txt
for %%a in (ip.txt) do (
  for /f %%b in ("%%~ta") do (
    if "%%b" neq "%date:~,10%" echo,IP列表>ip.txt
  )
)
:lp
echo,&echo,    网络连接中，请稍等。。。
rasdial /disconnect>nul 2>nul
call :delay 2
rasdial %name% %user% %password%>nul 2>nul
call :delay 2
ping /n 1 www.baidu.com>nul||goto lp
cls&echo,&echo,    网络成功连接。。。
call :delay 2
set "ip="&set "flag="
for /f "delims=" %%a in ('ipconfig') do (
  set "str=%%a"
  if not defined ip (
    if defined flag (
      if "!str:IP Address=!" neq "!str!" (
        set "ip=!str:*:=!"
        set "ip=!ip:~1!"
      )
    ) 
    if "!str:~,3!" equ "PPP" set "flag=a"
  )
)
findstr "%ip%" ip.txt>nul&&goto lp||echo,%ip%>>ip.txt
cls&echo,&echo,    网络保持中。。。
call :delay %s%
goto lp
:delay
mshta "javascript:document.write();setTimeout('close()',%1*1000)"
复制代码

samiking

谢谢版主,不怨其烦的修改代码.学到好多东西,谢谢

batman

应该可以结帖了。。。

'初始化全局变量
Dim AdslName, AdslUser, AdslPassword, Ip, File, Text, Times
AdslName = "XXXX"
AdslUser = "XXXX"
AdslPassword = "XXXXXX" 
Ip = "www.baidu.com"
File = "ip.txt"

'输入断网时间
Do Until Times <> 0
  Times = Int(InputBox("请输入自动断网重连的时间，单位为分钟，默认为10分钟",,10))
Loop

'判断ip.txt最后一次访问时间到现在是不是过了24小时
GetText File, "test", Null

'每Times分钟断网重连循环
Do
  Again
  WScript.Sleep Times * 60 * 1000
Loop

Function Again
  '拔号循环
  Dim OK
  OK = vbNullString
  Do Until OK = "ok"
    Adsl "disconnect"
    WScript.Sleep 1000
    Adsl "connect"
    WScript.Sleep 1000
    Juge
    If Juge = 0 Then 
      GetIp : Text = vbNullString
      GetText File, "read", Null
      If InStr(Text, GetIp) = 0 Then 
        GetText File, "write", GetIp
        OK = "ok"
      End If
     End If
  Loop
End Function

Function Juge
  '判断网络通畅
  Juge = 1
  Dim objWMI, objItems, objItem
  Set objWMI = GetObject("Winmgmts:")
  Set objItems = objWMI.ExecQuery _
    ("Select * From Win32_PingStatus " _
      & "Where Address = '" & Ip & "'")
  For Each objItem In objItems
    If objItem.ResponseTime > 0 Then Juge = 0
  Next
  Set objItems = Nothing
  Set objWMI = Nothing
End Function 

Function Adsl(Types)
  'ADSL拔号版块
  Dim objSHELL
  Set objSHELL = CreateObject("Wscript.Shell")
  If Types = "connect" Then
    objSHELL.Run "rasdial.exe " & AdslName _
      & " " & AdslUser & " " & Adslpassword, 0, 0
    Else
    objSHELL.Run "rasdial.exe /disconnect", 0, 0
  End If
  Set objSHELL = Nothing
End Function

Function GetIp
  '获取外网IP
  Dim objWMI, objItems, objItem
  Set objWMI = GetObject("Winmgmts:")
  Set objItems = objWMI.ExecQuery _
    ("Select * From Win32_NetworkAdapterConfiguration " _
      & "Where IPEnabled = True")
  For Each objItem In objItems
    For Each address In objItem.IPAddress
      If address <> "" And InStr(objItem.Caption, "WAN 微型端口") _
        Then GetIp = address
    Next
  Next 
End Function

Function GetText(File, Types, GetIp)
  '文本读、写版块
  Dim objFSO
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If Not objFSO.FileExists(File) Then _
    objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
  If Types = "read" Then
    Text = objFSO.OpenTextFile(File).ReadAll
    Else
    If Types = "write" Then
      objFSO.OpenTextFile(File, 8).WriteLine GetIp
      Else
      oldday = objFSO.GetFile(File).DateLastModified
      If DateDiff("h", oldday, Now) > 24 Then _
        objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
     End If
  End If
  Set objFSO = Nothing
End Function
复制代码

batman

加批处理群找我吧，群号43011867

samiking

刚测试,还是不行,版主.这次ip一个也记录不了.
错误提示:
行 82
字符 3
我加入点个人理解
'每Times分钟断网重连循环

Do

  WScript.Sleep Times * 60 * 1000

  Adsl "disconnect"

  WScript.Sleep 1 * 1000

  Adsl "connect"

Loop

这个模块里,是不是应该加入调用 获取IP和读写版块 这样才会做一个循环?
============
'判断ip.txt最后一次访问时间到现在是不是过了24小时

GetText File, "test", Null

这个模块,如果ip.txt超过24小时后续操作是什么???没代码

加个Q可以吗,有利调试和反溃信息更快传达给你

batman

楼主一直在描述问题，一直没有描述清楚。。。。
PS:ip.txt肯定不会只记录第一次的，这个我都测试了很多次了（xp）

'初始化全局变量
Dim AdslName, AdslUser, AdslPassword, Url, Ip, File, Text, OK, Times
AdslName = "xxxx"
AdslUser = "xxxx"
AdslPassword = "xxxxxx" 
Url = "http://iframe.ip138.com/ic.asp"
Ip = "www.baidu.com"
File = "ip.txt"
OK = vbNullString

'输入断网时间
Do Until Times <> 0
  Times = Int(InputBox("请输入自动断网重连的时间，单位为分钟，默认为10分钟",,10))
Loop

'判断ip.txt最后一次访问时间到现在是不是过了24小时
GetText File, "test", Null

'拔号循环
Adsl "disconnect"
WScript.Sleep 1000
For i = 1 To 5
  Adsl "connect"
  WScript.Sleep 1000
  Juge
  If Juge = 0 Then 
    GetIp : Text = vbNullString
    GetText File, "read", Null
    If InStr(Text, GetIp) = 0 Then 
      GetText File, "write", GetIp
      OK = "ok"
      Exit For
      Else
      Adsl "disconnect"
    End If
   End If
Next
If OK <> "ok" Then 
  MsgBox "拔号出错"
  WScript.Quit
End if

'每Times分钟断网重连循环
Do
  WScript.Sleep Times * 60 * 1000
  Adsl "disconnect"
  WScript.Sleep 1 * 1000
  Adsl "connect"
Loop

Function Juge
  '判断网络通畅
  Juge = 1
  Dim objWMI, objItems, objItem
  Set objWMI = GetObject("Winmgmts:")
  Set objItems = objWMI.ExecQuery _
    ("Select * From Win32_PingStatus " _
      & "Where Address = '" & Ip & "'")
  For Each objItem In objItems
    If objItem.ResponseTime > 0 Then Juge = 0
  Next
  Set objItems = Nothing
  Set objWMI = Nothing
End Function 

Function Adsl(Types)
  'ADSL拔号版块
  Dim objSHELL
  Set objSHELL = CreateObject("Wscript.Shell")
  If Types = "connect" Then
    objSHELL.Run "rasdial.exe " & AdslName _
      & " " & AdslUser & " " & Adslpassword, 0, 0
    Else
    objSHELL.Run "rasdial.exe /disconnect", 0, 0
  End If
  Set objSHELL = Nothing
End Function

Function GetIp
  '获取外网IP
  Dim objDOM, Arr, Arr2
  Set objDOM = WScript.GetObject(Url)  
  Do Until objDOM.Readystate = "complete" 
    WScript.Sleep 200 
  Loop
  Arr = Split(objDOM.DocumentElement.Innertext, "[")
  Arr2 = Split(Arr(1), "]")
  GetIp = Arr2(0)
  Set objDOM = Nothing
End Function

Function GetText(File, Types, GetIp)
  '文本读、写版块
  Dim objFSO
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If Not objFSO.FileExists(File) Then _
    objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
  If Types = "read" Then
    Text = objFSO.OpenTextFile(File).ReadAll
    Else
    If Types = "write" Then
      objFSO.OpenTextFile(File, 8).WriteLine GetIp
      Else
      oldday = objFSO.GetFile(File).DateLastModified
      If DateDiff("h", oldday, Now) > 24 Then _
        objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
     End If
  End If
  Set objFSO = Nothing
End Function
复制代码

batman

回复 8# samiking


    请及时反馈情况。。。

samiking

好的,我试试先
已测试,自动拨号会上号,有几个问题:
1,设置多少分钟自动断线重连,这个不会循环,如果设置10分钟,那就每10分钟断一次
2,ip.txt只会记录第一次,我想要每次都记,这样对比才有意思,避免拨号重复

batman

我已在家调试了代码，请测试先。。。

batman

单位没有拔号测试条件，回家再来调试代码。。。

samiking

我确实不知道,对编程也是刚刚接触.不过前提条件我确实说清楚了,只是放在前面,你没注意...
照你所说,保存为text.vbs 编译还是无法通过,无法自动拨号,我已经把ADSL 帐号,密码 加入变量里了,运行好久,弹出对话 拨号错误

batman

回复 3# samiking


    这是vbs，没想到你这都不知道，保存文件为test.vbs，然后前提条件你在顶楼并没讲清楚。。。

samiking

编译出错,运行不了.显示"变量出错..Dim不是内部命令或外部命令...url不是内部命令或外部命令".而且前提有个功能没有实现,就是可以手动设置多少分钟断开连接.比如输入10,20....60分钟等.由于批处理我是初学,只是个小白,代码只看懂小部分,希望版主能不能编译通过了再发.
变量我只修改了三个部分
AdslName = "xxx" 我改成 宽带连接
AdslUser = "xxxx" 我改成 拨号帐号
AdslPassword = "xxxxxx"  我改成 拨号密码

运行系统 win2003

batman

变量自己改，如果问题解决了，请将钱捐到论坛基金，具体事项找Batcher。。。

'初始化全局变量
Dim AdslName, AdslUser, AdslPassword, Url, Ip, File, Text, OK, Times, StartTime
AdslName = "xxxx"
AdslUser = "xxxx"
AdslPassword = "xxxxxx" 
Url = "http://iframe.ip138.com/ic.asp"
Ip = "www.baidu.com"
File = "ip.txt"
OK = vbNullString

'输入断网时间
Do Until Times <> 0
  Times = Int(InputBox("请输入自动断网的时间，单位为分钟，默认为60分钟",,60))
Loop
StartTime = Now

'判断ip.txt最后一次访问时间到现在是不是过了24小时
GetText File, "test", Null

'拔号循环
Adsl "disconnect"
WScript.Sleep 1000
For i = 1 To 5
  Adsl "connect"
  WScript.Sleep 1000
  Juge
  If Juge = 0 Then 
    GetIp : Text = vbNullString
    GetText File, "read", Null
    If InStr(Text, GetIp) = 0 Then 
      GetText File, "write", GetIp
      OK = "ok"
      Exit For
      Else
      Adsl "disconnect"
    End If
   End If
Next
If OK <> "ok" Then 
  MsgBox "拔号出错"
  WScript.Quit
End if

'在没到达断网时间内每10秒检测一次网络发现断线后重拔
Do
  If DateDiff("s", StartTime, Now) >= Times * 60 Then
    Adsl "disconect"
    WScript.Quit
  End If  
  Juge
  If Juge = 1 Then
    Adsl "connect"
  End If
  WScript.Sleep 10 * 1000
Loop

Function Juge
  '判断网络通畅
  Juge = 1
  Dim objWMI, objItems, objItem
  Set objWMI = GetObject("Winmgmts:")
  Set objItems = objWMI.ExecQuery _
    ("Select * From Win32_PingStatus " _
      & "Where Address = '" & Ip & "'")
  For Each objItem In objItems
    If objItem.ResponseTime > 0 Then Juge = 0
  Next
  Set objItems = Nothing
  Set objWMI = Nothing
End Function 

Function Adsl(Types)
  'ADSL拔号版块
  Dim objSHELL
  Set objSHELL = CreateObject("Wscript.Shell")
  If Types = "connect" Then
    objSHELL.Run "rasdial.exe " & AdslName _
      & " " & AdslUser & " " & Adslpassword, 0, 0
    Else
    objSHELL.Run "rasdial.exe /disconnect", 0, 0
  End If
  Set objSHELL = Nothing
End Function

Function GetIp
  '获取外网IP
  Dim objDOM, Arr, Arr2
  Set objDOM = WScript.GetObject(Url)  
  Do Until objDOM.Readystate = "complete" 
    WScript.Sleep 200 
  Loop
  Arr = Split(objDOM.DocumentElement.Innertext, "[")
  Arr2 = Split(Arr(1), "]")
  GetIp = Arr2(0)
  Set objDOM = Nothing
End Function

Function GetText(File, Types, GetIp)
  '文本读、写版块
  Dim objFSO
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  If Not objFSO.FileExists(File) Then _
    objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
  If Types = "read" Then
    Text = objFSO.OpenTextFile(File).ReadAll
    Else
    If Types = "write" Then
      objFSO.OpenTextFile(File, 8).WriteLine GetIp
      Else
      oldday = objFSO.GetFile(File).DateLastModified
      If DateDiff("h", oldday, Now) > 24 Then _
        objFSO.OpenTextFile(File, 2, True).WriteLine "IP列表"
     End If
  End If
  Set objFSO = Nothing
End Function
复制代码