469,952 Members | 2,615 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,952 developers. It's quick & easy.

How best to set current system date/time in A97?

MLH
I want to change my system time date each time an A97 app is
started. Here's how I've been doing it. Am looking for a better
way. Sure some of you have researched this.

Function SnatchInterNETTD():
'************************************************* **********************
' Internet lookup used to retrieve correct time and date.
' Remove instances of "FUCKING". I could not make this
' post stick unless I changed eBay to eFUCKINGBay. Sorry
' for the inconvenience to all readers on this forum.
'************************************************* **********************
On Error GoTo Err_SnatchInterNETTD

Dim msXML As Object, strPageContent As String, MyURL As String

Set msXML = CreateObject("Microsoft.XMLHTTP")
time/month/day, but not year!
MyURL =
"http://cgi1.eFUCKINGbay.com/aw-cgi/eFUCKINGBayISAPI.dll?TimeShow&hc=1&hm=td.s5ddl7437 "
msXML.Open "GET", MyURL, False
msXML.send
strPageContent = msXML.responseText
Set msXML = Nothing

Dim DTFacts As String, TimePart As String, DatePart As String,
StartStr As String, EndStr As String, _
StartLocn As Long, EndLocn As Long, RevisedDatePart As String,
RevisedTimePart As String
StartStr = "The official eFUCKINGBay Time is now:"
EndStr = "PDT</b></p>"
StartLocn = InStr(1, strPageContent, StartStr)
EndLocn = InStr(1, strPageContent, EndStr)
If StartLocn = 0 Or EndLocn = 0 Then
DTFacts = "eFUCKINGBay has changed the code on their time server
found at the following URL:" & CRLF & CRLF
DTFacts = DTFacts &
"http://cgi1.eFUCKINGBay.com/aw-cgi/eFUCKINGBayISAPI.dll?TimeShow&hc=1&hm=td.s5ddl7437 "
MsgBox DTFacts, 64, "URL Changed -OR- Not Found - " & MyApp$ & ",
rev. " & MY_VERSION$
Exit Function
End If
DTFacts = Mid$(strPageContent, StartLocn + 40, EndLocn - StartLocn -
37) 'Should get something like "Sunday, Oct 02, 2005 15:59:22 PDT"
Debug.Print DTFacts
DatePart = left$(DTFacts, Len(DTFacts) - 13)
'Something like Sunday, Oct 02, 2005
RevisedDatePart = right$(DatePart, 12)
'Something like Oct 02, 2005
TimePart = left$(right$(DTFacts, 12), 8)
'Something like 17:27:38
RevisedTimePart = PadWithZeros(Trim$(CStr(Val(left$(TimePart, 2)) +
3)), 2, "left") & right$(TimePart, 6) 'Something like 17:27:38
Debug.Print DatePart
Debug.Print TimePart
Date = DateValue(RevisedDatePart)
Time = TimeValue(RevisedTimePart)
SnatchInterNETTD = DTFacts

Exit_SnatchInterNETTD:
Exit Function

Err_SnatchInterNETTD:
If Err = -2146697211 Then
MsgBox "Check to see if your InterNET connection is down.",
48, "Unexpected Error - " & MyApp$ & ", rev. " & MY_VERSION$
Set msXML = Nothing
Exit Function
End If
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in FN
SnatchInterNETTD in Harvell module."
k = CRLF & CRLF & str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_SnatchInterNETTD

End Function
Function PadWithZeros(String2Bpadded As String, TargetLen As Integer,
RL As String)
'************************************************* ******
' Accepts String2Bpadded (a numeric string), TargetLen
' and RL ("left" or "right").
'
' Returns String2Bpadded padded on left side with zeros
' to make it a specified length (TargetLen).
'************************************************* ******
On Error GoTo Err_PadWithZeros
Dim MyLen As Integer, HowMuchPadding As Integer, i As Integer, Padding
As String, MyMsg As String

MyLen = Len(Trim$(String2Bpadded))
HowMuchPadding = TargetLen - MyLen
If HowMuchPadding < 0 Then
MyMsg = "Your source string is already longer than the target
length to which you wish to pad it out to."
MsgBox MyMsg, 48, "Can't Pad This String - " & MyApp$ & ", rev. "
& MY_VERSION$
Exit Function
End If
For i = 1 To HowMuchPadding
Padding = Padding & "0"
Next i

Select Case RL
Case "Left"
PadWithZeros = Padding & Trim$(String2Bpadded)
Case "Right"
PadWithZeros = Trim$(String2Bpadded) & Padding
End Select

Exit_PadWithZeros:
Exit Function

Err_PadWithZeros:
Dim r As String, k As String, Message3 As String
r = "The following unexpected error occurred in global Function
PadWithZeros."
k = CRLF & CRLF & str$(Err) & ": " & Quote & Error$ & Quote
Message3 = r & k
MsgBox Message3, 48, "Unexpected Error - " & MyApp$ & ", rev. " &
MY_VERSION$
Resume Exit_PadWithZeros

End Function

Nov 13 '05 #1
1 2019
MLH
Wow! I made it. Changing all my references to eBay in the URL
strings allowed the post to go through. However, some of my
attempts had NO problems whatsoever - and they had eBay's
name buried in the URL strings.

I'm happy this one made it through. I am trying to acquire the
current time/date and use it to set the system time/date. Going
through eBay's time/date server is a hassel - and besides, its
difficult to post questions in this forum because of the SPAM
filter that censors eBay's name in some URL strings but not
others. That's reason enough to change right there.
Nov 13 '05 #2

This discussion thread is closed

Replies have been disabled for this discussion.

Similar topics

2 posts views Thread by Mike Button | last post: by
5 posts views Thread by Mark Feller | last post: by
136 posts views Thread by Matt Kruse | last post: by
4 posts views Thread by xenophon | last post: by
6 posts views Thread by Scott | last post: by
5 posts views Thread by Robert W. | last post: by
29 posts views Thread by gs | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.