File Splitter - China DOS Union Forum - China DOS Union

Post a script for splitting files, and by the way, learn HTML, JS, and regular expressions.

Noob learning, please give pointers from experts, no need for veterans to enter.

There are some formatting issues on the forum in the middle, I'm too lazy to fix it, those interested can make do with it.


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>File Splitting</Title>"
    .Write "<BODY Scroll=No OnContextMenu='return false;' "					'No scroll bar, no right-click menu
    .Write "OnKeyDown='if(event.keyCode==13)objButton.onclick();"			'If Enter is pressed
    .Write "if(event.keyCode==27){self.opener=null;self.close();}'>"		'If ESC is pressed, exit
    .Write "<INPUT Type='Text'  ID='objFileName' Size='18'>"					'File name, text box
    .Write "<Button  ACCESSKEY='f' ID='objGetFile'>Browse(<u>F</u>)...</Button><Br>"  'Browse button, shortcut key is ALT+F
    .Write "<INPUT Type='Radio' ID='objRadio1' Name='Radio' "				'Radio button 1
    .Write "OnFocus='objText2.disabled=true;"								'Gray out objText2
    .Write "objText1.disabled=false;objText1.focus();'>"					'Activate objText1 and get focus
    .Write "<LABEL For='objRadio1' ACCESSKEY='1'>Number of Splits(<u>1</u>):</LABEL>" 'Shortcut key is ALT+1
    .Write "<INPUT Type='Text'  ID='objText1' SIZE='2' Disabled=False "		'Text box, default disabled
    .Write "OnChange='value=value.replace(//g,"""");' "				'Only allow input of numbers
    .Write "OnKeyUp='value=value.replace(//g,"""");'><BR>"				'Only allow input of numbers
    .Write "<INPUT Type='Radio' ID='objRadio2' Name='Radio' "				'Radio button 2
    .Write "OnFocus='objText1.disabled=true;"								'Gray out objText1
    .Write "objText2.disabled=false;objText2.focus();'>"					'Activate objText2 and get focus
    .Write "<LABEL For='objRadio2' ACCESSKEY='2'>Size per Part(<u>2</u>):</LABEL>" 'Shortcut key is ALT+2
    .Write "<INPUT Type='Text'  ID='objText2' SIZE='2' Disabled=False "		'Text box, default disabled
    .Write "OnChange='value=value.replace(//g,"""");' "				'Only allow input of numbers
    .Write "OnKeyUp='value=value.replace(//g,"""");'>"					'Only allow input of numbers
    .Write "<BUTTON ID='objButton' STYLE='WIDTH:70'>OK</BUTTON>"			'"OK" button, shortcut key set to Enter above
    .Write "</BODY</HTML>"	
End With

'Create pointers for each Element object
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    

'Event binding
    oGetFile.OnClick = GetRef("GetFile")
    oButton.OnClick = GetRef("Begin")

'Wait for exit
Do 
    WScript.Sleep 200
Loop

'***********************************************************************************
'End
'***********************************************************************************
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

'***********************************************************************************
'Get file name
'***********************************************************************************
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

'***********************************************************************************
'After pressing OK...
'***********************************************************************************
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 "File not found"
            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 "Please specify size per part:"
                oText2.focus
            ElseIf CInt(oText2.Value) > 1 And intSize > CInt(oText2.Value) Then
                WriteFile oFileName.Value,oText2.Value
                strFile = ""
            Else
                WScript.Echo "Please re-specify size per part:"
                oText2.focus
            End If
        
        ElseIf oRadio1.Checked Then
            If Len(Trim(oText1.Value)) = 0 Then 
                WScript.Echo "Please specify number of splits:"
                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 "Please re-specify number of splits:"
                oText1.focus
            End If
            
        Else
            WScript.Echo "Please specify splitting parameters!"
        End If

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


'***********************************************************************************
'Split
'***********************************************************************************
Sub WriteFile(strFileName,intNumber)        

    On Error Resume Next
    Dim objFile,objStream1,objStream2
    Dim intLen,str,i,j,strFolder,binstrTmp
    
    'Overwrite and create directory to store split files
    Set objFile = oFSO.GetFile(WScript.ScriptFullName)
        strFolder = objFile.ParentFolder & "\Split Files"
        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
	
	'Fill 0s before the file name serial number for generating simple bat merge file
	j = Len(Int(objStream1.Size / intNumber) + 1)
	For i = 1 To j
	    str = str & "0"
	Next
	
	'Begin splitting...
	i = 0
    Do Until objStream1.EOS
        
        objStream1.Position = i * intNumber
        binstrTmp = objStream1.Read(intNumber)
        i = i + 1
        objStream2.Write binstrTmp
        objStream2.SaveToFile strFolder & "Fragment" & Right(str & i,j) & ".bak",2
        objStream2.Close
        objStream2.Open

    Loop
    
    'Generate merge batch script
    Set objFile = oFSO.OpenTextFile(strFolder & "Merge.bat",2,True)
    objFile.WriteLine "@echo off"
    objFile.WriteLine "    copy /b *.bak  Merge." & Right(strFileName,3)
    objFile.WriteLine "goto :eof"
    
    If Err Then
        WScript.Echo Err.Description
    Else
        WScript.Echo "File splitting completed!" & vbCrLf & "Size per part:" & intNumber & _
                     vbCrLf & "Number of parts:	" & i
    End If

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

