home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1998 February
/
CHIP_2_98.iso
/
software
/
pelne
/
optionp
/
iis4_07.cab
/
Advertisement.cls
< prev
next >
Wrap
Text File
|
1997-11-01
|
5KB
|
142 lines
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Advertisement"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'
' This class manages data associated with advertisements and press releases
' in the Exploration Air website.
'
' Like all of the classes for the site, it has no global properties or
' variables. This is so that objects will be called by the application
' (i.e. the ASPs) and then released as soon as they have performed their
' function. That way, if many users are creating instances of the same objects,
' the server on which the objects are running will not become burdened with
' too many instances.
'
' One of the ways in which this is made apparent is that each function must
' establish its own database connection. If a connection were made and stored
' as a global variable, the object could not be recycled as quickly. This would
' also hinder Microsoft Transaction Server from pooling database connections
' efficiently. That is why the first parameter of every function that talks
' to the database is a string containing the location of the file DSN.
'
Option Explicit
Function ListAll(ByVal strFileDSN As String)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADODB.Recordset
strSQL = "SELECT AdID, Description, FileName " & _
"FROM Ads"
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
objContext.SetComplete
Set ListAll = rst
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Advertisement.ListAll()", Err.Description
End Function
Function ListForInterests(ByVal strFileDSN As String, ByVal lngAccountID As Long)
Dim objContext As ObjectContext
Set objContext = GetObjectContext
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rst As New ADODB.Recordset
Dim arrFileNames() As Variant
Dim arrTemp(), strTemp As String, fltTemp As Single
Dim n, m, i As Integer
strSQL = "SELECT Ads.FileName " & _
"FROM " & _
"(Ads INNER JOIN AdsInterests ON Ads.AdID = AdsInterests.AdID) " & _
"LEFT JOIN MembersInterests ON MembersInterests.InterestID = AdsInterests.InterestID " & _
"WHERE MembersInterests.AccountID = " & lngAccountID
rst.CursorLocation = adUseServer
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenStatic, adLockReadOnly, adCmdText
' if no hits happened, then select all the ads
If rst.EOF Then
Set rst = Nothing
strSQL = "SELECT FileName FROM Ads"
rst.Open strSQL, "FILEDSN=" & strFileDSN, adOpenDynamic, adLockReadOnly, adCmdText
End If
n = 0
Do Until rst.EOF
For i = 0 To n - 1
If arrFileNames(i) = rst("FileName") Then
rst.MoveNext
i = 0
If rst.EOF Then
Exit Do
End If
End If
Next
ReDim Preserve arrFileNames(n)
arrFileNames(n) = CVar(rst("FileName"))
n = n + 1
rst.MoveNext
Loop
'change n back to reflect size of arrFileNames
n = n - 1
' Randomize the order of the array elements
ReDim arrTemp(n)
Randomize
For i = 0 To n
arrTemp(i) = Rnd
Next
For m = n - 1 To 1 Step -1
For i = 0 To m
If arrTemp(i) > arrTemp(i + 1) Then
' sorting the random numbers
fltTemp = arrTemp(i)
arrTemp(i) = arrTemp(i + 1)
arrTemp(i + 1) = fltTemp
' sorting the array the same way
strTemp = arrFileNames(i)
arrFileNames(i) = arrFileNames(i + 1)
arrFileNames(i + 1) = strTemp
End If
Next
Next
objContext.SetComplete
ListForInterests = arrFileNames
Exit Function
ErrorHandler:
If Not rst Is Nothing Then Set rst = Nothing
objContext.SetAbort
Err.Raise Err.Number, "Advertisement.ListForInterests()", Err.Description
End Function