Hejsa,
beklager mit sene svar, men ja jeg fik lavet en løsning som jeg lige ligger her :)
kan du ikke smide et svar, som tak for hjælpen :)
HPID = request.QueryString("HPID")
HPID = replace(HPID, "'","")
if HPID <> "" then
includethisintosql = " AND HPID = "&HPID&" "
end if
Response.Buffer=true
Response.Expires=-1
server.ScriptTimeout = 3600
Function funRplFileName(strTxt)
funRplFileName = funRplFolderName(strTxt)
funRplFileName = replace(funRplFileName,"/","")
End Function
Function funRplFolderName(strTxt)
funRplFolderName = replace(strTxt,"\","")
funRplFolderName = replace(funRplFolderName,":","")
funRplFolderName = replace(funRplFolderName,"*","")
funRplFolderName = replace(funRplFolderName,"?","")
funRplFolderName = replace(funRplFolderName,"""","")
funRplFolderName = replace(funRplFolderName,"<","")
funRplFolderName = replace(funRplFolderName,">","")
funRplFolderName = replace(funRplFolderName,"|","")
funRplFolderName = replace(funRplFolderName, "æ", "ae")
funRplFolderName = replace(funRplFolderName, "Æ", "ae")
funRplFolderName = replace(funRplFolderName, "ø", "oe")
funRplFolderName = replace(funRplFolderName, "Ø", "oe")
funRplFolderName = replace(funRplFolderName, "å", "aa")
funRplFolderName = replace(funRplFolderName, "Å", "aa")
end function
Sub subCreateHTMLPage(strFolder, strPostFile, strGetURL)
Dim strWebsite
Dim strPhysicalPath
Dim strWritePage
Dim objTear
Dim objFolder
Dim item
Dim objFile
Dim objTStream
Dim strRetrieval
Dim arrFolder
Dim arrFileName
'strWebsite = "
http://www.absolutmarkets.com/" 'strPhysicalPath = "d:\web\localuser\stein-graphic.com\kasper\"
strWebsite = thehttppath
strPhysicalPath = thedirectpath & "pages\"
'----------------------------------
' Replace invalid Text
strFolder = replace(strFolder,"\","/")
strFolder = funRplFolderName(strFolder)
strPostFile = funRplFileName(strPostFile)
if len(trim(strFolder))>0 then
if instr(strFolder,"/") = 1 then
strFolder = Mid(strFolder,2,len(strFolder))
end if
if instr(strFolder,"/") = len(strFolder) then
strFolder = Mid(strFolder,1,(len(strFolder)-1))
end if
end if
arrFolder = Split(strFolder,"/")
' Create folder
Set objFolder = Server.CreateObject("Scripting.FileSystemObject")
for each item in arrFolder
strPhysicalPath = strPhysicalPath & "/" & item
If objFolder.FolderExists(strPhysicalPath) = false Then
objFolder.CreateFolder(strPhysicalPath)
End If
next
Set objFolder = Nothing
'----------------------------------
'----------------------------------
strGetUrl = strWebsite & strGetURL
arrFileName = split(strPostFile,".")
strPostFile = arrFileName(0) & ".html"
strWritePage = strPhysicalPath & "/" & strPostFile
'----------------------------------
'----------------------------------
Set objTear = CreateObject("SOFTWING.ASPTear")
Response.ContentType = "text/html"
objTear.ConnectionTimeout = 3600
objTear.ForceReload = True
' response.Write(strGetUrl)
' response.End()
response.write strGetUrl
strRetrieval = objTear.Retrieve(strGetUrl, 2, "", "", "")
If Err.Number <> 0 Then
Response.Write "<b>"
If Err.Number >= 400 Then
Response.Write "Server returned error: " & Err.Number
Else
Response.Write "Component/WinInet error: " & Err.Description
End If
Response.Write "<b>"
Response.End
End If
Set objTear = Nothing
'----------------------------------
'----------------------------------
Set objFile = Server.CreateObject("Scripting.FileSystemObject")
Set objTStream = objFile.OpenTextFile(strWritePage, 2, True, 0)
objTStream.Write(strRetrieval)
Set objTStream = Nothing
Set objFile = Nothing
'----------------------------------
End Sub
set findmainpage = Conn.Execute("SELECT * FROM htmlpages where HPmainlevel = 1 AND themainstatus <> 'deleted' AND HPredirect = '' "&includethisintosql&"")
do while not findmainpage.eof
HPdirectfolders = findmainpage("HPdirectfolders")
HPdirectfolders = replace(HPdirectfolders,"\","")
HPdirectfolders = replace(HPdirectfolders,":","")
HPdirectfolders = replace(HPdirectfolders,"*","")
HPdirectfolders = replace(HPdirectfolders,"?","")
HPdirectfolders = replace(HPdirectfolders,"""","")
HPdirectfolders = replace(HPdirectfolders,"<","")
HPdirectfolders = replace(HPdirectfolders,">","")
HPdirectfolders = replace(HPdirectfolders,"|","")
HPdirectfolders = replace(HPdirectfolders,".","_")
HPdirectfolders = replace(HPdirectfolders, "æ", "ae")
HPdirectfolders = replace(HPdirectfolders, "Æ", "ae")
HPdirectfolders = replace(HPdirectfolders, "ø", "oe")
HPdirectfolders = replace(HPdirectfolders, "Ø", "oe")
HPdirectfolders = replace(HPdirectfolders, "å", "aa")
HPdirectfolders = replace(HPdirectfolders, "Å", "aa")
HPdirectfolders = replace(HPdirectfolders,"\","/")
HPdirectfilename = findmainpage("HPdirectfilename")
HPdirectfilename = replace(HPdirectfilename, " ", "_")
HPdirectfilename = replace(HPdirectfilename, "/", "_")
HPdirectfilename = replace(HPdirectfilename, "\", "_")
HPdirectfilename = replace(HPdirectfilename, "*", "_")
HPdirectfilename = replace(HPdirectfilename, "?", "")
HPdirectfilename = replace(HPdirectfilename, "&", "_")
HPdirectfilename = replace(HPdirectfilename, "%", "_")
HPdirectfilename = replace(HPdirectfilename, "æ", "ae")
HPdirectfilename = replace(HPdirectfilename, "Æ", "ae")
HPdirectfilename = replace(HPdirectfilename, "ø", "oe")
HPdirectfilename = replace(HPdirectfilename, "Ø", "oe")
HPdirectfilename = replace(HPdirectfilename, "å", "aa")
HPdirectfilename = replace(HPdirectfilename, "Å", "aa")
strSql= "UPDATE htmlpages SET HPdirectfolders = '" & HPdirectfolders & "', HPdirectfilename = '" & HPdirectfilename & "' WHERE HPID = " & findmainpage("HPID") & ""
Conn.Execute(strSql)
call subCreateHTMLPage(""&HPdirectfolders&"",""&HPdirectfilename&"","pages.asp?HPID="&findmainpage("HPID")&"")
findmainpage.MoveNext
loop
findmainpage.close
Conn.close