home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / vbwin / vbaccess / frmmain.frm < prev    next >
Text File  |  1995-02-26  |  4KB  |  155 lines
  1. VERSION 2.00
  2. Begin Form frmMain 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "BP Professionell Demo"
  6.    ClientHeight    =   4830
  7.    ClientLeft      =   2340
  8.    ClientTop       =   2445
  9.    ClientWidth     =   7365
  10.    Height          =   5520
  11.    Icon            =   FRMMAIN.FRX:0000
  12.    Left            =   2280
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   4830
  15.    ScaleWidth      =   7365
  16.    Top             =   1815
  17.    Width           =   7485
  18.    Begin Menu mnuFile 
  19.       Caption         =   "&File"
  20.       Begin Menu mnuFileDelete 
  21.          Caption         =   "&L÷sch Demo"
  22.       End
  23.       Begin Menu mnuFileEnd 
  24.          Caption         =   "&Beenden"
  25.       End
  26.    End
  27.    Begin Menu mnuReorg 
  28.       Caption         =   "&Reorganisation"
  29.       Begin Menu mnuReorgKomp 
  30.          Caption         =   "&Verdichten"
  31.       End
  32.       Begin Menu mnuReorgRep 
  33.          Caption         =   "&Reparatur"
  34.       End
  35.    End
  36.    Begin Menu mnuAbout 
  37.       Caption         =   "&▄ber"
  38.       Begin Menu mnuAboutInfo 
  39.          Caption         =   "&Info"
  40.       End
  41.    End
  42. End
  43. Option Explicit
  44.  
  45. Sub Form_Load ()
  46. Dim sPfad As String
  47. Dim sNewFile As String
  48. Dim sOldFile As String
  49. Dim sMitFile As String
  50.  
  51. 'wie hei▀t meine Datenbank (Fⁿr Komprimierung)
  52. sMdb_pur = "KdTest"
  53. ' wo ist meine Applikation
  54. sPfad = app.Path + "\"
  55. 'wie hei▀t die Datenbank
  56. sMdb = sPfad + sMdb_pur + ".mdb"
  57. 'auf das Laufwerk und in den Pfad wechseln
  58. ChDrive Left$(sPfad, 2)
  59. ChDir Left$(sPfad, Len(sPfad) - 1)
  60.  
  61. Set db1 = OpenDatabase(sMdb)
  62.  
  63. NL = Chr$(10) + Chr$(13)
  64. Datum = Mid$(Date$, 4, 2) + "." + Left$(Date$, 2) + "." + Right$(Date$, 2)
  65. CenterForm Me
  66.  
  67. Exit Sub
  68. '######################################################################
  69. 'Um nachstehende Funktion zu aktivieren, bitte zuerst Vorbereitungen
  70. 'wie in Artikel BP-Professionel  4/94 beschrieben, treffen.
  71. 'danach EXIT sub entfernen
  72.  
  73. 'iVersion = 1 'Stand vom 01.9.94
  74. iVersion = 2 'Stand vom 20.9.94
  75.  
  76. If MdbCheck() = True Then
  77.   'Umbenennen und tabellenschieben...
  78.   db1.Close
  79.   '÷ffnen mit exclusivem Zugriff
  80.   Set db1 = OpenDatabase(sMdb, True)
  81.   db1.Close
  82.  
  83.   sNewFile = sMdb
  84.   sOldFile = sPfad + sMdb_pur + ".old"
  85.   sMitFile = sPfad + sMdb_pur + ".new"
  86.  
  87.   On Error GoTo RenameErrorhandler
  88.   'altes File l÷schen wenn vorhanden
  89.   Kill sOldFile
  90.   'vorhandene Datenbank .mdb umbenennen in .old
  91.   Name sNewFile As sOldFile
  92.   'neue mitgelieferte Datenbank [.NEW] umbenennen
  93.   Name sMitFile As sNewFile
  94.   frmUpdate.Show MODAL
  95.   Set frmUpdate = Nothing
  96.   '...alles upgedatet.. open Database
  97.   Set db1 = OpenDatabase(sMdb)
  98.   'open Table
  99.   Set db1 = OpenDatabase("Settings")
  100.   tSettings.Edit
  101.   tSettings!MdbVersion = iVersion
  102.   tSettings.Update
  103.   tSettings.Close
  104.   Screen.MousePointer = Default
  105.   Exit Sub
  106. End If
  107. Exit Sub
  108.  
  109. RenameErrorhandler:
  110. If Err = ERR_FILENOTFOUND Then 'File not found
  111.    Resume Next
  112. End If
  113. Resume Next
  114.  
  115.  
  116.  
  117. End Sub
  118.  
  119. Sub Form_Unload (Cancel As Integer)
  120. 'nicht vergessen, die Datenbank zu schlie▀en...
  121. db1.Close
  122. Set db1 = Nothing
  123. End
  124. End Sub
  125.  
  126. Sub mnuAboutInfo_Click ()
  127. frmIntro1.Show 1
  128. End Sub
  129.  
  130. Sub mnuFileDelete_Click ()
  131. frmKunde.Show MODAL
  132. End Sub
  133.  
  134. Sub mnuFileEnd_Click ()
  135. Unload Me
  136. End Sub
  137.  
  138. Sub mnuReorgKomp_Click ()
  139. Dim iRet As Integer
  140. iRet = mdbVerdichten()
  141.  
  142. End Sub
  143.  
  144. Sub mnuReorgRep_Click ()
  145. Screen.MousePointer = Hourglass
  146. db1.Close
  147. Load frmInfo
  148. frmInfo.Tag = INFO_REPAIR
  149. frmInfo.Show MODAL
  150. Set frmInfo = Nothing
  151. Set db1 = OpenDatabase(sMdb)
  152. Screen.MousePointer = Default
  153. End Sub
  154.  
  155.