发个WINDOWS下用Email附件备份数据VBS脚本
前几天有个哥们Windows下的MYSQL数据库被未知生物袭击了清空了所有的内容 然后删除了所有的库
用数据恢复软件恢复出来的 都是空表
那哥们可是欲哭无泪啊...
然后就让我帮忙搞个备份功能....
记得论坛里发过一个Linux下用邮箱附件备份数据的软件 就想照这功能写个Win下的
本人不才 没学过VBScript 不当之处 欢迎指出
是先先rar打包 再发送
压缩包里的rar.exe 可以在您的WinRAR根目录里找到.. 当前貌似3.93版'-----------------------------------------------------------------------------------
'应用程序配置项↓
'-----------------------------------------------------------------------------------
'数据库目录 (目录均以"\" 结尾)
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 < number Then
GetInteger = GetInteger + 1
End IF
End Function
Sub DelFile(path)
IF deleteFile Then
fso.DeleteFile(path)
End IF
End Sub
Sub SendMail(file,time)
NameSpace = "http://schemas.microsoft.com/cdo/configuration/"
set Email = CreateObject("CDO.Message")
Email.From = EmailFrom
Email.To = EmailTo
Email.Subject = "MYSQL BACKUP : " & time
Email.Textbody = "这个是数据库备份文件,备份于: " & time
Email.AddAttachment file
With Email.Configuration.Fields
.Item(NameSpace&"sendusing") = 2
.Item(NameSpace&"smtpserver") = SmtpServer
.Item(NameSpace&"smtpserverport") = SmtpServerPort
.Item(NameSpace&"smtpauthenticate") = 1
.Item(NameSpace&"sendusername") = SendUserName
.Item(NameSpace&"sendpassword") = SendPassWord
.Update
End With
Email.Send
Set Email = Nothing
Call DelFile(file)
End Sub
[ 本帖最后由 Neta 于 2010-10-6 19:44 编辑 ] 不错。。。 :Qusa 真是极速 我还没编辑完沙发就没了... 好帖还是要支持支持 支持一下 支持一下！ 不错。收藏一个！ 好贴，要给分。 WScript.Shell
必须开着，有一定安全风险 支持
页:
[1]
2