HELP!!! PLEASE!!! Userdoc dillema
Buck Rogers
from the future.
'----Begin script----
'SetTime2.vbs - Adjusts system time if off by 1 second or more.
'© Bill James - wgj...@mvps.org - rev 28 Apr 2000
'Credit to Michael Harris for original concept.
'
Option Explicit
Dim ws, strTitle
Set ws = CreateObject("WScript.Shell")
strTitle = "SetTime.vbs © Bill James"
'
'Check system compatibility.
Dim http
Call ChkCompat
'
'Read time zone offset hex value from Registry.
Dim TimeOffset, HexVal
TimeOffset = ws.RegRead("HKLM\SYSTEM\CurrentControlSet\" & _
"Control\TimeZoneInformation\ActiveTimeBias")
'Reg value format varies between Win9x and NT
If IsArray(TimeOffset) Then
'Win9x uses a reversed 4 element array of Hex values.
HexVal = Hex(TimeOffset(3)) & Hex(TimeOffset(2)) & _
Hex(TimeOffset(1)) & Hex(TimeOffset(0))
Else 'Must be NT system.
HexVal = Hex(TimeOffset)
End If
'Convert to hours of time zone offset.
TimeOffset = - CLng("&H" & HexVal) / 60
'
'Get time from server. Recheck up to 5 times if lagged.
Dim n, timechk, localdate, lag, gmttime
For n = 0 to 4
'Fetch time page from US Naval Observatory web page.
'We don't actually need or use the page contents.
http.open "GET","http://tycho.usno.navy.mil" & _
"/cgi-bin/timer.pl"& now(),false, "<proxy login>","<password>"
'Check response time to avoid invalid errors.
timechk = Now
http.send
localdate = Now
lag = DateDiff("s", timechk, localdate)
'
'Key concept for script is reading header date.
gmttime = http.getResponseHeader("Date")
MsgBox gmttime
'
'Trim results to valid date format.
gmttime = right(gmttime,len(gmttime) - 5)
gmttime = left(gmttime,len(gmttime) - 3)
'
'If less than 2 seconds lag we can use the results.
If lag < 2 Then Exit For
Next
'
'If still too much lag after 5 attemps, quit.
If n = 4 then
ws.Popup "Unable to establish a reliable connection " & _
"with time server. This could be due to the " & _
"time server being too busy, your connection " & _
"already in use, or a poor connection." & vbcrlf & _
vbcrlf & "Please try again later.", 5, strTitle
Cleanup
End If
'
'Time and date error calculations.
Dim remotedate, diff, newnow, newdate, newtime, ddiff, sdiff
'Add local time zone offset to GMT returned from USNO server.
remotedate = DateAdd("h", timeoffset, gmttime)
'Calculate seconds difference betweed remote and local.
diff = DateDiff("s",localdate,remotedate)
'Adjust for difference and lag to get actual time.
newnow = DateAdd("s", diff + lag, now)
'Split out date and calculate any difference.
newdate = DateValue(newnow)
ddiff = DateDiff("d", Date, newdate)
'Split out time.
newtime = TimeValue(newnow)
'Convert time to 24 hr format required for OS compatibility.
newtime = Right(0 & Hour(newtime), 2) & ":" & _
Right(0 & Minute(newtime), 2) & ":" & _
Right(0 & Second(newtime), 2)
'Calculate time difference.
sdiff = DateDiff("s", time, newtime)
'
'If off by 1 or more seconds, adjust local time
Dim tmsg
If sdiff < 2 and sdiff > -2 Then
tmsg = "System is accurate to within " & _
"1 second. System time not changed."
Else
'Run DOS Time command in hidden window.
ws.Run "%comspec% /c time " & newtime, 0
tmsg = "System time off by " & sdiff & _
" seconds. System time changed to " & _
CDate(newtime)
End If
'
'If date off, change it.
Dim dmsg
If ddiff <> 0 Then
ws.Run "%comspec% /c date " & newdate, 0
dmsg = "Date off by " & ddiff & _
" days. System date changed to " & _
newdate & vbcrlf & vbcrlf
End If
'Show the changes
ws.Popup dmsg & tmsg, 5, strTitle
'
Call Cleanup
'
Sub ChkCompat
On Error Resume Next
Set http = CreateObject("microsoft.xmlhttp")
If Err.Number <> 0 Then
ws.Popup "Process Aborted!" & vbcrlf & vbcrlf & _
"Minimum system requirements to run this " & _
"script are Windows 95 or Windows NT 4.0 " & _
"with Internet Explorer 5.", , strTitle
Cleanup
End If
End Sub
'
Sub Cleanup
Set ws = Nothing
Set http = Nothing
WScript.Quit
End Sub
'----End Script----
"Cornelius J. van Dyk" <c...@dtdn.com> wrote in message
news:cZ5n6.141793$Ch.27...@newsrump.sjc.telocity.net...
> The project starts with an HTML page being opened.
> The page contains a link to some JavaScript which opens a userdoc
> (frmSplashMVS.vbd).
> The userdoc connects to our data on MVS and then maneuveres to another
HTML
> page with frames.
> Each frame is another userdoc.
> The app is developed in VB6 Enterprise SP3 under NT 4 SP6.
> At the present time, we compile to an Active X DLL.
> The problem is that we have to compile on each of our 4 servers in the
> WinFrame farm.
> To make the process less time intensive, we would like to compile to an
> Active X EXE format.
> That way we can simply copy the new version to the other servers and save
> time umung other things.
>
> I have experimented with this configuration and have come up with the
> following:
> If I run the app through my VB6 IDE, I can run it with no problem.
> If however I compile it to the EXE the following happens:
>
> I open the initial HTML page.
> Click the logon link and the (frmSplashMVS.vbd) page opens propperly.
> It goes through it's connection cycle and then navigates to the new HTML
> page.
> At this point there are 4 seperate vbd files to be loaded, one for each
> frame in the HTML page.
> None of the frames load their vbd files though.
> I am in fact presented with 4 "file download" dialog boxes.
> It's almost as if the EXE file did not propperly serve the vbd files.
>
> Any ideas would be GREATLY appreciated.
>
> Thanks
> C
>
>
>