The following code:
Set fso = Server.CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(path) Then
fso.CreateFolder(path)
End If
Is producing the following error:
Microsoft VBScript runtime error '800a003a' File already exists
If I delete the folder, so that ASP is able to create it itself, it works as expected.
It's only when I manually (or using DOS MKDIR) create it that FolderExists returns false and CreateFolder throws the above error.
What's going on here?
EDIT:
The variable path contains the string C:\Windows\Temp\email_attachments\ and FolderExists seems to be returning false for directories that have been around since before the last startup.
Hi my worked code.
file_path="C:\inetpub\wwwroot\upload\2018\4"
set fso=Server.CreateObject("Scripting.FileSystemObject")
tmpArr = Split(file_path, "\")
tmpPath = tmpArr(0)
For i = 1 To UBound(tmpArr)
If Not fso.FolderExists(Server.MapPath(tmpPath)) Then
fso.CreateFolder Server.MapPath(tmpPath)
End If
tmpPath = tmpPath & "\" & tmpArr(i)
Next
Related
OK so here's the situation. I've got a classic ASP website running inside an MVC 4 application. I need the classic ASP website to be able to get a key from the appsettings section of the web.config file.
Here is the function I've got:
' Imports a site string from an xml file (usually web.config)
Function ImportMySite(webConfig, attrName, reformatMSN)
Dim oXML, oNode, oChild, oAttr, dsn
Set oXML=Server.CreateObject("Microsoft.XMLDOM")
oXML.Async = "false"
oXML.Load(Server.MapPath(webConfig))
Set oNode = oXML.GetElementsByTagName("appSettings").Item(0)
Set oChild = oNode.GetElementsByTagName("add")
' Get the first match
For Each oAttr in oChild
If oAttr.getAttribute("key") = attrName then
dsn = oAttr.getAttribute("mysite")
ImportMySite = dsn
Exit Function
End If
Next
End Function
Here is the function call code:
msn = ImportMySite("web.config", "mysite", false)
So when I call this function the value I get back is always blank or null. I'm not sure where I'm going wrong, I'm a total novice with XML so maybe I'm missing something completely obvious. I have searched the questions but couldn't find anything related to this using classic ASP.
Any help would be much appreciated.
I appreciate Connor's work. It got me well along the way to making this happen. I made some changes that I think might be helpful to others.
I did not want to have to repeat the file name for each call and I have a couple of sections in my config. This seemed more general. Also, I consolidated his changes into a for-sure working example. You can paste this into your app, change the CONFIG_FILE_PATH and get on with your life.
'******************************GetConfigValue*******************************
' Purpose: Utility function to get value from a configuration file.
' Conditions: CONFIG_FILE_PATH must be refer to a valid XML file
' Input: sectionName - a section in the file, eg, appSettings
' attrName - refers to the "key" attribute of an entry
' Output: A string containing the value of the appropriate entry
'***************************************************************************
CONFIG_FILE_PATH="Web.config" 'if no qualifier, refers to this directory. can point elsewhere.
Function GetConfigValue(sectionName, attrName)
Dim oXML, oNode, oChild, oAttr, dsn
Set oXML=Server.CreateObject("Microsoft.XMLDOM")
oXML.Async = "false"
oXML.Load(Server.MapPath(CONFIG_FILE_PATH))
Set oNode = oXML.GetElementsByTagName(sectionName).Item(0)
Set oChild = oNode.GetElementsByTagName("add")
' Get the first match
For Each oAttr in oChild
If oAttr.getAttribute("key") = attrName then
dsn = oAttr.getAttribute("value")
GetConfigValue = dsn
Exit Function
End If
Next
End Function
settingValue = GetConfigValue("appSettings", "someKeyName")
Response.Write(settingValue)
OK I found my answer.
I changed:
For Each oAttr in oChild
If oAttr.getAttribute("key") = attrName then
dsn = oAttr.getAttribute("mysite")
ImportMySite = dsn
Exit Function
End If
Next
To:
For Each oAttr in oChild
If oAttr.getAttribute("key") = attrName then
dsn = oAttr.getAttribute("value")
ImportMySite = dsn
Exit Function
End If
Next
I am using a downloaded pure ASP script to upload files. My form contains a textarea and a file upload component. It works fine when I enter regular text but it cannot handle when I copy and paste something from word having special characters. The error I am getting is:
Provider error '80070057'
The parameter is incorrect.
/forum/freeaspupload.asp, line 309
The part of my code which throws the error is:
Private Function ConvertUtf8BytesToString(start, length)
StreamRequest.Position = 0
Dim objStream
Dim strTmp
' init stream
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeBinary
objStream.Open
' write bytes into stream
StreamRequest.Position = start+1
StreamRequest.CopyTo objStream, length
objStream.Flush
' rewind stream and read text
objStream.Position = 0
objStream.Type = adTypeText
strTmp = objStream.ReadText
' close up and return
objStream.Close
Set objStream = Nothing
ConvertUtf8BytesToString = strTmp
End Function
Line 309 is the line:
strTmp = objStream.ReadText
Any idea how to fix it?
I know it's an old question but since there is no answer and I got the exact same problem and finally found a solution, I think it can be good to share it.
The problem is related to IIS version since it was working fine on IIS6 but stop to work when we moved to IIS8.5
See ReadText
By defaut ReadText parameter is -1 (adReadAll).
For some reason, this default parameter seems not working with IIS8.5. You have to put the length of the text that you want to read.
so ReadText(2000) will work fine.
Of course, you will have to figured out the maximum length or find a way to loop and read everything
By MSFT :
If NumChar is more than the number of characters left in the stream, only the characters remaining are returned. The string read is not padded to match the length specified by NumChar. If there are no characters left to read, a variant whose value is null is returned. ReadText cannot be used to read backwards.
I'm very new to VBS and experimenting with removing the read only attribute from a directory recursively.
It's removing the read only attribute for files but not for the directories. Also The files within these directories seem to have lost their associated program link and are now all showing as an unregistered file type. Any help is greatly appreciated.
Update: I can see why the files have lost their associations now. It's because the . which separates the name from the extension has been removed! Doh! Ideally I'd like to rename the filename only.
re.Pattern = "[_.]"
re.IgnoreCase = True
re.Global = True
RemoveReadonlyRecursive("T:\Torrents\")
Sub RemoveReadonlyRecursive(DirPath)
ReadOnly = 1
Set oFld = FSO.GetFolder(DirPath)
For Each oFile in oFld.Files
If oFile.Attributes AND ReadOnly Then
oFile.Attributes = oFile.Attributes XOR ReadOnly
End If
If re.Test(oFile.Name) Then
oFile.Name = re.Replace(oFile.Name, " ")
End If
Next
For Each oSubFld in oFld.SubFolders
If oSubFld.Attributes AND ReadOnly Then
oSubFld.Attributes = oSubFld.Attributes XOR ReadOnly
End If
If re.Test(oSubFld.Name) Then
oSubFld.Name = re.Replace(oSubFld.Name, " ")
End If
RemoveReadonlyRecursive(oSubFld.Path)
Next
End Sub
It seems you want to automate a repeatable action by a script. Why don't you use the attrib command to do that for you:
attrib -r "T:\Torrents\*.*" /S
You can place that in a batch file if you want to attach it to an clickable icon.
EDIT:
To run it from VBScript silently:
Set WshShell = WScript.CreateObject("WScript.Shell")
WshShell.Run "attrib -r ""T:\Torrents\*.*"" /S", 0, true)
EDIT2:
To replace everything except the last period, use a regular expression like:
filename = "my file.name.001.2012.extension"
Set regEx = New RegExp
' Make two captures:
' 1. Everything except the last dot
' 2. The last dot and after that everything that is not a dot
regEx.Pattern = "^(.*)(\.[^.]+)$" ' Make two captures:
' Replace everything that is a dot in the first capture with nothing and append the second capture
For each match in regEx.Execute(filename)
newFileName = replace(match.submatches(0), ".", "") & match.submatches(1)
Next
I have the following xml result from this link - https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov
<eveapi version="2">
<currentTime>2013-01-16 18:57:38</currentTime>
<result>
<rowset name="characters" key="characterID" columns="name,characterID">
<row name="BorisKarlov" characterID="315363291"/>
</rowset>
</result>
<cachedUntil>2013-02-16 18:57:38</cachedUntil>
</eveapi>
and I am trying to extract the characterID into asp. I am using the following code,
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.LoadXML("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
Set oRoot = oXML.selectSingleNode("//result")
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
Set oXML = Nothing
All i keep getting is the following error:
Microsoft VBScript runtime error '800a01a8'
Object required: 'oRoot'
.............
I can only assume that Set oRoot = oXML.selectSingleNode("//result") is not actually generating any data and therefore throwing up the error in the next line.
Can anyone please shed some light on my problem?
You have a few problems there.
loadXML() is for loading a block of XML as a string, not fetching from a remote server; for that, you need to use load()
when loading from a server, you need to tell it to use the ServerXMLHTTP component, and set async to false so that it waits until loaded before executing the rest of your script.
when I tried loading that XML, I got an encoding error; you will need to resolve that one way or another
when I loaded the XML directly from a string, it wouldn't parse because there is a script element containing non-XML content; that needs to be contained within a CDATA section
your XPath query is to //result, but you actually need it to be //result/rowset
This code should work once you resolve issues 3 and 4 above:
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
oXML.async = False
oXML.setProperty "ServerHTTPRequest", true
oXML.Load("https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov")
If oXML.parseError.errorCode <> 0 Then
Response.Write "<p>XML parse error: " & Server.HTMLEncode(oXML.parseError.reason) & "</p>"
Else
Set oRoot = oXML.selectSingleNode("//result/rowset")
If oRoot Is Nothing Then
response.write "Nothing!"
response.end
End If
For Each oNode In oRoot.childNodes
response.Write oNode.Attributes.getNamedItem("characterID").Text
Next
End If
Set oXML = Nothing
Edit: to get around the problem #3, and oddly also #4 (don't know why!), use this snippet to load the XML instead. For some reason, I think the code above isn't handling the gzip compressed stream correctly, but this code below does.
Set oXML = Server.CreateObject("Msxml2.DOMDocument.6.0")
Set xh = Server.CreateObject("Msxml2.ServerXMLHTTP.6.0")
xh.open "GET", "https://api.eveonline.com/eve/CharacterID.xml.aspx?names=BorisKarlov", False
xh.send
xml = xh.responseText
oXML.LoadXML xml
I have a vbscript function to create a tinyurl from a regular url.
FUNCTION GetShortURL(strUrl)
Dim oXml,strTinyUrl,strReturnVal
strTinyUrl = "http://tinyurl.com/api-create.php?url=" & strUrl
set oXml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", strTinyUrl, false
oXml.Send
strReturnVal = oXml.responseText
Set oXml = nothing
GetShortURL = strReturnVal
END FUNCTION
I have come across the problem when the tinyurl api is down or inaccessible, making my script fail:
msxml3.dll
error '80072efe'
The connection with the server was terminated abnormally
Is there a safeguard I can add to this function to prevent the error and use the long url it has..?
Many thanks in advance,
neojakey
If you want to just return strUrl if the call fails, you can use On Error Resume Next
FUNCTION GetShortURL(strUrl)
on error resume next
Dim oXml,strTinyUrl,strReturnVal
strTinyUrl = "http://tinyurl.com/api-create.php?url=" & strUrl
set oXml = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", strTinyUrl, false
oXml.Send
strReturnVal = oXml.responseText
Set oXml = nothing
'Check if an error occurred.
if err.number = 0 then
GetShortURL = strReturnVal
else
GetShortURL = strUrl
end if
END FUNCTION
Obviously, you need some kind of error handling. In general, VBScript's error handling is no fun, but for your specs - get the right thing or the default in case of any/don't care what problem - you can use a nice and simple approach:
Reduce your original function to
assignment of default value to function name (to prepare for the failures)
On Error Resume Next (to disable VBScript's default error handling, i.e. crash)
assignment of the return value of a helper function to function name (to prepare for success)
In code:
Function GetShortURL2(strUrl)
GetShortURL2 = strUrl
On Error Resume Next
GetShortURL2 = [_getshorturl](GetShortURL2)
End Function
I use [] to be able to use an 'illegal' function name, because I want to emphasize that _getshorturl() should not be called directly. Any error in _getshorturl() will cause a skip of the assignment and a resume on/at the next line (leaving the function, returning the default, reset to default error handling).
The helper function contains the 'critical parts' of your original function:
Function [_getshorturl](strUrl)
Dim oXml : Set oXml = CreateObject("Msxml2.ServerXMLHTTP.3.0")
oXml.Open "GET", "http://tinyurl.com/api-create.php?url=" & strUrl, False
oXml.Send
[_getshorturl] = oXml.responseText
End Function
No matter which operation fails, the program flow will resume on/at the "End Function" line of GetShortURL2().
Added: Comments on the usual way to do it (cf. Daniel Cook's proposal)
If you switch off error handling (and "On Error Resume Next" is just that) you are on thin ice: all errors are hidden, not just the ones you recon with; your script will do actions in all the Next lines whether necessary preconditions are given or preparations done.
So you should either restrict the scope to one risky line:
Dim aErr
...
On Error Resume Next
SomeRiskyAction
aErr = Array(Err.Number, Err.Description, Err.Source)
On Error Goto 0
If aErr(0) Then
deal with error
Else
normal flow
End If
or check after each line in the OERN scope
On Error Resume Next
SomeRiskyAction1
If Err.Number Then
deal with error
Else
SomeRiskyAction2
If Err.Number Then
deal with error
Else
...
End If
End If
That's what I meant, when I said "no fun". Putting the risky code in a function will avoid this hassle.