批处理之家 - Powered by Discuz! Board

dim r(1),file(1),read(1)
set fso=CreateObject("Scripting.FileSystemObject")
Set RegExp = New RegExp
file(0)="1.txt"
file(1)="2.txt"
n=2
for i = 0 to 1
if not fso.fileexists(file(i)) then
n=n-1
err_msg="'"&file(i)&"' "
end if
next
if n=0 then
err_msg="'"&file(0)&"' 和 '"&file(1)&"' "
end if
if n<>2 then
msgbox err_msg&"不存在,请检查vbs代码是否修改正确!",16,"Error":wsh.quit
end if
for i = 0 to 1
if fso.getfile(file(i)).size=0 then
n=n-1:a=a+1
err_msg="'"&file(i)&"' "
end if
next
if n=0 then
err_msg="'"&file(0)&"' 和 '"&file(1)&"' "
end if
if a=1 then a=empty
if n<>2 then
msgbox err_msg&"文件内容为空,请检查这"&a&"个"&fso.getextensionname(file(0))&"是否是需要修改的文件!",16,"Error":wsh.quit
end if
n=2
for i = 0 to 1
read(i)=fso.opentextfile(file(i)).readall
next
With RegExp
.Global = -1
.multiline=-1
.pattern="^(.*)=(.*$)"
if .test(read(0)) then
for each match in .execute(read(0))
r(0)=match.submatches(0)
r(1)=match.submatches(1)
.pattern="(^"&r(0)&"=)(.*)$"
read(1)=.Replace(read(1),"$1"&r(1))
next
fso.createtextfile(file(1)).write read(1)
else
n=n-1
err_msg="'"&file(0)&"' "
end if
if not .test(read(1)) then
n=n-1
err_msg="'"&file(1)&"' "
end if
if n=0 then
err_msg="'"&file(0)&"' 和 '"&file(1)&"' "
end if
if n<>2 then
msgbox "没有在 '"&err_msg&"' 中找到相应匹配!",16,"Error":wsh.quit
end if
End With

复制代码

'Read & Write INI Files
'http://www.robvanderwoude.com/vbstech_files_ini.php#SampleScript
WriteIni "test.ini", "TEST1", "My1stKey", "My1stValue"
WriteIni "test.ini", "TEST2", "My1stKey", "My1stValue"
WScript.Echo ReadIni( "test.ini", "TEST1", "My1stKey" )
WriteIni "test.ini", "TEST1", "My1stKey", "My2ndValue"
WScript.Echo ReadIni( "test.ini", "TEST1", "My1stKey" )
'DeleteINI
'To delete a key in an INI file, use WriteINI with a value "<DELETE_THIS_VALUE>".
Function ReadIni( myFilePath, mySection, myKey )
' This function returns a value read from an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be returned
'
' Returns:
' the [string] value for the specified key in the specified section
'
' CAVEAT: Will return a space if key exists but value is blank
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim intEqualPos
Dim objFSO, objIniFile
Dim strFilePath, strKey, strLeftString, strLine, strSection
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
ReadIni = ""
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
If objFSO.FileExists( strFilePath ) Then
Set objIniFile = objFSO.OpenTextFile( strFilePath, ForReading, False )
Do While objIniFile.AtEndOfStream = False
strLine = Trim( objIniFile.ReadLine )
' Check if section is found in the current line
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
strLine = Trim( objIniFile.ReadLine )
' Parse lines until the next section is reached
Do While Left( strLine, 1 ) <> "["
' Find position of equal sign in the line
intEqualPos = InStr( 1, strLine, "=", 1 )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
' Check if item is found in the current line
If LCase( strLeftString ) = LCase( strKey ) Then
ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
' In case the item exists but value is blank
If ReadIni = "" Then
ReadIni = " "
End If
' Abort loop when item is found
Exit Do
End If
End If
' Abort if the end of the INI file is reached
If objIniFile.AtEndOfStream Then Exit Do
' Continue with next line
strLine = Trim( objIniFile.ReadLine )
Loop
Exit Do
End If
Loop
objIniFile.Close
Else
WScript.Echo strFilePath & " doesn't exists. Exiting..."
Wscript.Quit 1
End If
End Function
Sub WriteIni( myFilePath, mySection, myKey, myValue )
' This subroutine writes a value to an INI file
'
' Arguments:
' myFilePath [string] the (path and) file name of the INI file
' mySection [string] the section in the INI file to be searched
' myKey [string] the key whose value is to be written
' myValue [string] the value to be written (myKey will be
' deleted if myValue is <DELETE_THIS_VALUE>)
'
' Returns:
' N/A
'
' CAVEAT: WriteIni function needs ReadIni function to run
'
' Written by Keith Lacelle
' Modified by Denis St-Pierre, Johan Pol and Rob van der Woude
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
Dim intEqualPos
Dim objFSO, objNewIni, objOrgIni, wshShell
Dim strFilePath, strFolderPath, strKey, strLeftString
Dim strLine, strSection, strTempDir, strTempFile, strValue
strFilePath = Trim( myFilePath )
strSection = Trim( mySection )
strKey = Trim( myKey )
strValue = Trim( myValue )
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set wshShell = CreateObject( "WScript.Shell" )
strTempDir = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName )
Set objOrgIni = objFSO.OpenTextFile( strFilePath, ForReading, True )
Set objNewIni = objFSO.CreateTextFile( strTempFile, False, False )
blnInSection = False
blnSectionExists = False
' Check if the specified key already exists
blnKeyExists = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
blnWritten = False
' Check if path to INI file exists, quit if not
'strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
'If Not objFSO.FolderExists ( strFolderPath ) Then
' WScript.Echo "Error: WriteIni failed, folder path (" _
' & strFolderPath & ") to ini file " _
' & strFilePath & " not found!"
' Set objOrgIni = Nothing
' Set objNewIni = Nothing
' Set objFSO = Nothing
' WScript.Quit 1
'End If
While objOrgIni.AtEndOfStream = False
strLine = Trim( objOrgIni.ReadLine )
If blnWritten = False Then
If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
blnSectionExists = True
blnInSection = True
ElseIf InStr( strLine, "[" ) = 1 Then
blnInSection = False
End If
End If
If blnInSection Then
If blnKeyExists Then
intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
If intEqualPos > 0 Then
strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
If LCase( strLeftString ) = LCase( strKey ) Then
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
End If
If Not blnWritten Then
objNewIni.WriteLine strLine
End If
Else
objNewIni.WriteLine strLine
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
blnWritten = True
blnInSection = False
End If
Else
objNewIni.WriteLine strLine
End If
Wend
If blnSectionExists = False Then ' section doesn't exist
objNewIni.WriteLine
objNewIni.WriteLine "[" & strSection & "]"
' Only write the key if the value isn't empty
' Modification by Johan Pol
If strValue <> "<DELETE_THIS_VALUE>" Then
objNewIni.WriteLine strKey & "=" & strValue
End If
End If
objOrgIni.Close
objNewIni.Close
' Delete old INI file
objFSO.DeleteFile strFilePath, True
' Rename new INI file
objFSO.MoveFile strTempFile, strFilePath
Set objOrgIni = Nothing
Set objNewIni = Nothing
Set objFSO = Nothing
Set wshShell = Nothing
End Sub

复制代码

'Read and write windows INI files in VBSscriptMOTOBIT.COM
'http://www.motobit.com/tips/detpg_asp-vbs-read-write-ini-files/
WriteINIString "Mail", "MAPI", "1", "win.ini" '写入INI
WScript.echo GetINIString("Mail", "MAPI", "-", "win.ini") '读取INI
Sub WriteINIStringVirtual(Section, KeyName, Value, FileName)
WriteINIString Section, KeyName, Value, FileName
End Sub
Function GetINIStringVirtual(Section, KeyName, Default, FileName)
GetINIStringVirtual = GetINIString(Section, KeyName, Default, FileName)
End Function
'Work with INI files In VBS (ASP/WSH)
'v1.00
'2003 Antonin Foller, PSTRUH Software, http://www.motobit.com
'Function GetINIString(Section, KeyName, Default, FileName)
'Sub WriteINIString(Section, KeyName, Value, FileName)
Sub WriteINIString(Section, KeyName, Value, FileName)
Dim INIContents, PosSection, PosEndSection
'Get contents of the INI file As a string
INIContents = GetFile(FileName)
'Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
'Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
'?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
'Separate section contents
Dim OldsContents, NewsContents, Line
Dim sKeyName, Found
OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
OldsContents = split(OldsContents, vbCrLf)
'Temp variable To find a Key
sKeyName = LCase(KeyName & "=")
'Enumerate section lines
For Each Line In OldsContents
If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
Line = KeyName & "=" & Value
Found = True
End If
NewsContents = NewsContents & Line & vbCrLf
Next
If isempty(Found) Then
'key Not found - add it at the end of section
NewsContents = NewsContents & KeyName & "=" & Value
Else
'remove last vbCrLf - the vbCrLf is at PosEndSection
NewsContents = Left(NewsContents, Len(NewsContents) - 2)
End If
'Combine pre-section, new section And post-section data.
INIContents = Left(INIContents, PosSection-1) & _
NewsContents & Mid(INIContents, PosEndSection)
else'if PosSection>0 Then
'Section Not found. Add section data at the end of file contents.
If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then
INIContents = INIContents & vbCrLf
End If
INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
KeyName & "=" & Value
end if'if PosSection>0 Then
WriteFile FileName, INIContents
End Sub
Function GetINIString(Section, KeyName, Default, FileName)
Dim INIContents, PosSection, PosEndSection, sContents, Value, Found
'Get contents of the INI file As a string
INIContents = GetFile(FileName)
'Find section
PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
If PosSection>0 Then
'Section exists. Find end of section
PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
'?Is this last section?
If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
'Separate section contents
sContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
If InStr(1, sContents, vbCrLf & KeyName & "=", vbTextCompare)>0 Then
Found = True
'Separate value of a key.
Value = SeparateField(sContents, vbCrLf & KeyName & "=", vbCrLf)
End If
End If
If isempty(Found) Then Value = Default
GetINIString = Value
End Function
'Separates one field between sStart And sEnd
Function SeparateField(ByVal sFrom, ByVal sStart, ByVal sEnd)
Dim PosB: PosB = InStr(1, sFrom, sStart, 1)
If PosB > 0 Then
PosB = PosB + Len(sStart)
Dim PosE: PosE = InStr(PosB, sFrom, sEnd, 1)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf, 1)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(sFrom, PosB, PosE - PosB)
End If
End Function
'File functions
Function GetFile(ByVal FileName)
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
'Go To windows folder If full path Not specified.
'If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
' FileName = FS.GetSpecialFolder(0) & "\" & FileName
'End If
On Error Resume Next
GetFile = FS.OpenTextFile(FileName).ReadAll
End Function
Function WriteFile(ByVal FileName, ByVal Contents)
Dim FS: Set FS = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
'Go To windows folder If full path Not specified.
'If InStr(FileName, ":\") = 0 And Left (FileName,2)<>"\\" Then
' FileName = FS.GetSpecialFolder(0) & "\" & FileName
'End If
Dim OutStream: Set OutStream = FS.OpenTextFile(FileName, 2, True)
OutStream.Write Contents
End Function

复制代码