Board logo

标题: [vbs]文件分割器 [打印本页]

作者: 3742668     时间: 2007-6-3 19:02    标题: [vbs]文件分割器

发个分割文件的脚本,顺便学习一下HTML和JS以及正则表达式。
菜鸟学习,高手指教,达人勿进。
中间有部分在论坛上排版有问题,懒得改了,有兴趣的将就点看吧。
CODE:  [Copy to clipboard]
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

作者: eech     时间: 2007-6-5 10:14
我这运行错误,并在浏览器中打开一个空白网页,测试环境SP2
作者: baomaboy     时间: 2007-6-5 11:12
关掉Maxthon类的多页面浏览器再试应该就可以了,我这里也是。
作者: kich     时间: 2007-6-5 20:08
太棒了,下下来好好的研究了,谢谢
作者: m5891662l     时间: 2008-5-3 11:31
大虾们,怎个用了。。。
作者: abczxc     时间: 2008-5-4 01:08
厉害………………………




欢迎光临 中国DOS联盟论坛 (http://cndos.fam.cx/forum/) Powered by Discuz! 2.5