文件分割器 - 中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛

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

第1楼　3742668	发表于 2007-06-03 19:02
荣誉版主　发帖 718　积分 2,013
[vbs]文件分割器发个分割文件的脚本，顺便学习一下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

第2楼　eech	发表于 2007-06-05 10:14
高级用户　发帖 346　积分 906
我这运行错误，并在浏览器中打开一个空白网页，测试环境SP2

第3楼　baomaboy	发表于 2007-06-05 11:12
银牌会员　发帖 554　积分 1,513
关掉Maxthon类的多页面浏览器再试应该就可以了，我这里也是。

第4楼　kich	发表于 2007-06-05 20:08
中级用户　发帖 168　积分 397
太棒了,下下来好好的研究了,谢谢

第5楼　m5891662l	发表于 2008-05-03 11:31
新手上路　发帖 9　积分 13　来自陕西/榆林/绥德
大虾们，怎个用了。。。

第6楼　abczxc	发表于 2008-05-04 01:08
初级用户　发帖 53　积分 135
厉害………………………