Code:
Option Explicit Const ci_for_reading = 1 Const ci_for_writing = 2 Const ci_temporary_folder = 2 Const cs_script_version = "v0.01" Dim go_fso, go_wsh, go_net Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title Dim gs_temp_file, gs_temp_path, gs_temp_spec Call s_init() Call s_main1() Call s_main2() WScript.Quit Sub s_init() Const cs_fac = "%s_init, " Set go_fso = CreateObject( "Scripting.FileSystemObject" ) Set go_wsh = CreateObject( "WScript.Shell" ) Set go_net = CreateObject( "WScript.Network" ) gs_script_spec = Wscript.ScriptFullName gs_script_path = go_fso.GetParentFolderName( gs_script_spec ) gs_script_name = go_fso.GetBaseName( gs_script_spec ) gs_script_title = gs_script_name & " (" & cs_script_version & ")" gs_temp_file = go_fso.GetTempName gs_temp_path = go_fso.GetSpecialFolder( ci_temporary_folder ) gs_temp_spec = gs_temp_path & "\" & gs_temp_file End Sub Sub s_main1() Const cs_fac = "%s_main1, " Dim ll_secs, ls_dt1, ls_dt2 Call s_log( "" ) Call s_log( cs_fac & "GMT to BST..." ) For ll_secs = 922582740 To 922582740 + (121*60) Step (11*60) ls_dt1 = fs_ctime_to_dt( ll_secs ) ls_dt2 = fs_secs_to_dt( ll_secs ) Call s_log( " ctime = `" & ll_secs & "` bpdbm = `" & ls_dt1 & "` fs = `" & ls_dt2 & "`" ) Next Call s_log( "" ) Call s_log( cs_fac & "BST to GMT..." ) For ll_secs = 941327940 To 941327940 + (121*60) Step (11*60) ls_dt1 = fs_ctime_to_dt( ll_secs ) ls_dt2 = fs_secs_to_dt( ll_secs ) Call s_log( " ctime = `" & ll_secs & "` bpdbm = `" & ls_dt1 & "` fs = `" & ls_dt2 & "`" ) Next End Sub Function fl_dt_to_secs( pd_dt ) Const cs_fac = "%fl_dt_to_secs, " Dim ll_dt If Not IsDate( pd_dt ) Then Call s_abort( cs_fac & "Expected date as parameter..." ) ll_dt = CLng( DateDiff( "s", "01/01/1970 00:00:00", pd_dt ) ) If fb_bst( pd_dt ) Then ll_dt = ll_dt - 3600 fl_dt_to_secs = ll_dt End Function Function fs_secs_to_dt( pl_seconds ) Dim ld_dt, ls_dt ld_dt = DateAdd( "s", pl_seconds, "01/01/1970 00:00:00" ) If fb_bst( ld_dt ) Then ld_dt = DateAdd( "h", 1, ld_dt ) ls_dt = FormatDateTime( ld_dt, vbShortdate ) & " " & FormatDateTime( ld_dt, vbLongtime ) fs_secs_to_dt = ls_dt End Function Function fs_secs_to_yyyymmdd( pl_seconds ) Dim ld_dt, ls_dt If Not IsNumeric( pl_seconds ) Then Call s_abort( cs_fac & "Expected integer seconds as parameter..." ) ld_dt = DateAdd( "s", pl_seconds, "01/01/1970 00:00:00" ) ls_dt = fs_zeroes( Year( ld_dt ), 4 ) & fs_zeroes( Month( ld_dt ), 2 ) & fs_zeroes( Day( ld_dt ), 2 ) fs_secs_to_yyyymmdd = ls_dt End Function Function fb_bst( pd_dt ) Const cs_fac = "%fb_bst, " Dim ls_eom If Not IsDate( pd_dt ) Then Call s_abort( cs_fac & "Expected date as parameter..." ) Select Case Month( pd_dt ) Case 4, 5, 6, 7, 8, 9 fb_bst = True Case 1, 2, 11, 12 fb_bst = False Case 3 fb_bst = False If Day( pd_dt ) < 25 Then Exit Function ls_eom = "31/03/" & Year( pd_dt ) If WeekDay( pd_dt ) - WeekDay( ls_eom ) > 0 Then Exit Function If Hour( pd_dt ) < 1 Then Exit Function fb_bst = True Case 10 fb_bst = True If Day( pd_dt ) < 25 Then Exit Function ls_eom = "31/10/" & Year( pd_dt ) If WeekDay( pd_dt ) - WeekDay( ls_eom ) > 0 Then Exit Function If Hour( pd_dt ) < 1 Then Exit Function fb_bst = False Case Else Call s_abort( cs_fac & "Unexpected month in date..." ) End Select End Function Sub s_main2() Const cs_fac = "%s_main2, " Dim ll_year, ls_date, ld_date, lb_done For ll_year = 1999 To 2007 Call s_log( String( 80, "*" ) ) Call s_log( cs_fac & "Testing year `" & ll_year & "`..." ) ls_date = "24-MAR-" & CStr( ll_year ) ld_date = CDate( ls_date ) lb_done = False Do ld_date = DateAdd( "d", 1, ld_date ) If WeekDayName( WeekDay( ld_date ), True ) = "Sun" Then If Month( ld_date ) <> Month( DateAdd( "d", 7, ld_date ) ) Then Call s_test2( ld_date ) lb_done = True End If End If Loop Until lb_done ls_date = "24-OCT-" & CStr( ll_year ) ld_date = CDate( ls_date ) lb_done = False Do ld_date = DateAdd( "d", 1, ld_date ) If WeekDayName( WeekDay( ld_date ), True ) = "Sun" Then If Month( ld_date ) <> Month( DateAdd( "d", 7, ld_date ) ) Then Call s_test2( ld_date ) lb_done = True End If End If Loop Until lb_done Next End Sub Sub s_test2( pd_date ) Const cs_fac = "%s_test2, " Dim ll_mins, ld_dt Dim ls_dt1, ll_dt2, ls_dt3, ls_dt4 Call s_log( "" ) For ll_mins = 59 To 183 Step 31 ld_dt = DateAdd( "n", ll_mins, pd_date ) ls_dt1 = FormatDateTime( ld_dt, vbShortdate ) & " " & FormatDateTime( ld_dt, vbLongtime ) ll_dt2 = fl_dt_to_secs( ls_dt1 ) ls_dt3 = fs_ctime_to_dt( ll_dt2 ) ls_dt4 = fs_secs_to_dt( ll_dt2 ) Call s_log( cs_fac & " input = `" & ls_dt1 & "` fl_dt_to_secs = `" & ll_dt2 & "` bpdbm = `" & ls_dt3 & "` fs_secs_to_dt = `" & ls_dt4 & "`" ) Next End Sub Function fs_ctime_to_dt( pl_secs ) Exit Function Const cs_fac = "%fs_ctime_to_dt, " Dim ls_output, ls_old, ls_parts, ls_dt, ld_dt ls_output = fs_run_command( "bpdbm -ctime " & CStr( pl_secs ) ) Do ls_old = ls_output ls_output = Replace( ls_output, " ", " " ) ls_output = Replace( ls_output, vbTab, " " ) ls_output = Replace( ls_output, vbCrlf, " " ) ls_output = Trim( ls_output ) Loop Until ls_output = ls_old ls_parts = Split( ls_output, " " ) If UBound( ls_parts ) <> 6 Then Call s_abort( cs_fac & "Expected 7 fields from bpdbm..." ) If ls_parts( 0 ) <> Cstr( pl_secs ) Then Call s_abort( cs_fac & "Seconds not same as passed..." ) If ls_parts( 1 ) <> "=" Then Call s_abort( cs_fac & "Expected `=` sign at field 1..." ) Select Case ls_parts( 2 ) Case "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun" Case Else Call s_abort( cs_fac & "Expected day name at field 2..." ) End Select Select Case ls_parts( 3 ) Case "Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" Case Else Call s_abort( cs_fac & "Expected month name at field 3..." ) End Select If Len( ls_parts( 4 ) ) <> 2 Then Call s_abort( cs_fac & "Expected a two byte day number at field 4..." ) If Not IsNumeric( ls_parts( 4 ) ) Then Call s_abort( cs_fac & "Expected a two byte day number at field 4..." ) If Len( ls_parts( 5 ) ) <> 8 Then Call s_abort( cs_fac & "Expected an eight byte time string at field 5..." ) If Mid( ls_parts( 5 ), 3, 1 ) <> ":" Then Call s_abort( cs_fac & "Expected an eight byte time string at field 5..." ) If Mid( ls_parts( 5 ), 6, 1 ) <> ":" Then Call s_abort( cs_fac & "Expected an eight byte time string at field 5..." ) If Len( ls_parts( 6 ) ) <> 4 Then Call s_abort( cs_fac & "Expected a four byte year number at field 4..." ) If Not IsNumeric( ls_parts( 6 ) ) Then Call s_abort( cs_fac & "Expected a four byte year number at field 4..." ) fs_ctime_to_dt = ls_parts( 4 ) & "-" & ls_parts( 3 ) & "-" & ls_parts( 6 ) & " " & ls_parts( 5 ) End Function Function fs_run_command( ps_command ) Const cs_fac = "%fs_run_command, " Dim ls_output, ls_text, ll_status, lo_file, lo_chan fs_run_command = "" ls_text = "Failed to run command `" & ps_command & "`." On Error Resume Next ll_status = go_wsh.Run( "%comspec% /c " & ps_command & " >""" & gs_temp_spec & """", 0, True ) If Err.Number <> 0 Then Call s_error( cs_fac & ls_text ) On Error Goto 0 Set lo_file = go_fso.GetFile( gs_temp_spec ) If lo_file.Size = 0 Then Exit Function Set lo_chan = go_fso.OpenTextFile( gs_temp_spec, ci_for_reading ) ls_output = lo_chan.ReadAll lo_chan.Close go_fso.DeleteFile gs_temp_spec ls_text = ls_text & vbCrlf & vbTab & "Status: " & ll_status & vbCrlf & vbTab & "Output: " & ls_output If ll_status <> 0 Then Call s_error( cs_fac & ls_text ) fs_run_command = ls_output End Function Sub s_error( ps_message ) Dim ls_error, ls_message ls_error = " error:" & vbTab & Err.Number ls_error = ls_error & vbCrlf & " text:" & vbTab & Err.Description ls_error = ls_error & vbCrlf & " source:" & vbTab & Err.Source ls_message = "Script has encountered an error, and will now stop..." ls_message = ls_message & vbCrlf & " at:" & vbTab & fs_datetime( Now ) ls_message = ls_message & vbCrlf & " reason:" & vbTab & ps_message ls_message = ls_message & vbCrlf & ls_error Call s_quit( ls_message ) End Sub Sub s_abort( ps_message ) Dim ls_message ls_message = "Script is aborting, and will now stop..." ls_message = ls_message & vbCrlf & " at:" & vbTab & fs_datetime( Now ) ls_message = ls_message & vbCrlf & " reason:" & vbTab & ps_message Call s_quit( ls_message ) End Sub Sub s_quit( ps_message ) Call s_log( ps_message & vbCrlf & vbCrlf & "Script will now quit immediately..." ) WScript.Quit(1) End Sub Sub s_log( ps_text ) WScript.Echo ps_text End Sub Function fs_datetime( pd_datetime ) Dim ld_datetime, ls_result ld_datetime = pd_datetime ls_result = WeekDayName( WeekDay( ld_datetime ), False, 1 ) ls_result = ls_result & " " & FormatDateTime( ld_datetime, vbLongdate ) ls_result = ls_result & " " & FormatDateTime( ld_datetime, vbLongtime ) fs_datetime = ls_result End Function