<% Function ConvertNULL(val) If IsNUll(val) Then ConvertNULL = "" Else ConvertNULL = val End If End Function Function DisplayImage(IMGID) set SELImage2 = Server.CreateObject("ADODB.Command") SELImage2.ActiveConnection = MM_ADOSQL_STRING SELImage2.CommandText = "dbo._SP_SELECT_IMAGE" SELImage2.CommandType = 4 SELImage2.CommandTimeout = 0 SELImage2.Prepared = true SELImage2.Parameters.Append SELImage2.CreateParameter("RETURN_VALUE", 3, 4) SELImage2.Parameters.Append SELImage2.CreateParameter("@IMAGEID", 3, 1,4,IMGID) set rsIMAGE = SELImage2.Execute If NOT rsIMAGE.EOF Then DisplayImage = " " Else DisplayImage = "" End If End Function %> <% Function CutName(filename) ' BY OLIVER SCHNARS ext = Right(filename,4) If Len(filename) > 24 Then If InStr(20, filename, ext) = 0 Then CutName = Left(filename,24) Else TempName = Replace(filename,ext,"") CutName = Left(TempName,24) & "(" & ext & ")" End If Else CutName = filename End If End Function Function ReadMore(strSearchText, start, URL, Ref) ' by Oliver Schnars ' start == when to start looking for a space If start = "" then start = 1 If (NOT InStr(start,strSearchText, " ") = 0) Then z = Instr(start,strSearchText," ") text = Left(strSearchText,z) ReadMore = text & " ...  
" & "More
" Else ReadMore = strSearchText End If End Function Function MakeShort(strSearchText, start) ' by Oliver Schnars If (NOT InStr(start,strSearchText, " ") = 0) Then z = Instr(start,strSearchText," ") title = Left(strSearchText,z) MakeShort = title & " ..." Else MakeShort = strSearchText End If End Function ' *************** START : SUB CDONTS MAILER ***************************** Sub SendMail(MailTo, MailFrom, MailSubject, MailBody) ' By Oliver Schnars Dim Sender: Sender = CStr(Trim(MailFrom)) Dim Receiver: Receiver = CStr(Trim(MailTo)) Dim Message: Message = CStr(Trim(MailBody)) Dim SLine: SLine = CStr(Trim(MailSubject)) Set MailObj = Server.CreateObject("CDONTS.NewMail") MailObj.From = Sender MailObj.To = Receiver MailObj.Subject = SLine MailObj.Importance = 2 MailObj.Body = Message MailObj.Send End Sub ' *************** END : SUB CDONTS MAILER ******************************** Function ConnectSQL(dbName, dbServer, dbUser, dbPwd) Dim Conn Set Conn = Server.CreateObject("ADODB.Connection") Conn.ConnectionTimeout = 15 Conn.CommandTimeout = 30 Conn.Open "DRIVER=SQL Server;SERVER=" & dbServer & ";UID=" & dbUser & ";PWD=" & dbPwd & ";DATABASE=" & dbName Set ConnectSQL = Conn End Function Function ConnectSQLNT(dbName, dbServer) Dim Conn Set Conn = Server.CreateObject("ADODB.Connection") Conn.ConnectionTimeout = 15 Conn.CommandTimeout = 30 'Conn.Open "Driver=SQL Server;Server=" & dbServer & ";DATABASE=" & dbName 'Old ODBC call commented out 7/14/00 by Sue Klaiber, SysLogic 4:40pm ------------- Conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & dbName & ";Data Source=" & dbServer Set ConnectSQLNT = Conn end Function Function ConnectJetdb(dbPath) Dim Conn Set Conn = Server.CreateObject("ADODB.Connection") Conn.CommandTimeout = 300 ' Old ODBC call commented out 12/6/99 by SLP 3:30pm 'Conn.Open "DBQ=" & dbPath & ";DefaultDir=;Driver={Microsoft Access Driver (*.mdb)};DriverId=25;FIL=MS Access;ImplicitCommitSync=Yes;MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UID=admin;UserCommitSync=Yes;" 'conn.open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;User ID=Admin;Data Source=" & dbPath & ";Mode=Share Deny None;Extended Properties="";COUNTRY=0;CP=1252;LANGID=0x0409"";Locale Identifier=1033;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Global Partial Bulk Ops=2;User Id=Admin;" conn.ConnectionTimeout=15 conn.open "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Data Source=" & dbPath & ";Mode=Share Deny None;Extended Properties="""";Locale Identifier=1033;Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=4;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False" Set ConnectJetdb = Conn End Function Function OpenRecordset(Conn, sql) Dim cmd Dim rs Set cmd = Server.CreateObject("ADODB.Command") cmd.CommandType = 1 Set cmd.ActiveConnection = Conn cmd.CommandText = sql Set rs = Server.CreateObject("ADODB.Recordset") 'rs.Open cmd, , adOpenKeyset, adLockPessimistic rs.Open cmd, , 1, 2 Set OpenRecordset = rs End Function 'Note: This new function, OpenClientSideRecordset, was created since without it, some pages balked at their use of rs.AbsolutePage property. 7/17/00 by Sue Klaiber. Function OpenClientSideRecordset(Conn, sql) Dim cmd Dim rs Set cmd = Server.CreateObject("ADODB.Command") cmd.CommandType = 1 Set cmd.ActiveConnection = Conn cmd.CommandText = sql Set rs = Server.CreateObject("ADODB.Recordset") rs.CursorLocation = adUseClient rs.Open cmd, , adOpenKeyset, adLockPessimistic Set OpenClientSideRecordset = rs End Function Sub SendData2Excel(objRST) '********************************************************************** 'Object: SendData2Excel 'Created By: Ali Afshar, Metamor Industry Solutions 'Created: 4/6/2000 'Description: This routine is used to export data from any ' recordset to an Excel file. The routine will ' also dynamically create the HTML needed to ' expose a link to the file for WebUser to view/download. 'Inputs: objRST - any recordset 'Returns: none 'Comments: NOTE THAT THE RECORDSET IS NOT CLOSED AT THE END OF THE ' ROUTINE SO THAT IT CAN BE DONE SO BY THE CALLING PROGRAM. '********************************************************************** Dim objFSO, objMyFile, objFolder, colFiles, intF1 Dim strFileName, strDate, j, i If objRST.RecordCount=0 Then Response.Write "No Records Were Found!!!!

" Else 'Session("dbToolsExcelPath")="/champadmin/excel/" Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(Server.MapPath(Session("dbToolsExcelPath"))) Set colFiles = objFolder.Files 'clean up OLD temp report files before processing new report 'NOTE: The path of the temp files is stored in Session variable created in the GLOBAL.ASA For Each intF1 In colFiles strFileName = intF1.name strDate = intF1.DateLastModified 'response.write strFileName & " " & strDate & " diff=" & datediff("n",cDate(strDate),now()) & "
" 'delete all temp files older than 20 minutes If DateDiff("n",cDate(strDate),now()) > 20 Then objFSO.DeleteFile(Server.MapPath(Session("dbToolsExcelPath")) & "\" & strFileName) End If Next 'make up the filename based on 'a constant pre-qualifier + session id + randomly system generated name strFileName = objFSO.GetTempName strFileName = Left(strFileName,instr(strFileName,".tmp")-1) 'remove the .tmp strFileName = "ExcelRpt_" & strFileName & "_" & session.SessionID & ".xls" 'create the file Set objMyFile = objFSO.CreateTextFile((server.MapPath(Session("dbToolsExcelPath")) & "\" & strFileName), True) objRST.MoveFirst 'write the header For i = 0 To objRST.Fields.Count-2 'Response.Write objRST(i).Name & "," objMyFile.Write(objRST(i).Name & vbTab) Next objMyFile.WriteLine(objRST(i).Name) 'Response.Write "
" 'Response.Write "
" 'write the actual data While Not objRST.EOF For j = 0 To objRST.Fields.Count-2 ' Response.Write objRST(j).value & "," objMyFile.Write(objRST(j).value & vbTab) Next objMyFile.WriteLine(objRST(j).value & "") ' Response.Write "
" objRST.MoveNext Wend objMyFile.Close Set objMyFile = Nothing Set objFSO = Nothing 'Response.Write Session("dbToolsExcelPath") & "/" & strFileName Response.Write "
Click Here To Open MS Excel File
Load Excel File


" End If End Sub %>