Floor1　3742668	Posted 2007-06-03 19:02
荣誉版主　Posts 718　Credits 2,013
Post a script for splitting files, and by the way, learn HTML, JS, and regular expressions. Noob learning, please give pointers from experts, no need for veterans to enter. There are some formatting issues on the forum in the middle, I'm too lazy to fix it, those interested can make do with it. 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>File Splitting</Title>" .Write "<BODY Scroll=No OnContextMenu='return false;' " 'No scroll bar, no right-click menu .Write "OnKeyDown='if(event.keyCode==13)objButton.onclick();" 'If Enter is pressed .Write "if(event.keyCode==27){self.opener=null;self.close();}'>" 'If ESC is pressed, exit .Write "<INPUT Type='Text' ID='objFileName' Size='18'>" 'File name, text box .Write "<Button ACCESSKEY='f' ID='objGetFile'>Browse(<u>F</u>)...</Button><Br>" 'Browse button, shortcut key is ALT+F .Write "<INPUT Type='Radio' ID='objRadio1' Name='Radio' " 'Radio button 1 .Write "OnFocus='objText2.disabled=true;" 'Gray out objText2 .Write "objText1.disabled=false;objText1.focus();'>" 'Activate objText1 and get focus .Write "<LABEL For='objRadio1' ACCESSKEY='1'>Number of Splits(<u>1</u>):</LABEL>" 'Shortcut key is ALT+1 .Write "<INPUT Type='Text' ID='objText1' SIZE='2' Disabled=False " 'Text box, default disabled .Write "OnChange='value=value.replace(//g,"""");' " 'Only allow input of numbers .Write "OnKeyUp='value=value.replace(//g,"""");'><BR>" 'Only allow input of numbers .Write "<INPUT Type='Radio' ID='objRadio2' Name='Radio' " 'Radio button 2 .Write "OnFocus='objText1.disabled=true;" 'Gray out objText1 .Write "objText2.disabled=false;objText2.focus();'>" 'Activate objText2 and get focus .Write "<LABEL For='objRadio2' ACCESSKEY='2'>Size per Part(<u>2</u>):</LABEL>" 'Shortcut key is ALT+2 .Write "<INPUT Type='Text' ID='objText2' SIZE='2' Disabled=False " 'Text box, default disabled .Write "OnChange='value=value.replace(//g,"""");' " 'Only allow input of numbers .Write "OnKeyUp='value=value.replace(//g,"""");'>" 'Only allow input of numbers .Write "<BUTTON ID='objButton' STYLE='WIDTH:70'>OK</BUTTON>" '"OK" button, shortcut key set to Enter above .Write "</BODY</HTML>" End With 'Create pointers for each Element object 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 'Event binding oGetFile.OnClick = GetRef("GetFile") oButton.OnClick = GetRef("Begin") 'Wait for exit Do WScript.Sleep 200 Loop '********************************************************************************* 'End '******************************************************************************* 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 '******************************************************************************* 'Get file name '********************************************************************************* 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 '******************************************************************************** 'After pressing OK... '******************************************************************************* 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 "File not found" 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 "Please specify size per part:" oText2.focus ElseIf CInt(oText2.Value) > 1 And intSize > CInt(oText2.Value) Then WriteFile oFileName.Value,oText2.Value strFile = "" Else WScript.Echo "Please re-specify size per part:" oText2.focus End If ElseIf oRadio1.Checked Then If Len(Trim(oText1.Value)) = 0 Then WScript.Echo "Please specify number of splits:" 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 "Please re-specify number of splits:" oText1.focus End If Else WScript.Echo "Please specify splitting parameters!" End If Set objFile = Nothing oFileName.Value = strFile oText1.Value = "" oText2.Value = "" oButton.Disabled = False End Sub '******************************************************************************* 'Split '********************************************************************************* Sub WriteFile(strFileName,intNumber) On Error Resume Next Dim objFile,objStream1,objStream2 Dim intLen,str,i,j,strFolder,binstrTmp 'Overwrite and create directory to store split files Set objFile = oFSO.GetFile(WScript.ScriptFullName) strFolder = objFile.ParentFolder & "\Split Files" 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 'Fill 0s before the file name serial number for generating simple bat merge file j = Len(Int(objStream1.Size / intNumber) + 1) For i = 1 To j str = str & "0" Next 'Begin splitting... i = 0 Do Until objStream1.EOS objStream1.Position = i * intNumber binstrTmp = objStream1.Read(intNumber) i = i + 1 objStream2.Write binstrTmp objStream2.SaveToFile strFolder & "Fragment" & Right(str & i,j) & ".bak",2 objStream2.Close objStream2.Open Loop 'Generate merge batch script Set objFile = oFSO.OpenTextFile(strFolder & "Merge.bat",2,True) objFile.WriteLine "@echo off" objFile.WriteLine " copy /b *.bak Merge." & Right(strFileName,3) objFile.WriteLine "goto :eof" If Err Then WScript.Echo Err.Description Else WScript.Echo "File splitting completed!" & vbCrLf & "Size per part:" & intNumber & _ vbCrLf & "Number of parts: " & i End If objStream1.Close objStream2.Close Set objFile = Nothing Set objStream1 = Nothing Set objStream2 = Nothing End Sub

Floor2　eech	Posted 2007-06-05 10:14
高级用户　Posts 346　Credits 906
I'm having an error during operation and opening a blank web page in the browser. Test environment SP2

Floor3　baomaboy	Posted 2007-06-05 11:12
银牌会员　Posts 554　Credits 1,513
Turn off Maxthon - like multi - page browsers and then try again. It's the same for me here.

Floor4　kich	Posted 2007-06-05 20:08
中级用户　Posts 168　Credits 397
Great, downloaded it and will study it carefully, thanks

Floor5　m5891662l	Posted 2008-05-03 11:31
新手上路　Posts 9　Credits 13　From 陕西/榆林/绥德
Oh, guys, how to use it...

Floor6　abczxc	Posted 2008-05-04 01:08
初级用户　Posts 53　Credits 135
amazing………………………