中国DOS联盟

-- 联合DOS 推动DOS 发展DOS --

联盟域名:www.cn-dos.net 论坛域名:www.cn-dos.net/forum
DOS,代表着自由开放与发展,我们努力起来,学习FreeDOS和Linux的自由开放与GNU精神,共同创造和发展美好的自由与GNU GPL世界吧!

中国DOS联盟论坛
现在时间是 2026-06-24 03:25
中国DOS联盟论坛 » DOS批处理 & 脚本技术(批处理室) » [vbs]文件分割器 查看 1,527 回复 5
楼 主 [vbs]文件分割器 发表于 2007-06-03 19:02 ·  中国 北京 中国中信股份有限公司
荣誉版主
★★★
积分 2,013
发帖 718
注册 2006-02-18 07:07
20年会员
UID 50550
状态 离线
发个分割文件的脚本,顺便学习一下HTML和JS以及正则表达式。
菜鸟学习,高手指教,达人勿进。
中间有部分在论坛上排版有问题,懒得改了,有兴趣的将就点看吧。

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oIE = WScript.CreateObject("InternetExplorer.Application","Event_")
With oIE
.MenuBar = 0
.AddressBar = 0
.ToolBar = 0
.StatusBar = 0
.Width = 260
.Height = 130
.Resizable = 0
.Navigate "About:Blank"
.Left = Fix((oIE.Document.ParentWindow.Screen.AvailWidth - oIE.Width) / 2)
.Top = Fix((oIE.Document.ParentWindow.Screen.AvailHeight - oIE.Height) / 2)
.Visible = 1
End With

With oIE.Document
.Write "<HTML><Title>文件分割</Title>"
.Write "<BODY Scroll=No OnContextMenu='return false;' " '无滚动条,无右键蔡单
.Write "OnKeyDown='if(event.keyCode==13)objButton.onclick();" '若按下回车键
.Write "if(event.keyCode==27){self.opener=null;self.close();}'>" '若ESC则退出
.Write "<INPUT Type='Text' ID='objFileName' Size='18'>" '文件名,文本框
.Write "<Button ACCESSKEY='f' ID='objGetFile'>浏览(<u>F</u>)...</Button><Br>" '浏览按纽,快捷键为ALT+F
.Write "<INPUT Type='Radio' ID='objRadio1' Name='Radio' " '单选按纽1
.Write "OnFocus='objText2.disabled=true;" '灰化objText2
.Write "objText1.disabled=false;objText1.focus();'>" '激活objText1并获得焦点
.Write "<LABEL For='objRadio1' ACCESSKEY='1'>分割数量(<u>1</u>):</LABEL>" '快捷键为ALT+1
.Write "<INPUT Type='Text' ID='objText1' SIZE='2' Disabled=False " '文本框,默认禁止
.Write "OnChange='value=value.replace(//g,"""");' " '只允许输入数字
.Write "OnKeyUp='value=value.replace(//g,"""");'><BR>" '只允许输入数字
.Write "<INPUT Type='Radio' ID='objRadio2' Name='Radio' " '单选按纽2
.Write "OnFocus='objText1.disabled=true;" '灰化objText1
.Write "objText2.disabled=false;objText2.focus();'>" '激活objText2并获得焦点
.Write "<LABEL For='objRadio2' ACCESSKEY='2'>每份大小(<u>2</u>):</LABEL>" '快捷键为ALT+2
.Write "<INPUT Type='Text' ID='objText2' SIZE='2' Disabled=False " '文本框,默认禁止
.Write "OnChange='value=value.replace(//g,"""");' " '只允许输入数字
.Write "OnKeyUp='value=value.replace(//g,"""");'>" '只允许输入数字
.Write "<BUTTON ID='objButton' STYLE='WIDTH:70'>确定</BUTTON>" '"确定"按纽,前面设置快捷键为回车
.Write "</BODY</HTML>"
End With

'创建各Element对象指针
With oIE.Document.ALL

Set oFileName = .objFileName
Set oGetFile = .objGetFile
Set oRadio1 = .objRadio1
Set oRadio2 = .objRadio2
Set oButton = .objButton
Set oText1 = .objText1
Set oText2 = .objText2

End With

'事件绑定
oGetFile.OnClick = GetRef("GetFile")
oButton.OnClick = GetRef("Begin")

'等待退出
Do
WScript.Sleep 200
Loop

'***********************************************************************************
'结束
'***********************************************************************************
Sub Event_OnQuit

Set oFileName = Nothing
Set oGetFile = Nothing
Set oRadio1 = Nothing
Set oRadio2 = Nothing
Set oButton = Nothing
Set oText1 = Nothing
Set oText2 = Nothing

Set oFSO = Nothing
Set oIE = Nothing
WScript.Quit

End Sub

'***********************************************************************************
'获得文件名
'***********************************************************************************
Sub GetFile

Dim objDialog
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "All Files|*.*|vbs File|*.vbs|exe File|*.exe|bat File|*.bat"
objDialog.ShowOpen
oFileName.Value = objDialog.FileName
Set objDialog = Nothing

End Sub

'***********************************************************************************
'按下确定后...
'***********************************************************************************
Sub Begin

