Attribute VB_Name = "Website"
'new dbase
Option Compare Database

Public StopImporting As Boolean
Public EmailedInvoice As Integer
Public Configs() As String

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long


Sub ExportData()
 Dim cmd As String
 DoCmd.SetWarnings False
[Form_577 Foundation].ProgressBar.Visible = True
[Form_577 Foundation].ProgressBar.Value = 1
 temp = FirstValue("Select Count(*) from _IM_Reg")
 If temp <> -9999 Then
  If temp <> 0 Then
   MsgBox "You must finish importing before you can export.", vbOKOnly, "Export Error"
   Exit Sub
  End If
 End If
 DownloadDatabase
 If FirstValue("Select Count(*) from _IM_Reg") <> 0 Then
   MsgBox "You must finish importing before you can export.", vbOKOnly, "Export Error"
   Exit Sub
 End If
 [Form_577 Foundation].ProgressBar.Value = 40
 DoCmd.OpenQuery "_Qry_ExportContacts"
 DoCmd.OpenQuery "_Qry_ExportClasses"
 [Form_577 Foundation].ProgressBar.Value = 50
 DoCmd.TransferDatabase acExport, "Microsoft Access", "p:\577\577web.mdb", acTable, "_Ex_Classes", "Classes", False
 [Form_577 Foundation].ProgressBar.Value = 52
 DoCmd.TransferDatabase acExport, "Microsoft Access", "p:\577\577web.mdb", acTable, "_Ex_Contacts", "Contacts", False
 [Form_577 Foundation].ProgressBar.Value = 54
 DoCmd.TransferDatabase acExport, "Microsoft Access", "p:\577\577web.mdb", acTable, "WebRegistrations", "Registrations", False
 [Form_577 Foundation].ProgressBar.Value = 56
 DoCmd.DeleteObject acTable, "_EX_Contacts"
 [Form_577 Foundation].ProgressBar.Value = 58
 DoCmd.DeleteObject acTable, "_EX_Classes"
 cmd = "p:\577\ncftpput -u " & Configs(2) & " -p " & Configs(3) & " " & Configs(1) & " /database/ p:\577\577web.mdb"
 [Form_577 Foundation].ProgressBar.Value = 60
 RunExternal cmd
 [Form_577 Foundation].ProgressBar.Value = 100
 [Form_577 Foundation].ProgressBar.Visible = False
 DoCmd.SetWarnings True
End Sub

Sub LoadConfigs()
  Dim qd As QueryDef
  Dim r As Recordset
  Set qd = CurrentDb.CreateQueryDef("")
  qd.SQL = "SELECT * FROM Config ORDER BY ID;"
  Set r = qd.OpenRecordset
  ReDim Configs(1)
  Do While Not r.EOF And Not r.BOF
   ReDim Preserve Configs(UBound(Configs) + 1)
   Configs(r("ID")) = r("Item")
   r.MoveNext
  Loop
  r.Close
End Sub

Sub UpdateData()
 Dim cmd As String
 DoCmd.SetWarnings False
 LoadConfigs
 cmd = "p:\577\ncftpput -u " & Configs(2) & " -p " & Configs(3) & " " & Configs(1) & " /database/ p:\577\577web.mdb"
 RunExternal cmd
 Kill "p:\577\577web.mdb"
 DoCmd.SetWarnings True
End Sub

Sub ImportData()
 Dim Contact As Integer, PrevContact As Integer, RegID As Integer, CountOfRecords As Integer
 On Error Resume Next
 [Form_577 Foundation].ProgressBar.Visible = True
[Form_577 Foundation].ProgressBar.Value = 1
 temp = FirstValue("Select Count(*) from _IM_Reg")
 If temp = -9999 Or temp = 0 Then
   DownloadDatabase
 End If
