[trakktour]

(09-11-18, 10:25 PM)dasktop كتب : مرحبا

هل يوجد طريقة لتعامل مع مراكز رفع ملفات مثل تحميل صوره الى مركز رفع وجلب الرابط

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

مرحبا اخي
تفضل جرب هذا الكود

كود :

  Public Sub New()
       InitializeComponent()
       Control.CheckForIllegalCrossThreadCalls = False
   End Sub
   Dim ClientId As String = "66665db7b4b0608"
   Dim Dictionner As New Dictionary(Of WebClient, ListViewItem)

   Private Sub Completed(sender As Object, e As UploadValuesCompletedEventArgs)
       Dim Result As String = (New UTF8Encoding).GetString(e.Result)
       If e.Cancelled = True Then
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).ForeColor = Color.RoyalBlue
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).Text = "Cancelled"
       ElseIf e.Error IsNot Nothing Then
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).ForeColor = Color.Red
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).Text = "Error"
       ElseIf e.Result IsNot Nothing Then
           Dim K As Match = Regex.Match(Result, ",""link"":""(.*?)""}")
           lvfiles.Items(Dictionner.Item(sender).Index).ToolTipText = K.Groups(1).Value.Replace("\", "")
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).ForeColor = Color.Green
           lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).Text = "Sucessfully, Uploaded"
       End If

   End Sub
   Private Sub Progress(sender As Object, e As UploadProgressChangedEventArgs)
       On Error Resume Next
       lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).ForeColor = Color.Blue
       lvfiles.Items(Dictionner.Item(sender).Index).SubItems(1).Text = e.ProgressPercentage & "%"
   End Sub

   Private Sub lvfiles_DoubleClick(sender As Object, e As EventArgs) Handles lvfiles.DoubleClick
       If Not lvfiles.FocusedItem.SubItems(1).ForeColor = Color.Green Then : Exit Sub : End If
       Clipboard.SetText(lvfiles.FocusedItem.ToolTipText, TextDataFormat.Text)
       MsgBox("Link Copied", MsgBoxStyle.Information)
   End Sub

   Private Sub lvfiles_DragDrop(sender As Object, e As DragEventArgs) Handles lvfiles.DragDrop
       Try
           Dim FilePath As String = e.Data.GetData(DataFormats.FileDrop)(0)

           Dim NIcon As Icon = Icon.ExtractAssociatedIcon(FilePath)
           ImageList1.Images.Add(NIcon)
           Dim itm As New ListViewItem
           itm.UseItemStyleForSubItems = False
           itm.Text = Path.GetFileName(FilePath)
           itm.SubItems.Add("Uploading...").ForeColor = ColorTranslator.FromHtml("#3b4451")
           itm.ImageIndex = ImageList1.Images.Count - 1
           lvfiles.Items.Add(itm)

           Dim w As New WebClient()
           w.Headers.Add("Authorization", "Client-ID " & ClientId)
           AddHandler w.UploadValuesCompleted, AddressOf Completed
           AddHandler w.UploadProgressChanged, AddressOf Progress
           Dim Keys As New System.Collections.Specialized.NameValueCollection
           Keys.Add("image", Convert.ToBase64String(File.ReadAllBytes(FilePath)))
           w.UploadValuesAsync(New Uri("https://api.imgur.com/3/image"), Keys)
           Dictionner.Add(w, itm)
       Catch ex As Exception
           MsgBox(ex.Message)
       End Try
   End Sub

   Private Sub lvfiles_DragEnter(sender As Object, e As DragEventArgs) Handles lvfiles.DragEnter
       If e.Data.GetDataPresent(DataFormats.FileDrop) Then
           e.Effect = DragDropEffects.All
       End If
   End Sub