<%Option Explicit
'Version 2.5 data 03.01.2003
'Version 2.5 data 08.05.2003 Add the counter of articles
'Version 2.5 data 11.03.2005 Searching method modified
'Version 2.5 data 11.03.2005 changes Copyringt 2002 - 2007 
Response.Buffer=True
Dim bUser
Dim bAdmin
Dim bAgent
Dim bAuthor
Dim sAction
Dim sRemoteAddress
Dim sCookie
Dim sThisASP
Dim sTimeStamp
Dim sServerName 
Dim sScriptName
Dim sUserName
Dim sPassWord
Dim sLanguage
Dim sCategory
Dim sUsersGroup
Dim sUserID
Dim sFullName
Dim sLink1
Dim sLink2
Dim sTitle
Dim sDescription
Dim sContent
Dim sPublicationDate
Dim sEmail
Dim sStatus
Dim sID
Dim sNewsString
Dim sUsersString
Dim sPageCount     
Dim sPageCurrent
Dim sPreviousPage
Dim sPage
Dim sNextPage 
Dim sHeight
Dim sWidth   
Dim sSQL  
          
Dim NewsCN   
Dim NewsRS  
Dim UsersCN
Dim UsersRS

Dim sCurrentPage
Dim sCurrentUserName
Dim sCurrentUserID
Dim sCurrentFullName

Dim sRecordsShown  
Dim sStyle
Dim sDataPath
Dim sCalendar
Dim sImgLoc
Dim sSearchString
Dim sType
Dim sDateFrom
Dim sDateTo
Dim I
Dim sNewsCopyright
Dim sMailerCopyright

Const sCookieName       ="BELGIANSHOP"
Const sMailerTitle      ="BelgianShop"
      sMailerCopyright  ="Copyright &copy; BelgianShop, 2001 - " & Year(Now)
Const sNewsMailAddress  = "info@e-malt.com"
Const sNewsTitle        = "BelgianShop news "
      sNewsCopyright    = sMailerCopyright
Const ColorTonB         ="#000080"
Const ColorTonL         ="#fffff0"
Const ColorTon0         ="#00007d"  '#00007d
Const ColorTon1         ="#4040c0"
Const ColorTon2         ="#4040b0"

Const sPageSize         = 10
Const sPageSizeAdmin    = 100
Const sPageSizeBrief    = 50

Const ImagesDirectory     = "/News/Images/" 
Const StyleFileName       = "/News/BShopNews.css"
Const UsersDataBaseName   = "/BShopBase/BShopUsers.mdb"
Const NewsDataBaseName    = "/BShopBase/BShopNews.mdb"

'include ADO CursorTypeEnum Values
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'include ADO LockTypeEnum Values
Const adLockReadOnly = 1
Const adLockPessimistic = 2
Const adLockOptimistic = 3
Const adLockBatchOptimistic = 4
'include ADO CommandTypeEnum Values
Const adCmdUnknown          = &H0008
Const adCmdText             = &H0001
Const adCmdTable            = &H0002
Const adCmdStoredProc       = &H0004
Const adCmdFile             = &H0100
Const adCmdTableDirect      = &H0200
'include ADO ObjectStateEnum Values
Const adStateClosed         = &H00000000
Const adStateOpen           = &H00000001
Const adStateConnecting     = &H00000002
Const adStateExecuting      = &H00000004
Const adStateFetching       = &H00000008
'include ADO RecordStatusEnum Values
Const adRecOK                   = &H0000000
Const adRecNew                  = &H0000001
Const adRecModified             = &H0000002
Const adRecDeleted              = &H0000004
Const adRecUnmodified           = &H0000008
Const adRecInvalid              = &H0000010
Const adRecMultipleChanges      = &H0000040
Const adRecPendingChanges       = &H0000080
Const adRecCanceled             = &H0000100
Const adRecCantRelease          = &H0000400
Const adRecConcurrencyViolation = &H0000800
Const adRecIntegrityViolation   = &H0001000
Const adRecMaxChangesExceeded   = &H0002000
Const adRecObjectOpen           = &H0004000
Const adRecOutOfMemory          = &H0008000
Const adRecPermissionDenied     = &H0010000
Const adRecSchemaViolation      = &H0020000
Const adRecDBDeleted            = &H0040000

'____________________________________________________ OpenUsersDataBase
Sub OpenUsersDataBase(TheSQL,PageSize)
Dim ConStr, Path
Path       = Server.MapPath(UsersDataBaseName)
ConStr     = "PROVIDER=MSDASQL;"
ConStr     = ConStr & "DBQ=" & Path & ";"
ConStr     = ConStr & "Driver={Microsoft Access Driver (*.mdb)};"
ConStr     = ConStr & "UID=Admin;PWD=;"
Set UsersCN = Server.CreateObject("ADODB.Connection")
UsersCN.Open ConStr
Set UsersRS = Server.CreateObject("ADODB.Recordset")
UsersRS.PageSize  = PageSize
UsersRS.CacheSize = PageSize
UsersRS.Open TheSQL, UsersCN, adOpenKeyset, adLockPessimistic, adCmdText
End Sub
'____________________________________________________ CloseConfigDataBase
Sub CloseUsersDataBase
UsersRS.Close
UsersCN.Close
Set UsersRS=Nothing
Set UsersCN=Nothing
End Sub
'____________________________________________________ OpenNewsDataBase
Sub OpenNewsDataBase(TheSQL,PageSize)
Dim ConStr, Path
Path       = Server.MapPath( NewsDataBaseName)
ConStr     = "PROVIDER=MSDASQL;"
ConStr     = ConStr & "DBQ=" & Path & ";"
ConStr     = ConStr & "Driver={Microsoft Access Driver (*.mdb)};"
ConStr     = ConStr & "UID=Admin;PWD=;"
Set NewsCN = Server.CreateObject("ADODB.Connection")
NewsCN.Open ConStr
Set NewsRS = Server.CreateObject("ADODB.Recordset")
NewsRS.PageSize  = PageSize
NewsRS.CacheSize = PageSize
NewsRS.Open TheSQL, NewsCN, adOpenKeyset, adLockOptimistic, adCmdText
End Sub
'____________________________________________________ CloseConfigDataBase
Sub CloseNewsDataBase
NewsRS.Close
NewsCN.Close
Set NewsRS=Nothing
Set NewsCN=Nothing
End Sub
'___________________________________________________________________ GetParam
Function GetParam(ParameterName)
     Dim Tmp
     Tmp=Request.Form(ParameterName)
     If Trim(Tmp)="" Then Tmp= Request.QueryString(ParameterName)
     GetParam=Trim(Tmp)
End Function
'___________________________________________________________________ DateFormat

Function DateFormat(FullDateAndTime,Format)
Dim DD, MM, YY, YYYY, HH, NN, SS, MNames, D0, R, MN

If IsDate(FullDateAndTime) Then
      D0=CDate(FullDateAndTime)
Else
      DateFormat=FullDateAndTime
      Exit Function
End If
DD    = Right("0" & Day(D0),2)  
MM    = Right("0" & Month(D0),2)
YYYY  = Year(D0)
YY    = Right(YYYY,2)
HH    = Right("0" & Hour(D0),2) 
NN    = Right("0" & Minute(D0),2)
SS    = Right("0" & Second(D0),2)
MNames=Split("January,February,March,April,May,June,July,August,September,October,November,December",",")
MN    = MNames(Month(D0)-1)
R = Replace(Format,"MN:3",Left(MN,3))
R = Replace(R,"MN",MN)
R = Replace(R,"MM",MM)
R = Replace(R,"DD",DD)
R = Replace(R,"YYYY",YYYY)
R = Replace(R,"YY",YY)
R = Replace(R,"HH",HH)
R = Replace(R,"NN",NN)
R = Replace(R,"SS",SS)
DateFormat=R
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 IsMydate
'
' Function: IsMydate
' Destination: To check date format in accordance with format: DD.MM.YYYY
' Parameter: StringAsMyDateFormat
' Return:  True or False
'
Function IsMyDate(StringAsMyDateFormat)
Dim DD,MM,YYYY,A,Tmp,N,R
If Trim(StringAsMyDateFormat)="" Then 
      IsMydate=False
      Exit Function
End If
Tmp=Replace(StringAsMyDateFormat,"  "," ")
Tmp=Replace(Tmp,"\",";")
Tmp=Replace(Tmp,"-",";")
Tmp=Replace(Tmp,"|",";")
Tmp=Replace(Tmp,",",";")
Tmp=Replace(Tmp,".",";")
Tmp=Replace(Tmp,"/",";")
A=Split(Tmp,";")
N=UBound(A)
If N<>2 Then 
      IsMydate=False
      Exit Function
End If
For N=LBound(A) To UBound(A)
If IsNumeric(A(N))=False Then
      IsMydate=False
      Exit Function
End If
Next
R    = True
DD   = CInt(A(0))
MM   = CInt(A(1))
YYYY = CInt(A(2))
If DD<1 OR DD>31 Then R=False
If MM<1 OR MM>12 Then R=False
If YYYY<1000 OR YYYY>9000 Then R=False
If R=True Then 
      IsMydate=True
Else
      IsMydate=False
End If
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 MyDate2Date
'
' Function: MyDate2Date
' Goal: Conver the date from local format: dd.mm.yyyy 
' into Access format MM/DD/YYYY 
' Parameter: StringAsMyDateFormat ( date in format dd.mm.yyyy)
' Return: date 
' 
Function MyDate2Date(StringAsMyDateFormat)
Dim DD,MM,YYYY,A,Tmp,N,R
Tmp=Replace(StringAsMyDateFormat,"  "," ")
Tmp=Replace(Tmp,"\",";")
Tmp=Replace(Tmp,"-",";")
Tmp=Replace(Tmp,"|",";")
Tmp=Replace(Tmp,",",";")
Tmp=Replace(Tmp,".",";")
Tmp=Replace(Tmp,"/",";")
A=Split(Tmp,";")
N=UBound(A)
If N<>2 Then 
      MyDate2Date=False
      Exit Function
End If
For N=LBound(A) To UBound(A)
If IsNumeric(A(N))=False Then
      MyDate2Date = False
      Exit Function
End If
Next
R=True
DD=CInt(A(0)):MM=CInt(A(1)):YYYY=CInt(A(2))
If DD<1 OR DD>31 Then R=False
If MM<1 OR MM>12 Then R=False
If YYYY<1000 OR YYYY>9000 Then R=False
If R=True Then 
      MyDate2Date=DateSerial(YYYY,MM,DD) 
Else
      MyDate2Date=False
End If
End Function
'____________________________________________________GetText
Function GetTextFile(FileName)
Dim loc
Dim objFSO
Dim txtFIL
loc = Server.MapPath(FileName)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set txtFIL = objFSO.OpenTextFile( loc, 1, False )
GetTextFile = txtFIL.ReadAll()
txtFIL.Close
Set objFSO = Nothing
Set txtFIL = Nothing
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧Apletize
'Remove all significaly characters from string
Function Apletize(TheString,TheLenght)
Dim Rez
Rez=Replace(TheString,"'","^")
Rez=Replace(Rez,CHR(13) & CHR(10),"\n")
Rez=Replace(Rez,"%","\%")
Rez=Replace(Rez,"""","\""")
Apletize=Left(Rez,TheLenght)
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧AfterWord
Function AfterWord(N,TheString)
Dim Index
Index=0
For I=1 To Len(TheString)
  If Mid(TheString,I,1)=" " Then Index=Index+1
  If Index=N Then
     AfterWord=I
     Exit Function
  End If 
Next
AfterWord=I
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧
Function MultipleLIKE(RefList,RefFieldName)
Dim Ar, R, I 
If Trim(RefList) = "" Then
     MultipleLike = R
     Exit Function
End If
If InStr(1, RefList, "All") > 0 Then
     R = "(" & RefFieldName & "<>'x')"
     MultipleCountries = R
     Exit Function
End If
If InStr(1, RefList, ",") > 0 Then
   Ar = Split(RefList, ",")
   R = "("
   For I = LBound(Ar) To UBound(Ar)
       R = R & "(" & RefFieldName & " LIKE '%" & Trim(Ar(I)) & "%')"
       If I < UBound(Ar) Then R = R & " OR "
   Next
   R = R & ")"
Else
   R = "(" & RefFieldName & " LIKE '%" & RefList & "%')"
End If
MultipleLike = R
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧SendStructure
Sub SendStructure
SendHeader "Database structure"
sSQL = "SELECT * FROM Documents"
Set NewsCN = Server.CreateObject("ADODB.Connection")
NewsCN.Open sNewsString
Set NewsRS = Server.CreateObject("ADODB.Recordset")
NewsRS.Open sSQL, NewsCN, adOpenStatic, adLockReadOnly, adCmdText
Send "<table border='1' cellpadding='0' cellspacing='0'>"
Send "<tr><td>Field Nr.</td><td>Name</td><td>Type</td><td>DefinedSize</td><td>Precision</td><td>NumericScale</td><tr>"
For i = 0 To NewsRS.Fields.Count - 1

Send "<tr><td>" & i 
Send "</td><td>" & NewsRS.Fields(i).Name 
Send "</td><td>" & NewsRS.Fields(i).Type
Send "</td><td>" & NewsRS.Fields(i).DefinedSize
Send "</td><td>" & NewsRS.Fields(i).Precision
Send "</td><td>" & NewsRS.Fields(i).NumericScale
Send "</td></tr>"
Next 
Send "</table>"
NewsRS.Close
Set NewsRS = Nothing
NewsCN.Close
Set NewsCN = Nothing
SendFooter
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 NewKey
Function NewKey
Dim Counter
Dim TempString
Randomize()
TempString=""
For Counter = 1 To 50
    TempString = TempString & Chr(65+Int((26 * Rnd)))
Next
NewKey = Left(TempString, 40)
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 ExpireAfterMinute
Function ExpireAfterMinute(ExpiredMinutes)
Dim dd,mm,yy,hh,nn,ss,MName,DName,Wday
Dim CurrentTime,ExpireTime
CurrentTime=Now
ExpireTime=DateAdd("n",ExpiredMinutes,CurrentTime)
dd=Day(ExpireTime)
mm=Month(ExpireTime)
yy=Year(ExpireTime)
hh=Hour(ExpireTime)
nn=Minute(ExpireTime)
ss=Second(ExpireTime)
Select Case mm
       Case 1 MName  = "Jan"
       Case 2 MName  = "Feb"
       Case 3 MName  = "Mar"
       Case 4 MName  = "Apr"
       Case 5 MName  = "May"
       Case 6 MName  = "Jun"
       Case 7 MName  = "Jul"
       Case 8 MName  = "Aug"
       Case 9 MName  = "Sep"
       Case 10 MName = "Oct"
       Case 11 MName = "Nov"
       Case 12 MName = "Dec"
End Select
Wday=Weekday(ExpireTime)
Select Case Wday
       Case 1 DName="Sunday"
       Case 2 DName="Monday"
       Case 3 DName="Tuesday" 
       Case 4 DName="Wednesday" 
       Case 5 DName="Thursday" 
       Case 6 DName="Friday"
       Case 7 DName="Saturday" 
End Select
ExpireAfterMinute=DName & ", "& dd & "-" & MName & "-" & yy & " " & hh & ":" & nn & ":" & ss & " GMT"  
'Friday, 31-Dec-2002 23:59:59 GMT
End Function

'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧Links
Function Links(Url1,Url2)
Dim Res
If Trim(Url1)<>"" Then Res="<a href='" & Url1 & "'>" & Url1 & "</a> "
If Trim(Url2)<>"" Then Res=Res & "<a href='" & Url2 & "'>" & Url2 & "</a> "
Links=Res
End Function
Function MailTo(MailAddress)
MailTo="<a href='mailto:" & MailAddress & "'>" & MailAddress & "</a>"
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧IsEmail
Function IsEmail(byVal mailaddress)
	Dim tmp, x, y, bErr, tmp2, objReg
	Dim objMatch, z, i
	bErr = False
	tmp = Trim( mailaddress )
	tmp = CStr( mailaddress )
' minimum 6 characters...
	if Len(tmp) < 6 then
		IsEmail = False
		Exit Function
	end if
' need an @ but only 1 is allowed
	If instr(tmp, "@") then
		x = instr(tmp, "@")
		y = instr(x + 1, tmp, "@")
		On Error Resume Next
		y = CLng(y)
		If Err Then bErr = True Else bErr = False
		On Error GoTo 0
		If bErr Then
			IsEmail = False
			Exit Function
		End If
		if y <> 0 then
			IsEmail = False
			Exit Function
		end if
	Else
		IsEmail = False
		Exit Function
	End If
' needs to have at least 2 characters (letters) after the . (dot)
	z = InStr( tmp, "." )
	tmp2 = Right( tmp, Len(tmp) - z )
	Set objReg = New RegExp
	With objReg
		.Global = True
		.IgnoreCase = True
		.Pattern = "[A-Z][A-Z]"
		Set objMatch = .Execute(tmp2)
	End With
	If objMatch.Count = 0 then
		IsEmail = False
		Exit Function
	End If
	Set objMatch = Nothing
	Set objReg = Nothing
' check for illegal characters
	For i = 1 to Len(tmp)
		tmp2 = Mid( tmp, i, 1 )
		Select Case tmp2
			Case "(", ")", ";", ":", ",", "/", "'", chr(34), _
			     "~", "`", "!", "#", "$", "%", "^", "&amp;", "*", _
			     "+", "=", "[", "]", "{", "}", "|", "\", "?", _
			     " ", "&lt;", "&gt;"
				IsEmail = False
				Exit Function
			Case Else
		End Select
	Next
' if an address makes it through, it's an email address
	IsEmail = True
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧delDelimiter
Function DelImportantChars(str)
Dim Rez
Rez=str & "          "
Rez=Replace(Rez,vbCrLf,"<br>")
Rez=Replace(Rez,vbLf," ")
Rez=Replace(Rez,vbCr," ")
DelImportantChars=Rez
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧delDelimiter
Function DelBreaks(str)
Dim Rez
Rez=str & "          "
Rez=Replace(Rez,vbCrLf," ")
Rez=Replace(Rez,vbLf," ")
Rez=Replace(Rez,vbCr," ")
Rez=Replace(Rez,"  "," ")
Rez=Replace(Rez,"  "," ")
Rez=Replace(Rez,"  "," ")
DelBreaks=Rez
End Function
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 MsgError
Sub MsgError(Title, Text)
SendHeader Title
Send "<center>"
Send "<font class='error'>"
Send Text
Send "</center>"
SendFooter
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 MsgInfo
Sub MsgInfo(Title,Text)
SendHeader Title
Send "<center>"
Send "<font class='head'>"
Send Text
Send "</font>"
Send "</center>"
SendFooter
End Sub


'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 FormLogIn
Sub LogInForm(RefMessage)
SendHeader "Log In"
Send "<div align='center' valign='center'><center>"
Send "<form action='" & sThisASP & "'  method='post'>"
Send "<table border='1' cellpadding='0' cellspacing='5'>"
Send "<tr>"
Send "<td align='right'>UserName</td>"
Send "<td><input type='text' name='UserName' size='20'></td>"
Send "</tr>"
Send "<tr>"
Send "<td align='right'>PassWord</td>"
Send "<td><input type='password' name='PassWord' size='20'></td>"
Send "</tr>"
Send "<tr>"
Send "<td align='center' colspan='2'>"
Send "<input type='submit' name='Submit' value='Log In'>"
Send "<input type='hidden' name='Action' value='Login'>"
Send "</td>"
Send "<tr>"
Send "<td align='center' colspan='2'>"
Send RefMessage
Send "</td>"
Send "</tr>"
Send "</table>"
Send "</form>"
Send "</center></div>"
SendFooter
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧LogIn()
Sub LogIn(RefUserName,RefPassWord)
Dim SetKeyRez
OpenUsersDataBase "SELECT * FROM Users WHERE UserName='" & RefUserName & "' AND PassWord='" & RefPassWord & "';",10
If UsersRS.EOF=True AND UsersRS.BOF=True Then
   MsgError "Access denied", "Access denied! <br>User with specified name and/or password not found."
   Exit Sub
End If
If UCase(UsersRS.Fields("Status").Value)<>"ACTIVATED" Then
   MsgError "Access denied", "Access denied! <br>User not have status ""Activated""."
   Exit Sub
End If
If UsersRS.Fields("IsAdmin").Value<>True Then
   MsgError "Admin denied", "Amin denied! <br>Specified user is not an administrator."
   Exit Sub
End If
SetKeyRez = NewKey
UsersRS.Fields("SKey").Value           = SetKeyRez
UsersRS.Fields("LoginTimeStamp").Value = Now
UsersRS.Update

Send "<META HTTP-EQUIV='Set-Cookie' CONTENT='" & sCookieName & "=" & SetKeyRez & ";PATH=/;EXPIRES=" & ExpireAfterMinute(1440) & "'>"
MsgInfo "LogIn Ok","LogIn Ok! Please select any commands from menu!"
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧LogIn()
Sub LogOut(RefKey)
Dim SetKeyRez
OpenUsersDataBase "SELECT * FROM Users WHERE SKey='" & RefKey & "';",10
If UsersRS.EOF=True AND UsersRS.BOF=True Then
   MsgError "Uknown key", "User with identification key not found.<br>Please make log in!"
   Exit Sub
End If
SetKeyRez = NewKey
UsersRS.Fields("SKey").Value           = SetKeyRez
UsersRS.Update
CloseUsersDataBase
MsgInfo "Log out Ok","Log out Ok!<br>Registration data was deleted from database.<br> Thanks!"
End Sub

'____________________________________________________SendHeader
Sub SendHeader(TitleMessage)
Dim Sp
If GetParam("Menu")="Left" Then Sp = "colspan='2'"
Send "<html>"
Send "<head><title>" & sNewsTitle & " - " & TitleMessage & "</title>"
Send  sStyle
Send "</head>" & vbCrLf
Send "<body text='" & ColorTonB & "' link='" & ColorTonB & "' vlink='" & ColorTonB & "' "
Send " alink='" & ColorTonB & "' bgcolor='#00007d' topmargin='0' leftmargin='0' marginwidth='0' marginheight='0'  background='' bgproperties='fixed'>"
Send vbCrLf
Send "<div align='center'>"
Send "<center>"
Send "<table width='100%' height='100%' border='0'  cellspacing='0' cellpadding='0'>"
Send "<tr><td align='center' valign='top' "& Sp & ">"
Send "<table  width='100%' align='center' border='0' bordercolor='" & ColorTonB & "'  cellspacing='0' cellpadding='0'>"
Send "<tr >"
Send "<td valign='top' bgcolor='" & ColorTonB & "' bordercolor='" & ColorTonB & "' width='90%' align='center'>"
Send "<p class='head' align='center'><font color='#e9c10a'>" & sNewsTitle & " - " & TitleMessage & "</font></p></td>"
Send "<td bgcolor='" & ColorTonB & "' bordercolor='" & ColorTonB & "' align='right' valign='top' width='10%'>"
Send "<a href='javascript:history.back();'>" & _
"<img src='" & sImgLoc & "but_back_on_blue.gif' width='16' height='16' border='0' alt='Go back!'></a> " & _
"<a href='" & sThisASP & "?Action=Start'>" & _
"<img src='" & sImgLoc & "but_compas_on_blue.gif'  width='16' height='16' border='0' alt='News start menu!'></a>"
Send "</td>"
sEND "</tr></table>"
Send "<tr>"
If GetParam("Menu")="Left" Then
Send "<td align='center' valign='top'>" & LeftMenu & "</td>"
End If
Send "<td align='center' valign='top'>"
Send "<div align='center'><center>"
Send vbCrLf
End Sub
'------------------------------------------------------------LeftMenu
Function LeftMenu
Dim R 
R = "<div align='center'>"
R = R & "<table width='150' border='0 cellpadding='0' bgcolor='#ffffff' cellspacing='0'>" & vbNewLine
R = R & "<tr><td>" & vbNewLine
R = R & "<a  href='http://www.belgianshop.com/'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianShopEnter.gif' border='0' alt='BelgianShop.com enter to shop' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/News/BShopNews.asp'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianShopNews.gif' border='0' alt='BelgianShop news' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_21.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerAbbey.gif' border='0' alt='Belgian Beers: Abbey' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_22.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerTrappists.gif' border='0' alt='Belgian Beers: Trappists' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_23.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerLambic.gif' border='0' alt='Belgian Beers: Lambic and Fruit' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_24.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerWhite.gif' border='0' alt='Belgian Beers: White' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_25.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerPils.gif' border='0' alt='Belgian Beers: Pils' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_27.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerSpecial.gif' border='0' alt='Belgian Beers: Special' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_29.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerSeason.gif' border='0' alt='Belgian Beers: Season' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_59.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerNewBeers.gif' border='0' alt='Belgian Beers: New Beers' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_13.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianBeerGlasses.gif' border='0' alt='Belgian Beers: Glases' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_63.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/StephenBeaumontPack.gif' border='0' alt='Stephan Beaumont Pack' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_6.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BeerGifts.gif' border='0' alt='Beer Gifts' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_12.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/BelgianChocolate.gif' border='0' alt='Belgian Chocolate' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/shop/en-us/dept_62.html'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/GiftCertificate.gif' border='0' alt='Gift certificate' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/MassMail/MassMail.asp?Action=SubscribeEmailForm'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/WeekletterSubscribe.gif' border='0' alt='To subscribe to our free WeekLetter' width='150' height='40'></a>" & vbNewLine

R = R & "<a  href='http://www.belgianshop.com/MassMail/MassMail.asp?Action=UnsubscribeEmailForm'>" & vbNewLine
R = R & "<img src='http://www.belgianshop.com/massmail/Buttons/WeekletterUnsubscribe.gif' border='0' alt='To unsubscribe from our submission' width='150' height='40'></a>" & vbNewLine

R = R & "</td></tr></table></div>" & vbNewLine

LeftMenu = R
End Function
'____________________________________________________Send
Sub Send(OutString)
Response.Write OutString & vbCrLf
End Sub
Sub JSWrite (OutJSString)
Response.Write "document.write(""" & OutJSString & """);" & vbCrLf 
End Sub
'____________________________________________________SendFooter
Sub SendFooter
Dim Sp
If GetParam("Menu")="Left" Then Sp = "colspan='2'"
Send vbCrLf
Send "</center></div>"
Send "</td></tr>"
Send "<tr><td align='center' valign='bottom' " & Sp & ">"
Send "<table  width='100%' align='center' border='0' bordercolor='" & ColorTonB & "'  cellspacing='0' cellpadding='0'>"
Send " <tr bgcolor='" & ColorTonB & "' bordercolor='" & ColorTonB & "'>"
Send "  <td align='center' >"
Send "    <p class='copy' align='center'>" & sNewsCopyright
Send "  </td>"
Send " </tr>"
Send "</table>"
Send "  </td>"
Send " </tr>"
Send "</table>"
Send "</center></div>"
Send "</body>"
Send "</html>"
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧 CkPermissions
Function CkPermissions(RefCokie,Rights)
Dim CurrentTime, LoginTime, IsUser, IsAdmin, IsAuthor
OpenUsersDataBase "SELECT * FROM Users WHERE SKey='" & RefCokie & "';", 1
If UsersRS.EOF = True And UsersRS.BOF = True Then
   CkPermissions = False
   Exit Function
Else
   LoginTime        = UsersRS.Fields("LoginTimeStamp").Value
   sCurrentUserName = UsersRS.Fields("UserName").Value
   sCurrentUserID   = UsersRS.Fields("ID").Value
   sCurrentFullName = UsersRS.Fields("FullName").Value
   IsUser           = UsersRS.Fields("IsUser").Value
   IsAuthor         = UsersRS.Fields("IsAuthor").Value 
   IsAdmin          = UsersRS.Fields("IsAdmin").Value
   CloseUsersDataBase   
End If
If IsAdmin=True AND Rights="Admin" Then
    CkPermissions = True
    Exit Function
ElseIf IsAuthor=True AND Rights="Author" Then
    CkPermissions = True
    Exit Function
ElseIf IsUser=True AND Rights="User" Then
    CkPermissions = True
    Exit Function
End If
CurrentTime = Now
If DateDiff("n",CurrentTime,LoginTime)>1 Then
    CkPermissions=False
    Exit Function
End If
CkPermissions=False
End Function
'____________________________________________________DocumentVerify
Function DocumentVerify
Dim Res
Res=""
If Trim(sCategory)=""   Then 
     Res=Res & "<li>It is necessary to type a name of a category," & _
     " where to place the ready document. We recommend to click the name" & _
     """Category"" and receive the list already of known categories!</li>"
End If
If Len(sContent)<2     Then 
    Res=Res & "<li>""Document complete content !""." & _
    " Describe this field in more details, please!</li> "
End If
If IsMyDate(sPublicationDate)<> True Then
    Res=Res & "<li>""Publication date !""." & _
    " The date format error please use format ""DD.MM.YYYY""!</li> "
End If
If (Trim(sEmail) <> "") And (Not iSEmail(sEmail))  Then 
                        Res=Res & "<li>Not valid a e-mail address. Enter other, please!</li>"
End If
If (Trim(sLink1) <> "") And LCase(Left(sLink1,5))<>"http:"  Then 
                        Res=Res & "<li>It is necessary that the ""links"" began by the letters ""http:""  Retype it, please!</li>"
End If
If (Trim(sLink2) <> "") And LCase(Left(sLink2,5))<>"http:"  Then 
                        Res=Res & "<li>It is necessary that the ""links"" began by the letters ""http:""  Retype it, please!</li>"
End If
If Res<>"" Then
         DocumentVerify="" & _
         "<p align='center' class='error'>Detected ERRORS</p>"& _
         "<table border='0' align='center' width='70%'>"& _
         "<tr><td>"& _
         "<ol>" & Res & "</ol>"& _
         "</td></tr></table>"
 Else
         DocumentVerify=True
 End If
End Function
'____________________________________________________ PublishEvent
'Recived data from publisher check and add to database if ok.
Sub DocumentSave(RefDocumentID,SaveAsNew)
Dim CheckData

CheckData=DocumentVerify
If CheckData<>True Then 
     MsgError "Errors", CheckData
     Exit Sub
End If

If SaveAsNew = True Then
    sSQL = "SELECT * FROM Documents ORDER BY ID DESC;"
Else
    sSQL = "SELECT * FROM Documents WHERE ID=" & RefDocumentID & " ORDER BY ID;"
End If
OpenNewsDataBase sSQL,1
If SaveAsNew = True Then
    NewsRS.AddNew 
End If
NewsRS.Fields("Status").Value      ="Public"
NewsRS.Fields("AuthorName").Value  =sUserName & " "
NewsRS.Fields("Description").Value =sDescription & " "
NewsRS.Fields("Content").Value     =sContent & " "
NewsRS.Fields("Title").Value       =sTitle & " "
NewsRS.Fields("Link1").Value       =sLink1 & " "
NewsRS.Fields("Link2").Value       =sLink2 & " "
NewsRS.Fields("Language").Value    =sLanguage & " "
NewsRS.Fields("Email").Value       =sEmail & " "
NewsRS.Fields("Category").Value    =sCategory & " "
NewsRS.Fields("TimeStamp").Value   =MyDate2Date(sPublicationDate)


NewsRS.Update
If SaveAsNew = True Then
    NewsRS.Requery
    RefDocumentID            =NewsRS.Fields("ID")
End If
CloseNewsDataBase
If SaveAsNew = True Then
    MsgInfo "Publish article","Article was published under ID " & RefDocumentID
Else
    MsgInfo "Update article","Article under ID " & RefDocumentID & " was updated!" 
End If
End Sub
'____________________________________________________ DocumentStatusSet
Sub DocumentStatusSet(RefID, RefStatus)
If IsNumeric(RefID)=False Then
    MsgInfo "Error ID", "Wrong ID, please verify article ID."
    Exit Sub
End If
sSQL = "SELECT * FROM Documents WHERE ID=" & RefID & ";"
OpenNewsDataBase sSQL, 1
If NewsRS.BOF And NewsRS.EOF Then
    MsgInfo "Record not found", "Record under code " & sID & " not found."
    Exit Sub
End If
NewsRS.Fields("Status").Value      = RefStatus
NewsRS.Update
CloseNewsDataBase
MsgInfo "Set status","Status for article under ID " & RefID & " set as " & RefStatus
End Sub
'覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧覧ClearDeleted
Sub DocumentDelete(RefID)
sSQL = "DELETE * FROM Documents WHERE ID="& RefID &";"
OpenNewsDataBase sSQL, 1
MsgInfo "Delete article","Article under ID " & RefID & " was deleted from database!"
End Sub
'____________________________________________________SelectorCategory
Function SelectorCategory(SelectedItem)
Dim R, S, C, Cnt
sSQL = "SELECT Count(*) AS Cnt, Category FROM Documents GROUP BY Category;"
OpenNewsDataBase sSQL,100
If NewsRS.EOF=True AND NewsRS.BOF=True Then
    SelectorCategories="Empty Category fields"
    Exit Function
End If
R ="<nobr><select name='Category'>" & vbNewLine
Do While Not NewsRS.EOF
C   = NewsRS.Fields("Category").Value
Cnt = NewsRS.Fields("Cnt").Value
If InStr(1,SelectedItem,C)>0 Then 
     S=" selected "
Else
     S=""
End If
If Trim(C)<>"" Then
R = R & "<option value='" & C & "'" & S & ">"
R = R & C & " (" & Cnt & " articles)</option>" & vbNewLine
End If
NewsRS.MoveNext
Loop
R = R & "<option value='Other'>Other (type in next field -->)</option>"
R = R & "</select>"
R = R & "<input type='text' name='CategoryOther' size='20'></nobr>" 
SelectorCategory = R & vbNewLine
CloseNewsDataBase
End Function
'____________________________________________________DocumentEditor

Sub DocumentEditor(RefID,OpenBlankEditor)
If OpenBlankEditor <> True Then
sSQL = "SELECT * FROM Documents WHERE ID=" & sID & ";"
OpenNewsDataBase sSQL, 1
If NewsRS.BOF And NewsRS.EOF Then
   MsgError "Record not found", "Record under code " & sID & " not found."
   Exit Sub
End If
sDescription   =NewsRS.Fields("Description")
sContent       =NewsRS.Fields("Content")
sTitle         =NewsRS.Fields("Title")
sLink1         =NewsRS.Fields("Link1")
sLink2         =NewsRS.Fields("Link2")
sLanguage      =NewsRS.Fields("Language")
sEmail         =NewsRS.Fields("Email")
sTimeStamp     =NewsRS.Fields("Timestamp")
sCategory      =NewsRS.Fields("Category")
CloseNewsDataBase
End If
SendHeader "Editor, article: " & sTitle
Send "<br>"
Send "<table width='90%' border='1' bordercolor='#00007d' cellspacing='0' cellpadding='0'>"
Send "<tr bgcolor='#00007d' bordercolor='#00007d'>"
Send "<td>"
Send "        <div align='center'>"
Send "        <center>"
Send "         <form method='post' action='" & sThisASP & "' name='pb'>"
Send "         <table width='80%' border='0' cellpadding='0' cellspacing='0'>"
Send "         <tr align='center'>"
Send "          <td align='center'>Category !<br>"
Send "          " & SelectorCategory(sCategory) & "</td>"
Send "          <td align='center'>Language!<br><input type='text' name='Language' size='10' value='English'></td>"
Send "          <td align='center'>Pub. date !<br><input type='text' name='PublicationDate' size='12'value='" & DateFormat(Now,"DD.MM.YYYY") & "'></td>"

Send "          </tr>"
Send "         </table>"
Send "         <table width='98%' border='0' cellpadding='0' cellspacing='0'>"
Send "          <tr><td align='center'>"
Send "               Document title (will be displayed by navigator) !"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <input type='text' name='Title' size='80' value='" & sTitle & "'>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               Brief document description (head lines, 15-20 words about the document)!"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <textarea rows='2' name='Description' cols='80'>" & sDescription & "</textarea>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               Document complete content!"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <textarea rows='16' name='Content' cols='80'>" & sContent & "</textarea>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               Author's e-mail!"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <input type='text' name='Email' size='80'  value='" & sEmail & "'>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               Link(s), URL to other documents  (not required)."
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <input type='text' name='Link1' size='80' value='" & sLink1 & "'>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <input type='text' name='Link2' size='80' value='" & sLink2 & "'>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "              <input type='reset'  value='Reset' name='Reset'>"
If OpenBlankEditor = False Then
Send "              <input type='submit' value='Update document' name='Submit'> "
Send "              <input type='hidden' value='UPDATE' name='Action'> "
Send "              <input type='hidden' value='" & RefID & "' name='ID'> "
Else
Send "              <input type='submit' value='Publis document' name='Submit'> "
Send "              <input type='hidden' value='PUBLISH' name='Action'> "
End If
Send "           </td>"
Send "          </tr>"
Send "         </table>"
Send "        </form>"
Send "       </center>"
Send "      </div>"
Send "     </td>"
Send "    </tr>"
Send "</table>"
Send "<br>"
SendFooter
End Sub


Sub SendPublisherSimple
SendHeader "News publisher (simple form)"
Send "<br>"
Send "<table width='90%' border='1' bordercolor='#00007d' cellspacing='0' cellpadding='0'>"
Send "<tr bgcolor='#00007d' bordercolor='#00007d'>"
Send "<td align='center'>"
Send " <form method='post' action='" & sThisASP & "' name='pb'>"
Send " <table width='40%' border='0' cellpadding='0' cellspacing='0'>"
Send "         <tr align='center'>"
Send "          <td align='center'>"
Send "          <a href='" & sThisASP & "?Action=Categories' target='cat'>Category !</a><br>"
Send "                                                  <input type='text' name='Category' value='"& sCategory &"' size='20'></td>"
Send "          <td align='center'>Language!<br><input type='text' name='Language' size='10' value='English'></td>"
Send "          <td align='center'>Pub. date !<br><input type='text' name='PublicationDate' size='12' value='" & DateFormat(Now,"DD.MM.YYYY") & "'></td>"
Send "          </tr>"
Send "</table>"
Send "<table width='98%' border='0' cellpadding='0' cellspacing='0'>"
Send "          <tr>"
Send "           <td align='center'>"
Send "               Document complete content!"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "               <textarea rows='16' name='Content' cols='80'></textarea>"
Send "          </td></tr>"
Send "          <tr><td align='center'>"
Send "              <input type='submit' value='Publish document as news' name='Submit'><input type='reset'  value='Reset' name='Reset'><br>"
Send "              <input type='button' value='Using the complete form' name='Normal' "
Send "               onClick='javascript:Go(""" & sThisASP & "?Action=NewDocument"");'><br>"
Send "              <script language='javascript'>"
Send "               function Go(To){document.location=To;};"
Send "              </script>"
Send "              <input type='hidden' value='PUBLISH' name='Action'> "
Send "              </nobr>"
Send "           </td>"
Send "          </tr>"
Send "  </table>"
Send "  </form>"
Send "</td>"
Send "</tr>"
Send "</table>"
Send "<br>"
SendFooter
End Sub
'____________________________________________________
Sub SendStart
Dim Tmp
SendHeader "Start page"
Tmp="<p>&nbsp;</p><p align='center'>"
Tmp=Tmp & "<nobr>[<a href='" & sThisASP & "?Action=ListAll'> View available news </a>]</nobr><br>   "
Tmp=Tmp & "<nobr>[<a href='" & sThisASP & "?Action=ListBrief'> View available news in brief </a>]</nobr>    "
Send Tmp
SendFooter
End Sub
'____________________________________________________ Start
Sub SendStartAdvance
Dim Tmp
SendHeader "Advance search news"
Send "<form action='" & sThisASP &  "' method='post' id=form1 name=form1>"
Send "<nobr>Category:<select name='Category'>"
Send "<option selected value=''>Select category of news</option>"
sSQL = "SELECT DISTINCT Category FROM Documents WHERE Category<>''"
Set NewsCN = Server.CreateObject("ADODB.Connection")
NewsCN.Open sNewsString
Set NewsRS = Server.CreateObject("ADODB.Recordset")
NewsRS.Open sSQL, NewsCN, adOpenKeyset, adLockPessimistic, adCmdText
Do While Not NewsRS.EOF
Send "<option value='" & NewsRS.Fields("Category")& "'>" & NewsRS.Fields("Category") & "</option>"
NewsRS.MoveNext
Loop
Send "</select>"
Set NewsRS = Nothing
NewsCN.Close
Set NewsCN = Nothing
Send " and Language:<select name='Language' size='1'>"
Send "<option value='RUSSIAN'>Russian</option>"
Send "<option selected value='ENGLISH'>English</option>"
Send "<option value='FRACE'>France</option>"
Send "<option value='SPANISH'>Spanish</option>"
Send "<option value='DEUTSCH'>Deutsch</option>"
Send "</select> "
Send "<input type='Submit' name='Submit' value='Go'>"
Send "<input type='Hidden' name='Action' value='ListAll'>"
Send "</nobr></form><br>"
Tmp="<p align='center'>"
Tmp=Tmp & "<nobr>[<a href='" & sThisASP & "?Action=ListAll'> View available news </a>]</nobr>   "
Tmp=Tmp & "<nobr>[<a href='" & sThisASP & "?Action=ListBrief'> View available news in brief </a>]</nobr>   "
Tmp=Tmp & "</p>"
Send Tmp
SendFooter
End Sub
'____________________________________________________ SendAllNews
Sub SendAllNews(Cat,Lng)
Dim TotalArticles
Dim CurrentColor
Dim CurrentCorner
Dim Index3
Dim d1, d2, d3
Dim q1
Dim str1
Dim Pg

OpenNewsDataBase "SELECT Count(*) AS Cnt FROM Documents WHERE Status LIKE 'Pub%';",1
TotalArticles = NewsRS.Fields("Cnt").Value
CloseNewsDataBase

SetLocale("fr")

SendHeader "All available news (" & TotalArticles & " articles)"

If sDateFrom<>"" AND Not IsDate (sDateFrom) Then 
 Send "<div align='center'><center>"
 Send "<table width='100%' border='1' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
 Send "<tr bordercolor='" & ColorTon0 & "' bgcolor='" & ColorTon0 & "'><td align='center'>"
 Send "From Date format is incorrect!"
 Send "</tr></td></table>"
 Send "</center></div>"
 Exit Sub
End If

If sDateTo<>"" AND Not IsDate (sDateTo) Then 
 Send "<div align='center'><center>"
 Send "<table width='100%' border='1' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
 Send "<tr bordercolor='" & ColorTon0 & "' bgcolor='" & ColorTon0 & "'><td align='center'>"
 Send "To Date format is incorrect!"
 Send "</tr></td></table>"
 Send "</center></div>"
 Exit Sub
End If


If sDateFrom<>"" AND IsDate(sDateFrom) Then 
 d1 = Day (sDateFrom)
 d2 = Month (sDateFrom)
 d3 = Year (sDateFrom)
 sDateFrom =  d2 & "/" & d1 & "/" & d3 & " 00:00:00" 
End If

If sDateTo<>"" AND IsDate(sDateTo) Then 
 d1 = Day (sDateTo)
 d2 = Month (sDateTo)
 d3 = Year (sDateTo)
 sDateTo =  d2 & "/" & d1 & "/" & d3  & " 23:59:59" 
End If

str1 = ") "

sSQL = "SELECT * FROM Documents WHERE (Status='Public' "


If sSearchString<>"" Then 
 str1 = ""
 q1  = Split (sSearchString, " ")
 sSQL = sSQL & ") AND ("

 For i = lBound(q1) to uBound(q1)
  If i<>uBound(q1) Then
   sSQL = sSQL & " Title LIKE '%" & q1(i) & "%' OR "
  End if 
 Next 
 For i = lBound(q1) to uBound(q1)
  If i<>uBound(q1) Then
   sSQL = sSQL & " (Content LIKE '%" & q1(i) & "%') AND "
  Else
   sSQL = sSQL & " (Content LIKE '%" & q1(i) & "%') "
  End if 
 Next 
  sSQL = sSQL & ") "
End If 

 
If (sDateFrom<>"" OR sDateTo<>"") AND sSearchString="" Then
 str1 = "" 
 sSQL = sSQL & ") "
End If
sSQL = sSQL & str1
  
If Trim(Cat)<>"" Then sSQL = sSQL & "AND Category='" & Cat & "' "
If Trim(Lng)<>"" Then sSQL = sSQL & "AND Language='" & Lng & "' "

If sDateFrom<>"" AND sDateTo="" Then
 sSQL = sSQL & " AND TimeStamp>=#" & sDateFrom & "#"
ElseIf sDateFrom="" AND sDateTo<>"" Then
 sSQL = sSQL &  " AND TimeStamp<=#" & sDateTo & "#"
ElseIf sDateFrom<>"" AND sDateTo<>"" Then
 sSQL = sSQL &  " AND TimeStamp>=#" & sDateFrom &"# AND TimeStamp<=#" & DateTo & "#"
End if
sSQL=sSQL & " Order By Timestamp DESC"

Send "<form action='" & sThisASP & "' method='post' style='display:inline'>"
Send "<input type='hidden' name='Command' value='ViewSearchNews'>"
Send "<div align='center'><center>"
Send "<b>Searching through the news: </b><br>"
Send "<table width='60%' border='0' cellspacing='0' cellpadding='0'>"
Send "<tr><td align='center'>Keyword:</td>"
Send "<td align='center'>Date From:</td>"
Send "<td align='center'>Date To:</td>"
Send "<td align='center'>&nbsp;</td>"
Send "</tr>"
Send "<tr><td  align='center'>"
Send "<input type='text' name = 'SearchString' value='" & sSearchString & "'></input>"
Send "</td>"
Send "<td align='center'>"
Send "<input type='text' name = 'DateFrom' size='12' maxlength='10'></input>"
Send "</td>"
Send "<td align='center'>"
Send "<input type='text' name = 'DateTo' size='12' maxlength='10'></input>"
Send "</td>"
Send "<td align='center'>"
Send "<input type='submit' name='Submit'  value='Get the news' class='ButtonType'>"
Send "</td>"
Send "</tr>"

Send "</table>"
Send "</center></div><br>"
Send "</form>"

sSQL=sSQL & ";"
OpenNewsDataBase sSql, sPageSize
sPageCount = NewsRS.PageCount

If iSNumeric(sPage) Then sPageCurrent = CInt(sPage)
If sPageCurrent > sPageCount Then sPageCurrent = sPageCount
If sPageCurrent < 1 Then sPageCurrent = 1
If sPageCount = 0 Then
  Send "<div align='center'><center>"
  Send "<table width='100%' border='1' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
  Send "<tr bordercolor='#00007d' bgcolor='#00007d'><td align='center'>"
  Send "No documents found!"
  Send "</tr></td></table>"
  Send "</center></div>"
Else
  NewsRS.AbsolutePage = sPageCurrent
  Send "<div align='center'><center>"
  CurrentColor=ColorTon2
  Send "<table width='98%' border='0' cellspacing='0' cellpadding='0'>"
  Send "<tr><td colspan='3' align='center'>"
  Send "<b>Click on news in order to get the full article</b>"
  Send "</td></tr>"
  Send "<tr><td colspan='3' align='left'>"
  Send "<b>Page " & sPageCurrent & "</b><br>"
  Send "</td></tr>"
  Send "<tr><td colpan='3'>&nbsp;&nbsp;</td></tr>"  
  sRecordsShown = 0
  Do While sRecordsShown < sPageSize And Not NewsRS.EOF
    sID            =NewsRS.Fields("ID")
    sTitle		   =NewsRS.Fields("Title") 
    sContent       =Left(NewsRS.Fields("Content"),200)
    sTimeStamp     =NewsRS.Fields("TimeStamp") 
    If CurrentColor=ColorTon1 Then
        CurrentColor=ColorTon2
        CurrentCorner="left_top_corner2.gif"
    Else
        CurrentColor=ColorTon1
        CurrentCorner="left_top_corner1.gif"
    End If
    Send "<tr bgcolor='" & CurrentColor & "'>"
    Send "<td  align='left' valign='top' width='1%'>"
    Send "<img src='" & sImgLoc & "" & CurrentCorner & "' border='0' alt='#'>"
    Send "<td><td>&nbsp;&nbsp;&nbsp;&nbsp;"
    Send "<a href='" & sThisASP & "?Action=View&ID="& sID & "' target='_self'>"
    If AfterWord(2,sContent)=Len(sContent) Then
    Send "<b>" & sTitle & "<br>" & sContent & " . . .</b>"  
    Else
    Send "<b>" & sTitle & "<br>" & Left(sContent,AfterWord(2,sContent)) & "</b>"
    Send Right(sContent,Len(sContent)-AfterWord(2,sContent)+1) & " . . . "
    End If
    Send "<br>" & DateFormat(sTimestamp,"DD MN, YYYY")
    Send "</a>"
    Send "<hr width='98%' size='1' color='" & ColorTonL & "'>"
    Send "</td>"
    Send "<td width='1%'>&nbsp;</td></tr>"
   	Send "<tr><td colpan='3'>&nbsp;&nbsp;</td></tr>"
   	sRecordsShown = sRecordsShown + 1
	NewsRS.MoveNext
  Loop
CloseNewsDataBase
Send "</tr></td></table>"

 Send "<b>Page " & sPageCurrent & "</b>"
 Send "Pages "
  For I=1 To sPageCount
       Pg="<A HREF='" & sThisASP & "?Action=ListAll&Page=" & I & ""
	       If sSearchString<>"" Then Pg = Pg & "&SearchString="& sSearchString 
	       If sDateFrom<>""     Then Pg = Pg & "&DateFrom="    & sDateFrom 
	       If sDateTo<>""       Then Pg = Pg & "&DateTo="      & sDateTo 
        Pg  =  Pg & "'> " & I & " </a>  "
   	    Send Pg
   Next
End If
Send "</center></div>"
SendFooter
End Sub
'____________________________________________________SendAllAsScript
Sub SendAllAsScript(Cat,Lng,Wid,Het)
Dim Tmp
sSQL = "SELECT * FROM Documents "
sSQL = "SELECT * FROM Documents WHERE Status='Public' "
If Trim(Cat)<>"" Then sSQL = sSQL & "AND Category='" & Cat & "' "
If Trim(Lng)<>"" Then sSQL = sSQL & "AND Language='" & Lng & "' "
sSQL=sSQL & "Order By Timestamp DESC"

Set NewsCN = Server.CreateObject("ADODB.Connection")
NewsCN.Open sNewsString
Set NewsRS = Server.CreateObject("ADODB.Recordset")
NewsRS.PageSize = sPageSize
NewsRS.CacheSize = sPageSize
NewsRS.Open sSQL, NewsCN, adOpenStatic, adLockReadOnly, adCmdText
sPageCount = NewsRS.PageCount
If iSNumeric(sPage) Then sPageCurrent = CInt(sPage)
If sPageCurrent > sPageCount Then sPageCurrent = sPageCount
If sPageCurrent < 1 Then sPageCurrent = 1
If sPageCount = 0 Then
  Send ""
Else
  NewsRS.AbsolutePage = sPageCurrent
   sRecordsShown = 0
If Wid<>"" AND Het<>"" Then
JSWrite "<applet  codebase='../' code='tscroll.class' width='" & CInt(Wid) & "' height='" & CInt(Het) & "'>"
Else
JSWrite "<applet  codebase='../' code='tscroll.class' width='600' height='20'>"
End If
JSWrite "<param name='file' value='Message'>"
JSWrite "<param name='csep' value=';'>"
JSWrite "<param name='tscr' value='3'>"
JSWrite "<param name='speed' value='1'>"
JSWrite "<param name='delay' value='50'>"
JSWrite "<param name='target' value='principal'>"
JSWrite "<param name='pause' value='5000'>"
JSWrite "<param name='StopOnMouseOver' value='1'>"
JSWrite "<param name=image value='images/malt_background_news.jpg'>"   

  Do While sRecordsShown < sPageSize And Not NewsRS.EOF
    sID            =NewsRS.Fields("ID")
    sContent       =Apletize(NewsRS.Fields("Content"),1000)
    sTimeStamp     =NewsRS.Fields("TimeStamp")
   Tmp="<param name='Message" & sRecordsShown & "' value='"
   Tmp=Tmp & Left(DateFormat(sTimestamp,"DD MN, YYYY") & " " & sContent & Space(80),80) & ". . .; "
   Tmp=Tmp & sThisASP & "?Action=View&ID=" & sID
   Tmp=Tmp & " ; 16777198 ; 128 ;"
   Tmp=Tmp & " Verdana ; 12 ;"
   Tmp=Tmp & " principal ; 1 ; 2 '>"
   JSWrite "    " & Tmp 
   	sRecordsShown = sRecordsShown + 1
	NewsRS.MoveNext
  Loop
JSWrite "</applet>"
NewsRS.Close
Set NewsRS = Nothing
NewsCN.Close
Set NewsCN = Nothing
End If
End Sub
'____________________________________________________ List Admin
Sub SendAllNewsBrief(Cat,Lng)
Dim CurrentColor
Dim CurrentCorner
SendHeader "All available news in brief"
sSQL = "SELECT * FROM Documents WHERE Status='Public' "
If Trim(Cat)<>"" Then sSQL = sSQL & "AND Category='" & Cat & "' "
If Trim(Lng)<>"" Then sSQL = sSQL & "AND Language='" & Lng & "' "
sSQL=sSQL & "Order By Timestamp DESC"
OpenNewsDataBase sSQL, sPageSizeBrief
sPageCount = NewsRS.PageCount
If iSNumeric(sPage) Then sPageCurrent = CInt(sPage)
If sPageCurrent > sPageCount Then sPageCurrent = sPageCount
If sPageCurrent < 1 Then sPageCurrent = 1
If sPageCount = 0 Then
  Send "<div align='center'><center>"
  Send "<table width='100%' border='1' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
  Send "<tr bordercolor='00007d' bgcolor='00007d'><td align='center'>"
  Send "No documents found!"
  Send "</tr></td></table>"
  Send "</center></div>"
Else
  NewsRS.AbsolutePage = sPageCurrent
    Send "<div align='center'><center>"
  CurrentColor=ColorTon2
  
  Send "<table width='90%' border='0' cellspacing='8' cellpadding='0'>"
  Send "<tr><td align='center'>"
  Send "<b>Click on news in order to get the full article</b>"
  Send "</td></tr>"
  sRecordsShown = 0
  Do While sRecordsShown < sPageSizeBrief And Not NewsRS.EOF
    sID            =NewsRS.Fields("ID")
    sContent       =NewsRS.Fields("Content")
    sTimeStamp     =NewsRS.Fields("TimeStamp")
    sLanguage      =NewsRS.Fields("Language")
    If CurrentColor=ColorTon1 Then
        CurrentColor=ColorTon2
        CurrentCorner="left_top_corner2.gif"
    Else
        CurrentColor=ColorTon1
        CurrentCorner="left_top_corner1.gif"
    End If
    Send "<tr bgcolor='" & CurrentColor & "'>"
    Send "<td>"
    Send "<table width='100%' height='1%' border='0' cellspacing='0' cellpadding='0'>"
    Send "<tr><td valign='top' align='left'><img src='" & sImgLoc & "" & CurrentCorner & "' border='0' alt='#'></td>"
    Send "<td  valign='center' align='left'><a href='" & sThisASP & "?Action=View&ID="& sID & "' target='_self'>"
    Send DateFormat(sTimestamp,"DD MN, YYYY") & "<br>" & Left(DelBreaks(sContent) & Space(40),90) & " . . .  </a>"
    Send "</td></tr></table>"
    Send "</td>"
   	Send "</tr>"
   	sRecordsShown = sRecordsShown + 1
	   NewsRS.MoveNext
  Loop

  If sPageCount>1 Then
      Send "<tr><td align='left'>"
      Send "Selected page  " & sPageCurrent & ", from " & sPageCount & ". "
      Send "Other pages "
      For I=1 To sPageCount
	         Send "<A HREF='" & sThisASP & "?Action=ListBrief&Page=" & i & "'>&nbsp;" & I & "&nbsp;</a>"
      Next
      
      Send "</td></tr>"
  End If
  Send "</table>"
End If

 Send "</tr></td></table>"
 Send "</center></div>"
CloseNewsDataBase
SendFooter
End Sub
'_____________________________________________________
Sub SendAdmin
Dim CurrentColor
Dim sNote

SendHeader "News database for administrators"
If Request.QueryString("Page") = "" Then
	sPageCurrent = 1
Else
	sPageCurrent = CInt(Request.QueryString("Page"))
End If
If Trim(sStatus)<>"" Then
sSQL = "SELECT * FROM Documents WHERE Status='" & sStatus & "' Order By Timestamp DESC"
  If sStatus="Public" Then
  sNote=", Status=Public, <a href='" & sThisASP & "?Action=Admin&Status=Archive'>List all ""Archived""</a>"
  Else
  sNote=", Status=Archive, <a href='" & sThisASP & "?Action=Admin&Status=Public'>List all ""Public""</a>"
  End If
Else
sSQL = "SELECT * FROM Documents Order By Timestamp DESC"
sNote=", Status=""Public"" and Status=""Archive"", "
sNote=sNote & "<a href='" & sThisASP & "?Action=Admin&Status=Public'>List of all ""Public""</a>, "
sNote=sNote & "<a href='" & sThisASP & "?Action=Admin&Status=Archived'>and ""Arhived""</a>"
End If

OpenNewsDataBase sSQL, sPageSizeAdmin

sPageCount = NewsRS.PageCount

If sPageCurrent > sPageCount Then sPageCurrent = sPageCount
If sPageCurrent < 1 Then sPageCurrent = 1
If sPageCount = 0 Then

  Send "<div align='center'><center>"
  Send "<table width='100%' border='1' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
  Send "<tr bordercolor='" & ColorTon0 & "' bgcolor='" & ColorTon0 & "'><td align='center'>"
  Send "No documents found!"
  Send "</tr></td></table>"
  Send "</center></div>"
Else
  NewsRS.AbsolutePage = sPageCurrent
    Send "<div align='center'><center>"
  
  Send "<table width='100%' border='0' bordercolor='000080' cellpadding='0' cellspacing='0' align='center'>"
  Send "<tr><td align='center'>"
 
  Send "<table width='98%' border='0' align='center'>"
  Send "<tr><td align='center' >"
  Send "<p align='center'>News for admin, page " & sPageCurrent & " of " & sPageCount
  Send sNote & "</p>"
  Send "</tr></td></table>"
  Send "<table width='98%' border='0' cellpadding='0' cellspacing='0'>"
  sRecordsShown = 0
  CurrentColor=ColorTon1
  Do While sRecordsShown < sPageSizeAdmin And Not NewsRS.EOF
    sID            =NewsRS.Fields("ID")
    sStatus        =NewsRS.Fields("Status")
    sDescription   =NewsRS.Fields("Description")
    sContent       =NewsRS.Fields("Content")
    sTitle         =NewsRS.Fields("Title")
    sLink1         =NewsRS.Fields("Link1")
    sLink2         =NewsRS.Fields("Link2")
    sEmail         =NewsRS.Fields("Email")
    sUserName      =NewsRS.Fields("AuthorName")
    sTimeStamp     =NewsRS.Fields("TimeStamp")
    sCategory      =NewsRS.Fields("Category")
    If CurrentColor=ColorTon1 Then
        CurrentColor=ColorTon2
    Else
        CurrentColor=ColorTon1
    End If
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Title&nbsp;</td><td>" & sTitle & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Head&nbsp;line</td><td>" & sDescription & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Content&nbsp;</td><td>" & Left(sContent,80) & " . . . </td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Published&nbsp;</td><td>" & DateFormat(sTimestamp,"DD MN, YYYY") & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Author&nbsp;</td><td>" & sUserName & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Links&nbsp;</td><td>" & Links(sLink1,sLink2) & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;E-mail&nbsp;</td><td>" & MailTo(sEmail) & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Status&nbsp;</td><td>" & sStatus & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;Category&nbsp;</td><td>" & sCategory & "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td>&nbsp;ID " & sID & "</td><td align='center'>" 
    Send "<a href='" & sThisASP & "?Action=View&ID="& sID & "' target='new'>[View document]</a>  "
    Send "<a href='" & sThisASP & "?Action=Edit&ID="& sID & "' target='new'>[Edit document]</a>  "
    Send "<a href='" & sThisASP & "?Action=Set&Status=Archived&ID="& sID & "' target='new'>[Set Status=Arhived]</a>  "
    Send "<a href='" & sThisASP & "?Action=Set&Status=Public&ID="& sID & "' target='new'>[Set Status=Public]</a>  "
    Send "<a href='" & sThisASP & "?Action=Del&ID="& sID & "' target='new'>[<font color='red'>Delete</font>]</a> "
    Send "</td></tr>"
    Send "<tr bgcolor='" & CurrentColor & "'><td colspan='2'><hr width='98%' size='1' color='" & ColorTonB & "'></td></tr>"
   	sRecordsShown = sRecordsShown + 1
	NewsRS.MoveNext
  Loop
  Send "</table>"
  Send "<table width='90%' border='0' align='center'>"
  Send "<tr><td align='center'>"
  Send "Pages "
  For I=1 To sPageCount
	Send "<A HREF='" & sThisASP & "?Action=Admin&Page=" & i & "'>&nbsp;" & I & "&nbsp;</a>"
  Next
  Send "</tr></td></table>"
  Send "</table>"
End If

 Send "</tr></td></table>"
 Send "</center></div>"
CloseNewsDataBase
SendFooter
End Sub
'____________________________________________________ Send Event
Sub SendDocument(RefDocumentID)
If sID="" Then
    MsgError "Error ID", "Please select the article ID"
    Exit Sub
End If
sSQL = "SELECT * FROM Documents WHERE ID=" & sID & ";"
OpenNewsDataBase sSQL, 1

If NewsRS.BOF And NewsRS.EOF Then
   MsgInfo "Record not found", "Record under code " & RefDocumentID & " not found."
   Exit Sub
End If 

sDescription   =DelImportantChars(NewsRS.Fields("Description"))
sContent       =DelImportantChars(NewsRS.Fields("Content"))
sTitle         =DelImportantChars(NewsRS.Fields("Title"))
sLink1         =DelImportantChars(NewsRS.Fields("Link1"))
sLink2         =DelImportantChars(NewsRS.Fields("Link2"))
sLanguage      =DelImportantChars(NewsRS.Fields("Language"))
sEmail         =DelImportantChars(NewsRS.Fields("Email"))
sTimeStamp     =DelImportantChars(NewsRS.Fields("TimeStamp"))
sUserName      =DelImportantChars(NewsRS.Fields("AuthorName"))
CloseNewsDataBase

SendHeader "Article: " & sTitle
Send "<table border='0' height='100%' width='100%'>"
Send "<tr><td valign='top' align='center'>"
Send "<div align='center'>"
Send "<center>"
Send "<table width='90%' border='1' bordercolor='#000080' cellspacing='0' cellpadding='0'>"
Send "<tr border='0' bgcolor='" & ColorTon1 & "' bordercolor='" & ColorTon1 & "'>"
Send "<td align='left' valign='top'>"
Send "<img src='Images/left_top_corner.gif' border='0' alt='A'>"
Send "</td>"
Send "<td>"
Send "  <div align='center'>"
Send "  <center>"
Send "  <table width='90%' border='0' cellspacing='0' cellpadding='0'>"
If Trim(sTitle)<>"" Then 
Send "  <tr>"
Send "  <td>"
Send "<h4 align='center'>"
Send sTitle
Send "</h4>"
Send "  </td>"
Send "  </tr>"
End If
If Trim(sDescription)<>"" Then 
Send "  <tr>" 
Send "  <td>"
Send "<h5 align='justify'>"
Send "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
Send sDescription
Send "</p>"
Send "  </td>"
Send "  </tr>"
End If
Send "  <tr>" 
Send "  <td>"
Send "<p align='justify'>"
Send "&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;"
Send sContent
Send "</p>"
Send "  </td>"
Send "  </tr>"
If Trim(sLink1)<>"" OR Trim(sLink2)<>"" Then
Send "  <tr>"
Send "  <td align='right'>"
Send "<br><br><h5 align='right'>"
Send Links(sLink1, sLink2)
Send "<br><br></h5>"
Send "   </td>"
Send "   </tr>"
End If
Send "<tr><td>&nbsp;</td></tr>"
Send "  </table>"
Send " </center>"
Send "</div>"
Send "&nbsp;&nbsp;" & DateFormat(sTimeStamp,"DD MN, YYYY") & "<br><br>"
Send "</td>"
Send "</tr>"
Send "</table>"
Send " </center>"
Send "</div>"
Send "  </td>"
Send " </tr>"
Send "</table>"
SendFooter
End Sub
'____________________________________________________ Get Variable
Sub GetVariables
sStyle                = GetTextFile(StyleFileName)
sRemoteAddress        = Request.ServerVariables("REMOTE_ADDR")
sServerName           = Request.ServerVariables("SERVER_NAME")
sScriptName           = Request.ServerVariables("SCRIPT_NAME")
sThisASP              = "http://" & sServerName & sScriptName   
sImgLoc               = "http://" & sServerName & ImagesDirectory
sCookie               = Request.Cookies(sCookieName)
sUserName             = GetParam("UserName")
sPassWord             = GetParam("PassWord")
sLanguage             = GetParam("Language") 
sCategory             = GetParam("Category")
If Left(sCategory,5)  ="Other" Then
    sCategory         = GetParam("CategoryOther")
End If 
sLink1                = GetParam("Link1")
sLink2                = GetParam("Link2") 
sTitle                = GetParam("Title")
sDescription          = GetParam("Description") 
sContent              = GetParam("Content")
sPublicationDate      = GetParam("PublicationDate")
sEmail                = GetParam("Email")
sStatus               = GetParam("Status") 
sWidth                = GetParam("Width") 
sHeight               = GetParam("Height") 
sID                   = GetParam("ID") 
sAction               = GetParam("Action")
sSearchString         = GetParam("SearchString") 
sDateTo               = GetParam("DateTo") 
sDateFrom             = GetParam("DateFrom") 
sType		               = GetParam("sType")
sUsersGroup           = GetParam("UsersGroup")
sUserID               = GetParam("UserID")
sUserName             = GetParam("UserName")
sFullName             = GetParam("FullName")
sPassWord             = GetParam("PassWord")
sPage		               = GetParam("Page")	 
End Sub
'____________________________________________________ Execute Action
Sub ExecuteAction
Dim Permissions
sAction=UCase(sAction)
Select Case sAction 
       Case ""                  SendAllNews sCategory, sLanguage
       Case "START"             SendStart
       Case "LOGIN"		           LogIn sUserName, sPassWord
       Case "LOGOUT"            LogOut sCookie
       Case "ADVANCE"           SendStartAdvance
       Case "LOGINFORM"         LogInForm ""
       Case "VIEW"              SendDocument sID
       Case "LISTALL"           SendAllNews sCategory, sLanguage
       Case "VIEWSEARCHNEWS"	   SendAllNews sCategory, sLanguage
       Case "LISTBRIEF"         SendAllNewsBrief sCategory, sLanguage
       Case "JAVASCRIPT"        SendAllAsScript sCategory, sLanguage, sWidth, sHeight
       Case Else 
            Permissions=CkPermissions(sCookie,"Admin")
            If Permissions=False Then LoginForm ""
Select Case sAction
       Case "SET"               DocumentStatusSet sID, sStatus
       Case "ADMIN"             SendAdmin
       Case "GETPUBLISHER"      SendPublisher "" 
       Case "EDIT"              DocumentEditor sID, False
       Case "NEWDOCUMENT"       DocumentEditor sID, True
       Case "NEWSIMPLE"         SendPublisherSimple
       Case "DEL"               DocumentDelete sID
       Case "PUBLISH"           DocumentSave sID, True
       Case "UPDATE"            DocumentSave sID, False
       Case "CLEAR"             ClearDeleted
       Case "STRUCTURE"         SendStructure
 Case Else MsgError "Unknown action","Unknown action!"
End Select
End Select
End Sub
'____________________________________________________Main program
GetVariables
ExecuteAction
'____________________________________________________End Main program
%>