看板 P_qman
作者 標題 [轉寄] Re: [請問] 把.txt檔名自動改為內文第一行文
時間 2010年10月13日 Wed. PM 07:50:01
看板 EZsoft
作者 標題 Re: [請問] 把.txt檔名自動改為內文第一行文
時間 Wed Oct 6 21:24:11 2010
重新修正了一下,本來的 Select Case 部份沒寫好,造成使用上會有 Bug
感謝 sanbis 提醒。
另外提醒:因系統的參數列長度限制 255 字元,故能夠拖曳的檔案數量
會因為檔名長度而變動。
版本 1: 直接拖檔案到 vbs 檔
-----------------------8<--------------------- 複製虛線內文另存 VBS 檔
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If Wscript.Arguments.Count <> 0 Then
Dim FilePath()
For i = 0 to Wscript.Arguments.Count - 1
'// 設定預設編碼格式
Redim Preserve FilePath(i)
FilePath(i) = Wscript.Arguments(i)
Dim Line1 : Line1 = GetLine1(FilePath(i))
Set objFile0 = objFSO.GetFile(FilePath(i))
path = objFSO.GetParentFolderName(objFile0)
ext = objFSO.GetExtensionName(objFile0)
newpath = path & "\" & Line1 & "." & ext
objFSO.MoveFile FilePath(i), newpath
Next
End If
Function GetLine1(filename)
Dim stream : set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "437"
stream.Open
stream.LoadFromFile(filename)
Dim bom : bom = Escape(stream.ReadText(2))
stream.Close
Select case bom
case "%u2229%u2557" '// UTF-8 Signature
stream.Charset = "UTF-8"
case "%B5%F2"
stream.Charset = "UTF-8"
case "%A0%u25A0" '// UTF-16 LE BOM
stream.Charset = "Unicode"
case "%u25A0%A0" '// UTF-16 BE BOM
stream.Charset = "Unicode"
case "%5De" '// UTF-16 LE
stream.Charset = "Unicode"
case "e%5D" '// UTF-16 BE
stream.Charset = "Unicode"
case else
stream.Charset = "Big5" '// 預設定為 Big5(950) 編碼
End Select
stream.Open
stream.LoadFromFile(filename)
GetLine1 = stream.ReadText(-2)
stream.Close
Set stream = Nothing
End Function
-----------------------8<--------------------- 複製虛線內文另存 VBS 檔
版本 2: 拖資料夾到 vbs 檔上 (要改名的檔案全部放到該資料夾)
-----------------------8<--------------------- 複製虛線內文另存 VBS 檔
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
If WScript.Arguments.Count <> 0 Then
Dim root : root = WScript.Arguments(0)
Dim folder : set folder = objFSO.GetFolder(root)
Dim files : set files = folder.files
Dim fname, oldpath, newpath
If files.Count <> 0 Then
For each f in files
oldpath = root & "\" & f.Name
fname = GetLine1(oldpath)
newpath = root & "\" & fname & "." & Split(f.Name, ".")(1)
Do While objFSO.FileExists(newpath)
newpath = root & "\" & fname & "-" & _
Split(objFSO.GetTempName, ".")(0) & "." & _
Split(f.Name, ".")(1)
Loop
objFSO.MoveFile oldpath, newpath
Next
End If
End If
Function GetLine1(filename)
Dim stream : set stream = CreateObject("ADODB.Stream")
stream.Type = 2
stream.Charset = "437"
stream.Open
stream.LoadFromFile(filename)
Dim bom : bom = Escape(stream.ReadText(2))
stream.Close
If (strcomp(bom, "%u2229%u2557") or strcomp(bom, "%B5%F2")) Then
stream.Charset = "UTF-8"
Elseif (strcomp(bom,"%A0%u25A0") or strcomp(bom, "%u25A0%A0") or _
strcomp(bom, "%5De") or strcomp(bom, "e%5D")) Then
stream.Charset = "Unicode"
Else
stream.Charset = "Big5"
End If
stream.Open
stream.LoadFromFile(filename)
GetLine1 = stream.ReadText(-2)
stream.Close
End Function
-----------------------8<--------------------- 複製虛線內文另存 VBS 檔
--
※ 發信站: 批踢踢實業坊(ptt.cc)
◆ From: 123.204.46.87
→ :咦,不是應該 s 嗎?1F 10/06 22:56
※ 編輯: hpo14 來自: 123.204.46.87 (10/06 23:00)--
※ 來源: Disp BBS 看板: P_qman 文章連結: http://disp.cc/b/25-Ejf
※ 看板: P_qman 文章推薦值: 0 目前人氣: 0 累積人氣: 187
回列表(←)
分享