Visual Basic, .NET, ASP, VBScript
 

   
   
     

Форум - ASP и VBScript

Страница: 1 |

 

  Вопрос: Кто ставил код сапы на ASP? Добавлено: 19.12.08 01:17  

Автор вопроса:  Виталий
не чего не получаеться((( вот скрипт ошибка быстрее всего кроеться в JScript

<%

' SAPE.ru -- Интеллектуальная система купли-продажи ссылок
'
' ASP-клиент, версия 0.5.1 от 21.11.2008
'
' По всем вопросам обращайтесь на support@sape.ru
' Читайте: http://www.sape.ru/faq.php


dim sapeVersion
dim sapeUser
dim sapeHost
dim sapeUrl
dim rawFileName
dim incFileName
dim updateTimeout
dim linksClassName
dim linksPrefix
dim defaultDocument
dim linksHeader
dim linksFooter

sapeVersion = "0.5"
sapeUser = "эти данные я заполня коректно"                       ' user hash
sapeHost = "эти данные я заполня коректно"                    ' домен
sapeUrl = "http://dispenser-01.sape.ru/"        ' адрес диспенсера
rawFileName = "эти данные я заполня коректно"                    ' raw file (from sape)
incFileName = "эти данные я заполня коректно"                    ' include file with links
updateTimeout = 60                  ' время кэширования ссылок на сайте
linksHeader = "|"                    ' links header
linksFooter = "|"                    ' links footer
defaultDocument = "default.asp"     ' default site document

getLinksUpdate()


'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
sub getLinksUpdate()
dim lastUpdateTime

' init vars
if isEmpty(Application("lastUpdateTime")) then
Application("lastUpdateTime") = Now
Application("lastUpdateTimeLocked") = false
end if

' if lastUpdateTime is older than specified timeout and update process is not locked ----> update keywords cache
if ( DateDiff("n", Application("lastUpdateTime"), Now) > updateTimeout ) and ( Application("lastUpdateTimeLocked") = false )  then
Application("lastUpdateTimeLocked") = true
call getLinks()
Application("lastUpdateTime") = Now
Application("lastUpdateTimeLocked") = false
end if
end sub
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
sub getLinks()
dim responseBody
dim rawString
' get response body
responseBody = getResponseBody()
if Trim(responseBody)="" then
exit sub
end if
' save raw file
if not saveRawFile(responseBody) then
exit sub
end if
' get raw string
rawString = getRawFile()
if Trim(rawString)="" then
exit sub
end if
' save inc file
if not saveIncFile( parseRawString(rawString) ) then
exit sub
end if
end sub
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
' get raw file contents
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
function getRawFile()
on error resume next
dim fso
dim f
set fso = Server.CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(rawFileName,1)
getRawFile = f.ReadAll()
if err<>0 then
getRawFile = ""
response.write "Нет доступа на чтение файла: " & rawFileName & ". Выставите необходимые права на папку."
exit function
end if
set f = Nothing
set fso = Nothing
end function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
' save raw file
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
function saveRawFile(responseBody)
on error resume next
dim stream
set stream = Server.CreateObject("ADODB.Stream")
stream.Open()
stream.Type = 1
stream.write( responseBody )
stream.SaveToFile rawFileName,2
if err<>0 then
saveRawFile = false
response.write "Нет доступа на запись файла: " & rawFileName & ". Выставите необходимые права на папку."
exit function
end if
stream.Close()
set stream = Nothing
saveRawFile = true
end function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
' get links raw string
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
function getResponseBody()
on error resume next
dim xmlHttp, url
url = sapeUrl & "/code.php?" & "user=" & sapeUser & "&host=" & sapeHost
     set xmlHttp = Server.CreateObject("MSXML2.ServerxmlHttp")
xmlHttp.open "GET", url, false
xmlHttp.setRequestHeader "Pragma", "no-cache"
xmlHttp.setRequestHeader "Cache-Control", "no-cache, must-revalidate"
xmlHttp.setRequestHeader "Expires", "Mon, 26 Jul 1997 05:00:00 GMT"
xmlHttp.setRequestHeader "User-Agent", "SAPE_Client ASP " & sapeVersion
xmlHttp.send
if xmlHttp.status<>200 then
response.write "Не могу подключиться к серверу: " & url
getResponseBody = ""
exit function
end if
if err<>0 then
response.write "При подключении к серверу возникла ошибка: " & err.description
err.clear
getResponseBody = ""
exit function
end if
getResponseBody = xmlHttp.responseBody
set xmlHttp = nothing
end function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
function saveIncFile(strg)
on error resume next
dim fso
dim f
set fso = Server.CreateObject("Scripting.FileSystemObject")
set f = fso.OpenTextFile(incFileName,2,true)
f.Write strg
if err<>0 then
saveIncFile = false
response.write "Нет доступа на запись файла: " & incFileName & ". Выставите необходимые права на папку."
exit function
end if
f.Close
set f = Nothing
set fso = Nothing
saveIncFile = true
end function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
%>
<script language="JScript" runat=server>
//-------------------------------------------------------------------
function trim(strg)
{
return(rtrim(ltrim(strg)));
}
//-------------------------------------------------------------------
function ltrim(strg)
{
var temp = strg;
while (temp.charAt(0)==" ")
{
temp = temp.substring(1, temp.length)
}
return (temp);
}
//-------------------------------------------------------------------
function rtrim(strg)
{
var temp = strg;
while (temp.charAt(temp.length-1)==" ")
{
temp = temp.substring(0, temp.length-1)
}
return (temp);
}
//-------------------------------------------------------------------
function parseRawString(strg)
{
var s = strg;

// replace "a:13:"
s = s.replace(/a:\d{1,10}\:/gi,"");
// replace "s:13:"
s = s.replace(/s:\d{1,10}\:/gi,"");
// replace "i:13;"
s = s.replace(/i:\d{1,10}\;/gi,"");
// replace "{"
s = s.replace(/\{/g,"");
// replace "}"
s = s.replace(/\}/g,"");
// temp replace " ;"
s = s.replace(/ \;/g,"$crv1");
// temp replace "; "
s = s.replace(/\; /g,"$crv2");
// remove special characters
s = s.replace(/\r/g,"");
s = s.replace(/\n/g,"");

var cntr = -1;
var newArr = new Array();
var arr = s.split(";");
for ( var i=0;i<arr.length;i++ )
{
tmp = trim(arr[i]);
tmp = tmp.replace(/^\"/,"");
tmp = tmp.replace(/\"$/,"");
tmp = tmp.replace(/\$crv1/gi," ;");
tmp = tmp.replace(/\$crv2/gi,"; ");
if ( tmp.search(/\<a/gi)==-1 && tmp.search(/\<\/a\>/gi)==-1 )
{
cntr++;
newArr[cntr] = new Array( tmp, new Array() );
}
else
{
tmpArr = newArr[cntr][1];
tmpArr[tmpArr.length] = tmp;
newArr[cntr][1] = tmpArr;
}
}

// get delimiter and check code
var linksDelimiter = "; ";
var linksDelimiterIdx = newArr.length;
var linksCheckCode = "<\!--check code-->";
var linksCheckCodeIdx = newArr.length;
for ( var i=0;i<newArr.length;i++ )
{
if ( ( newArr[i][0] == "__sape_delimiter__" ) && ( (i+1) < newArr.length ) )
{
linksDelimiter = newArr[i+1][0];
linksDelimiterIdx = i+1;
}
if ( ( newArr[i][0] == "__sape_new_url__" ) && ( (i+1) < newArr.length ) )
{
linksCheckCode = newArr[i+1][0];
linksCheckCodeIdx = i+1;
}
}

// prepare string for output
var outputArr = new Array();
outputArr[ outputArr.length ] = "<%";
outputArr[ outputArr.length ] = "dim linksCheckUrl";
outputArr[ outputArr.length ] = "if Request.QueryString=\"\" then";
outputArr[ outputArr.length ] = "linksCheckUrl = Request.ServerVariables(\"URL\")";
outputArr[ outputArr.length ] = "else";
outputArr[ outputArr.length ] = "linksCheckUrl = Request.ServerVariables(\"URL\") & \"?\" & Request.QueryString";
outputArr[ outputArr.length ] = "end if";
outputArr[ outputArr.length ] = "select case LCase(linksCheckUrl)";
for ( var i=0;i<newArr.length;i++ )
{
if ( i != linksDelimiterIdx &&
i != linksCheckCodeIdx &&
i != linksDelimiterIdx-1 &&
i != linksCheckCodeIdx-1 &&
newArr[i][0] != ""
)
{
try
{
outputArr[ outputArr.length ] = "case LCase(\"" + newArr[i][0] + "\")";
outputArr[ outputArr.length ] = "%>" + linksHeader + newArr[i][1].join(linksDelimiter) + linksFooter + "<%";
if ( newArr[i][0].substring(newArr[i][0].length-1,newArr[i][0].length) == "/" )
{
outputArr[ outputArr.length ] = "case LCase(\"" + newArr[i][0].replace(/\"/gi,"\"\"") + defaultDocument + "\")";
outputArr[ outputArr.length ] = "%>" + linksHeader + newArr[i][1].join(linksDelimiter) + linksFooter + "<%";
}
}
catch(e){}
}
}
outputArr[ outputArr.length ] = "case else";
outputArr[ outputArr.length ] = "%>" + linksCheckCode + "<%";
outputArr[ outputArr.length ] = "end select";
outputArr[ outputArr.length ] = "%>";

return outputArr.join("\n");
}
</script>

Ответить

  Ответы Всего ответов: 4  

Номер ответа: 1
Автор ответа:
 Isage.ru



Вопросов: 3
Ответов: 38
 Профиль | | #1 Добавлено: 19.12.08 09:25
На сайте сапы есть форум и тех справка (там тебе помогут)!
А лучше пиши сайт на php. Миром признан Php и ты не отличайся!

Ответить

Номер ответа: 2
Автор ответа:
 Виталий



Вопросов: 3
Ответов: 5
 Профиль | | #2 Добавлено: 19.12.08 11:03
Isage.ru, да сайт уже готовый и ему 4 года, супорт сапе не огут не чем помочь(((
а на пхп только купил книжку и буду учить

Ответить

Номер ответа: 3
Автор ответа:
 



Администратор

ICQ: 278109632 

Вопросов: 42
Ответов: 3949
 Web-сайт: domkratt.com
 Профиль | | #3
Добавлено: 19.12.08 15:34
Ты хоть бы симптомы ошибки рассказал что ли... Или все должны кинуться ставить IIS+ASP и дебажить твой скрипт?)

Ответить

Номер ответа: 4
Автор ответа:
 Виталий



Вопросов: 3
Ответов: 5
 Профиль | | #4 Добавлено: 19.12.08 15:37
Executioner, дело в том что может кто уже ставил,
а вообще работособность скрипта определяеться выводом этой строки "<\!--check code-->"

Ответить

Страница: 1 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам