Centar za edukaciju-BiH

iCentar → Racunari i oprema → Programirannje i baze podataka → Access


Prosiri i skupi Opcije teme
Stranice (1):1
 Prikazi prvu neprocitanu poruku

#1 01.04.2015 14:55
MOZEBITIPONOVO Van mreze
Clan
Registrovan od:22.03.2012
Postovi:139


Predmet:Samo jedno otvaranje baze
Pozdrav!

Negde sam jednom našao na nekom forumu, sada kada mi treba nema šansi. Kako da se ne dozvoli otvaranje iste baze dva puta?
↑  ↓

#2 01.04.2015 16:38
pmiroslav Van mreze
Clan
Registrovan od:02.02.2009
Postovi:1,458


Predmet:Re: Samo jedno otvaranje baze
Probaj ovo. Kopiraj ovaj kod u neki modul i onda napravi Macro kojeg čeÅ¡ nazvati Autoexec i u njemu slijedeće:

Action: Run Code
Function: =winCheckMultipleInstances(False)

PreuzmiIzvorni kôd (vbnet):
  1. Option Compare Database
  2.  
  3. '******************** Code Start ********************
  4. ' Module mdlCheckMultipleInstances
  5. ' © Graham Mandeno, Alpha Solutions, Auckland, NZ
  6. ' graham@alpha.co.nz
  7. ' This code may be used and distributed freely on the condition
  8. '  that the above credit is included unchanged.
  9.  
  10. Private Const cMaxBuffer = 255
  11.  
  12. Private Declare Function apiGetClassName Lib "user32" _
  13.   Alias "GetClassNameA" _
  14.   (ByVal hWnd As Long, _
  15.   ByVal lpClassName As String, _
  16.   ByVal nMaxCount As Long) _
  17.   As Long
  18.    
  19. Private Declare Function apiGetDesktopWindow Lib "user32" _
  20.   Alias "GetDesktopWindow" _
  21.   () As Long
  22.  
  23. Private Declare Function apiGetWindow Lib "user32" _
  24.   Alias "GetWindow" _
  25.   (ByVal hWnd As Long, _
  26.   ByVal wCmd As Long) _
  27.   As Long
  28.  
  29. Private Const GW_CHILD = 5
  30. Private Const GW_HWNDNEXT = 2
  31.  
  32. Private Declare Function apiGetWindowText Lib "user32" _
  33.   Alias "GetWindowTextA" _
  34.   (ByVal hWnd As Long, _
  35.   ByVal lpString As String, _
  36.   ByVal aint As Long) _
  37.   As Long
  38.  
  39. Private Declare Function apiSetActiveWindow Lib "user32" _
  40.   Alias "SetActiveWindow" _
  41.   (ByVal hWnd As Long) _
  42.   As Long
  43.  
  44. Private Declare Function apiIsIconic Lib "user32" _
  45.   Alias "IsIconic" _
  46.   (ByVal hWnd As Long) _
  47.   As Long
  48.  
  49. Private Declare Function apiShowWindowAsync Lib "user32" _
  50.   Alias "ShowWindowAsync" _
  51.   (ByVal hWnd As Long, _
  52.   ByVal nCmdShow As Long) _
  53.   As Long
  54.  
  55. Private Const SW_SHOW = 5
  56. Private Const SW_RESTORE = 9
  57.  
  58. Public Function winGetClassName(hWnd As Long) As String
  59. Dim sBuffer As String, iLen As Integer
  60.   sBuffer = String$(cMaxBuffer - 1, 0)
  61.   iLen = apiGetClassName(hWnd, sBuffer, cMaxBuffer)
  62.   If iLen > 0 Then
  63.     winGetClassName = Left$(sBuffer, iLen)
  64.   End If
  65. End Function
  66.  
  67. Public Function winGetTitle(hWnd As Long) As String
  68. Dim sBuffer As String, iLen As Integer
  69.   sBuffer = String$(cMaxBuffer - 1, 0)
  70.   iLen = apiGetWindowText(hWnd, sBuffer, cMaxBuffer)
  71.   If iLen > 0 Then
  72.     winGetTitle = Left$(sBuffer, iLen)
  73.   End If
  74. End Function
  75.  
  76. Public Function winGetHWndDB(Optional hWndApp As Long) As Long
  77. Dim hWnd As Long
  78. winGetHWndDB = 0
  79. If hWndApp <> 0 Then
  80.   If winGetClassName(hWndApp) <> "OMain" Then Exit Function
  81. End If
  82. hWnd = winGetHWndMDI(hWndApp)
  83. If hWnd = 0 Then Exit Function
  84. hWnd = apiGetWindow(hWnd, GW_CHILD)
  85. Do Until hWnd = 0
  86.   If winGetClassName(hWnd) = "ODb" Then
  87.     winGetHWndDB = hWnd
  88.     Exit Do
  89.   End If
  90.   hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
  91. Loop
  92. End Function
  93.  
  94. Public Function winGetHWndMDI(Optional hWndApp As Long) As Long
  95. Dim hWnd As Long
  96. winGetHWndMDI = 0
  97. If hWndApp = 0 Then hWndApp = Application.hWndAccessApp
  98. hWnd = apiGetWindow(hWndApp, GW_CHILD)
  99. Do Until hWnd = 0
  100.   If winGetClassName(hWnd) = "MDIClient" Then
  101.     winGetHWndMDI = hWnd
  102.     Exit Do
  103.   End If
  104.   hWnd = apiGetWindow(hWnd, GW_HWNDNEXT)
  105. Loop
  106. End Function
  107.  
  108. Public Function winCheckMultipleInstances(Optional fConfirm As Boolean = True) As Boolean
  109. Dim fSwitch As Boolean, sMyCaption As String
  110. Dim hWndApp As Long, hWndDb As Long
  111. On Error GoTo ProcErr
  112.   sMyCaption = winGetTitle(winGetHWndDB())
  113.   hWndApp = apiGetWindow(apiGetDesktopWindow(), GW_CHILD)
  114.   Do Until hWndApp = 0
  115.     If hWndApp <> Application.hWndAccessApp Then
  116.       hWndDb = winGetHWndDB(hWndApp)
  117.       If hWndDb <> 0 Then
  118.         If sMyCaption = winGetTitle(hWndDb) Then Exit Do
  119.       End If
  120.     End If
  121.     hWndApp = apiGetWindow(hWndApp, GW_HWNDNEXT)
  122.   Loop
  123.   If hWndApp = 0 Then Exit Function
  124.   If fConfirm Then
  125.     If MsgBox(sMyCaption & " is already open@" _
  126.       & "Do you want to open a second instance of this database?@", _
  127.       vbYesNo Or vbQuestion Or vbDefaultButton2) = vbYes Then Exit Function
  128.   End If
  129.   apiSetActiveWindow hWndApp
  130.   If apiIsIconic(hWndApp) Then
  131.     apiShowWindowAsync hWndApp, SW_RESTORE
  132.   Else
  133.     apiShowWindowAsync hWndApp, SW_SHOW
  134.   End If
  135.   Application.Quit
  136. ProcEnd:
  137.   Exit Function
  138. ProcErr:
  139.   MsgBox Err.Description
  140.   Resume ProcEnd
  141. End Function
Pozdrav
Ovaj post je ureden 1 puta. Posljednja izmjena 01.04.2015 16:39 od strane pmiroslav. ↑  ↓

Stranice (1):1

Srodne teme

Ko je online?

Aktivni clanovi:
nema clanova


Kontakt
Sva vremena su GMT +01:00. Trenutno vrijeme: 8: 44 pm.