网站首页  汉语字词  英语词汇  考试资料  写作素材  旧版资料

请输入您要查询的考试资料：

　

标题 使用vbs获得外网ip并发送到邮箱里
内容
    代码如下:
    '* **************************************** *
    '* 程序名称：getip.vbs
    '* 程序说明：获得本地外网地址并发送到指定邮箱
    '* 编码：lyserver
    '* **************************************** *
    option explicit
    call main '执行入口函数
    '- ----------------------------------------- -
    ' 函数说明：程序入口
    '- ----------------------------------------- -
    sub main()
    dim objwsh
    dim objenv
    dim strnewip, stroldip
    dim dtstarttime
    dim ninstance
    stroldip =
    dtstarttime = dateadd(n, -30, now) '设置起始时间
    '获得运行实例数，如果大于1，则结束以前运行的实例
    set objwsh = createobject(wscript.shell)
    set objenv = createobject(wscript.shell).environment(system)
    ninstance = val(objenv(getiptoemail)) + 1 '运行实例数加1
    objenv(getiptoemail) = ninstance
    if ninstance > 1 then exit sub '如果运行实例数大于1则退出，以防重复运行
    '开启远程桌面
    'enabledrometedesktop true, null
    '在后台连续检测外网地址，如果有变化则发送邮件到指定邮箱
    do
    if err.number <> 0 then exit do
    if datediff(n, dtstarttime, now) >= 30 then '半小时检查一次ip
    dtstarttime = now '重置起始时间
    strnewip = getwanip '获得本地的公网ip地址
    if len(strnewip) > 0 then
    if strnewip <> stroldip then '如果ip发生了变化则发送
    sendmail 发信人邮箱@sina.com, 密码, 收信人邮箱@sina.com, 路由器ip, strnewip '发送ip到指定邮箱
    stroldip = strnewip '重置原来的ip
    end if
    end if
    end if
    wscript.sleep 2000 '延时2秒，以释放cpu资源
    loop until val(objenv(getiptoemail)) > 1
    objenv.remove getiptoemail '清除运行实例数变量
    set objenv = nothing
    set objwsh = nothing
    msgbox 程序被成功终止!, 64, 提示
    end sub
    '- ----------------------------------------- -
    ' 函数说明：开启远程桌面
    ' 参数说明：blnenabled是否开启，true开启，false关闭
    ' nport远程桌面的端口号，默认为3389
    '- ----------------------------------------- -
    sub enabledrometedesktop(blnenabled, nport)
    dim objwsh
    if blnenabled then
    blnenabled = 0 '0表示开启
    else
    blnenabled = 1 '1表示关闭
    end if
    set objwsh = createobject(wscript.shell)
    '开启远程桌面并设置端口号
    objwsh.regwrite hkey_local_machine/system/currentcontrolset/control/terminal server/fdenytsconnections, blnenabled, reg_dword '开启远程桌面
    '设置远程桌面端口号
    if isnumeric(nport) then
    if nport > 0 then
    objwsh.regwrite hkey_local_machine/system/currentcontrolset/control/terminal server/wds/rdpwd/tds/tcp/portnumber, nport, reg_dword
    objwsh.regwrite hkey_local_machine/system/currentcontrolset/control/terminal server/winstations/rdp-tcp/portnumber, nport, reg_dword
    end if
    end if
    set objwsh = nothing
    end sub
    '- ----------------------------------------- -
    ' 函数说明：获得公网ip
    '- ----------------------------------------- -
    function getwanip()
    dim npos
    dim objxmlhttp
    getwanip =
    on error resume next
    '创建xmlhttp对象
    set objxmlhttp = createobject(msxml2.xmlhttp)
    '导航至http://www.ip138.com/ip2city.asp获得ip地址
    objxmlhttp.open get, http://iframe.ip138.com/ic.asp, false
    objxmlhttp.send
    '提取html中的ip地址字符串
    npos = instr(objxmlhttp.responsetext, [)
    if npos > 0 then
    getwanip = mid(objxmlhttp.responsetext, npos + 1)
    npos = instr(getwanip, ])
    if npos > 0 then getwanip = trim(left(getwanip, npos - 1))
    end if
    '销毁xmlhttp对象
    set objxmlhttp = nothing
    end function
    '- ----------------------------------------- -
    ' 函数说明：将字符串转换为数值
    '- ----------------------------------------- -
    function val(vnum)
    if isnumeric(vnum) then
    val = cdbl(vnum)
    else
    val = 0
    end if
    end function
    '- ----------------------------------------- -
    ' 函数说明：发送邮件
    ' 参数说明：stremailfrom：发信人邮箱
    ' strpassword：发信人邮箱密码
    ' stremailto：收信人邮箱
    ' strsubject：邮件标题
    ' strtext：邮件内容
    '- ----------------------------------------- -
    function sendmail(stremailfrom, strpassword, stremailto, strsubject, strtext)
    dim i, npos
    dim strusername
    dim strsmtpserver
    dim objsock
    dim streml
    const sckconnected = 7
    set objsock = createwinsock()
    objsock.protocol = 0
    npos = instr(stremailfrom, @)
    '校验参数完整性和合法性
    if npos = 0 or instr(stremailto, @) = 0 or len(strtext) = 0 or len(strpassword) = 0 then exit function
    '根据邮箱名称获得邮箱帐号
    strusername = trim(left(stremailfrom, npos - 1))
    '根据发信人邮箱获得esmtp服务器名称
    strsmtpserver = smtp. & trim(mid(stremailfrom, npos + 1))
    '组装邮件
    streml = mime-version: 1.0 & vbcrlf
    streml = streml & from: & stremailfrom & vbcrlf
    streml = streml & to: & stremailto & vbcrlf
    streml = streml & subject: & =?gb2312?b? & base64encode(strsubject) & ?= & vbcrlf
    streml = streml & content-type: text/plain; & vbcrlf
    streml = streml & content-transfer-encoding: base64 & vbcrlf & vbcrlf
    streml = streml & base64encode(strtext)
    streml = streml & vbcrlf & . & vbcrlf
    '连接到邮件服务哭
    objsock.connect strsmtpserver, 25
    '等待连接成功
    for i = 1 to 10
    if objsock.state = sckconnected then exit for
    wscript.sleep 200
    next
    if objsock.state = sckconnected then
    '准备发送邮件
    sendcommand objsock, ehlo vbsemail
    sendcommand objsock, auth login '申请进行smtp会话
    sendcommand objsock, base64encode(strusername)
    sendcommand objsock, base64encode(strpassword)
    sendcommand objsock, mail from: & stremailfrom '发信人
    sendcommand objsock, rcpt to: & stremailto '收信人
    sendcommand objsock, data '以下为邮件内容
    '发送邮件
    sendcommand objsock, streml
    '结束邮箱发送
    sendcommand objsock, quit
    end if
    '断开连接
    objsock.close
    wscript.sleep 200
    set objsock = nothing
    end function
    '- ----------------------------------------- -
    ' 函数说明：sendmail的辅助函数
    '- ----------------------------------------- -
    function sendcommand(objsock, strcommand)
    dim i
    dim strecho
    on error resume next
    objsock.senddata strcommand & vbcrlf
    for i = 1 to 50 '等待结果
    wscript.sleep 200
    if objsock.bytesreceived > 0 then
    objsock.getdata strecho, vbstring
    if (val(strecho) > 0 and val(strecho) < 400) or instr(strecho, +ok) > 0 then
    sendcommand = true
    end if
    exit function
    end if
    next
    end function
    '- ----------------------------------------- -
    ' 函数说明：创建winsock对象，如果失败则下载注册后再创建
    '- ----------------------------------------- -
    function createwinsock()
    dim objwsh
    dim objxmlhttp
    dim objadostream
    dim objfso
    dim strsystempath
    '创建并返回winsock对象
    on error resume next
    set createwinsock = createobject(mswinsock.winsock)
    if err.number = 0 then exit function '创建成功，返回winsock对象
    err.clear
    on error goto 0
    '获得windows/system32系统文件夹位置
    set objfso = createobject(scripting.filesystemobject)
    strsystempath = objfso.getspecialfolder(1)
    '如果系统文件夹中的mswinsck.ocx文件不存在，则从网站下载
    if not objfso.fileexists(strsystempath & /mswinsck.ocx) then
    '创建xmlhttp对象
    set objxmlhttp = createobject(msxml2.xmlhttp)
    '下载mswinsck.ocx控件
    objxmlhttp.open get, , false
    objxmlhttp.send
    '将mswinsck.ocx保存到系统文件夹
    set objadostream = createobject(adodb.stream)
    objadostream.type = 1 'adtypebinary
    objadostream.open
    objadostream.write objxmlhttp.responsebody
    objadostream.savetofile strsystempath & /mswinsck.ocx, 2 'adsavecreateoverwrite
    objadostream.close
    set objadostream = nothing
    '销毁xmlhttp对象
    set objxmlhttp = nothing
    end if
    '注册mswinsck.ocx
    set objwsh = createobject(wscript.shell)
    objwsh.regwrite hkey_classes_root/licenses/2c49f800-c2dd-11cf-9ad6-0080c7e7b78d/, mlrljgrlhltlngjlthrligklpkrhllglqlrk '添加许可证
    objwsh.run regsvr32 /s & strsystempath & /mswinsck.ocx, 0 '注册控件
    set objwsh = nothing
    '重新创建并返回winsock对象
    set createwinsock = createobject(mswinsock.winsock)
    end function
    '- ----------------------------------------- -
    ' 函数说明：base64编码函数
    '- ----------------------------------------- -
    function base64encode(strsource)
    dim objxmldom
    dim objxmldocnode
    dim objadostream
    base64encode =
    if strsource = or isnull(strsource) then exit function
    '创建xml文档对象
    set objxmldom = createobject(microsoft.xmldom)
    objxmldom.loadxml (<?xml version='1.0' ?> <root/>)
    set objxmldocnode = objxmldom.createelement(mytext)
    objxmldocnode.datatype = bin.base64
    '将字符串转换为字节数组
    set objadostream = createobject(adodb.stream)
    objadostream.mode = 3
    objadostream.type = 2
    objadostream.open
    objadostream.charset = gb2312
    objadostream.writetext strsource
    objadostream.position = 0
    objadostream.type = 1
    objxmldocnode.nodetypedvalue = objadostream.read() '将转换后的字节数组读入到xml文档中
    objadostream.close
    set objadostream = nothing
    '获得base64编码
    base64encode = objxmldocnode.text
    objxmldom.documentelement.appendchild objxmldocnode
    set objxmldom = nothing
    end function
随便看

　

在线学习网考试资料包含高考、自考、专升本考试、人事考试、公务员考试、大学生村官考试、特岗教师招聘考试、事业单位招聘考试、企业人才招聘、银行招聘、教师招聘、农村信用社招聘、各类资格证书考试等各类考试资料。

　

Copyright © 2002-2024 cuapp.net All Rights Reserved
更新时间：2025/5/20 8:35:38