How to Sync 6 Laptops in network in MS Access 2010 Application with Split database [closed] - ms-access-2010

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 6 years ago.
Improve this question
i created an Application build in MS Access 2010, this create Jobs Orders, I am using split database which let me keep the tables in the server and the Front end program in the Work Station. Now, the problem is i have 6 laptops with the same application, but when the go out to the field the Laptops disconnect from network. I NEED A WAY TO SYNC TABLES WITH THE JOBS DONE when laptops come back to the office and connect to the network again.
I am Syncing pressing a button that copy files to server, delete tables locally and then copy back from server the records, but i want to find a way to Sync automatic when laptops find the network.
'*************IN THIS PART AM SENDING UPDATING SERVER AND SENDING NEW RECORDS ************
Dim x As Integer
Dim i As Integer
Dim strSQL As String
x = MsgBox("Are you Sure you want to Send to Server?????", vbOKCancel, "Are you sure?")
If x = vbOK Then
Dim intX, intY As Integer
Dim intW As Integer
Dim db As Database
Dim LSQL, SOurce, DestinaTion, fILE As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
SOurce = "O:\fieldticket\"
'DestinaTion = "\\rvfile03\Departments\Water\Common\FieldTickets\"
DestinaTion = "\\rwmain01\gis\FieldTicket\"
fILE = Dir$(SOurce & "*.one")
' Do While Len(fILE) > 0 And FSO.FileExists(DestinaTion & fILE) = True
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
fILE = Dir$(SOurce & "*.pdf")
Do While Len(fILE) > 0
If FSO.FileExists(fILE & DestinaTion) = False Then
FileCopy SOurce & fILE, DestinaTion & fILE
End If
fILE = Dir$()
Loop
Set db = CurrentDb()
' REINIT PROGRESS BAR
ProgressBarB.WIDTH = 0
Me.Repaint
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries
DoCmd.SetWarnings False
Me.Refresh
Me.Repaint
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
' ******* COUNT HOW MANY NEW RECORD ARE TRANSFERING **************************************************
intX = DCount("*", "RECORDS IN JobsOrder NOT IN JobsOrder1")
' ********** UPDATE JOBSORDER TABLE AND COUNT HOW MANY RECORDS ARE UPDATED ******************************
LSQL = "UPDATE_Jobsorder1_SERVER_WITH_Jobsorder"
db.Execute LSQL
' **************** GIVE A MESSAGE OF HOW MANY RECORDS ARE UPDATED AND TRANSFERED **********************
MsgBox CStr(db.RecordsAffected) & " RECORDS UPDATED " & intX & " NEW RECORDS WILL BE ADDED AND "
'************ new progress bar code using for command *************
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For i = 1 To colSQL.Count
strSQL = colSQL(i)
Debug.Print "Executing : " & strSQL
Call .QueryDefs(strSQL).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL.Count) * i
Me.Repaint
Next i
Call Me.Requery
DoCmd.SetWarnings True
End With
' MsgBox ("TRANSFER AND UPDATE HAS BEEN FINISHED!!!")
Me.ProgressBarA.Visible = False
Me.ProgressBarB.Visible = False
' Exit Sub
ElseIf x = vbCancel Then
Exit Sub
End If
'*******NOW I AM SENDING BACK FROM SERVER TO HANDHELD ************************
Dim y As Integer
Dim ii As Integer
Dim strSQL1, SOurce1, DestinaTion1, fIL1E As String
Beep
'x = MsgBox("Are you Sure you want to UPDATE HANDHELD?????", vbOKCancel, "Are you sure?")
'If y = vbOK Then
'If PASSWORD = "222222" Then
Dim intX1, intY1 As Integer
Dim intW1 As Integer
DoCmd.SetWarnings False
ProgressBarB.WIDTH = 0
Me.Repaint
'SOurce = "\\rvfile03\Departments\Water\Common\FieldTickets\"
'DestinaTion = "c:\mapping\"
'fILE = Dir$(SOurce & "*.one")
'Do While Len(fILE) > 0
' If Dir$(fILE) & "" = "" Then
' FileCopy SOurce & fILE, DestinaTion & fILE
' End If
' fILE = Dir$()
'Loop
' FILL IN OUR SQL QUERIES COLLECTION
Define_SQL_Queries1
DoCmd.SetWarnings False
Me.Refresh
With CurrentDb
intX1 = DCount("*", "RECORD IN Jobsorder1 not Finished")
' MsgBox (intX1 & " RECORDS WILL BE ADDED")
Me.ProgressBarA.Visible = True
Me.ProgressBarB.Visible = True
For ii = 1 To colSQL1.Count
strSQL1 = colSQL1(ii)
Debug.Print "Executing : " & strSQL1
Call .QueryDefs(strSQL1).Execute
ProgressBarB.WIDTH = (ProgressBarA.WIDTH / colSQL1.Count) * ii
Me.Repaint
Next ii
Call Me.Requery
DoCmd.SetWarnings True
End With
MsgBox ("HANDHELD UPDATE COMPLETED!!!"), vbInformation
ProgressBarA.Visible = False
ProgressBarB.Visible = False
Exit Sub
'ElseIf y = vbCancel Then
' Exit Sub
'End If
MsgBox (intX1 & " RECORDS ADDED TO HANDHELD")
'******** FINISHING THE HANADHEL UPDATING *******************

You'll need to write some code to check connectivity (On Error Resume next when connecting to the back end tables and check for an Error) and then connect to another local table if offline. Then once back in the office that code can then connect as normal and then you can upload your Jobs. Bottom line is that it'll take some VBA to do this. I can't give you a solution in code but this is the gist of it.
If you know how to code in VBA then you can really just check for a Network Folder that will be there if you're on the network. If it's not there, then you can assume you're offline. Then you will need to write more code to deal with local tables rather than linked tables.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FolderExists("[Path to Network Folder]") Then
' I'm online
Else
' I'm offline
End If

Related

GetCurrentUserName() is causing crash in MS Access 2010

I am running Windows 7 Professional. I have an MS Access frontend to an MS Access backend. The form that opens at the start of opening the frontend causes the app to crash.
Here is the code:
Private Sub Form_Open(Cancel As Integer)
Dim strMyDir As String
Dim intPos As Integer
Dim rst As dao.Recordset
Dim strSQL As String
Dim rstWhatsNew As dao.Recordset
DoCmd.ShowToolbar "Database", acToolbarNo
DoCmd.ShowToolbar "Toolbox", acToolbarNo
DoCmd.ShowToolbar "Form View", acToolbarNo
If Application.GetOption("ShowWindowsInTaskbar") = -1 Then
Application.SetOption "ShowWindowsInTaskbar", 0
End If
If DLookup("Locked", "luLockOut") <> 0 Then
MsgBox "Database is being worked on. Please try back in a couple minutes.", vbInformation, " "
DoCmd.Quit
Else
strSQL = "Select * From tblLastLogins Where UserName = '" & GetCurrentUserName() & "'"
This is where I have traced the error to: GetCurrentUserName()
Set rst = CurrentDb.OpenRecordset(strSQL)
With rst
If Not .EOF Then
.Edit
strSQL = "Select WhatsNewID From tblWhatsNew Where DateAdded >= #" & !LastLoginDate & "#"
Set rstWhatsNew = CurrentDb.OpenRecordset(strSQL)
While Not rstWhatsNew.EOF
DoCmd.OpenForm "frmWhatsNew", , , , , acDialog, rstWhatsNew!WhatsNewID
rstWhatsNew.MoveNext
Wend
rstWhatsNew.Close
Set rstWhatsNew = Nothing
Else
.AddNew
!UserName = GetCurrentUserName()
End If
!LastLoginDate = Now()
!IsLoggedIn = -1
Me.txtLastLoginID = !LastLoginID
.Update
.Close
End With
Set rst = Nothing
DoCmd.OpenForm "frmPrivacyNote"
Debug.Print Me.txtLastLoginID
End If
I need to track the username, so if GetCurrentUserName() is outdated, what is the current syntax?
Further follow up. I could not find data on Bing for GetCurrentUserName(), for good reason. It is a function within a MOD, so I need to figure out why the MOD is not getting called, or is malfunctioning.
After further delving, I found a Referenced MDB that has another function created by one of our users that is the cause of this error.
This is currently not an issue of MS Access working incorrectly. It is an issue with user created code.
GetCurrentUserName() is not defined by Access, so you should have looked at (and posted) its code.
If you are looking for the Windows user name, use this function:
Public Function GetUserName() As String
' GetUserName = Environ("USERNAME")
' Environ("USERNAME") is easily spoofed, see comment by HansUp
GetUserName = CreateObject("WScript.Network").UserName
End Function
Source
The link below would suggest that
CurrentUser()
is the function
CurrentUser()
Andre, thank you very much for the insight! I found this link:
http://www.codeproject.com/Articles/1422/Getting-User-Information-Using-WSH-and-VBScript
Dim objNet
On Error Resume Next
'In case we fail to create object then display our custom error
Set objNet = CreateObject("WScript.NetWork")
If Err.Number <> 0 Then 'If error occured then display notice
MsgBox "Don't be Shy." & vbCRLF &_
"Do not press ""No"" If your browser warns you."
Document.Location = "UserInfo.html"
'Place the Name of the document.
'It will display again
End If
Dim strInfo
strInfo = "User Name is " & objNet.UserName & vbCrLf & _
"Computer Name is " & objNet.ComputerName & vbCrLf & _
"Domain Name is " & objNet.UserDomain
MsgBox strInfo
Set objNet = Nothing 'Destroy the Object to free the Memory

How to show window prompt for downloading excel file?

I have written code for exporting data to xlsx file. But i dont understand how to show window prompt for downloading that xlsx file at client end.
Here's my code:
Private Sub DataTableToExcel(ByVal tbl As DataTable)
Dim Excel As Object = CreateObject("Excel.Application")
Dim strFilename As String
Dim intCol, intRow As Integer
Dim strPath As String = "C:\"
If Excel Is Nothing Then
MsgBox("It appears that Excel is not installed on this machine. This operation requires MS Excel to be installed on this machine.", MsgBoxStyle.Critical)
Return
End If
Try
With Excel
.SheetsInNewWorkbook = 1
.Workbooks.Add()
.Worksheets(1).Select()
.cells(1, 1).value = "Complaint Detail Report" 'Heading of the excel file
.cells(1, 1).EntireRow.Font.Bold = True
Dim intI As Integer = 1
For intCol = 0 To tbl.Columns.Count - 1
.cells(2, intI).value = tbl.Columns(intCol).ColumnName
.cells(2, intI).EntireRow.Font.Bold = True
intI += 1
Next
intI = 3
Dim intK As Integer = 1
For intCol = 0 To tbl.Columns.Count - 1
intI = 3
For intRow = 0 To tbl.Rows.Count - 1
.Cells(intI, intK).Value = tbl.Rows(intRow).ItemArray(intCol)
intI += 1
Next
intK += 1
Next
If Mid$(strPath, strPath.Length, 1) <> "\" Then
strPath = strPath & "\"
End If
strFilename = strPath & "ComplaintDetail.xlsx"
.ActiveCell.Worksheet.SaveAs(strFilename)
End With
System.Runtime.InteropServices.Marshal.ReleaseComObject(Excel)
Excel = Nothing
MsgBox("Data's are exported to Excel Succesfully: Location: '" & strFilename & "'", MsgBoxStyle.Information)
' Response.AddHeader("content-disposition", "attachment;filename=ComplaintDetail.xlsx")
'Response.ContentType = "application/vnd.excel"
Catch ex As Exception
MsgBox(ex.Message)
End Try
Dim pro() As Process = System.Diagnostics.Process.GetProcessesByName("EXCEL")
For Each i As Process In pro
i.Kill()
Next
End Sub
Here I am saving .XLSX file directly to "C Drive".
Why I choose C Drive? : Because 99% of people have C: in there pc.
But I got some scenario where user don't allow access of their C drive or they don't give permission to write anything inside c drive.
That's why I am trying to add this window prompt where user will decide where to save that file. But i got some issue in above code.
Can you please help me to add window prompt in above code?
Save in the App_Data directory. You can find the absolute path with Server.MapPath("~/App_Data") This path is writeable by the application
Use Response.TransmitFile to make the file to be downloaded.
Try using something like a save file dialog (this can be added via the ui designer).
Then use:
If dialog.Show() = Windows.Forms.DialogResult.OK Then
strPath = dialog.FileName
End If

extract attachments from DB to separate folders for each document

Have an assignment to do - it's to extract data from Lotus Notes DB including documents and their attachments. The purpose of this is to put it and store on the Sharepoint as a library.
So far I have managed to create a view and export the data for it to structure in Excel.
Also, I have looked up some Agents examples for extracting the attachments. With implementation of the below script, I managed to export the attachments:
Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Sub Initialize
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Dim rtItem As NotesRichTextItem
Dim RTNames List As String
Dim DOCNames List As String
Dim itemCount As Integer
Dim sDefaultFolder As String
Dim x As Integer
Dim vtDir As Variant
Dim iCount As Integer
Dim j As Integer
Dim lngExportedCount As Long
Dim attachmentObject As Variant
x = MsgBox("This action will extract all attachments From the " & CStr(dc.Count) & _
" document(s) you have selected, And place them into the folder of your choice." & _
Chr(10) & Chr(10) & "Would you like To continue?", 32 + 4, "Export Attachments")
If x <> 6 Then Exit Sub
sDefaultFolder = s.GetEnvironmentString("LPP_ExportAttachments_DefaultFolder")
If sDefaultFolder = "" Then sDefaultFolder = "F:"
vtDir = w.SaveFileDialog( False, "Export attachments To which folder?", "All files|*.*", sDefaultFolder, "Choose Folder and Click Save")
If IsEmpty(vtDir) Then Exit Sub
sDir = StrLeftBack(vtDir(0), "\")
Call s.SetEnvironmentVar("LPP_ExportAttachments_DefaultFolder", sDir)
While Not (doc Is Nothing)
iCount = 0
itemCount = 0
lngExportedCount = 0
Erase RTNames
Erase DocNames
'Scan all items in document
ForAll i In doc.Items
If i.Type = RICHTEXT Then
Set rtItem = doc.GetfirstItem(i.Name)
If Not IsEmpty(rtItem.EmbeddedObjects) Then
RTNames(itemCount) = CStr(i.Name)
itemCount = itemCount +1
End If
End If
End ForAll
For j = 0 To itemCount-1
Set rtItem = Nothing
Set rtItem = doc.GetfirstItem(RTNames(j))
ForAll Obj In rtItem.EmbeddedObjects
If ( Obj.Type = EMBED_ATTACHMENT ) Then
Call ExportAttachment(Obj)
Call doc.Save( False, True )
'creates conflict doc if conflict exists
End If
End ForAll
Next
'Scan all items in document
ForAll i In doc.Items
If i.Type = ATTACHMENT Then
DOCNames(lngExportedCount) = i.Values(0)
lngExportedCount = lngExportedCount + 1
End If
End ForAll
For j% = 0 To lngExportedCount-1
Set attachmentObject = Nothing
Set attachmentObject = doc.GetAttachment(DOCNames(j%))
Call ExportAttachment(attachmentObject)
Call doc.Save( False, True )
'creates conflict doc if conflict exists
Next
Set doc = dc.GetNextDocument(doc)
Wend
MsgBox "Export Complete.", 16, "Finished"
End Sub
Sub ExportAttachment(o As Variant)
Dim sAttachmentName As String
Dim sNum As String
Dim sTemp As String
sAttachmentName = sDir & "\" & o.Source
While Not (Dir$(sAttachmentName, 0) = "")
sNum = Right(StrLeftBack(sAttachmentName, "."), 2)
If IsNumeric(sNum) Then
sTemp = StrLeftBack(sAttachmentName, ".")
sTemp = Left(sTemp, Len(sTemp) - 2)
sAttachmentName = sTemp & Format$(CInt(sNum) + 1, "##00") & _
"." & StrRightBack(sAttachmentName, ".")
Else
sAttachmentName = StrLeftBack(sAttachmentName, ".") & _
"01." & StrRightBack(sAttachmentName, ".")
End If
Wend
Print "Exporting " & sAttachmentName
'Save the file
Call o.ExtractFile( sAttachmentName )
End Sub
So the issue I do have right now is that these attachments are being saved to the same folder, which means that I would manually have to put them into right folders of library (several thousands). Could anyone help on how should I change the above code to have the attachments saved to separate folder for each document from DB?
Also for some reason that I cant find out below line is causing error pop up with "Object Variable not set":
sAttachmentName = sDir & "\" & o.Source
Would anyone know why it causes failure and stops the whole process?
You need to use the MkDir statement to create directory and extract attachments in the folder. Probably write something like:
MkDir sDir
You need to write code that create a new directory for each document (make sure you check if the directory exists, and preferably you make sure each directory has a unique name).
I wrote a tool like that, that exports all the fields of a document into XML, as well as attachments and embedded images. It can be set to separate each document into it's own directory.
You can read more about it ate the link below, perhaps you can get some ideas from the description. I use the UniversalID of teh document to get a unique folder name.
http://www.texasswede.com/websites/texasswede.nsf/Page/Notes%20XML%20Exporter

Set IP address from a list in VBS

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.

ASP.NET - remote screenshot

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()
%>

Resources