'==================================================== ========= 'Create a record output (.csv) file' production date: March 2003 Author: Saichi's snow '================= ===================================================================2 FEXPORT DIM EXP_TYPE
Private sub class_initialize () SET FSO = Server.createObject ("scripting.filesystemObject") 'Establishing file system object instance exp_type = 1' Export Type 1 To append a file 2 to create a new file to write End Sub ' Close Object private sub Class_Terminate () fExport.Close set FSO = nothing end sub 'export main routine (array with a given field) public Function exportFile (fullpath, rsSet, HeaderArray) if Exp_type = 1 then if not existFile (fullpath) then if CreateFile "An error occurred while creating a file!" (fullpath) then writeHeader HeaderArray WriteBody rsSet, HeaderArray else err_Show "error opening file!" end if else if OpenFile (fullpath) then WriteBody rsSet, HeaderArray else err_Show end if end if elseif Exp_type = 2 Then IF EXISTFILE (FULLPATH) THEN ERR_SHOW "File name conflict! "Else if createFile (FullPath) Then WriteHeader Headerarray WriteBody Rsset, HeaderaRray Else Err_show" error occurred while creating a file! "END if End if End if if Err = 0 THEN EXPORTFILE = TRUE ELSE ELSE ELSE END FUENTFILE = FALSE END IF End Function 'Specified Title Writing Public Sub WriteHeader (HeaderarRay) Sline =" "for i = 0 to Ubound (Headerarray, 2) Sline = Sline & "," & "&"
Headerarray (0, i) Next if Sline <> "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" "" Headerarray) rsset.movefirst Do Until Rsset.eof Sline = "" "for i = 0 to Ubound (Headerarray, 2) Sline = Sline &", "& RSSET (Headerarray (1, I)) Next IF Sline <>" " Then Sline = Right (Sline, Len (Sline) -1) fEXPORT.WRITELINE (Sline) end if rsset.movenext loop end sub exports the main program (full record set) public function exportfile2 (Fullpath, RSset) if exp_type = 1 Then If not existfile (fullpath) Then writeHeader2 rsset writebody2 rsset else err_show creates a file error! "end if else if Openfile (Fullpath) Then WriteBody2 RSset Else Err_show "An error occurred while opening a file! "END if End if elseif exp_type = 2 the if existfile (fullpath) The Err_show file name conflict! "Else if createfile (fullpath) THEN WRITEHEADER2 RSSET WRITEBODY2 RSSET ELSE ERR_SHOW" Errors when you create a file! "END if end if End if if Err =
0 THEN EXPORTFILE2 = true Else Exportfile2 = false End If End Function 'Writing Public Sub WriteHeader2 (RSSET) Sline = "for i = 0 to rsset.fields.count-1 Sline = Sline &", RSSET.FIELDS (I) .Name Next IF Sline <> "" "the sline = right (sline, len (sline) -1) fEXPORT.WRITELINE (SLINE) End If End Sub 'Output Record Concentration Information Public Sub WriteBody2 (RSSET) RSSET.MOVEFIRST DO Until Rsset.eof Sline = "" "" for i = 0 to rsset.fields.count-1 sline = sline & "," & rsset.fields (i) .value next if sline <> "" "" "" "" "" "" "" "" " right (sLine, Len (sLine) -1) fExport.WriteLine (sLine) end if rsSet.MoveNext Loop end sub 'outputs error information private sub Err_Show (errDesc) Response.Write errDesc Response.End end sub' to create a file public Function CreateFile (Fullpath) set fEXPORT = fso.createteTextFile (Fullpath, False) IF ER r = 0 then CreateFile = true else CreateFile = false end if end function 'to open a file public Function OpenFile (fullpath) set fExport = FSO.OpenTextFile (fullPath, 8, false) if err = 0 then OpenFile = true else OpenFile = false End if End Function 'Determines the file name of the specified file name whether there is a public function existfile (FullPath) if fso.fileexists (fullpath) THEN EXISTFILE = True else existfile = false end if End Functionend Class
