home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / vbwin / vbaccess / glob.bas < prev    next >
BASIC Source File  |  1995-02-26  |  4KB  |  159 lines
  1. Option Explicit
  2.  
  3. 'globale Konstanten und Variable
  4. Global Const DEFAULT = 0
  5. Global Const HOURGLASS = 11
  6. Global Const MB_OK = 0
  7. Global Const MB_YESNO = 4              ' Yes and No buttons
  8. Global Const IDYES = 6                 ' Yes button pressed
  9. Global Const MB_ICONSTOP = 16
  10. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  11. Global Const ERR_FILENOTFOUND = 53
  12. Global Const MODAL = 1
  13.  
  14.  
  15. 'Konstanten zur Unterscheidung der Aktionen
  16. 'Konstante wird aus dem Tag frmInfo ausgelesen
  17.  
  18. Global Const INFO_COMPACT = 0
  19. Global Const INFO_REPAIR = 1
  20.  
  21.  
  22. Global NL As String
  23. Global Datum As String
  24.  
  25. Global sMdb As String
  26. Global sMdb_pur As String
  27. Global db1 As Database
  28. Global sVNewFile As String
  29. Global sVOldFile As String
  30.  
  31.  
  32. 'Datenbank Version
  33. Global iVersion As Integer
  34. Global tSettings As table
  35.  
  36. Sub CenterForm (frmX As Form)
  37. frmX.Top = Screen.Height / 2 - frmX.Height / 2
  38. frmX.Left = Screen.Width / 2 - frmX.Width / 2
  39.  
  40. End Sub
  41.  
  42. Function Date2Julian& (DAT As String)
  43. 'erwartet Short oder longDate
  44. Dim iMonth As Integer, iDay As Integer, iYear As Integer
  45. Dim lTa As Long, lTb As Long, lTc As Long
  46.  
  47. iMonth = Val(Mid$(DAT, 4, 2))
  48. iDay = Val(Mid$(DAT, 1, 2))
  49. 'new  8.1.94: unterscheidet long an short Version
  50. Select Case Len(DAT)
  51. Case 8   'short Date
  52.    iYear = Year2BigYear%(Val(Mid$(DAT, 7, 2)))
  53. Case 10  'long Date
  54.    iYear = Val(Right$(DAT, 4))
  55. End Select
  56.  
  57. If iMonth > 2 Then
  58.     iMonth = iMonth - 3
  59. Else
  60.     iMonth = iMonth + 9
  61.     iYear = iYear - 1
  62. End If
  63. lTa = 146097 * (iYear \ 100) \ 4
  64. lTb = 1461& * (iYear Mod 100) \ 4
  65. lTc = (153 * iMonth + 2) \ 5 + iDay + 1721119
  66. Date2Julian& = lTa + lTb + lTc
  67. End Function
  68.  
  69. Function DaysBetweenDates& (DAT1 As String, DAT2 As String)
  70. DaysBetweenDates& = Abs(Date2Julian&(DAT1) - Date2Julian&(DAT2))
  71. End Function
  72.  
  73. Function MdbCheck () As Integer
  74.  
  75. Dim it As Integer
  76. Dim lmdb As Long
  77. Dim sMsg As String
  78. Dim iDgDef As Integer
  79. Dim iResponse As Integer
  80. Dim sTitel As String
  81.  
  82. Set tSettings = db1.OpenTable("Settings")
  83. If tSettings!MdbVersion <> iVersion Then
  84.   tSettings.Close
  85.   MdbCheck = True
  86.   Exit Function
  87. End If
  88.  
  89. If DaysBetweenDates&((tSettings!LastReorg), Datum) > 14 Then
  90.   sTitel = "Verdichtung"
  91.   sMsg = "Datenbank ist seit mehr als 14 Tagen nicht mehr komprimiert worden." + NL
  92.   sMsg = sMsg + "Wollen Sie jetzt verdichten ?" + NL
  93.   iDgDef = MB_YESNO + MB_ICONSTOP + MB_DEFBUTTON2
  94.   iResponse = MsgBox(sMsg, iDgDef, sTitel)
  95.   If iResponse = IDYES Then
  96.     tSettings.Close
  97.     If mdbVerdichten() Then
  98.       Set tSettings = db1.OpenTable("Settings")
  99.       tSettings.Edit
  100.       tSettings!LastReorg = Datum
  101.       tSettings.Update
  102.     End If
  103.   End If
  104. End If
  105. tSettings.Close
  106. End Function
  107.  
  108. Function mdbVerdichten () As Integer
  109.  
  110. Dim sTitel As String
  111. Dim sMsg As String
  112. Dim iDgDef As Integer
  113. Dim iResponse As Integer
  114.  
  115. Screen.MousePointer = HOURGLASS
  116. On Error GoTo Verdicht_Errorhandler
  117.  
  118. db1.Close
  119. Set db1 = OpenDatabase(sMdb, True)
  120. db1.Close
  121.  
  122. sVNewFile = sMdb_pur + ".mdb"
  123. sVOldFile = sMdb_pur + ".old"
  124.  
  125. Kill sVOldFile
  126. Name sVNewFile As sVOldFile
  127. Load frmInfo
  128. frmInfo.Tag = INFO_COMPACT  'Verdichten
  129. frmInfo.Show MODAL
  130. Set frmInfo = Nothing
  131. Set db1 = OpenDatabase(sMdb)
  132. Screen.MousePointer = DEFAULT
  133. mdbVerdichten = True
  134. Exit Function
  135.  
  136. Verdicht_Errorhandler:
  137. If Err = 3051 Or Err = 3000 Then
  138.   sTitel = "Verdichtung fehlgeschlagen !"
  139.   sMsg = "Datenbank kann nicht verdichtet werden, da sie von einem anderen Benutzer bereits ge÷ffnet ist !" + NL
  140.   sMsg = sMsg + "Zur Verdichtung alle Zugriffe beenden und Verdichtung nochmals starten !"
  141.   iDgDef = MB_OK + MB_ICONSTOP
  142.   iResponse = MsgBox(sMsg, iDgDef, sTitel)
  143.   Set db1 = OpenDatabase("Stamm.mdb")
  144.   Screen.MousePointer = DEFAULT
  145.   Exit Function
  146. End If
  147.   
  148. If Err = ERR_FILENOTFOUND Then
  149.   Resume Next
  150. End If
  151. Resume Next
  152. End Function
  153.  
  154. Function Year2BigYear% (iDay As Integer)
  155. 'Korrektur 1900 bzw 2000
  156. Year2BigYear% = IIf(iDay < 50, iDay + 2000, iDay + 1900)
  157. End Function
  158.  
  159.