On Error Resume Next
oButton.Disabled = True

Dim objFile,intSize,strFile

Err.Clear
Set objFile = oFSO.GetFile(oFileName.Value)

If Err Then
WScript.Echo "找不到文件"
intSize = 0
strFile = ""
oFileName.focus
Else
strFile = oFileName.Value
intSize = objFile.Size
End If

If oRadio2.Checked Then
If Len(Trim(oText2.Value)) = 0 Then
WScript.Echo "请指定每份大小:"
oText2.focus
ElseIf CInt(oText2.Value) > 1 And intSize > CInt(oText2.Value) Then
WriteFile oFileName.Value,oText2.Value
strFile = ""
Else
WScript.Echo "请重新指定每份大小:"
oText2.focus
End If

ElseIf oRadio1.Checked Then
If Len(Trim(oText1.Value)) = 0 Then
WScript.Echo "请指定分割数量:"
oText1.focus
ElseIf CInt(oText1.Value) > 1 And intSize > CInt(oText1.Value) Then
WriteFile oFileName.Value,Int(objFile.Size / oText1.Value) + 1
strFile = ""
Else
WScript.Echo "请重新指定分割数量:"
oText1.focus
End If

Else
WScript.Echo "请指定分割参数!"
End If

Set objFile = Nothing
oFileName.Value = strFile
oText1.Value = ""
oText2.Value = ""
oButton.Disabled = False

End Sub


'***********************************************************************************
'分割
'***********************************************************************************
Sub WriteFile(strFileName,intNumber)

On Error Resume Next
Dim objFile,objStream1,objStream2
Dim intLen,str,i,j,strFolder,binstrTmp

'覆盖创建目录用于存放分割后的文件
Set objFile = oFSO.GetFile(WScript.ScriptFullName)
strFolder = objFile.ParentFolder & "\分割文件"
oFSO.DeleteFolder strFolder,True
oFSO.CreateFolder strFolder
strFolder = strFolder & "\"
Err.Clear

Set objStream1 = CreateObject("Adodb.Stream")
Set objStream2 = CreateObject("Adodb.Stream")

With objStream1
.Type = 1
.Mode = 3
.Open
.LoadFromFile strFileName
End With
With objStream2
.Type = 1
.Mode = 3
.Open
End With

'文件名序号前填0,以便生成简单的bat合并文件
j = Len(Int(objStream1.Size / intNumber) + 1)
For i = 1 To j
str = str & "0"
Next

'开始分割...
i = 0
Do Until objStream1.EOS

objStream1.Position = i * intNumber
binstrTmp = objStream1.Read(intNumber)
i = i + 1
objStream2.Write binstrTmp
objStream2.SaveToFile strFolder & "碎片" & Right(str & i,j) & ".bak",2
objStream2.Close
objStream2.Open

Loop

'生成合并的批处理脚本
Set objFile = oFSO.OpenTextFile(strFolder & "合并.bat",2,True)
objFile.WriteLine "@echo off"
objFile.WriteLine " copy /b *.bak 合并." & Right(strFileName,3)
objFile.WriteLine "goto :eof"

If Err Then
WScript.Echo Err.Description
Else
WScript.Echo "文件分割完毕!" & vbCrLf & "每份大小:" & intNumber & _
vbCrLf & "份数: " & i
End If

objStream1.Close
objStream2.Close
Set objFile = Nothing
Set objStream1 = Nothing
Set objStream2 = Nothing

End Sub
本帖最近评分记录 (共 3 条) 点击查看详情
评分人分数时间
lxmxn +20 2007-06-03 19:07
namejm +10 2007-06-03 20:22
abczxc +2 2008-05-04 01:08
2 发表于 2007-06-05 10:14 ·  中国 安徽 芜湖 电信
高级用户
★★★
积分 906
发帖 346
注册 2006-07-10 09:58
19年会员
UID 58334
性别 男
状态 离线
我这运行错误,并在浏览器中打开一个空白网页,测试环境SP2
3 发表于 2007-06-05 11:12 ·  中国 江苏 南京 电信
银牌会员
★★★
积分 1,513
发帖 554
注册 2005-12-30 00:50
20年会员
UID 48180
性别 男
状态 离线
关掉Maxthon类的多页面浏览器再试应该就可以了,我这里也是。
4 发表于 2007-06-05 20:08 ·  中国 安徽 马鞍山 电信
中级用户
★★
积分 397
发帖 168
注册 2006-10-08 10:07
19年会员
UID 64934
状态 离线
太棒了,下下来好好的研究了,谢谢
5 发表于 2008-05-03 11:31 ·  中国 陕西 榆林 电信
新手上路
积分 13
发帖 9
注册 2008-05-03 09:07
18年会员
UID 117616
性别 男
来自 陕西/榆林/绥德
状态 离线
大虾们,怎个用了。。。
6 发表于 2008-05-04 01:08 ·  中国 广东 深圳 罗湖区 电信
初级用户
★★
积分 135
发帖 53
注册 2007-04-28 23:05
19年会员
UID 86817
性别 男
状态 离线
厉害………………………
论坛跳转: