空格换成 - 中国DOS联盟论坛 - 中国DOS联盟之联合DOS论坛

很久以前做过一个


Option Explicit
'By Shilyx 2006.12.15 oversleep@163.com (2007.3.31 新加打开文件和拷贝到剪贴板功能
Dim fso, ts, target, output, objDialog
Const SpaceToNBSPRate = 1
Const TabToSpace = 8
Const ForWriting = 2
Const ForReading = 1
Const adTypeBinary = 1

If WScript.Arguments.Count < 1 Then
    Set objDialog = CreateObject("UserAccounts.CommonDialog")
    objDialog.Filter = "All Files|*.*"
    objDialog.InitialDir = "."
    If objDialog.ShowOpen = 0 Then
        WScript.Quit
    Else
        target = objDialog.FileName
    End If
    Set objDialog = Nothing
Else
    target = WScript.Arguments(0)
End If

Set fso = CreateObject("Scripting.FileSystemObject")

If Not fso.FileExists(target) Then
    MsgBox "找不到文件" & target, 16, "错误"
    WScript.Quit
End If

If Not IsTextFile(target) Then
    WScript.echo target & "不是有效的文本文件"
    WScript.Quit
End If

GetOutput
If output = target Then WScript.Quit 
ChangeFileFormat target, output, SpaceToNBSPRate
If vbYes = MsgBox("输出已经复制到系统剪贴扳，并且保存在" & output & VbCrLf & "现在是否打开输出文件？",vbYesNo,"By Shilyx 2006.12.15") Then
    Dim ws
    Set ws = WScript.CreateObject("WScript.Shell")
    ws.Run "Notepad " & Chr(32) & output & Chr(32)
End If

Function IsTextFile(file)
    Dim aso, ch
    IsTextFile = True
    Set ASO = CreateObject("ADODB.Stream")
    aso.Type = adTypeBinary
    aso.Open
    aso.LoadFromFile file
    aso.Position = 0
    Do While Not aso.EOS
        ch = aso.Read(1)
        If ASCB(ch) = 0 Then  
            IsTextFile = False
            Exit Function
        End If
    Loop
End Function

Sub GetOutput
    Dim len1, len2
    output = WScript.ScriptFullName
    len1 = Len(output)
    len2 = Len(fso.GetFileName(output))
    output = Left(output, len1 - len2)
    output = output + "output.txt"
End Sub

Sub CopyToClipBoard(Text)
    Dim objIE
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate("about:blank")
    objIE.Document.ParentWindow.ClipboardData.SetData "text", Text
    objIE.Quit
End Sub

Sub ChangeFileFormat(input, output, nSpace)
    Dim line, Fin, Fout, NewLine, AllNewLines
    Set Fin = fso.OpenTextFile(input, ForReading)
    Set Fout = fso.CreateTextFile(output, ForWriting)
    Do While Not Fin.AtEndOfStream
        line = Fin.ReadLine
        NewLine = ChangeLine(line, nSpace)
        AllNewLines = AllNewLines & vbCrLf & NewLine
        Fout.WriteLine(NewLine)
    Loop
    Fin.Close
    Fout.Close
    CopyToClipBoard AllNewLines
End Sub

Function ChangeLine(line, nSpace)
    Dim SpaceNum
    If Replace(line, " ", "") = "" Then
        ChangeLine = Chr(38) + "nbsp;"
        Exit Function
    End If
    line = RTrim(line)
    SpaceNum = 0
    Do While True
        If Left(line, 1) = " " Then
    	      SpaceNum = SpaceNum + 1
    	  ElseIf Left(line, 1) = Chr(9) Then
    	      SpaceNum = SpaceNum + TabToSpace
    	  Else
    	      Exit Do
    	  End If
    	  line = Right(line, Len(line) - 1)
    Loop
    ChangeLine = GetNBSP(SpaceNum * nSpace) & Trim(line)
End Function

Function GetNBSP(SpaceNum)
    GetNBSP = Space(SpaceNum)
    GetNBSP = Replace(GetNBSP, " ", Chr(38) + "nbsp;")
End Function

http://hi.baidu.com/shilyx/blog/item/1822b5012893f802738da5c1.html

第1楼　online365	发表于 2007-06-20 10:34
初级用户　发帖 75　积分 182
空格换成百度贴上去的东西都把空格给缩略掉了. 想让高手帮忙写个批处理让所有的空格都换成  这样就方便,而且好看些了. 3Q

第2楼　zh159	发表于 2007-06-20 10:37
金牌会员　发帖 1,467　积分 3,687
字符替换就可以了： set str=%filename: = %

第3楼　online365	发表于 2007-06-20 13:05
初级用户　发帖 75　积分 182
- -\|\| 不是很懂啊..麻烦把代码全部贴出来,我自己再研究研究.. 我是想把空格换成   再生成一个新的文件.

第4楼　lxmxn	发表于 2007-06-20 16:33
版主　发帖 4,938　积分 11,386
sed "s/ /\ /g" yourfile

第5楼　my3439955	发表于 2007-06-22 13:11
中级用户　发帖 99　积分 272
很久以前做过一个 Option Explicit 'By Shilyx 2006.12.15 oversleep@163.com (2007.3.31 新加打开文件和拷贝到剪贴板功能 Dim fso, ts, target, output, objDialog Const SpaceToNBSPRate = 1 Const TabToSpace = 8 Const ForWriting = 2 Const ForReading = 1 Const adTypeBinary = 1 If WScript.Arguments.Count < 1 Then Set objDialog = CreateObject("UserAccounts.CommonDialog") objDialog.Filter = "All Files\|." objDialog.InitialDir = "." If objDialog.ShowOpen = 0 Then WScript.Quit Else target = objDialog.FileName End If Set objDialog = Nothing Else target = WScript.Arguments(0) End If Set fso = CreateObject("Scripting.FileSystemObject") If Not fso.FileExists(target) Then MsgBox "找不到文件" & target, 16, "错误" WScript.Quit End If If Not IsTextFile(target) Then WScript.echo target & "不是有效的文本文件" WScript.Quit End If GetOutput If output = target Then WScript.Quit ChangeFileFormat target, output, SpaceToNBSPRate If vbYes = MsgBox("输出已经复制到系统剪贴扳，并且保存在" & output & VbCrLf & "现在是否打开输出文件？",vbYesNo,"By Shilyx 2006.12.15") Then Dim ws Set ws = WScript.CreateObject("WScript.Shell") ws.Run "Notepad " & Chr(32) & output & Chr(32) End If Function IsTextFile(file) Dim aso, ch IsTextFile = True Set ASO = CreateObject("ADODB.Stream") aso.Type = adTypeBinary aso.Open aso.LoadFromFile file aso.Position = 0 Do While Not aso.EOS ch = aso.Read(1) If ASCB(ch) = 0 Then IsTextFile = False Exit Function End If Loop End Function Sub GetOutput Dim len1, len2 output = WScript.ScriptFullName len1 = Len(output) len2 = Len(fso.GetFileName(output)) output = Left(output, len1 - len2) output = output + "output.txt" End Sub Sub CopyToClipBoard(Text) Dim objIE Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate("about:blank") objIE.Document.ParentWindow.ClipboardData.SetData "text", Text objIE.Quit End Sub Sub ChangeFileFormat(input, output, nSpace) Dim line, Fin, Fout, NewLine, AllNewLines Set Fin = fso.OpenTextFile(input, ForReading) Set Fout = fso.CreateTextFile(output, ForWriting) Do While Not Fin.AtEndOfStream line = Fin.ReadLine NewLine = ChangeLine(line, nSpace) AllNewLines = AllNewLines & vbCrLf & NewLine Fout.WriteLine(NewLine) Loop Fin.Close Fout.Close CopyToClipBoard AllNewLines End Sub Function ChangeLine(line, nSpace) Dim SpaceNum If Replace(line, " ", "") = "" Then ChangeLine = Chr(38) + "nbsp;" Exit Function End If line = RTrim(line) SpaceNum = 0 Do While True If Left(line, 1) = " " Then SpaceNum = SpaceNum + 1 ElseIf Left(line, 1) = Chr(9) Then SpaceNum = SpaceNum + TabToSpace Else Exit Do End If line = Right(line, Len(line) - 1) Loop ChangeLine = GetNBSP(SpaceNum * nSpace) & Trim(line) End Function Function GetNBSP(SpaceNum) GetNBSP = Space(SpaceNum) GetNBSP = Replace(GetNBSP, " ", Chr(38) + "nbsp;") End Function http://hi.baidu.com/shilyx/blog/item/1822b5012893f802738da5c1.html

第6楼　my3439955	发表于 2007-06-22 13:13
中级用户　发帖 99　积分 272
缩略掉的只是每行开头的空格行中间和末尾的不做改动

第7楼　slore	发表于 2007-06-22 21:50
铂金会员　发帖 2,478　积分 5,212
chr(38)? VBS对这个没有转义，为什么不直接" "

第8楼　my3439955	发表于 2007-06-23 19:58
中级用户　发帖 99　积分 272
Originally posted by slore at 2007-6-22 21:50: chr(38)? VBS对这个没有转义，为什么不直接" " 这个并非是出于转义的考虑,由于这个工具在百度上发过,因此直接使用&nb..的话,在百度上显示仍然是一个空格,不利于传播,复制不来