Skip to main content

AccessTr.neT


SQL üzerinden Access Sürüm Güncelleme

SQL üzerinden Access Sürüm Güncelleme

Question #1
Merhaba arkadaşlar, 

Ekteki sistemde Sayın Taruz un yaptığı güncelleme sistemini kullanıyorum. Bu sistem bir XML dosyasını internet üzerinden kontrol edilerek içerisindeki link ile yeni access.mdb dosyası ile güncelleme yapıyor. Yalnız bunun için internet alanına bir hosting e ihtiyaç var. Dropbox veya Google ın drive sisteminde yeni güncellemelerle bu işlemi yaptıramadım. Benimde aklıma şu geldi, benim tablolarım zaten Sql üzerinden çalışıyor. Sistemin XML üzerinden alacağı bilgileri ben Sql üzerinden tabloya girsem bu işlemi yaptırabilirim diye düşündüm. Bu kodlar üzerinde ne türlü değişiklikler yapmam gerekli. Fikir verebilecek olan arkadaşlar varsa çok sevinirim.

Kod aşağıdaki gibidir. Ayrıca ekteki dosyada FTrzSurumKontrol formunun kodlarıdır.

Kod:
Option Compare Database
#If VBA7 Then
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias _
  "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
    szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
#Else
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
  "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal _
    szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    #End If

Sub LinkTazele()

Open CurrentProject.Path & "\trz.txt" For Input As #1
Input #1, Text
Close #1

