发个WINDOWS下用Email附件备份数据VBS脚本

Neta

前几天有个哥们Windows下的MYSQL数据库被未知生物袭击了
清空了所有的内容 然后删除了所有的库
用数据恢复软件恢复出来的 都是空表
那哥们可是欲哭无泪啊...

然后就让我帮忙搞个备份功能....
记得论坛里发过一个Linux下用邮箱附件备份数据的软件 就想照这功能写个Win下的
本人不才 没学过VBScript 不当之处 欢迎指出
是先先rar打包 再发送
压缩包里的rar.exe 可以在您的WinRAR根目录里找到.. 当前貌似3.93版[ol]

'-----------------------------------------------------------------------------------

'应用程序配置项↓

'-----------------------------------------------------------------------------------

'数据库目录 (目录均以"" 结尾)

Const MySqlDataDir = "C:\Users\Neta\Desktop\Data"

'备份数据库目录

Const MySqlBackupDir = "C:\Users\Neta\Desktop"

'RAR压缩程序文件路径

Const RarExePath = "rar.exe"

'发件邮箱

Const EmailFrom = "send@qq.com"

'收件邮箱 推荐网易邮箱

Const EmailTo = "receive@163.com"

'SMTP地址

Const SmtpServer = "smtp.qq.com"

'SMTP端口

Const SmtpServerPort = 25

'SMTP发信登陆帐号

Const SendUserName = "send@qq.com"

'SMTP发信登陆密码

Const SendPassWord = "password"

'发送完毕是否删除备份数据文件 true | false

Const DeleteFile = true

'单个附件大小 单位为MB

Const AttachmentSize = 30

'---------------------------------------------------------------------------------------

'其他说明: 当执行RAR压缩的时候 会出现一个命令行窗口 显示压缩过程 请勿关闭!

'---------------------------------------------------------------------------------------

backupDateTime = now()

backupFileName = GetName(backupDateTime)

attach = MySqlBackupDir & backupFileName & ".rar"

'开始备份

Set WshShell = CreateObject("WScript.Shell")

Set fso = CreateObject("Scripting.FileSystemObject")

WshShell.run RarExePath & " a -ibck " & attach & " " & MySqlDataDir,,true

Set backupFile = fso.GetFile(attach)

'判断附件大小 如果超过AttachmentSize  则进行分卷打包

IF backupFile.Size > AttachmentSize * 1024 * 1024 Then

  '计算分卷打包文件个数

  TotalFile = GetInteger(backupFile.Size / (AttachmentSize * 1024 * 1024))

  

  '重新取得文件打包时间

  backupDateTime = now()

  backupFileName = GetName(backupDateTime)

  

  '开始分卷打包

  WshShell.run RarExePath & " a -v" & AttachmentSize & "m -ibck " & MySqlBackupDir & backupFileName & " " & attach,,true

  

  '删除初次打包的文件

  Call DelFile(attach)

  

  '发送分卷

  For P = 1 To TotalFile

    attach = MySqlBackupDir & backupFileName & ".part" & P & ".rar"

    Call SendMail(attach,backupDateTime)

  Next

  

Else

  Call SendMail(attach,backupDateTime)

End IF

Set WshShell = Nothing

Set fso = Nothing

Function GetName(time)

        GetName = Replace(Replace(Replace(time, "/", "-"), " ", "-"), ":", "-")

End Function

Function GetInteger(number)

        GetInteger = int(number)

        IF GetInteger 复制代码
[ 本帖最后由 Neta 于 2010-10-6 19:44 编辑 ]

usa

不错。。。

Neta

  usa 真是极速 我还没编辑完沙发就没了...

sunday

好帖还是要支持支持

drivel

支持一下

jimmy0017

支持一下！

press

不错。收藏一个！

小夜

好贴，要给分。

Captain

WScript.Shell
必须开着，有一定安全风险

zrdlrofmine

支持