AccessTr.neT

Tam Versiyon: Online Access Sürüm Güncelleme
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
Evet Atoz hocamın da talebiyle, konuyu devam ettirerek sizlerinde katılımlarıyla daha güzel bir online güncelleme sistemi yapmayı düşündüm. Dün yukarıdaki yazıyı yazdıktan sonra bir iki deneme daha yaptım ve sistemin stabil çalışmasını başardım. 

Öncelikle kodlarda hata yok. Sorun oluşturduğumuz online xml ve yeni sürüm dosyasının linkinde. Bazı arkadaşlar bu işi kendi web sitelerine veya benzer sistemlere koyarak direct link almışlar. Ama herkesin böyle bir imkanı olmayabilir. Daha önceki konularda GoogleDrive veya Dropbox üzerinden bu sürüm güncelleme işlemi yapılabiliyormuş. Ama son güncellemelerle bazı değişiklikler var. Direk googledrive a koyarak paylaşım linkiyle bu işlemi olmuyor Access xml dosyasını okumuyordu. 

GENEL ÇALIŞMA PRENSİBİ:
Şimdi nasıl çalıştığına kısaca değineceğim. Aşağıdaki ekte trz-dosya-guncelleme veritabanında bir form ve iki modülü sisteminize aktarın. Yine ekte sürüm kontol.xml adlı dosyayıda indirin. Bu dosya Drive üzerinde duracak ve siz bunun içerisine yeni sürümün linkini ve versyon bilgilerini felan gireceksiniz.

XML DOSYASINI ONLINE YAPMAK

Ben bu işlem için Google Drive kullanıyorum. Ama farklı bir şekilde link alınıyor. Bunun için aşağıdaki videoyu izleyiniz.




XML Dosyasının içerik bilgisi aşağıdaki gibidir. Kırmızılı alanları istediğiniz gibi ayarlayabilirsiniz. Bu yazdıklarınız diğer kullanıcılar güncelleme sayfasını açınca görülecektir.

[Resim: do.php?imgf=146710759839841.png]
"Yeni Sürümün Linki" kısmına upload edeceğimiz yeni veritabanımızın linkini koyacağız. Bu linkide aynı yukarıdaki videoda anlatılan upload yapmalıyız. Aksi halde hata verir. Ayrıca upload ettiğimiz veritabanımızın adı ile mevcut veritabanlarının adları aynı olmalı.


Bu işlemi de yaptıktan sonra sıra XML linkinin adresini mevcut veritabanımıza yerleştirelim.
Veritabanımızda FtrzSurumKontrol formunun kod satırlarına aşağıdaki gibi XML dosyamızın linkini giriyoruz.


[Resim: do.php?imgf=146710916539081.png]

[Resim: do.php?imgf=146710916553852.png]


Artık formu açtığınızda size xml dosyasına girdiğiniz bilgileri verecek ve güncelleme olduğunu söyleyecek. İndir derseniz yeni sürümü indirecek ve Access i yeniden başlattığınızda yeni sürümü kullanıyor olacaksınız. Yeniden uyarayım tablolarınız bağlı tablo olmalı aksi halde hata veriyor.


XML DOSYASINI DRİVE DAN GÜNCELLEME

Her yeni güncellemede drivedaki xml dosyasının içeriğini değiştirerek herkesin aynı güncellemeye erişmesini sağlayabilirsiniz. Bunun için drive daki dosyayı iki der silip yenisi yüklerseniz muhtemelen dosyanızın linki değişir. Uzaktaki diğer veritabanlarındaki linkler yeni link olmayacağı için sistem bir işe yaramaz. Google Drive da xml dosyasının online düzelnleme şansımız var. Bunun için Drive da xml edity adlı bir eklenti indirmemiz gerekli. Driveda xml dosyanızı açın ve yukarıdaki menüden daha fazla uygulama bağla ile XML Editey i Drive a bağlayın.

[Resim: do.php?imgf=14671106974981.png]


[Resim: do.php?imgf=146711069760242.png]

Şimdi XML dosyasını açınca yukarıdaki menüden XML Editey ile açın.


[Resim: do.php?imgf=146711095894111.png]

Artık linkinizi ve diğer bilgileri değiştirebilirsiniz. Değişiklikler otomatik olarak drive üzerindeki xml dosyanıza kaydedilecektir.

[Resim: do.php?imgf=146711095905822.png]

Evet ben bu şekilde sorunsuz olarak çalıştırdım. Yorum görüş ve önerilerinizi bekliyorum. Anlatımım çok iyi değil kusuruma bakmayın. Saygılarımla... Img-grin




Not: Kullanım sırasında eksik referans hatası "Can't find project or library" alıyorsanız aşağıdaki referanslar eksik olabilir.