lnk = Mid(Text, InStr(1, Text, ":\") - 1)
lnk2 = lnk

Kill CurrentProject.Path & "\trz.txt"

If Right(lnk2, Len(lnk2) - InStrRev(lnk2, "\")) <> _
Right(lnk, Len(lnk) - InStrRev(lnk, "\")) Then
mesajtxt.Caption = "Dosyanın, veritabanı dosyanız olduğuna emin olun.."
mesajtxt.ForeColor = vbBlue
Else
Dim rst As New ADODB.Recordset
Dim sorgu As String
sorgu = "SELECT Name FROM MsysObjects WHERE Name Not Like '*" & "TMPC" & "*' AND Type=6 order by name desc"
rst.Open sorgu, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
rst.MoveFirst
Do Until rst.EOF
Tablo = rst(0)

DoCmd.DeleteObject acTable, Tablo
DoCmd.TransferDatabase acLink, "Microsoft Access", lnk, acTable, Tablo, Tablo
rst.MoveNext

Loop

Set rst = Nothing

mesajtxt.Visible = True
mesajtxt.Caption = "Veritabanı dosyanız başarıyla bağlandı.."
mesajtxt.ForeColor = vbBlue

End If

End Sub
Private Sub Form_Open(Cancel As Integer)
DoCmd.MoveSize , , , 2400

If Len(Dir(CurrentProject.Path & "\trz.txt")) > 0 Then
LinkTazele

End If

On Error Resume Next
'Bağlantı adresini kopyaladığınız XML linkini burada tanımlayacaksınız..
XMLLink = "http://www.raykentlojistik.com.tr/userfiles/file/pbif.xml"

Metin1 = ""
Metin3.Caption = ""
tt = DFirst("ID", "tversiyon")
CurrentDb.Execute "delete from tversiyon where ID<>" & tt
ImportXML XMLLink, acAppendData

vv = DLast("versiyon", "tversiyon")

If vv <> DFirst("versiyon", "tversiyon") Then
Metin1 = DFirst("versiyon", "tversiyon")
Metin3.ForeColor = vbRed
Metin3.Caption = "Uygulamanın yeni bir sürümü (" & DLast("versiyon", "tversiyon") & ") mevcut.. " & Chr(10) & Chr(13) & _
"Yeni sürümü indirmek için tıklayınız.."
Komut0.Caption = "Şimdi değil.."
Else
Metin1 = DFirst("versiyon", "tversiyon")
Metin3.Caption = "Uygulamanın en son sürümünü kullanmaktasınız.." & vbNewLine & _
DFirst("mesaj", "tversiyon")
Metin3.ForeColor = vbBlack
End If
Metin7 = DLast("bilgi", "tversiyon")
End Sub

Function BagliTabloLinki(TabloAdi As String)
Dim db As DAO.Database, Ret
On Error GoTo DBNameErr
Set db = CurrentDb()
Ret = db.TableDefs(TabloAdi).Connect
BagliTabloLinki = Right(Ret, Len(Ret) - (InStr _
                                   (1, Ret, "DATABASE=") + 8))
Exit Function
DBNameErr:
BagliTabloLinki = 0
End Function
Sub BagliTabloLinkiKaydet()
Dim rs As New ADODB.Recordset
Dim sorgu As String
sorgu = "SELECT Name FROM MsysObjects WHERE Name Not Like '*" & "TMPC" & "*' AND Type=6 order by name desc"
rs.Open sorgu, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If rs.RecordCount = 0 Then Exit Sub
baglitabloyolu = Len(Dir(BagliTabloLinki(rs(0))))
If baglitabloyolu <> 0 Or Mid(rs(0), 1, 4) <> "~TMP" Then
lnk = BagliTabloLinki(rs(0))


On Error Resume Next
    Dim objStream As stream
    Set objStream = New stream
    objStream.Open
    objStream.Position = 0
    objStream.Charset = "UTF-8"
    objStream.WriteText lnk
    objStream.SaveToFile CurrentProject.Path & "\trz.txt", adSaveCreateOverWrite

End If

Set rs = Nothing

End Sub

Private Sub Komut0_Click()
DoCmd.Close
End Sub

Private Sub Metin3_Click()
If Mid(Metin3.Caption, 13, 4) = "Yeni" Then
DoCmd.MoveSize , , , 4200

WebBrowser2.Visible = -1
Komut0.Top = 2500
WebBrowser2.Navigate _
          "about:<html><body scroll='no'>" & _
          "<center><img src='http://dl.dropbox.com/u/78997398/trz-bekle.gif'></img></center></body></html>"
          On Error Resume Next
WebBrowser2.BorderThemeColorIndex = 5
mesajtxt.Visible = -1
mesajtxt.Caption = "İndiriliyor..."
Bekle 2
BagliTabloLinkiKaydet
    Set sas = CreateObject("Scripting.FileSystemObject")
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üncellediğiniz için teşekkür ederiz.." & vbNewLine & _
     "Yeni sürümün geçerli olması için uygulamayı yeniden başlatacağım..", vbInformation, "Taruz"
       TrzYenidenBaslat

    Else
        MsgBox "Hata oluştu..", vbCritical, "Taruz.."
        Quit
    End If
   Else
     MsgBox "Kullandığınız sürüm..: " & DFirst("versiyon", "tversiyon"), vbInformation, "Taruz.."
    End If
End Sub

Public Function Bekle(Sure As Single)
Dim Basla As Single

   On Error GoTo Bekle_Error

Basla = Timer
Do
DoEvents
Loop Until Basla + Sure < Timer

   On Error GoTo 0
   Exit Function

Bekle_Error:

End Function

Private Sub Metin3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
MauseEL IDC_HAND
End Sub


Teşekkürler.

.rar pbifsurumkontroldeneme.rar (Dosya Boyutu: 926,3 KB | İndirme Sayısı: 12)
Cevapla
#2
sayın Akifff,

bahsettiğiniz talebinize yönelik olarak;

İnternetten sürüm güncelleme

yukarıda bağlantısı yazılı olan ve sizin de bazı bilgilendirmeler ile katılımda bulunduğunuz konuyu hatırlatmak adına tekrar incelemeniz belki bir fikir verebilir.

bilginize...iyi çalışmalar,saygılar.
Herkes,kendisinin AR-GE'cisidir...


Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler
Alt Form Denetim Değerlerine ulaşma ve Alt Form Güncelleme
Kapatırken Düzenle (Compact On Close) Seçeneğinin İşaretlenmesi Hakkında
Cevapla
#3
Sayın Atoz, bu konuda gelime sağladım.

Online txt dosyası yerine Sql üzerinden SürümGüncelleme tablosundaki değerleri uzaktan elle giriyorum. Yeni versyonun linkinide aynı tabloya ekliyorum. Uzaktaki bilgisayarlar güncelleme uyarısı alıyor. Fakat güncelleme yapınca dosya türü hatalı uyarısı veriyor ve veritabanı bozuluyor. 

Bu durumda bu talebim aslında çözülmüş oldu. Veridiğini konuyu takip ediyorum bu konuyu kapatabilirsiniz. Saygılarımla...
Cevapla
#4
sayın Akifff,

Alıntı:Bu durumda bu talebim aslında çözülmüş oldu

ifadeniz öncesinde yazdıklarınıza göre değerlendirilecek olunduğunda sanırım sorun hali hazırda devam ediyor veya bu belirttiğiniz sorunlara maruz kalıyorsunuz kullanımlar akabinde.

konunun kapatılmasını talep etmişsiniz fakat isterseniz bu sorunlarla hangi işlemi yaparken karşılaşıyorsunuz (aslında,ekran görüntülerini de konunuza dahil edebilirsiniz) veya bu işlemleri gerçekleştirirken kullandığınız uygulamanızın yeni bir hali mevcutsa bunu ekleyebilir ve bu uygulama üzerinden incelemeler söz konusu olabilir,bahsettiğiniz hatalara neden olan kod yazımları mevcutsa kontrol etmek adına.

site arama sayfasında araştırmak sureti ile uyarıları kapatma hususunda konuları inceleyebilir paylaşılan kodları deneyebilirsiniz.

dosya türü hatasını da doğru tanımlama yazmak sureti ile giderebilirsiniz.

son olarak;
eğer yine de konunuzun kapatılmasını ve Cevaplanmış Sorular kategorisi içerisine taşınmasını isterseniz elbette tercih ve takdir sizindir.bu mesaj,naçizane kendi adıma,henüz konunuzun çözüme ulaşmış olmadığı kanısı ile yazılmıştır.

bilginize...iyi çalışmalar,saygılar.
Herkes,kendisinin AR-GE'cisidir...


Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler
Alt Form Denetim Değerlerine ulaşma ve Alt Form Güncelleme
Kapatırken Düzenle (Compact On Close) Seçeneğinin İşaretlenmesi Hakkında
Cevapla
#5
Tabiki kalsın eğer faydası olur derseniz ben yaptıklarımı paylaşmaktan memnuniyet duyarım. Hem benim sistemim hemde başka arkadaşların yaptıklarını düzeltmesi adına güzel olabilir. Teşekkürler. Ben burada sistemimden biraz bahsederim gün içerisinde.
Cevapla
#6
Sayın Akifff,

Talebiniz doğrultusunda,konunuzun bu bahsini yaptığınız paylaşımları sunmanız için bir süre daha Sorular kategorisinde kalması uygun görülmüştür.

sadece çözüm bekleyen değil aynı zamanda gerek kendi ve gerekse de harici çabaları ve araştırmaları (kaldı ki,bunlar;kendinize her zaman için artı değer katan girişimler ve gelişmelerdir) nezdinde elde ettiği çözümleri paylaşıma sunma ve çözüm önerilerine alternatif öneriler de katabilmek ve aynı zamanda üreten de olmak adına bu yaklaşımınızdan dolayı teşekkür ederim.

gerektiğinde paylaşımlarınız üzerine yorum veya bilgilendirmelerin de yapılması söz konusu olacaktır,tam anlamda çözüm elde etmek ve konunun Cevaplanmış Sorular Kategorisi'ne taşınmasına geçerli zemin oluşturuncaya değin.

Bilginize…iyi çalışmalar,saygılar.
Herkes,kendisinin AR-GE'cisidir...


Konulara eklenen Uygulama içeriğine yönelik Tavsiyeler
Alt Form Denetim Değerlerine ulaşma ve Alt Form Güncelleme
Kapatırken Düzenle (Compact On Close) Seçeneğinin İşaretlenmesi Hakkında
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da