[Form_577 Foundation].ProgressBar.Value = 45
 PrevContact = 0
 Do While FirstValue("Select Count(*) from _IM_Reg") <> 0
    RegID = FirstValue("Select RegID from _IM_Reg order by ContactID")
    DoCmd.OpenForm "_Frm_ImportContact", acNormal, , , , acDialog, RegID
    Do While FormLoaded("_frm_ImportContact")
     DoEvents
    Loop
    If StopImporting Then Exit Do
 Loop
[Form_577 Foundation].ProgressBar.Value = 55
 If Not StopImporting Then
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "_Qry_UpdateExportClasses"
  DoCmd.DeleteObject acTable, "_IM_Classes"
  DoCmd.DeleteObject acTable, "_IM_Contacts"
  DoCmd.DeleteObject acTable, "_IM_Reg"
[Form_577 Foundation].ProgressBar.Value = 60
  UpdateData
[Form_577 Foundation].ProgressBar.Value = 100
  DoCmd.SetWarnings True
 End If
 [Form_577 Foundation].ProgressBar.Visible = False
 StopImporting = False
End Sub


Sub DownloadDatabase()
  On Error Resume Next
  LoadConfigs
  DoCmd.DeleteObject acTable, "_IM_Classes"
  DoCmd.DeleteObject acTable, "_IM_Contacts"
  DoCmd.DeleteObject acTable, "_IM_Reg"
  Kill "p:\577\577web.mdb"
  Err.Clear
  On Error GoTo 0
  Dim cmd As String
  cmd = "p:\577\ncftpget -u " & Configs(2) & " -p " & Configs(3) & " " & Configs(1) & " p:\577\ /database/577web.mdb"
  RunExternal cmd
  DoCmd.TransferDatabase acLink, "Microsoft Access", "p:\577\577web.mdb", acTable, "Classes", "_IM_Classes", False
  DoCmd.TransferDatabase acLink, "Microsoft Access", "p:\577\577web.mdb", acTable, "Contacts", "_IM_Contacts", False
  DoCmd.TransferDatabase acLink, "Microsoft Access", "p:\577\577web.mdb", acTable, "Registrations", "_IM_Reg", False
End Sub


