Online Access Sürüm Güncelleme - Akifff - 28/06/2016
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.
"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.
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.
Şimdi XML dosyasını açınca yukarıdaki menüden XML Editey ile açın.
Artık linkinizi ve diğer bilgileri değiştirebilirsiniz. Değişiklikler otomatik olarak drive üzerindeki xml dosyanıza kaydedilecektir.
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...
Not: Kullanım sırasında eksik referans hatası "Can't find project or library" alıyorsanız aşağıdaki referanslar eksik olabilir.
Cvp: Online Access Sürüm Güncelleme - atoz112 - 29/06/2016
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.
Cvp: Online Access Sürüm Güncelleme - alperalper - 09/01/2018
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
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
Cvp: Online Access Sürüm Güncelleme - alperalper - 09/01/2018
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))
|