[vbs]文件分割器 - DOS批处理 & 脚本技术（批处理室） - 中国DOS联盟论坛

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(/[^\d]/g,"""");' " '只允许输入数字
.Write "OnKeyUp='value=value.replace(/[^\d]/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(/[^\d]/g,"""");' " '只允许输入数字
.Write "OnKeyUp='value=value.replace(/[^\d]/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