Sub WriteUser(UserName,FileName,UserInfo) Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(FileName) = False Then fs.CreateTextFile (FileName) End If '以添加方式打开文件 Set f = fs.OpenTextFile(FileName, 8) '用户信息开始标志 f.WriteLine ("`" & UserName & "`") f.WriteLine (UserInfo) '用户信息结束标志 f.WriteLine ("`e`")
Function ReadUser(UserName,FileName) Dim i Dim s Dim ret Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing ReadUser="" Exit Function end if '以只读方式打开文件 Set f = fs.OpenTextFile(FileName, 1)
Do While f.AtEndOfStream <> True s = f.ReadLine If s = "`" & UserName & "`" Then s = f.ReadLine ret="" Do While s <> "`e`" if ret="" then ret = ret + s else ret = ret + Chr(13) & Chr(10)+s end if s = f.ReadLine Loop Exit Do End If Loop
f.Close Set f = Nothing Set fs = Nothing ReadUser = ret End Function
Sub DeleteUser(UserName,FileName) Dim i Dim s Dim tmp Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing Exit Sub end if Set f = fs.OpenTextFile(FileName, 1) tmp="" Do While f.AtEndOfStream <> True s = f.ReadLine If s <> "`" & UserName & "`" Then if tmp="" then tmp = tmp + s else tmp = tmp + Chr(13) & Chr(10)+ s end if Else Do While s <> "`e`" s = f.ReadLine Loop End If Loop
f.Close Set f = fs.CreateTextFile(FileName, True) f.WriteLine tmp
Sub ModifyUser(UserName,FileName,NewUserInfo) Dim i Dim s Dim tmp Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing Exit Sub end if Set f = fs.OpenTextFile(FileName, 1) tmp="" Do While f.AtEndOfStream <> True s = f.ReadLine If s <> "`" & UserName & "`" Then if tmp="" then tmp = tmp + s else tmp = tmp + Chr(13) & Chr(10)+ s end if Else Do While s <> "`e`" s = f.ReadLine Loop if tmp="" then tmp = tmp + "`" & UserName & "`" else tmp = tmp + Chr(13) & Chr(10)+ "`" & UserName & "`" end if tmp = tmp + Chr(13) & Chr(10)+ NewUserInfo tmp = tmp + Chr(13) & Chr(10) + "`e`" End If Loop
f.Close Set f = fs.CreateTextFile(FileName, True) f.WriteLine tmp
f.Close Set f = Nothing Set fs = Nothing End Sub
还有一个函数是用来判断用户是否存在,通过在保存用户名的文件中进行定 位来实现,代码如下:
Function UserExist(UserName,FileName) Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=False then Set fs=Nothing UserExist=False Exit Function end if Set f = fs.OpenTextFile(FileName, 1)
Do While f.AtEndOfStream <> True s = f.ReadLine If s = "`" & UserName & "`" Then UserExist = True Exit Function End If Loop
UserNmFile=Server.MapPath(UserNmFile) UserPwdFile=Server.MapPath(UserPwdFile) NmFile=Server.MapPath(NmFile) GenderFile=Server.MapPath(GenderFile) MmFile=Server.MapPath(MmFile) '//////////////////////////////////////////////////////// '写用户信息到文件 Sub WriteUser(UserName,FileName,UserInfo) Dim fs, f Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(FileName) = False Then fs.CreateTextFile (FileName) End If '以添加方式打开文件 Set f = fs.OpenTextFile(FileName, 8) '用户信息开始标志 f.WriteLine ("`" & UserName & "`") f.WriteLine (UserInfo) '用户信息结束标志 f.WriteLine ("`e`")
f.Close Set f = Nothing Set fs = Nothing End Sub '读取用户信息 Function ReadUser(UserName,FileName) Dim i Dim s Dim ret Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing ReadUser="" Exit Function end if '以只读方式打开文件 Set f = fs.OpenTextFile(FileName, 1)
Do While f.AtEndOfStream <> True s = f.ReadLine If s = "`" & UserName & "`" Then s = f.ReadLine ret="" Do While s <> "`e`" if ret="" then ret = ret + s else ret = ret + Chr(13) & Chr(10)+s end if s = f.ReadLine Loop Exit Do End If Loop
f.Close Set f = Nothing Set fs = Nothing ReadUser = ret End Function '删除用户信息 Sub DeleteUser(UserName,FileName) Dim i Dim s Dim tmp Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing Exit Sub end if Set f = fs.OpenTextFile(FileName, 1) tmp="" Do While f.AtEndOfStream <> True s = f.ReadLine If s <> "`" & UserName & "`" Then if tmp="" then tmp = tmp + s else tmp = tmp + Chr(13) & Chr(10)+ s end if Else Do While s <> "`e`" s = f.ReadLine Loop End If Loop
f.Close Set f = fs.CreateTextFile(FileName, True) f.WriteLine tmp
f.Close Set f = Nothing Set fs = Nothing End Sub '修改用户信息 Sub ModifyUser(UserName,FileName,NewUserInfo) Dim i Dim s Dim tmp Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=false then Set fs=Nothing Exit Sub end if Set f = fs.OpenTextFile(FileName, 1) tmp="" Do While f.AtEndOfStream <> True s = f.ReadLine If s <> "`" & UserName & "`" Then if tmp="" then tmp = tmp + s else tmp = tmp + Chr(13) & Chr(10)+ s end if Else Do While s <> "`e`" s = f.ReadLine Loop if tmp="" then tmp = tmp + "`" & UserName & "`" else tmp = tmp + Chr(13) & Chr(10)+ "`" & UserName & "`" end if tmp = tmp + Chr(13) & Chr(10)+ NewUserInfo tmp = tmp + Chr(13) & Chr(10) + "`e`" End If Loop
f.Close Set f = fs.CreateTextFile(FileName, True) f.WriteLine tmp
f.Close Set f = Nothing Set fs = Nothing End Sub '判断用户是否已存在 Function UserExist(UserName,FileName) Dim fs, f
Set fs = CreateObject("Scripting.FileSystemObject") if fs.FileExists(FileName)=False then Set fs=Nothing UserExist=False Exit Function end if Set f = fs.OpenTextFile(FileName, 1)
Do While f.AtEndOfStream <> True s = f.ReadLine If s = "`" & UserName & "`" Then UserExist = True Exit Function End If Loop