Function WebReg(iContactID As Integer, iClassId As Integer, iQuantity As Integer, iNamesAges As Variant, AddContact As Boolean)
 Dim Class_ID As Integer, Quantity As Variant, names As String, alt As Boolean, PAD As Boolean, Paid As Integer, PaymentID As Long
 Dim Registered_Qua, iRegID As Integer
 Dim Class_Limit As Integer, Slots_Left As Integer, res As Integer, Reg_ID As Long, InvoiceID As Integer, Alternate As Long
 Dim SQL As String
  Class_Limit = FirstValue("Select limit from classes where classid=" & iClassId)
  If Class_Limit = 0 Then
   MsgBox "Class is Canceled", vbOKOnly, "Class Canceled"
   Exit Function
  End If
  Quantity = InputBox("Number of Registrations." & vbCrLf & "(enter 0 to quit)", "Number of Registrations.", iQuantity)
  alt = False
  If Quantity = "" Then Exit Function
  Registered_Qua = FirstValue("Select Sum(quantity) from ClassRegister where alternate=0 and classid=" & iClassId)
  If Registered_Qua = -9999 Then Registered_Qua = 0
  Slots_Left = Class_Limit - Registered_Qua
  If Slots_Left < 0 Then Slots_Left = 0
  If Slots_Left < Quantity Then
   If MsgBox("Class has " & Slots_Left & " slots left. Would you like to register as an alternate?", vbYesNo, "Class Full") = vbYes Then
    alt = True
   Else
    Exit Function
   End If
  End If
  
  If Not IsNull(iNamesAges) Then names = iNamesAges
  names = InputBox("A comma seperated list of names followed by grades.  The grade can be 0 which will prevent it from printing on the sign-in form." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "eg.  john,k,jenny,3,liz,4,gale,4", "Names and Ages", names)
  
  If AddContact Then
   ExecuteSQL ("INSERT INTO Contacts ( LastName, FirstName, Organization, Address, City, State, ZipCode, FirstNumber, SecondPhone, FaxNumber, EmailAddress ) SELECT [_IM_Contacts].LastName, [_IM_Contacts].FirstName, [_IM_Contacts].Organization, [_IM_Contacts].Address, [_IM_Contacts].City, [_IM_Contacts].State, [_IM_Contacts].ZipCode, [_IM_Contacts].FirstNumber, [_IM_Contacts].SecondPhone, [_IM_Contacts].FaxNumber, [_IM_Contacts].EmailAddress FROM _IM_Contacts Where ContactID=" & iContactID)
   ContactID = FirstValue("Select @@Identity")
  Else
   email = FirstValue("Select EmailAddress from _IM_Contacts where ContactID=" & iContactID)
   If email <> -9999 Then
    ExecuteSQL "Update Contacts set EmailAddress='" & email & "' WHERE ContactID=" & iContactID
   End If
   ContactID = iContactID
  End If
  
  If alt Then
   Title = FirstValue("Select Title from classes where classid=" & iClassId)
   DoCmd.SendObject acSendNoObject, , acFormatTXT, email, , , "577 Class Registration", "Sorry you could not get into " & Title & ". You have been but in th ealternate list. You will be alerted when you are accepted. Thank you ", False
  End If
  
  Dim ctl As Integer
  If Not alt Then
    PAD = FirstValue("Select PAD from classes where classid=" & iClassId)
    If Not PAD Then
     ctl = 2
    Else
     ctl = 3
    End If
  Else
    ctl = 0
  End If
  
  
  SQL = "INSERT INTO ClassRegister ( ClassID, ContactID, InvoiceID, Quantity, Alternate, NamesAges ,Control) VALUES(" & iClassId & "," & ContactID & ",0," & Quantity & "," & CInt(alt) & ",'" & names & " '," & ctl & ");"
  ExecuteSQL SQL
  iRegID = FirstValue("Select @@Identity")
  If Not alt Then ExecuteSQL "Update contacts set Attendee=-1 where contactid=" & ContactID
 
End Function

Sub SendInvoiceByMail(InvoiceID As Integer)
 email = FirstValue("Select Contacts.EmailAddress from Invoices,Contacts where Invoices.ContactID = Contacts.ContactID and Invoices.InvoiceID=" & InvoiceID)
 EmailedInvoice = InvoiceID
 Subject = "Registration for Classes at 577"
 Body = "You have been Registered for Classes at 577" & vbCrLf
 Body = Body & "Attached is an invoice and payment is due 1 week prior to class."
 DoCmd.SendObject acSendReport, "_rpt_InvoiceEmail", acFormatHTML, email, , , Subject, Body, False
End Sub



Public Function RunExternal(ShellCommand As String, Optional Timeout As Long = 120) As Long
Dim ProcessId, START As Double
Dim dummy As Long
Dim hProg, iExit As Long
Subject = "Registration for Pay at the Door Classes at 577"
Const where = "RunExternal"
    DoEvents
    ProcessId = Shell(ShellCommand, vbNormal)
    hProg = OpenProcess(2035711, False, ProcessId)
    GetExitCodeProcess hProg, iExit
    ' Wait, but allow painting and other processing
    START = Timer
    Do While iExit = 259
     DoEvents
     Sleep 1000
     If [Form_577 Foundation].ProgressBar.Value < [Form_577 Foundation].ProgressBar.Max Then [Form_577 Foundation].ProgressBar.Value = [Form_577 Foundation].ProgressBar.Value + 1
     If Timer - START > Timeout Then
      dummy = TerminateProcess(hProg, 259)
      RunExternal = -999
     End If
     GetExitCodeProcess hProg, iExit
    Loop
    CloseHandle hProg
    RunExternal = iExit
End Function

