中国DOS联盟论坛

中国DOS联盟

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

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

游客:  注册 | 登录 | 命令行 | 搜索 | 上传 | 帮助 »
作者:
标题: [vbs]文件分割器 上一主题 | 下一主题
3742668
荣誉版主





积分 2013
发帖 718
注册 2006-2-18
状态 离线
『楼 主』:  [vbs]文件分割器 使用 LLM 解释/回答一下

发个分割文件的脚本,顺便学习一下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


   此帖被 +32 点积分       点击查看详情   
评分人:【 lxmxn 分数: +20  时间:2007-6-3 19:07
评分人:【 namejm 分数: +10  时间:2007-6-3 20:22
评分人:【 abczxc 分数: +2  时间:2008-5-4 01:08


2007-6-3 19:02
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
eech
高级用户




积分 906
发帖 346
注册 2006-7-10
状态 离线
『第 2 楼』:   使用 LLM 解释/回答一下

我这运行错误,并在浏览器中打开一个空白网页,测试环境SP2

2007-6-5 10:14
查看资料  发短消息  网志   编辑帖子  回复  引用回复
baomaboy
银牌会员





积分 1513
发帖 554
注册 2005-12-30
状态 离线
『第 3 楼』:   使用 LLM 解释/回答一下

关掉Maxthon类的多页面浏览器再试应该就可以了,我这里也是。



好多菩提树,好多明镜台。本来好多物,好多的尘埃。
2007-6-5 11:12
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
kich
中级用户





积分 397
发帖 168
注册 2006-10-8
状态 离线
『第 4 楼』:   使用 LLM 解释/回答一下

太棒了,下下来好好的研究了,谢谢

2007-6-5 20:08
查看资料  发送邮件  发短消息  网志   编辑帖子  回复  引用回复
m5891662l
新手上路





积分 13
发帖 9
注册 2008-5-3
来自 陕西/榆林/绥德
状态 离线
『第 5 楼』:   使用 LLM 解释/回答一下

大虾们,怎个用了。。。

2008-5-3 11:31
查看资料  发送邮件  发短消息  网志  OICQ (673839417)  编辑帖子  回复  引用回复
abczxc
初级用户





积分 135
发帖 53
注册 2007-4-28
状态 离线
『第 6 楼』:   使用 LLM 解释/回答一下

厉害………………………

2008-5-4 01:08
查看资料  发短消息  网志   编辑帖子  回复  引用回复

请注意:您目前尚未注册或登录,请您注册登录以使用论坛的各项功能,例如发表和回复帖子等。


可打印版本 | 推荐给朋友 | 订阅主题 | 收藏主题



论坛跳转: