文本文件操作类 TxtFileDump Version 2.4
<%
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''
'''' FSO.asp
''''
'''' Sub: CheckFolder(AimFolder)
'''' class: TxtFileDump
''''
'''' Version: 2.4 Last-Modified: 2005-04-11 12:36
'''' Copyright: Xinsoft ( blogchina.com )
''''
''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
%><%
''// 检查目标文件夹是否存在。如果不存字，创建之。
Sub CheckFolder( AimFolder )
Dim HasFolder
Dim RealPath
''RealPath=Server.MapPath(AimFolder)
RealPath=AimFolder
HasFolder=True
Dim FoldA,FoldN,i,CurFolder,HasCur
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
HasFolder=fso.FolderExists(RealPath)
If HasFolder<>True Then
''fso.CreateFolder( RealPath )
''Response.Write fso.GetSpecialFolder
''Response.Write RealPath
FoldA=Split( RealPath,"\" )
FoldN=UBound(FoldA)+1
CurFolder=FoldA(0) & "\"
For i=1 To FoldN-1
CurFolder=CurFolder & FoldA(i) & "\"
HasCur=fso.FolderExists(CurFolder)
If HasCur<>True Then fso.CreateFolder( CurFolder )
''Response.Write "<p>HasCur=" & HasCur & " , " & CurFolder &"</p>"
Next
End if
Set fso=Nothing
End sub
%>
<%
Class TxtFileDump
Public FilePath
Public FileName
Private RowA
Private RowN
Private fso
''// Read the file into RowA and set RowN=count(line)
Public Sub Read()
Dim f,i
Set f=FSO.opentextfile( FilePath & FileName , 1 )
RowN=0
Do While Not f.AtEndOfStream
RowN=RowN+1
f.SkipLine
Loop
f.Close
ReDim RowA(RowN)
Set f=FSO.opentextfile( FilePath & FileName , 1 )
i=0
Do While Not f.AtEndOfStream
RowA(i)=f.ReadLine
i=i+1
Loop
f.Close
Set f=Nothing
End Sub
''// View content in RowA
Public Sub ShowDumpCont()
Dim i
For i=0 To RowN-1
Response.Write RowA(i) & VBCrLf
Next
End Sub
''// Return one line in file
Property Get Line(iLineNumber)
Dim iVal
iVal=iLineNumber
If iVal<1 Then iVal=1
If iVal>RowN Then iVal=RowN
Line=RowA(iVal-1)
End Property
Property Get LineCount()
LineCount=RowN
End Property
''// get the line number which include string(s) in file
''// search order: from begin to end of the file
Property Get Find( s )
Dim i
Dim Flag
Flag=0
For i=0 To RowN-1
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End if
Next
Find=Flag
End Property
''// get the line number which include string(s) in file between lines( iBegin ... iEnd )
''// search order: from begin to end of the file
Property Get FindArea( s , iBegin,iEnd )
Dim i
Dim Flag
Dim iB,iE
iB=iBegin
If iBegin<1 Then iB=1
If iBegin>RowN Then iB=RowN
iE=iEnd
If iE<iB Then iE=iB
If iE>RowN Then iE=RowN
Flag=0
For i=0 To RowN-1
If i>=iB-1 And i<=iE-1 Then
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End If
End if
Next
FindArea=Flag
End Property
''// get the line number which include string(s) in file
''// search order: from end to begin of the file
Property Get FindRev( s )
Dim i
Dim Flag
Flag=0
For i=RowN-1 To 0 Step -1
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End if
Next
FindRev=Flag
End Property
''// get the line number which include string(s) in file between lines( iBegin ... iEnd )
''// search order: from end to begin of the file
Property Get FindAreaRev( s , iBegin,iEnd )
Dim i
Dim Flag
Dim iB,iE
iB=iBegin
If iBegin<1 Then iB=1
If iBegin>RowN Then iB=RowN
iE=iEnd
If iE<iB Then iE=iB
If iE>RowN Then iE=RowN
Flag=0
For i=RowN-1 To 0 Step -1
If i>=iB-1 And i<=iE-1 Then
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End if
End if
Next
FindAreaRev=Flag
End Property
Public Function sFind( str )
Dim i
Dim Flag
Dim s
s=LCase(str)
Flag=0
For i=0 To RowN-1
If InStr( Lcase(RowA(i)),s )>0 Then
Flag=i+1
Exit For
End if
Next
sFind=Flag
End Function
Public Function sFindRev( str )
Dim i
Dim Flag
Dim s
s=LCase(str)
Flag=0
For i=RowN-1 To 0 Step -1
If InStr( Lcase(RowA(i)),s )>0 Then
Flag=i+1
Exit For
End if
Next
sFindRev=Flag
End Function
''// get the line number which include string(s) in file before the given line number
''// search order: from begin to end of the file
Property Get FindU( s , iPos )
Dim i
Dim Flag
Dim iP
iP=iPos
Flag=0
For i=RowN-1 To 0 Step -1
If i<iPos-1 Then
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End if
End if
Next
FindU=Flag
End Property
''// get the line number which include string(s) in file after the given line number
''// search order: from begin to end of the file
Property Get FindD( s , iPos )
Dim i
Dim Flag
Dim iP
iP=iPos
Flag=0
For i=0 To RowN-1
If i>iPos-1 Then
If InStr( RowA(i),s )>0 Then
Flag=i+1
Exit For
End if
End if
Next
FindD=Flag
End Property
Public sub SaveLines( iBegin,iEnd )
Dim f,i
Dim iB,iE
iB=iBegin
If iBegin<1 Then iB=1
If iBegin>RowN Then iB=RowN
iE=iEnd
If iEnd<=iBegin Then iE=iB
If iEnd>RowN Then iE=RowN
If fso.FileExists( FilePath & FileName )=True Then
fso.DeleteFile( FilePath & FileName )
End If
Set f=fso.opentextfile( FilePath & FileName , 2 , True )
For i=iB-1 To iE-1
f.WriteLine(RowA(i))
Next
f.Close
Set f=Nothing
Read
End Sub
Public Sub Save()
SaveLines 1,RowN
Read
End Sub
Public sub CutLines( iBegin , iEnd )
Dim f,i
Dim iB,iE
iB=iBegin
If iBegin<1 Then iB=1
If iBegin>RowN Then iB=RowN
iE=iEnd
If iEnd<=iBegin Then iE=iB
If iEnd>RowN Then iE=RowN
If fso.FileExists( FilePath & FileName )=True Then
fso.DeleteFile( FilePath & FileName )
End If
Set f=fso.opentextfile( FilePath & FileName , 2 , True )
For i=0 To RowN-1
If i<iBegin-1 Or i>iEnd-1 Then
f.WriteLine(RowA(i))
End if
Next
f.Close
Set f=Nothing
Read
End Sub
''// Content replace and save
Public Function ReplaceContInLines( SrcStr,DesStr, iBegin,iEnd )
Read
Dim ReplaceTimes
ReplaceTimes=0
Dim f,i
Dim iB,iE
iB=iBegin
If iBegin<1 Then iB=1
If iBegin>RowN Then iB=RowN
iE=iEnd
If iEnd<=iBegin Then iE=iB
If iEnd>RowN Then iE=RowN
If fso.FileExists( FilePath & FileName )=True Then
fso.DeleteFile( FilePath & FileName )
End If
Set f=fso.opentextfile( FilePath & FileName , 2 , True )
For i=0 To RowN-1
If iBegin-1<=i And i<=iEnd-1 Then
If InStr( RowA(i),SrcStr )>0 Then
RowA(i)=Replace(RowA(i),SrcStr,DesStr)
ReplaceTimes=ReplaceTimes+1
End if
End If
f.WriteLine(RowA(i))
Next
f.Close
Set f=Nothing
Read
ReplaceContInLines=ReplaceTimes
End Function
Public Function ReplaceCont( SrcStr,DesStr )
ReplaceCont=ReplaceContInLines(SrcStr,DesStr,1,RowN)
End Function
''// file coalition
Public Sub CoalitBefore( fp,fn )
Dim RecA,RecN
Dim f,i
RecN=0
If fso.FileExists( fp & fn )=True Then
''// 读引入文件到 RecA(RecN)中 :: Begin
Set f=FSO.opentextfile( FilePath & FileName , 1 )
Do While Not f.AtEndOfStream
RecN=RecN+1
f.SkipLine
Loop
f.Close
ReDim RecA(RecN)
Set f=FSO.opentextfile( FilePath & FileName , 1 )
i=0
Do While Not f.AtEndOfStream
RecA(i)=f.ReadLine
i=i+1
Loop
f.Close
Set f=Nothing
''// 读引入文件到 RecA(RecN)中 :: End
End If
If fso.FileExists( FilePath & FileName )=True Then
fso.DeleteFile( FilePath & FileName )
End If
Set f=fso.opentextfile( FilePath & FileName , 2 , True )
''// 写入引入文件
For i=0 To RecN-1
f.WriteLine(RecA(i))
Next
''// 写入原文件
For i=0 To RowN-1
f.WriteLine(RowA(i))
Next
f.Close
Set f=Nothing
Read
End Sub
''// file coalition
Public Sub CoalitAfter( fp,fn )
Dim RecA,RecN
Dim f,i
RecN=0
If fso.FileExists( fp & fn )=True Then
''// 读引入文件到 RecA(RecN)中 :: Begin
Set f=FSO.opentextfile( FilePath & FileName , 1 )
Do While Not f.AtEndOfStream
RecN=RecN+1
f.SkipLine
Loop
f.Close
ReDim RecA(RecN)
Set f=FSO.opentextfile( FilePath & FileName , 1 )
i=0
Do While Not f.AtEndOfStream
RecA(i)=f.ReadLine
i=i+1
Loop
f.Close
Set f=Nothing
''// 读引入文件到 RecA(RecN)中 :: End
End If
If fso.FileExists( FilePath & FileName )=True Then
fso.DeleteFile( FilePath & FileName )
End If
Set f=fso.opentextfile( FilePath & FileName , 2 , True )
''// 写入原文件
For i=0 To RowN-1
f.WriteLine(RowA(i))
Next
''// 写入引入文件
For i=0 To RecN-1
f.WriteLine(RecA(i))
Next
f.Close
Set f=Nothing
Read
End Sub
Private Sub Class_Initialize
Set fso=CreateObject("Scripting.FileSystemObject")
End Sub
Private Sub Class_Terminate
Set fso=Nothing
End sub
End class
%> from:asp学习网/title:文本文件操作类 TxtFileDump Version 2.4/ time:2006-4-28 16:36:39
本文主题文本文件操作类 TxtFileDump Version 2.4