Function BatchWebPAD()
 Dim ContactID As Integer, Amount As Integer, InvoiceSent As Boolean
 Dim qd As QueryDef, InvoiceID As Integer, sData As String, RegID As Integer
 Dim rs As Recordset
 On Error GoTo 0
  Set qd = CurrentDb.CreateQueryDef("")
  qd.SQL = "Select ClassRegister.RegID,ClassRegister.Quantity,ClassRegister.ContactID,ClassRegister.Control,Classes.Fee,classes.title,ClassRegister.Alternate,Classes.Date1,Contacts.EmailAddress from ClassRegister, Classes, Contacts where Classes.ClassID=ClassRegister.ClassID and Classes.ContactID=Contacts.ContactID and ClassRegister.control=3 and Classes.PAD=-1 and ClassRegister.Alternate=0 order by ClassRegister.ContactID"
  Set rs = qd.OpenRecordset
  sData = "You have been accepted in to these Pay at the Door Classes." & vbCrLf & vbCrLf
  Do While Not rs.BOF And Not rs.EOF
   If ContactID <> rs("ContactID") And ContactID <> 0 Then
    sData = sData & vbCrLf & "The 577 Foundation"
    email = FirstValue("Select emailaddress from contacts where contactid=" & ContactID)
    If email <> -9999 And email <> "" And email <> " " Then
     DoCmd.SendObject acSendNoObject, , acFormatTXT, email, , , "577 Pay at the Door Registration", sData, False
    End If
    ExecuteSQL "Update ClassRegister set control=2 where RegID=" & RegID
    sData = "You have been accepted in to these Pay at the Door Classes." & vbCrLf & vbCrLf
   End If
   ContactID = rs("ContactID").Value
   RegID = rs("RegID")
   sData = sData & "ClassName:" & vbTab & rs("Title") & vbCrLf
   sData = sData & "Quantity:" & vbTab & rs("Quantity") & vbCrLf
   sData = sData & "Fee:" & vbTab & vbTab & FormatCurrency(rs("Fee")) & vbCrLf
   sData = sData & "ClassDate:" & vbTab & rs("date1") & vbCrLf
   rs.MoveNext
  Loop
  If sData <> "" And RegID > 0 Then
    sData = sData & vbCrLf
    sData = sData & vbCrLf & "Thank You"
    sData = sData & vbCrLf & "The 577 Foundation"
    sData = sData & vbCrLf & "419-874-4174"
    sData = sData & vbCrLf & "www.577foundation.org" & vbCrLf
    email = FirstValue("Select emailaddress from contacts where contactid=" & ContactID)
    If email <> -9999 And email <> "" And email <> " " Then
     Dim Subject As String
     Subject = "577 Pay at the Door Registration"
     DoCmd.SendObject acSendNoObject, , acFormatTXT, email, , , Subject, sData, False
    End If
    ExecuteSQL "Update ClassRegister set control=2 where RegID=" & RegID
  End If
  rs.Close
  qd.Close
 Set rs = Nothing
 Set qd = Nothing
End Function


Function BatchWebALT()
 Dim ContactID As Integer, Amount As Integer, InvoiceSent As Boolean
 Dim qd As QueryDef, InvoiceID As Integer, sData As String, RegID As Integer
 Dim rs As Recordset
  Set qd = CurrentDb.CreateQueryDef("")
  qd.SQL = "Select ClassRegister.RegID,ClassRegister.Quantity,ClassRegister.ContactID,ClassRegister.Control,Classes.Fee,classes.title,ClassRegister.Alternate,Classes.Date1,Contacts.EmailAddress from ClassRegister, Classes, Contacts where Classes.ClassID=ClassRegister.ClassID and Classes.ContactID=Contacts.ContactID and ClassRegister.control=3 and ClassRegister.Alternate=-1 order by ClassRegister.ContactID"
  Set rs = qd.OpenRecordset
  sData = "You have been registred as an alternate in these classes." & vbCrLf
  Do While Not rs.BOF And Not rs.EOF
   If ContactID <> rs("ContactID") And ContactID <> 0 Then
    sData = sData & vbCrLf & "The 577 Foundation"
    email = FirstValue("Select emailaddress from contacts where contactid=" & ContactID)
    If email <> -9999 And email <> "" And email <> " " Then
     DoCmd.SendObject acSendNoObject, , acFormatTXT, email, , , "577 Foundation", sData, False
    End If
    ExecuteSQL "Update ClassRegister set control=2 where RegID=" & RegID
    sData = "You have been registred as an alternate in these classes." & vbCrLf & vbCrLf
   End If
   ContactID = rs("ContactID").Value
   RegID = rs("RegID")
   sData = sData & "ClassName:" & vbTab & rs("Title") & vbCrLf
   sData = sData & "Quantity:" & vbTab & rs("Quantity") & vbCrLf
   sData = sData & "Fee:" & vbTab & vbTab & rs("Fee") & vbCrLf
   sData = sData & "ClassDate:" & vbTab & rs("date1") & vbCrLf
   rs.MoveNext
  Loop
  If Data <> "" Then
    sData = sData & vbCrLf & "The 577 Foundation"
    email = FirstValue("Select emailaddress from contacts where contactid=" & ContactID)
    If email <> -9999 And email <> "" And email <> " " Then
     DoCmd.SendObject acSendNoObject, , acFormatHTML, email, , , "577 Foundation", sData, False
    End If
    ExecuteSQL "Update ClassRegister set control=2 where RegID=" & RegID
  End If
  rs.Close
  qd.Close
 Set rs = Nothing
 Set qd = Nothing
End Function


'Function RunBatch()
' Dim ContactID As Integer, Amount As Integer, InvoiceSent As Boolean
' Dim qd As QueryDef, InvoiceID As Integer, sNotes As String
' Dim rs As Recordset
'  Set qd = CurrentDb.CreateQueryDef("")
'  qd.SQL = "Select ClassRegister.RegID,ClassRegister.Quantity,ClassRegister.ContactID,ClassRegister.Control,Classes.Fee,classes.title from ClassRegister, Classes where Classes.ClassID=ClassRegister.ClassID and Classes.PAD=0 and  ClassRegister.InvoiceID=0 and ClassRegister.Alternate=0 order by ClassRegister.ContactID"
'  Set rs = qd.OpenRecordset
'  Amount = 0
'  Do While Not rs.BOF And Not rs.EOF
'   If ContactID <> rs("ContactID") And ContactID <> 0 Then
'    InvoiceID = InvoiceContact(ContactID, Amount, sNotes, InvoiceSent)
'    If SendEmail Then SendInvoiceByMail InvoiceID
'   TrackRegs InvoiceID, True
'    Amount = 0
'    InvoiceSent = False
'    SendEmail = False
' '   sNotes = ""
'   End If
'   ContactID = rs("ContactID").Value
'   Amount = Amount + (rs("Quantity") * rs("Fee"))
'   TrackRegs rs("RegID")
'   sNotes = sNotes & "<" & rs("Title") & "_" & rs("Quantity") & ">  "
'   If rs("control") = 1 Then InvoiceSent = True
'   If rs("control") = 2 Then SendEmail = True
'   rs.MoveNext
'  Loop
' If Amount <> 0 Then
'   InvoiceID = InvoiceContact(ContactID, Amount, sNotes, InvoiceSent)
'   If SendEmail Then SendInvoiceByMail InvoiceID
'   TrackRegs InvoiceID, True
'  End If
'  rs.Close
'  qd.Close
'  ExecuteSQL "DELETE * FROM Invoices where  ([Invoices].[Amount] -(select sum(amount) from refunds where invoiceid = invoices.invoiceid)) <=0 ;"
'   BatchWebPAD
' Set rs = Nothing
' Set qd = Nothing
'End Function