Upload File to internet

عمل برنامج بالفيجوال بيسك لل upload يتطلب نوعا ما الكثير

وعليك باستخدام دوال ال API الخاصة بال FTP لعمل ذلك

اخي العزيز اليك طلبك .

اولا:متطلبات البرنامج

FORM1 ونسمية FrmUpdate

اداة ProgressBar

عدد 2 زر امر.

أداة aDownloadFile وستجدها بالمرفق.

اداة Timer

ثانيا:الاكواد

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

ثالثا: مع المرفقات ملف يسمى Desktop.zip وهو ملفات الـ INI يجب رفعها على موقعك بجانب ملف التحديث.

واذا كنت تريد مشروع كامل لهذا العمل اليك في المرفقات ملف يسمى Project .

تحياتي لك .

aUpdateNow.zip

Desktop.zip

Project.zip

هو يحتاج UpLoad وليس Download

حبيبنا الغالي :

لم يقبل المكتبة .. ما الطريقة

اقتباس

هو يحتاج UpLoad وليس Download

لم اخذ في بالي كنت اعتقد انه يريد Update

لاتاخذ في بالك بل نحن اسفدنا ايضا

السلام عليكم

شكراً أخي العزيز A7med_prof على الرد الجميل وعلى مشاركتكم لي ولقد استفدت من الرد.

والرجاء إذا كنتم على علم بـ Upload فأرشدوني إليها وجزاكم الله كلّ الخير.

وهذا المثال كتبته لك ،،

تحياتي لك ، اي استفسار في اي نقطة انا جاهز .

Prof_UploadFile.zip

:(

السلام عليكم

جزاك الله كل الخير على الرد أخي prof_1982

ولكن نسيت أن أقول لك أن البرتوكول FTP لا يعمل عندنا في سورية فهل لديك برنامج على البروتوكول HTTP

وشكراً لك ولكل الأخوة

بعد التحية ...

عليك بعملية ال POST في بروتكول HTTP ، لضيق الوقت لم استطع اعداد مثال خاص ... و لكن بحثت لك ، و في الملفين مثالين حول ما طلبت ...

و لك الشكر الجزيل

E1.zip

E2.zip

جزاك الله خيراً أخي العزيز Mohammed-Saeed وإذا سمحت هل تعطني فكرة عن كيفية عمل البرنامج وما معنى أزراره كلها

وشكراً جزيلاً لك

بعد التحية ...

عمل ال POST له عدة طرق ، و كل زر لاحد هذه الطرق ، حيث ان الطريقة هي اسم الزر ...