兴国资源网 Design By www.nnzcdc.com
压缩:
Function fZip(sSourceFolder,sTargetZIPFile)
'This function will add all of the files in a source folder to a ZIP file
'using Windows' native folder ZIP capability.
Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription
Set oShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'The source folder needs to have a \ on the End
If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"
On Error Resume Next
'If a target ZIP exists already, delete it
If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Write the fileheader for a blank zipfile.
oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Start copying files into the zip from the source folder.
oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function
'from exiting until the file is finished zipping.
Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count
WScript.Sleep 1500'如果不成功,增加一下秒数
Loop
fZip = Array(0,"","")
End Function
Call fZip ("C:\vbs","c:\vbs.zip")
解压缩:
Function fUnzip(sZipFile,sTargetFolder)
'Create the Shell.Application object
Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")
'Create the File System object
Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
'Create the target folder if it isn't already there
If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder
'Extract the files from the zip into the folder
oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items
'This is a seperate process, so the script would continue even if the unzipping is not done
'To prevent this, we run a DO...LOOP once a second checking to see if the number of files
'in the target folder equals the number of files in the zipfile. If so, we continue.
Do
WScript.Sleep 1000‘有时需要更改
Loop While oFSO.GetFolder(sTargetFolder).Files.Count < oShellApp.NameSpace(sZipFile).Items.Count
End Function
Function fZip(sSourceFolder,sTargetZIPFile)
'This function will add all of the files in a source folder to a ZIP file
'using Windows' native folder ZIP capability.
Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription
Set oShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'The source folder needs to have a \ on the End
If Right(sSourceFolder,1) <> "\" Then sSourceFolder = sSourceFolder & "\"
On Error Resume Next
'If a target ZIP exists already, delete it
If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Write the fileheader for a blank zipfile.
oFSO.OpenTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Start copying files into the zip from the source folder.
oShellApp.NameSpace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr <> 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
'Because the copying occurs in a separate process, the script will just continue. Run a DO...LOOP to prevent the function
'from exiting until the file is finished zipping.
Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count
WScript.Sleep 1500'如果不成功,增加一下秒数
Loop
fZip = Array(0,"","")
End Function
Call fZip ("C:\vbs","c:\vbs.zip")
解压缩:
Function fUnzip(sZipFile,sTargetFolder)
'Create the Shell.Application object
Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")
'Create the File System object
Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
'Create the target folder if it isn't already there
If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder
'Extract the files from the zip into the folder
oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items
'This is a seperate process, so the script would continue even if the unzipping is not done
'To prevent this, we run a DO...LOOP once a second checking to see if the number of files
'in the target folder equals the number of files in the zipfile. If so, we continue.
Do
WScript.Sleep 1000‘有时需要更改
Loop While oFSO.GetFolder(sTargetFolder).Files.Count < oShellApp.NameSpace(sZipFile).Items.Count
End Function
兴国资源网 Design By www.nnzcdc.com
广告合作:本站广告合作请联系QQ:858582 申请时备注:广告合作(否则不回)
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
免责声明:本站资源来自互联网收集,仅供用于学习和交流,请遵循相关法律法规,本站一切资源不代表本站立场,如有侵权、后门、不妥请联系本站删除!
兴国资源网 Design By www.nnzcdc.com
暂无评论...
稳了!魔兽国服回归的3条重磅消息!官宣时间再确认!
昨天有一位朋友在大神群里分享,自己亚服账号被封号之后居然弹出了国服的封号信息对话框。
这里面让他访问的是一个国服的战网网址,com.cn和后面的zh都非常明白地表明这就是国服战网。
而他在复制这个网址并且进行登录之后,确实是网易的网址,也就是我们熟悉的停服之后国服发布的暴雪游戏产品运营到期开放退款的说明。这是一件比较奇怪的事情,因为以前都没有出现这样的情况,现在突然提示跳转到国服战网的网址,是不是说明了简体中文客户端已经开始进行更新了呢?
更新日志
2024年05月21日
2024年05月21日
- 《邓紫棋精选》[FLAC/分轨][980MB]
- 出发吧麦芬尤米尔深渊试炼怎么过 尤米尔深渊阵容打法攻略
- dnf属性lv转移是什么意思
- dnf属性成长用什么材料
- 《贪婪之秋2》登陆平台介绍
- 《机器节奏》成就达成条件一览
- 2024年04月13日
- TOGE-12083-84【TchaikovskySwanlake-AndrePrevin】2CD【ISO】
- SusieArioli,JordanOfficer-NightLights[SP1020](2014)[FLAC]
- 东野圭吾改编新片《彷徨之刃》豆瓣6.6:寡淡又平庸
- 游戏史的绝对经典 CDPR庆祝《巫师3》9周年纪念!
- 波音又出事!一架载468人大型客机的引擎突然起火
- 群星.1994-华纳IN爆榜3辑【华纳】【WAV+CUE】
- 古巨基.2008-GUITAR.FEVER(LPCD45)【金牌大风】【WAV+CUE】
- 自然卷.2005-大卷包小卷【风和日丽】【WAV+CUE】