China DOS Union

-- Unite DOS · Advance DOS · Grow DOS --

Union site: www.cn-dos.net Forum site: www.cn-dos.net/forum
DOS stands for freedom, openness and progress. Let us work hard, learn from the openness and GNU spirit of FreeDOS and Linux, and together build and grow a free GNU GPL world!

中国DOS联盟论坛
The time now is 2026-06-24 05:11
中国DOS联盟论坛 » DOS批处理 & 脚本技术(批处理室) » [vbs] File Splitter View 1,529 Replies 5
Original Poster Posted 2007-06-03 19:02 ·  中国 北京 中国中信股份有限公司
荣誉版主
★★★
Credits 2,013
Posts 718
Joined 2006-02-18 07:07
20-year member
UID 50550
Status Offline
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
Recent Ratings for This Post ( 3 in total) Click for details
RaterScoreTime
lxmxn +20 2007-06-03 19:07
namejm +10 2007-06-03 20:22
abczxc +2 2008-05-04 01:08
Floor 2 Posted 2007-06-05 10:14 ·  中国 安徽 芜湖 电信
高级用户
★★★
Credits 906
Posts 346
Joined 2006-07-10 09:58
19-year member
UID 58334
Gender Male
Status Offline
I'm having an error during operation and opening a blank web page in the browser. Test environment SP2
Floor 3 Posted 2007-06-05 11:12 ·  中国 江苏 南京 电信
银牌会员
★★★
Credits 1,513
Posts 554
Joined 2005-12-30 00:50
20-year member
UID 48180
Gender Male
Status Offline
Turn off Maxthon - like multi - page browsers and then try again. It's the same for me here.
Floor 4 Posted 2007-06-05 20:08 ·  中国 安徽 马鞍山 电信
中级用户
★★
Credits 397
Posts 168
Joined 2006-10-08 10:07
19-year member
UID 64934
Status Offline
Great, downloaded it and will study it carefully, thanks
Floor 5 Posted 2008-05-03 11:31 ·  中国 陕西 榆林 电信
新手上路
Credits 13
Posts 9
Joined 2008-05-03 09:07
18-year member
UID 117616
Gender Male
From 陕西/榆林/绥德
Status Offline
Oh, guys, how to use it...
Floor 6 Posted 2008-05-04 01:08 ·  中国 广东 深圳 罗湖区 电信
初级用户
★★
Credits 135
Posts 53
Joined 2007-04-28 23:05
19-year member
UID 86817
Gender Male
Status Offline
amazing………………………
Forum Jump: