Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
%IDC_Button = 500
%IDC_InBox = 501
%IDC_OutBox = 502
Global hDlg,hIcon As Dword
Function PBMain() As Long
Dialog Default Font "Tahoma", 12, 1
Dialog New Pixels, 0, "Email Date",300,300,350,200, %WS_OverlappedWindow To hDlg
Control Add TextBox, hDlg, %IDC_InBox,"Date: Wed, 3 Dec 2017 22:27:31 +0000", 10,10,330,25
Control Add Button, hDlg, %IDC_Button,"Get Age", 75,45,100,25
Control Add TextBox, hDlg, %IDC_OutBox,"", 10,85,330,90, %ES_MultiLine Or %WS_Border Or %WS_Child, %WS_Ex_ClientEdge
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_InitDialog
hIcon = LoadIcon(ByVal %Null, ByVal %IDI_Question) 'use a system icon for the dialog
SendMessage hDlg, %WM_SetIcon, %ICON_BIG, hIcon 'use a system icon for the dialog
DisplayAge
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Button, %IdOk : DisplayAge
End Select
End Select
End Function
Sub DisplayAge
Local Age As Long, HDS$, SortableDate$
Control Get Text hDlg, %IDC_InBox To HDS$
SortableDate$ = ConvertDateToSortableFormat(HDS$)
Age = GetEmailAge(HDS$, SortableDate$)
Control Set Text hDlg, %IDC_OutBox, HDS$ + $CrLf + SortableDate$ + $CrLf + "Today's Date: " + Date$ + $CrLf + "Email Age: " + Str$(Age)
End Sub
Function ConvertDateToSortableFormat(ByVal HDS As String) As String 'HDS=Header Date String
Local iMonth As Long
'this function assumes the incoming HDS looks like one of these, where the "Wed, " is optional
' "Date: Wed, 3 Jan 2017 22:27:31 +0000"
' "Date: 3 Jan 2017 22:27:31 +0000"
'output format is to be 2017 01 28
'single spacing is assumed between elements in the string
If InStr(HDS,",") Then
HDS = Mid$(HDS,12) 'strip off "Date: Wed, ", leave behind 3 Jan 2017 22:27:31 +0000
Else
HDS = Mid$(HDS,7) 'strip off "Date: " , leave behind 3 Jan 2017 22:27:31 +0000
End If
iMonth = InStr("JanFebMarAprMayJunJulAugSepOctNovDec",Parse$(HDS,$Spc,2))/3+1
' YEAR MONTH DAY 24-HOUR TIME
Function = Parse$(HDS,$Spc,3) + $Spc + Format$(iMonth,"00") + $Spc + Format$(Val(Parse$(HDS,$Spc,1)),"00") + $Spc + Parse$(HDS,$Spc,4)
End Function
Function GetEmailAge(HDS$, SortableDate$) As Long
'gives difference between EmailDate and Right Now
Local Day1 As Long, Day2 As Long, y As Long, m As Long, d As Long, EmailDate$
'Right Now
y = Val(Parse$(Date$, "-", 3))
m = Val(Parse$(Date$, "-", 1))
d = Val(Parse$(Date$, "-", 2))
Day1 = AstroDay(y, m, d)
'EmailDate
y = Val(Parse$(SortableDate$, $Spc, 1))
m = Val(Parse$(SortableDate$, $Spc, 2))
d = Val(Parse$(SortableDate$, $Spc, 3))
Day2 = AstroDay(y, m, d)
Function = Day1 - Day2
End Function
Function AstroDay(year As Long, month As Long, day As Long) As Long
Dim y As Double
y = year + (month - 2.85) / 12
Function = Int(Int(Int(367 * y) - 1.75 * Int(y) + day) -0.75 * Int(0.01 * y)) + 1721119
End Function
http://www.garybeene.com/sw/gbsnippets.htm