%
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 & " ...
"
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
"
End If
End Sub
%>