Keskustelu: Ohjelmointikysymykset: VB6: Access kannan tila

erkki [17.05.2011 20:17:43]

Nyt pitäisi tehdä koodia VB6:lla joka selvittää onko Access kanta varattuna, eli auki jollain verkon työasemista, jos ei ole "error handleria" niin ohjelma kaatuu jos tapahtuu yhteentörmäys kannassa.
E

neau33 [17.05.2011 21:29:43]

Moi erkki!

Tutkit Dir komennolla onko koneella/hakemistossa, jolla kanta fyysisesti sijaitsee olemassa saman niminen .ldb -päätteinen (locked database - Access 2003 alas sekä ylöspäin) tai .laccdb - päätteinen (locked access database - Access 2007 ja ylöspäin) tiedosto kuin, itse tietokanta. Jos moinen löytyy niin pitää virheen ohituksen + Kill käskyn avulla, muutaman kerran ajastetusti pyörähtävässä loopissa, yritettävä poistaa/tsekata löytyykö em. tiedosto edelleen. Tämä johtuu sellaisesta ilmiöstä, että ko. tiedosto jää melko tasaisesti, varsinkin virhetilanteissa, kummittelemaan vaikka kanta suljettaisiinkin.

Elikäs jotain tällaista:

Private Command1_Click()

  Dim vipu As integer
  Dim polku1 As string
  Dim polku2 As String

  polku = Lcase(Text1.Text)

  If Len(polku) > 4 And InStr(polku, ".mdb") > 0 Then
     If Right(polku, 4) = ".mdb" Then vipu = 1
  ElseIf Len(polku) > 6 And InStr(polku, ".accdb") > 0 Then
     If Right(polku, 6) = ".accdb" Then vipu = 2
  End if

  Select case vipu
     Case 1
        polku2 = Replace(polku1, ".mdb", ".ldb")
     Case 2
         polku2 = Replace(polku1, ".accdb", ".laccdb")
     Case else
        Exit Sub
   End Select

   Static laskuri As Integer
takaisin:

   DoEvents
   If Dir(polku2) = "" Then
      'avaa tietokanta (polku1)...
      laskuri = 0: Exit Sub
   Else
      On Error Resume Next
      Kill polku
      If Err <> 0 Then
         Err.Clear
         On Error Goto 0
         If laskuri < 10 Then
            laskuri = lakuri + 1
         Else
            MsgBox "Tietokanta varattu, yritä myöhemmin uudelleen"
            laskuri = 0: Exit Sub
         End If
         ajastin 0.5 'puoli sekuntia
         GoTo takaisin
      Else
         GoTo takaisin
      End If
   End If

End Sub

Sub ajastin (viive As single)
   viive = viive + Timer
   Do While viive > Timer: DoEvents: Loop
End Sub

erkki [23.05.2011 22:14:02]

nea
Ok, silloin kun kanta on avattu itse Access ohjelmalla syntyy tuo .ldb, mutta kun kanta on avattu omalla VB koodilla käyttäen DAO 3.6 niin ei synny tätä .ldb-fileä. Tosin voin luoda vastaavanlaisen tilapäis filen kun kanta avataan ja poistaa sen kun kanta suljetaan. Onkohan tämä nyt SQL vai joku muu mutta tällä avaan kannan:
Set asdb = OpenDatabase(datakanta, True, False, "")
Set astaulu = asdb.OpenRecordset("nimet", dbOpenDynaset

Kiitos koodista, kokeilen sitä.

neau33 [24.05.2011 16:24:02]

Moi taas erkki!

Jos käyttää DAO DNS-yhteyttä (dbUseODBC) niin edellä mainitsemani lock-tiedosto(t) luodaan yhteyttä avattaessa ja poistetaan, kun yhteys suljetaan.

Esim. Windows XP:ssä ODBC yhteystietolähde luodaan seuraavasti:
Käynnistä -> Ohjaupaneeli -> Vaihda perinteiseen näkymään -> Valvontatyökalut -> Tietolähteet (ODBC) -> Järjestelmätietolähde (DNS) -> Lisää -> Microsoft Access Driver (*.mdb, *.accdb) -> Valmis -> Data Source Name -tekstiruuttuun esim. DaoTest ja Description -tekstiruutuun esim. DaoTest Connection -> Select -> etsitään haluttu tietokanta (esim. X:\tietokannat\tietokanta.accdb) ja klikataan OK -> OK.

Dim wrkODBC As DAO.Workspace
Dim db As DAO.Database
Dim rs As DAO.Recordset

Private Sub Command1_Click()

   Dim vipu As integer
   Dim polku1 As string
   Dim polku2 As String
   polku1 = "X:\tietokannat\tietokanta.accdb" 'esim.
   Label1.Caption = "Tietokantayhteys: luodaan yhteyttä"

   If Dir(polku1) = "" Then
      MsgBox "Tiedostoa " & poku1 & " ei löydy!"
      Label1.Caption = "Tietokantayhteys: ei yhteyttä"
      Exit Sub
   End If

   If InStr(polku1, ".mdb") > 0 Then
       If Right(polku1, 4) = ".mdb" Then vipu = 1
   ElseIf InStr(polku1, ".accdb") > 0 Then
       If Right(polku1, 6) = ".accdb" Then vipu = 2
   End if

   Select case vipu
       Case 1
            polku2 = Replace(polku1, ".mdb", ".ldb")
       Case 2
             polku2 = Replace(polku1, ".accdb", ".laccdb")
       Case else
            Exit Sub
   End Select

   Static laskuri As Integer
takaisin:

   DoEvents

   If Dir(polku2) = "" Then
       AvaaTietokanta
       laskuri = 0: Exit Sub
   Else
      On Error Resume Next
      Kill polku2
      If Err <> 0 Then
         Err.Clear
         On Error Goto 0
         If laskuri < 10 Then
            laskuri = laskuri + 1
         Else
            Label1.Caption = "Tietokantayhteys: ei yhteyttä"
            MsgBox "Tietokanta varattu, yritä myöhemmin uudelleen"
            laskuri = 0: Exit Sub
         End If
         Label1.Caption = _
         "Tietokantayhteys: ei yhteyttä, yritetään uudestaan..."
         ajastin 0.5 'puoli sekuntia
         GoTo takaisin
      Else
         GoTo takaisin
      End If
   End If

End Sub

Sub AvaaTietokanta()

   Set wrkODBC = CreateWorkspace("", "", "", dbUseODBC)

   If wrkODBC Is Nothing Then
      MsgBox "Workspace objektin luonti epäonnistui!"
      Exit Sub
   End If

   Set db = wrkODBC.OpenDatabase("DaoTest", _
   dbDriverNoPrompt, False, _
   "ODBC;DATABASE=;UID=Admin;PWD=;DSN=DaoTest")
   Set rs = db.OpenRecordset("TAULU1", _
   dbOpenDynaset, dbRunAsync, dbOptimisticValue) 'esim.
   Label1.Caption = "Yhteys tietokantaan "
   Label1.Caption = "Tietokantayhteys: " & db.Name

   'Testi
   MsgBox rs.Fields(0).Value

   rs.Close: Set rs = Nothing
   db.Close: Set db = Nothing
   wrkODBC.Close: Set wrkODBC = Nothing
   Label1.Caption = "Tietokantayhteys: yhteys katkaistu"

End Sub

Sub ajastin (viive As single)
    viive = viive + Timer
    Do While viive > Timer: DoEvents: Loop
End Sub

(oikea nimi)

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen