I have an HTA that copies a set of files to a USB stick as a part of creating a usb utilities disk. It works correctly, but the problem is that the HTA becomes unresponsive while the copy process is running.
Const FOF_CREATEPROGRESSDLG = &H0&
sub CopyFiles(driveletter) ' Copys Files to the new USB Disk showing progress bar
if radio(0).checked Then
Set objFilesys = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Shell.Application")
driveletter = ((driveletter) & "\")
Set objFolder = objshell.NameSpace(driveletter)
pathstring = objFilesys.GetAbsolutePathName("c:")
objFolder.CopyHere pathstring & "\" & "*.*", FOF_CREATEPROGRESSDLG
exit sub
elseif radio(1).checked Then
Set objFilesys = CreateObject("Scripting.FileSystemObject")
set objShell = CreateObject("shell.application")
pathstring = userselections.txtFile.value
if objFilesys.fileExists(pathstring & "\" & "kernel.sys") then
driveletter = ((driveletter) & "\")
Set objFolder = objshell.NameSpace(driveletter)
objFolder.CopyHere pathstring & "\" & "*.*", FOF_CREATEPROGRESSDLG
Else
msgbox "Error! The Specified path does not contain valid Install Files", vbcritical
end if
end if
end sub
Your problem seems to be that shell.application's CopyHere method is aynchronous -- it doesn't pause execution while you are copying.
"objFolder.CopyHere" starts and "Exit Sub" is called immediately afterwards, causing your code to lose control before CopyHere has completed.
There are some examples of making CopyHere sort of synchronous
Here's one that works for zipping, but could be adapted to your needs.
Related
I have this function made to save a PDF file in the local disk.
How do I automatically close the window after the download completed with an alert/msg box stating that the window will close?
This doesn't work:
Response.Write ("<script>alert('Save Finished'); self.close();</script>")
TheCode:
Private Function SaveLocal1(ByRef cnCon, ByVal PDFFile)
Dim ObjStream
Dim ObjFileSys
Dim Size
Dim fpath
Dim bdata
'Response.Write("<script>alert('local');</script>")
fpath = "C:\1.pdf" 'path of the file in the local server
filename = "LocalSave.pdf" 'name to be saved
'Response.Write("<script>alert('file paths');</script>")
Set ObjStream = Server.CreateObject("ADODB.Stream")
ObjStream.Open
ObjStream.Type = 1
ObjStream.LoadFromFile fpath
'Response.Write("<script>alert('server.createobject');</script>")
Response.buffer = TRUE
Response.AddHeader "Content-Disposition","attachment;filename="& filename & ";"
Response.ContentType = "application/pdf"
Set ObjFileSys = CreateObject("Scripting.FileSystemObject")
Size = ObjFileSys.GetFile(fpath).Size
bdata = ObjStream.Read(Size)
Response.BinaryWrite(bdata) 'the file will be saved in the downloads folder
Response.Write("<script>alert('Save to local finish');</script>")
ObjStream.Close
Set ObjStream = Nothing
Response.Flush
Response.End
Response.Write ("<script>alert('Save Finished'); self.close();</script>")
End Function
I suppose there are could be 2 issue in your code.
2nd issue:
Response.End
Response.Write ("<script>alert('Save Finished'); self.close();</script>")
Response.End -- is last command. That is all. "Document" completed.
The End method causes the Web server to stop processing the script and
return the current result. The remaining contents of the file are not
processed.
Change order of following comand to
Response.Write ("<script>alert('Save Finished'); self.close();</script>")
Response.End
Use response.redirect and send this page to another page, use window.close on body onload
I work in a very large, complex Intranet environment. I have run into a very unique issue that I cannot seem to resolve.
Forwarning
The technologies I mention are very outdated and that is the way is has to stay. I work in a very large enterprise and they have a ton of legacy things in place. I normally work on the modern side of things, but this got placed in my lap.
The problem:
We have a file located on our IIS 7.x server with path \serverName\shareName\wwwroot\myfile.jpg. I need to copy this file to a webDav location of a DIFFERENT web server using ASP , vbscript, or another similar web technology. For a multitude of security implications, I don't have access to the webDav UNC path, only the http: path. I am able to map this drive and access the http: location using windows explorer. I can even manually copy files, create files, and delete them. However, when I try to use a script, I get no where.
I am not great with vbscript so bare with my attempts:
Attempt 1:
Set oShell = CreateObject("WScript.Shell")
strCommand = oShell.Run("Xcopy ""sourceLocation"" ""destination location"" /S /Y", 0, True)
If strCommand <> 0 Then
MsgBox "File Copy Error: " & strCommand
Else
MsgBox "Done"
End If
Attempt 2:
<%
dim objFSOpublish
set objFSOpublish = CreateObject("Scripting.FileSystemObject")
strCurrentUNCfull = "sourcePath"
mPublishPath = "destinationPath"
objFSOpublish.CopyFile strCurrentUNCfull, mPublishPath
set objFSOpublish = nothing
%>
I have no idea if this is even possible to do without the webDav UNC path because I don't have much experience with webDav. If it is possible I have exhausted my limited knowledge in this space and need help badly. I scoured Google tirelessly trying to find a similar issue to no avail. Any and all help or direction will be greatly appreciated.
You're going to want to do something like this:
On Error Resume Next
sUrl = "YourURLHere"
sFile = "UNCPathToYourFile"
'Here we are just reading your file into an ODB
'stream so we can manipulate it
Set oStream = CreateObject("ADODB.Stream")
oStream.Mode = 3
oStream.Type = 1
oStream.Open
oStream.LoadFromFile(sFile)
'Here we are doing the upload of the oStream
'object we just created.
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.Open "POST", sUrl, False
oHTTP.SetRequestHeader "Content-Length", oStream.Size
oHTTP.Send oStream.Read(oStream.Size)
'Check for errors.
If Err = 0 Then
Wscript.Echo oHTTP.responseText
Else
Wscript.Echo "Upload Error!" & vbCrLf & Err.Description
End If
'Optionally close out our objects
oStream.Close
Set oStream = Nothing
Set oHTTP = Nothing
Here is the code I am currently using with the actual file path redacted. Let me know if you see anything that is incorrect.
The page is saved as a .ASP.
<%
sUrl = "http://server.site.com:80/subDomain/wwwroot/"
sFile = "\\server\developmentShare\wwwroot\page.htm"
'Here we are just reading your file into an ODB
'stream so we can manipulate it
Set oStream = Server.CreateObject("ADODB.Stream")
oStream.Mode = 3
oStream.Type = 1
oStream.Open
oStream.LoadFromFile(sFile)
'Here we are doing the upload of the oStream
'object we just created.
Set oHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oHTTP.Open "POST", sUrl, False
oHTTP.SetRequestHeader "Content-Length", oStream.Size
oHTTP.Send oStream.Read(oStream.Size)
'Check for errors.
If Err = 0 Then
Wscript.Echo oHTTP.responseText
Else
Wscript.Echo "Upload Error!" & vbCrLf & Err.Description
End If
'Optionally close out our objects
oStream.Close
Set oStream = Nothing
Set oHTTP = Nothing
%>
I created a VB script to recursively list all of its file and subfolder files. The script begins fine but eventually crashes in any folder containing a file with a non-printable character/s in their filenames, i.e. I see little squares when I browse the folder in Explorer. I'm not sure how to change my below error handling to continue when it finds a file with such characters.
Any advice or solutions would be appreciated. Thank you.
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFolder = "C:\Input\"
Set objFolder = objFSO.GetFolder(strFolder)
Set NewFile = objFSO.CreateTextFile("C:\Output\" & objFolder.Name & " FileList.txt", True)
Set colFiles = objFolder.Files
On Error Resume Next
For Each objFile In colFiles
NewFile.WriteLine(objFile.Path)
If Err Then
Err.Clear
End If
Next
ShowSubFolders(objFolder)
Sub ShowSubFolders(objFolder)
Set colFolders = objFolder.SubFolders
For Each objSubFolder In colFolders
Set colFiles = objSubFolder.Files
For Each objFile In colFiles
NewFile.WriteLine(objFile.Path)
If Err Then
Err.Clear
End If
Next
ShowSubFolders(objSubFolder)
Next
End Sub
NewFile.Close
Create the output text file as unicode so it can handle "non printable" characters. Third parameter of CreateTextFile.
Set NewFile = objFSO.CreateTextFile(" ... ", True, True)
EDITED
If you can not work with unicode files, then file/folder names should be converted from unicode to ansi before writing to output file. This will do the conversion
Function Unicode2Ansi( text )
Unicode2Ansi = text
With (WScript.CreateObject("ADODB.Stream"))
' Put data into stream
.Type = 2 '( adTypeText )
.Charset = "x-ansi"
.Open
.WriteText text
'Retrieve data from stream
.Position = 0
Unicode2Ansi = .ReadText
.Close
End With
End Function
And adapt code to call it NewFile.WriteLine Unicode2Ansi(objFile.Path)
Ok so i'm in the process of imaging a bunch of PC's with Fog. My boss is a stickler for setting everything manually, he won't even let me use Print servers to manage the printers...
Anyway, to make a long story short I've made great strides by writing a bunch of printer install scripts and a couple other small monitoring and other scripts.
So it's now come down to setting IP addresses, which as usual must be set static without the normal AD\DHCP ezmode.
So i was hoping to get some help with this new script i Frankensteined together.
This script "Should"
Read the hostname it's run on (Working!)
Open Computerlist.csv on a network share (Mostly working)
Parse ComputerList.csv, looking for hostname (Works usually, but is case sensative)
take the information listed for hostname, and set variables (Looses .'s when pulled)
Use those variables to configure the network connection. (problematic because of the above #4)
I'm actually pretty surprised i wasn't able to google search a script that had already been built to do this.
Here is what i've cobbled together so far, it seems to be pretty close but I'm missing something wrong and i just can't sort it out.
option explicit
Dim WshShell
Dim ObjShell
Dim objSysInfo
Dim strComputerName
Dim strFile
Set WshShell = WScript.CreateObject("WScript.Shell")
If WScript.Arguments.length = 0 Then
Set ObjShell = CreateObject("Shell.Application")
ObjShell.ShellExecute "wscript.exe", """" & _
WScript.ScriptFullName & """" &_
" RunAsAdministrator", , "runas", 1
Else
end if
'* Pulls Computer name and sets it to variable
Set objSysInfo = CreateObject( "WinNTSystemInfo" )
strComputerName = objSysInfo.ComputerName
'* Loop through CSV file, read entries, store them in an array
dim CONNECTION : set CONNECTION = CreateObject("ADODB.CONNECTION")
dim RECORDSET : set RECORDSET = CreateObject("ADODB.RECORDSET")
CONNECTION.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\carmichaels\e\PCSetup\IPchanger\;Extended Properties=""text;HDR=YES;FMT=Delimited"""
RECORDSET.Open "SELECT * FROM ComputerList.csv WHERE ComputerName = '" & strComputerName & "'", CONNECTION, 3, 3
' //// For testing \\\\
WScript.Echo RECORDSET.Source
' \\\\ For testing ////
if RECORDSET.EOF then
WScript.Echo "Record not found"
WScript.Quit
else
dim strIPAddress : strIPAddress = RECORDSET("IPAddress") & ""
dim strSubnetMask : strSubnetMask = RECORDSET("SubnetMask") & ""
dim strGateway : strGateway = RECORDSET("Gateway") & ""
dim intGatewayMetric : intGatewayMetric = 1
dim strDns1 : strDns1 = RECORDSET("Dns1") & ""
dim strDns2 : strDns2 = RECORDSET("Dns2") & ""
dim strDns3 : strDns3 = RECORDSET("Dns3") & ""
WScript.Echo strIPAddress
end if
'* Set IP address information stored in variables
Set objShell = WScript.CreateObject("Wscript.Shell")
objShell.Run "netsh interface ip set address name=""Local Area Connection"" static " & strIPAddress & " " & strSubnetMask & " " & strGateway & " " & intGatewayMetric, 0, True
objShell.Run "netsh interface ip set dns name=""Local Area Connection"" static "& strDns1, 0, True
objShell.Run "netsh interface ip add dns name=""Local Area Connection"" addr="& strDns2, 0, True
objShell.Run "netsh interface ip add dns name=""Local Area Connection"" addr="& strDns3, 0, True
Set objShell = Nothing
My problem is when i run this script, It claims line 28 chr 1 cannot open the file (on 32 bit machines).
And on a 64 Bit machine, (i run it with the following in a .bat [%windir%\SysWoW64\cscript \server\share\folder\folder\IPchanger.vbs] ) it runs through but the IP address is missing dots. ex. 10.1.0.57 appears as 10.1057 in my test window, and will fail to run again claiming the file is open or locked.
Here's the CSV file
ComputerName,IPAddress,SubnetMask,Gateway,Dns1,Dns2,Dns3
CLONE2,10.1.0.57,255.255.255.0,10.1.0.1,10.1.0.18,10.1.0.13,10.1.0.12
Dont know about your file open errors, for me line 28 is
Set objShell = WScript.CreateObject("Wscript.Shell")
But to avoid the problem with the dots, using Jet OLEDB text filter, you need to define a Schema.ini file for the csv. See http://msdn.microsoft.com/en-us/library/windows/desktop/ms709353%28v=vs.85%29.aspx
I think Jet asumes your IPs to be decimal numbers, not text.
I made a very very simple small app to take screenshot of the desktop and send to network share. About 10 PC's would have this app installed.
My idea is, that there will be one dashboard in ASP.NET, which simply shows those screenshots on the webpage. So far, easy stuff.
But, because I don't want to clog the network and send the screenshot every 1 minute, I would like to launch the .exe on the remote PC's by demand of ASP.NET user.
Unfortunately I haven't found any information (and I'm a complete ASP.NET n00b), how to launch remote executable IN the context of the remote PC (so I won't see screenshots of ASP server :) )
If there is no such possibility, please advise about other way to solve this.
Update after clarification:
Take a look at the situation from another angle:
Why don't you run a web server on the clients that host an asp.net page that triggers the capture. Then you can, from your root server, simply sent http requests to the clients and fetch the image.
You can try http://CassiniDev.codeplex.com - it supports external IP and hostnames.
And you may also consider simply embedding the CassiniDev-lib (a very simple example is shown here - Using CassiniDev to host ASP.Net in your application, that way you can use the web server as the reciever and the forms app can do whatever it wants on the client.
I am confident in this approach as I designed cassinidev with this as one of the primary use cases.
From asp.net you cannot. It is only HTML/JavaScript once it gets to the browser.
ActiveX is a possibility but it is quite painful and dated and limited. And painful.
The new way to do something like this is to deploy a .net Forms application or WPF app via Click Once.
You can also write a WPF Browser Application but getting the kind of permissions you would need would entail setting the site as full trust.
If a web page could launch an arbitrary .exe file on your machine, that would be a security disaster.
However, since these are your PCs, you can require them to install an ActiveX control of some kind that you could then embed in your ASP.NET page.
As others have said, there is really no way for ASP.Net to call out to the apps, but reversing the control flow should work OK...
I suppose you could have the grabber application running all the time on the users desktop, but have it make a call to a web service / file served by the server that contains an instruction for that instance of the app to grab a screenshot.
Something like...
App : Do I have to do anything? (GET /workinstruction.aspx)
Server : no. (server decides whether to request work, and return the result in (workinstruction.aspx)
App : (waits 1 minute)
App : Do I have to do anything?
Server : yes.
App : (takes screenshot and submits)
App : (waits 1 minute)
App : Do I have to do anything?
etc...
Thank you all for answering, those were interesting approaches to the subject.
Yet due to many factors I ended up with following solution:
Pseudo-service (Windows Forms with tray icon and hidden form) application on client PC's. It is serving as TCP server.
ASP.Net web app on the server, with TCP client function.
On request of the web user, web app is sending preformatted TCP 'activation' string to the chosen PC. Tray app is making a screenshot and sending it to predefined SMB share, available for web app to display.
Thanks again!
I've done this exact thing a few times for monitoring remote display systems. What I found was that using MiniCap.exe to capture image also took video (which was required on remote display systems).
I also used Cassini as described by Sky Sanders with an ASPX-page with the following code.
Then I just reference the page from an img src="http://computer/page.aspx?paramters". (Let me know if you need more info)
<%# Import NameSpace="System.IO" %>
<%# Import NameSpace="System.Drawing" %>
<%# Import NameSpace="System.Drawing.Imaging" %>
<%# Import NameSpace="System.Diagnostics" %>
<%
Response.Buffer = True
Response.BufferOutput = True
Dim CompressionLevel As Integer = 1
Dim compress As Integer = 1
If Not Request.Item("compress") Is Nothing Then
If IsNumeric(Request.Item("compress")) = True Then
CompressionLevel = CInt(Request.Item("compress"))
End If
End If
compress = CompressionLevel
' Resize requested?
Dim SizeX As Integer = 100
Dim SizeY As Integer = 75
If Not Request.Item("width") Is Nothing Then
If IsNumeric(Request.Item("width")) = True Then
SizeX = CInt(Request.Item("width"))
CompressionLevel = 10
End If
End If
If Not Request.Item("height") Is Nothing Then
If IsNumeric(Request.Item("height")) = True Then
SizeY = CInt(Request.Item("height"))
CompressionLevel = 10
End If
End If
Dim Region As String = ""
If Not Request.Item("region") Is Nothing Then
Region = Request.Item("region")
End If
Dim XS As Integer = 0
Dim YS As Integer = 0
Dim XE As Integer = 1023
Dim YE As Integer = 766
Try
If Region.IndexOf(",") > -1 Then
Dim Rec() As String = Region.Split(",")
If Rec.GetUpperBound(0) >= 3 Then
If IsNumeric(Rec(0)) Then XS = Rec(0)
If IsNumeric(Rec(1)) Then YS = Rec(1)
If IsNumeric(Rec(2)) Then XE = Rec(2)
If IsNumeric(Rec(3)) Then YE = Rec(3)
End If
End If
Catch : End Try
Dim FileType As String = "jpg"
Dim MimeType As String = "jpeg"
If Not Request.Item("filetype") Is Nothing Then
FileType = Request.Item("filetype")
MimeType = FileType
End If
If Not Request.Item("mimetype") Is Nothing Then
FileType = Request.Item("mimetype")
End If
Dim ImageFile As String = ""
Dim ImageThumbFile As String = ""
Dim ImageFolder As String = Server.MapPath("~/ScreenShots/")
If IO.Directory.Exists(ImageFolder) = False Then
IO.Directory.CreateDirectory(ImageFolder)
End If
' Delete files older than 30 minutes
For Each File As String In IO.Directory.GetFiles(ImageFolder)
Response.Write("File: " & File & "<br>")
If IO.File.GetCreationTimeUtc(File).AddMinutes(30) < Now.ToUniversalTime Then
IO.File.Delete(File)
End If
Next
' Find available filename
Dim tmpC As Integer = 0
While tmpC < 100
tmpC += 1
ImageFile = "ScreenShot_" & CStr(tmpC).PadLeft(5, "0") & "." & FileType
ImageThumbFile = "ScreenShot_" & CStr(tmpC).PadLeft(5, "0") & "_thumb." & FileType
If IO.File.Exists(ImageFolder & "\" & ImageFile) = False Then
' Found our filename
' Reserve it
Dim ios As IO.FileStream = IO.File.Create(ImageFolder & "\" & ImageFile)
ios.Close()
ios = Nothing
Exit While
End If
End While
' Run MiniCap
' " -capturedesktop" & _
Dim CMD As String = """" & Server.MapPath("/MiniCap.EXE") & """" & _
" -save """ & ImageFolder & "\" & ImageFile & """" & _
" -captureregion " & XS & " " & YS & " " & XE & " " & YE & _
" -exit" & _
" -compress " & CompressionLevel
If Not CMD Is Nothing Then
Dim myProcess As Process = New Process
Dim RouteFB As String
With myProcess
With .StartInfo
.FileName = "cmd.exe"
.UseShellExecute = False
.CreateNoWindow = True
.RedirectStandardInput = True
.RedirectStandardOutput = True
.RedirectStandardError = True
End With
.Start()
End With
Dim sIn As IO.StreamWriter = myProcess.StandardInput
sIn.AutoFlush = True
' Create stream reader/writer references
Dim sOut As IO.StreamReader = myProcess.StandardOutput
Dim sErr As IO.StreamReader = myProcess.StandardError
' Send commands
sIn.Write(CMD & System.Environment.NewLine)
sIn.Write("exit" & System.Environment.NewLine)
' Wait one second
'Threading.Thread.CurrentThread.Sleep(60000)
' Read all data
Response.Write(sOut.ReadToEnd)
' Kill process if still running
If Not myProcess.HasExited Then
myProcess.Kill()
End If
sIn.Close()
sOut.Close()
sErr.Close()
myProcess.Close()
End If
Response.Clear()
Response.ClearContent()
If Not Request.Item("width") Is Nothing Or Not Request.Item("length") Is Nothing Then
' Resize, making thumbnail in desired size
Dim b As Bitmap = Bitmap.FromFile(ImageFolder & "\" & ImageFile)
Dim thumb As Bitmap = b.GetThumbnailImage(SizeX, SizeY, Nothing, IntPtr.Zero)
' Jpeg image codec
Dim jpegCodec As ImageCodecInfo
' Get image codecs for all image formats
Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageEncoders()
' Find the correct image codec
For i As Integer = 0 To codecs.Length - 1
If (codecs(i).MimeType = "image/" & MimeType) Then
jpegCodec = codecs(i)
Exit For
End If
Next i
Dim qualityParam As New EncoderParameter(System.Drawing.Imaging.Encoder.Quality, compress * 10)
Dim encoderParams As New EncoderParameters(1)
encoderParams.Param(0) = qualityParam
thumb.Save(ImageFolder & "\" & ImageThumbFile, jpegCodec, encoderParams)
thumb.Dispose()
b.Dispose()
' Send thumb
Response.TransmitFile(ImageFolder & "\" & ImageThumbFile)
Else
' Send normal file
Response.TransmitFile(ImageFolder & "\" & ImageFile)
End If
Response.End()
%>