[Resim: do.php?imgf=14672078847581.jpg]
sayın Akifff,

eklediğiniz çalışmanızı kendi adıma inceleme ve deneme imkanım ve zamanım olmadı fakat,
ekran görsellerini de dahil etmek sureti ile anlaşılabilir bir anlatım ile açıklamalar sağladığınız ve paylaşımınız için teşekkür ederiz.emeğinize sağlık.

kendinizi geliştirme hususunda başarı grafiğinizin artması,paylaşımlarınızın ve konulara katılımlarınızın daim olması temennisi ile.

Bilginize…iyi çalışmalar,saygılar.
Arkadaşlar bu modülle ilgili bir sorun yaşıyorum. Bilgisi olan arkadaşlardan yardım bekliyorum....

Sn.Trz hocamın FTrzSurumKontrol ve FYedekleme projelerini kendi projeme dahil ettim. Ancak FYedekleme içinde olan bir modülde Split() fonksiyonu kullanılmış dolayısı ile sürümkontrol içindede aynı komut olduğundanmıdır nedir URL yi işaretleyip sorun çıkartıyor. Bir türlü düzeltemedim.

Dim strSavePath As String
   Dim URL As String, ext As String
   Dim buf, Ret As Long
   URL = DLast("link", "tversiyon")
   buf = Split(URL, ".")
   ext = buf(UBound(buf))
   strSavePath = CurrentProject.Path & "\t" & CurrentProject.Name
   Ret = URLDownloadToFile(0, URL, strSavePath, 0, 0)
   If Ret = 0 Then
   WebBrowser2.Visible = 0
   mesajtxt.Visible = 0
   DoCmd.MoveSize , , , 2400
    MsgBox "Güncelleme başarılı şekilde alındı." & vbNewLine & _
    "Yeni sürümün geçerli olması için uygulamayı yeniden başlatacağım...", vbInformation, "Mustafa "
      TrzYenidenBaslat
[Resim: do.php?imgf=151552367190611.png]
sorun çıkardığını tahmin ettiğim modüle ait kodlar:
Option Compare Database
Option Explicit
Private Type Size
       cx As Long
       cy As Long
End Type

Private Const LF_FACESIZE = 32

Private Type LOGFONT
       lfHeight As Long
       lfWidth As Long
       lfEscapement As Long
       lfOrientation As Long
       lfWeight As Long
       lfItalic As Byte
       lfUnderline As Byte
       lfStrikeOut As Byte
       lfCharSet As Byte
       lfOutPrecision As Byte
       lfClipPrecision As Byte
       lfQuality As Byte
       lfPitchAndFamily As Byte
       lfFaceName As String * LF_FACESIZE
End Type

Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias _
       "CreateFontIndirectA" (lplogfont As LOGFONT) As Long

Private Declare Function apiSelectObject Lib "gdi32" _
Alias "SelectObject" (ByVal hDC As Long, ByVal hObject As Long) As Long

Private Declare Function apiGetDC Lib "user32" _
 Alias "GetDC" (ByVal hwnd As Long) As Long

Private Declare Function apiReleaseDC Lib "user32" _
 Alias "ReleaseDC" (ByVal hwnd As Long, _
 ByVal hDC As Long) As Long

Private Declare Function apiDeleteObject Lib "gdi32" _
 Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare Function apiGetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hDC As Long, ByVal lpsz As String, ByVal cbString As Long, _
lpSize As Size) As Long

Declare Function apiCreateIC Lib "gdi32" Alias "CreateICA" _
 (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
 ByVal lpOutput As String, lpInitData As Any) As Long
 
Declare Function apiDeleteDC Lib "gdi32" Alias "DeleteDC" _
 (ByVal hDC As Long) As Long

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Const SM_CXVSCROLL = 2
Private Const LOGPIXELSX = 88


Function JustifyString(myctl As String, myfield As Variant, _
col As Integer, RightOrCenter As Integer, Optional Sform As String = "") As Variant
Dim UserControl As Control
Dim UserForm As Form
Dim lngWidth As Long

Dim intSize As Integer
Dim strText As String
Dim lngL As Long
Dim strColumnWidths As String
Dim lngColumnWidth As Long
Dim lngScrollBarWidth As Long
Dim lngOneSpace As Long
Dim lngFudge As Long
Dim arrCols() As String
Dim lngRet As Long


On Error Resume Next
lngFudge = 60

If Len(Sform & vbNullString) > 0 Then
   Set UserForm = Forms.FYedekleme.Controls(Sform).Form
Else
   Set UserForm = Forms.FYedekleme
End If
Set UserControl = UserForm.Controls.Item(myctl)

With UserControl
  If col > Split(arrCols(), .ColumnWidths, ";") Then Exit Function
  If col = .ColumnCount - 1 Then

    lngScrollBarWidth = GetSystemMetrics(SM_CXVSCROLL)
    lngScrollBarWidth = lngScrollBarWidth * (1440 / GetTwipsPerPixel())
  End If
  lngColumnWidth = Nz(Val(arrCols(col)), 1)
  lngColumnWidth = lngColumnWidth - (lngScrollBarWidth + lngFudge)
End With

strText = " "

lngWidth = StringToTwips(UserControl, strText)

If lngWidth > 0 Then
      lngOneSpace = Nz(lngWidth, 0)

      lngWidth = 0

    Select Case varType(myfield)
   
    Case 1 To 6, 7
    strText = str$(myfield)
   
    Case 8

    strText = myfield
   
    Case Else

       Call MsgBox("Field type must be Numeric, Date or String", vbOKOnly)
   
    End Select
   

    strText = Trim$(strText)

    lngWidth = StringToTwips(UserControl, strText)

    If lngWidth > 0 Then

        Select Case RightOrCenter
           Case -1

           strText = String(Int((lngColumnWidth - lngWidth) / lngOneSpace), " ") & strText
         
           Case 0

           strText = String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ") & strText _
              & String((Int((lngColumnWidth - lngWidth) / lngOneSpace) / 2), " ")
         
            Case 1

           strText = strText
         
            Case Else
       End Select
         JustifyString = strText
   End If
End If

Set UserControl = Nothing
Set UserForm = Nothing

End Function



Function Split(ArrayReturn() As String, ByVal StringToSplit As String, _
SplitAt As String) As Integer
  Dim intInstr As Integer
  Dim intCount As Integer
  Dim strTemp As String

  intCount = -1
  intInstr = InStr(StringToSplit, SplitAt)
  Do While intInstr > 0
    intCount = intCount + 1
    ReDim Preserve ArrayReturn(0 To intCount)
    ArrayReturn(intCount) = Left(StringToSplit, intInstr - 1)
    StringToSplit = Mid(StringToSplit, intInstr + 1)
    intInstr = InStr(StringToSplit, SplitAt)
  Loop
  If Len(StringToSplit) > 0 Then
    intCount = intCount + 1
    ReDim Preserve ArrayReturn(0 To intCount)
    ArrayReturn(intCount) = StringToSplit
  End If
  Split = intCount
End Function


Private Function StringToTwips(ctl As Control, strText As String) As Long
   Dim myfont As LOGFONT
   Dim stfSize As Size
   Dim lngLength As Long
   Dim lngRet As Long
   Dim hDC As Long
   Dim lngscreenXdpi As Long
   Dim fontsize As Long
   Dim hfont As Long, prevhfont As Long
   
   hDC = apiGetDC(0&)
   
   lngscreenXdpi = GetTwipsPerPixel()
   

   With myfont
       .lfFaceName = ctl.FontName & Chr$(0)  'Terminate with Null
       fontsize = ctl.fontsize
       .lfWeight = ctl.FontWeight
       .lfItalic = ctl.FontItalic
       .lfUnderline = ctl.FontUnderline
   
       .lfHeight = (fontsize / 72) * -lngscreenXdpi
   End With
                                   
   hfont = apiCreateFontIndirect(myfont)
   prevhfont = apiSelectObject(hDC, hfont)
               
   lngLength = Len(strText)
   lngRet = apiGetTextExtentPoint32(hDC, strText, lngLength, stfSize)
   
   hfont = apiSelectObject(hDC, prevhfont)
   
   lngRet = apiDeleteObject(hfont)
       
   lngRet = apiReleaseDC(0&, hDC)
       
   StringToTwips = stfSize.cx * (1440 / GetTwipsPerPixel())
       
End Function


Private Function GetTwipsPerPixel() As Integer

   Dim lngIC As Long
   lngIC = apiCreateIC("DISPLAY", vbNullString, _
    vbNullString, vbNullString)
   
   If lngIC <> 0 Then
       GetTwipsPerPixel = GetDeviceCaps(lngIC, LOGPIXELSX)
       apiDeleteDC lngIC
   Else
       GetTwipsPerPixel = 120
   End If
End Function



Arkadaşlar flood oluyor kusura bakmayınız ama sorunu aşağıdaki gibi çözdüm lakin bunların işlevleri aynı mı? şuana kadar bir hata vermedi ama....

ESKİ:

 URL = DLast("link", "tversiyon")
   buf = Split(URL, ".")
   ext = buf(UBound(buf))

YENİ:

 URL = DLast("link", "tversiyon")

buf = StrConv(URL, ".")
   '////////////////////////buf = Split(URL, ".")
   ext = buf(UBound(buf))