أزيكم يا جماعة دى حاجة كدة لذيذة عشان تعمل أبديت من داخل برنامجك
طبعا العملية مش صعبة وانا جبتلكم الكود أهوة
بسم الله الرحمن الرحيم
الادوات :
FORM1 وتسمية FrmUpdate
اداة ProgressBar
عدد 2 زر كوماند
أداة aDownloadFile
اداة تيمر
الكود
'##############################################
'Upload the "version.ini" file to your own host
Private Const VersionURL = "http://www.alhosamnet.com/update/version.ini"
'
Private strOldVer As String
Private sNewVersion As String
Private sDescription As String
Private sURL As String
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Const SW_SHOWNORMAL = 1
Private cINI As clsINI
'
Private Sub aDownloadFile1_DownloadProgress(ByVal CurDownloadedBytes As Long)
'
ProgressBar1.Value = CurDownloadedBytes
'
End Sub
'
Private Sub aDownloadFile1_DownloadStateChange(ByVal CurState As UpdateNow.aStatesCode, ByVal StateStr As String)
'
If CurState = StatusCodeBeginDownloadData Then
If aDownloadFile1.FileLength > 0 Then ProgressBar1.Max = aDownloadFile1.FileLength
End If
'
End Sub
'
Private Sub Command2_Click()
'
aDownloadFile1.ShowConnectionDialog
'
End Sub
Private Sub Form_Load()
'لمعرفة هل الجهاز متصل ام لا
'If InternetAutodial(INTERNET_AUTODIAL_FORCE_ONLINE, 0) Then
'If Winsock1.LocalIP <> "127.0.0.1" Then
' imgConnected.Visible = True
' imgNotConnected.Visible = False
'Else
' imgConnected.Visible = False
' imgNotConnected.Visible = True
'End If
'
'--------------------------------------
'
FrmUpdate.Left = (FrmMain.Width - FrmUpdate.Width) / 2
FrmUpdate.Top = (FrmMain.Height - FrmUpdate.Height) / 3
'
Set cINI = New clsINI
cINI.INIFile = getAppPath & "config.ini"
aDownloadFile1.Tag = "GetNewVersionInfo"
'aDownloadFile1.RegName =??
'aDownloadFile1.RegID=??
'
End Sub
'
Private Sub Command1_Click()
strOldVer = cINI.ReadIni("Main", "LastVersion", cINI.INIFile)
If strOldVer = "" Then strOldVer = "1.0"
On Error Resume Next
Select Case aDownloadFile1.Tag
Case "GetNewVersionInfo"
aDownloadFile1.Tag = "GetingNewVersion"
picJinDu.Top = 645
CControl True
ProgressBar1.Value = 0
With aDownloadFile1
.LocalFile = getAppPath & "version.ini"
.URL = VersionURL
.DownType = ReadForceUpdate
.BeginDownload
End With
Case "BeginUpdate"
aDownloadFile1.Tag = "Updating"
picJinDu.Top = 1200
CControl True
ProgressBar1.Value = 0
aDownloadFile1.BeginDownload
Case "Updating"
Command1.Caption = "تحديثات"
CControl False
aDownloadFile1.Tag = "BeginUpdate"
aDownloadFile1.CancelDownload
Case "GetingNewVersion"
Command1.Caption = "بدء"
CControl False
aDownloadFile1.Tag = "GetNewVersionInfo"
aDownloadFile1.CancelDownload
End Select
End Sub
'
Private Sub aDownloadFile1_DownloadComplete(ByVal DownloadSuccess As Boolean)
If DownloadSuccess = False Then
If aDownloadFile1.Tag = "GetNewVersionInfo" Then
MsgBox "لم يستطع تحميل رسالة التحديث", vbCritical
CControl False
Command1.Caption = "بدء"
aDownloadFile1.Tag = "GetNewVersionInfo"
Else
MsgBox "لم يستطع تحميل التحديث الجديد", vbCritical
Command1.Caption = "تحديثات"
CControl False
aDownloadFile1.Tag = "BeginUpdate"
End If
Else
If aDownloadFile1.Tag = "GetingNewVersion" Then
UpdateNewVersion
Else
MsgBox "تم التحديث بنجاح !", vbInformation
'ShellExecute Me.hwnd, "", aDownloadFile1.LocalFile, "", "C:\", SW_SHOWNORMAL
ShellExecute Me.hwnd, "", aDownloadFile1.LocalFile, "", App.Path, SW_SHOWNORMAL
Unload Me
End If
End If
End Sub
Private Sub CControl(ByVal b As Boolean)
If b Then
Command1.Caption = "إحباط"
tmrImage.Enabled = True
picJinDu.Visible = True
imgConnected.Visible = True
imgNotConnected.Visible = False
Else
tmrImage.Enabled = False
picJinDu.Visible = False
imgConnected.Visible = False
imgNotConnected.Visible = True
End If
End Sub
'
Private Sub UpdateNewVersion()
'
sNewVersion = cINI.ReadIni("update", "Version", getAppPath & "version.ini")
sDescription = cINI.ReadIni("update", "Description", getAppPath & "version.ini")
sURL = Trim(cINI.ReadIni("update", "URL", getAppPath & "version.ini"))
sURL = Replace(sURL, Chr(0), "")
sURL = Replace(sURL, vbCrLf, "")
If sNewVersion <= strOldVer Or sURL = "" Then
MsgBox "لا يوجد إصدار جديد من البرنامج حاليا", vbInformation
Exit Sub
End If
With aDownloadFile1
.LocalFile = getAppPath & "ALMAISTRO.exe"
.URL = sURL
.DownType = ReadResynchronize ' so the control will support resume broken download
End With
aDownloadFile1.Tag = "BeginUpdate"
If MsgBox("الاصدار المتوفر الان :" & sNewVersion & ", " & vbCrLf & sDescription & vbCrLf & vbCrLf & " هل انت متأكد من تحديث هذا الاصدار الان ?", vbQuestion + vbYesNo) = vbYes Then
Command1_Click
Exit Sub
Else
Command1.Caption = "تحديثات"
CControl False
End If
End Sub
Private Sub imgConnected_Click()
'لقطع الاتصال
If InternetAutodialHangup(0) Then
imgConnected.Visible = False
imgNotConnected.Visible = True
End If
End Sub
'
Private Sub imgNotConnected_Click()
'لكى تتصل بالانترنت تلقائيا
If InternetAutodial(INTERNET_AUTODIAL_FORCE_UNATTENDED, 0) Then
imgConnected.Visible = True
imgNotConnected.Visible = False
End If
End Sub
'
Private Sub Timer1_Timer()
'
If picJinDu.Visible = True Then
imgConnected.Visible = True
imgNotConnected.Visible = False
End If
End Sub
'
Private Sub tmrImage_Timer()
'
tmrImage.Tag = Val(tmrImage.Tag) + 1
If tmrImage.Tag > 2 Then tmrImage.Tag = 0
picJinDu.Picture = Image1(Val(tmrImage.Tag)).Picture
'
End Sub
'
Private Function getAppPath()
'
getAppPath = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
'
End Function
######################################################
منتظرين الردود على ناااااااااااااااااار