要求:
1,被转换文本名为test.txt,必须为ANSI编码
2,中间分隔符号为中文冒号
3,第16行的 for /f "tokens=1,2* delims=:: " %%a in 中 delims=后依次为中文冒号、英文冒号以及一个tab制符- @echo off&setlocal enabledelayedexpansion
- set k=ENCODING=QUOTED-PRINTABLE;CHARSET=UTF-8:
- set 姓=N;%k%0
- set 名=N;%k%0
- set 常用移动电话=TEL;CELL:1
- set 常用电话=TEL;VOICE:2
- set 常用传真=TEL;FAX:3
- set 住宅电话=TEL;HOME;VOICE:4
- set 昵称=X-NICKNAME;%k%5
- set 公司=TITLE;%k%6
- set 职位=ORG;%k%7
- set 公司电话=TEL;VOICE;WORK:8
- set 常用详情=NOTE;%k%9
- set 备忘=NOTE;%k%9
- (for /f "delims=" %%a in ('more +45^<%~fs0') do echo.%%a)>temp_0.vbs
- for /f "tokens=1,2* delims=:: " %%a in ('findstr /n .* "test.txt"') do if "%%b"=="" (call:ye) else if defined %%b (
- if "%%b"=="姓" set m1=%%c
- if "%%b"=="名" set m2=%%c
- set b=!%%b!
- set c=%%c
- if "!b:~-3,1!"=="8" call:gu "!c!"
- for %%d in (!b:~-1!) do if "!n_%%d!"=="" (set n_%%d=!b:~0,-1!!c!) else if defined m1 (set n_%%d=!n_%%d!!c!) else set n_%%d=!c!!n_%%d!
- )
- del /q temp_*
- exit
- :ye
- (
- echo BEGIN:VCARD
- echo VERSION:2.1
- echo N;%k%!!
- for /l %%a in (0,1,9) do if defined n_%%a echo !n_%%a!&set n_%%a=
- echo X-CLASS:private
- echo END:VCARD
- )>"!m1!!m2!.vcf"
- set m1=&set m2=
- goto:eof
- :gu
- set/p"=%~1"<nul>temp_1.h
- temp_0.vbs temp_1.h>nul
- del /q temp_2.h 2>nul
- for %%a in (temp_1.h) do >nul fsutil file createnew temp_2.h %%~za
- set c=
- for /f "skip=4 tokens=2 delims=: " %%a in ('fc /b temp_1.h temp_2.h') do call set c=!c!=%%a
- goto:eof
- ::vbs
- aCode = "GB2312"
- bCode = "UTF-8"
- Set objArgs = WScript.Arguments
- If objArgs.Count=0 Then
- MsgBox "请删除...", vbInformation, "提示"
- End If
- For I = 0 To objArgs.Count - 1
- FileUrl = objArgs(I)
- Call CheckCode (FileUrl)
- Call WriteToFile(FileUrl, ReadFile(FileUrl, aCode), bCode)
- Next
- Function ReadFile(FileUrl, CharSet)
- Dim Str
- Set stm = CreateObject("Adodb.Stream")
- stm.Type = 2
- stm.mode = 3
- stm.charset = CharSet
- stm.Open
- stm.loadfromfile FileUrl
- Str = stm.readtext
- stm.Close
- Set stm = Nothing
- ReadFile = Str
- End Function
- Function WriteToFile (FileUrl, Str, CharSet)
- Set stm = CreateObject("Adodb.Stream")
- stm.Type = 2
- stm.mode = 3
- stm.charset = CharSet
- stm.Open
- stm.WriteText Str
- stm.SaveToFile FileUrl, 2
- stm.flush
- stm.Close
- Set stm = Nothing
- End Function
- Function CheckCode (FileUrl)
- Dim slz
- set slz = CreateObject("Adodb.Stream")
- slz.Type = 1
- slz.Mode = 3
- slz.Open
- slz.Position = 0
- slz.Loadfromfile FileUrl
- Bin=slz.read(2)
- if AscB(MidB(Bin,1,1))=&HEF and AscB(MidB(Bin,2,1))=&HBB Then
- Codes="UTF-8"
- elseif AscB(MidB(Bin,1,1))=&HFF and AscB(MidB(Bin,2,1))=&HFE Then
- Codes="Unicode"
- else
- Codes="GB2312"
- end if
- if not aCode = Codes Then
- MsgBox "文本编码不是ANSI",vbInformation,"错误"
- WScript.Quit
- end if
- slz.Close
- set slz = Nothing
- End Function
复制代码
[ 本帖最后由 hanyeguxing 于 2010-12-5 13:30 编辑 ] |