PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Drag and drop Image uploader (works with imageshack, etc)

https://www.purebasic.fr/english/viewtopic.php?t=34916

Page 1 of 1

Drag and drop Image uploader (works with imageshack, etc)

Posted: Mon Oct 27, 2008 5:34 am
by Joakim Christiansen
Well, I made this, but never got around to finish it (make it into a usefull application). So I have decided to share it as an example, and maybe some of you can finish it; since it has potential :wink: I actually had a lot of plans for it...

The way it works:
Drag a image-file to the window -> the image then gets uploaded -> url is then copied to clipboard.

Supports:
imageshack.us
tinypic.com
freeimagehosting.net (currently their site has some problems)
(feel free to add more)

Note:
Using Delay(600) in the recieve code was silly of me, now I know how to optimize, but I leave it up to you.

Code: Select all

;###################################
; Title:      Drag and drop image uploader
; Author:   Joakim L. Christiansen
; License: Provided as example, do whatever you want
;
; About:
; Here is a simple example on how to upload images to imageshack and similar sites
;
; ToDo:
; Lots of shit... But I don't have the time.
;###################################

EnableExplicit

#DQ$ = #DQUOTE$
#Main = 0
#Text = 0
Enumeration ;Menu items
  #SysMenu
  #SysMenu_Show
  #SysMenu_Settings
  #SysMenu_Exit
EndEnumeration
Enumeration ;Services
  #imageshack;us
  #freeimagehosting;net
  #tinypic;com
EndEnumeration
Global UAgent$ = "ImageUploader"
Define File$, Result$, i, Line$, Pos1, URL$
Global DefaultText$ = "Drag your image here to upload it", FileExt$

Procedure.s HttpGet(Server$,Path$,Cookies$="")
  Protected Request$,Result$,BytesRead,*RecieveBuffer = AllocateMemory(40000)
  Protected ServerID = OpenNetworkConnection(Server$,80)
  
  If ServerID
      Request$ = "GET "+Path$+" HTTP/1.1"+#CRLF$
      Request$ + "Host: "+Server$+#CRLF$
      If Cookies$
        Request$ + "Cookie: "+Cookies$+#CRLF$
      EndIf
      Request$ + "User-Agent: "+UAgent$+#CRLF$
      Request$ + #CRLF$

    ;{ Send data and recieve answer
    If SendNetworkData(ServerID,@Request$,Len(Request$))
      Repeat
        Delay(2)
      Until NetworkClientEvent(ServerID) = #PB_NetworkEvent_Data
      Repeat
        BytesRead = ReceiveNetworkData(ServerID,*RecieveBuffer,40000)
        Result$ + PeekS(*RecieveBuffer,BytesRead)
        ;Debug Result$
        Delay(600)
      Until NetworkClientEvent(ServerID) <> #PB_NetworkEvent_Data
      FreeMemory(*RecieveBuffer)
    Else
      Debug "Error sending data!"
    EndIf
    ;}
    CloseNetworkConnection(ServerID)
  Else
    Debug "Connection failed!"
  EndIf
  
  ProcedureReturn Result$
EndProcedure
Procedure.s HttpPostMultipart(Server$,Path$,PostVariables$,FileID$,File$,Cookies$="") ;for now only image files
  Protected Request$,Result$,BytesRead,*RecieveBuffer = AllocateMemory(40000)
  Protected FormData$, *Buffer, FileLength, ContentLength, i
  Protected Name$,Value$,String$,FileExt$=LCase(GetExtensionPart(File$))
  Protected EndString$,Text$,TextLength
  Protected ServerID = OpenNetworkConnection(Server$,80)
  If FileExt$ = "jpg": FileExt$ = "jpeg": EndIf ;freeimagehosting.net fix
  
  If ServerID
    ;{ Make data for multipart
    If PostVariables$
      For i=1 To CountString(PostVariables$,"&")+1
        String$ = StringField(PostVariables$,i,"&")
        Name$   = StringField(String$,1,"=")
        Value$  = StringField(String$,2,"=")
        FormData$ + "--AaB03x"+#CRLF$
        FormData$ + "content-disposition: form-data; name="+#DQ$+Name$+#DQ$+#CRLF$+#CRLF$
        FormData$ + Value$+#CRLF$
        Debug Name$+"="+Value$
      Next
    EndIf
    FormData$ + "--AaB03x"+#CRLF$
    FormData$ + "content-disposition: form-data; name="+#DQ$+FileID$+#DQ$+"; filename="+#DQ$+GetFilePart(File$)+#DQ$+#CRLF$
    FormData$ + "Content-Type: image/"+FileExt$+#CRLF$;++#CRLF$
    FormData$ + "Content-Transfer-Encoding: binary"+#CRLF$+#CRLF$
    ;}
    If OpenFile(0,File$)
      FileLength = Lof(0)
      ContentLength = Len(FormData$)+FileLength+12
      ;{ Make post request
      Request$ = "POST "+Path$+" HTTP/1.1"+#CRLF$
      Request$ + "Host: "+Server$+#CRLF$
      If Cookies$
        Request$ + "Cookie: "+Cookies$+#CRLF$
      EndIf
      Request$ + "User-Agent: "+UAgent$+#CRLF$
      Request$ + "Content-Length: "+Str(ContentLength)+#CRLF$
      Request$ + "Content-Type: multipart/form-data, boundary=AaB03x"+#CRLF$
      Request$ + #CRLF$
      ;}
      Text$ = Request$+FormData$
      TextLength = Len(Text$)
      EndString$ = #CRLF$+"--AaB03x--" ;12
      ;{ Create send buffer
      *Buffer = AllocateMemory(TextLength+FileLength+12)
      CopyMemory(@Text$,*Buffer,TextLength)
      ReadData(0,*Buffer+TextLength,FileLength)
      CopyMemory(@EndString$,*Buffer+TextLength+FileLength,12)
      CloseFile(0)
      ;}
    Else
      Debug "Error opening file!"
    EndIf
    ;{ Send data and recieve answer
    If SendNetworkData(ServerID,*Buffer,MemorySize(*Buffer))
      FreeMemory(*Buffer)
      Repeat
        Delay(2)
      Until NetworkClientEvent(ServerID) = #PB_NetworkEvent_Data
      Repeat
        BytesRead = ReceiveNetworkData(ServerID,*RecieveBuffer,40000)
        Result$ + PeekS(*RecieveBuffer,BytesRead)
        ;Debug Result$
        Delay(600)
      Until NetworkClientEvent(ServerID) <> #PB_NetworkEvent_Data
      FreeMemory(*RecieveBuffer)
    Else
      Debug "Error sending data!"
    EndIf
    ;}
    CloseNetworkConnection(ServerID)
  Else
    Debug "Connection failed!"
  EndIf
  
  ProcedureReturn Result$
EndProcedure
Procedure.s ExtraxtString(String$,Left$,Right$)
  Protected Pos1,Pos2
  Pos1 = FindString(String$,Left$,1)+Len(Left$)
  Pos2 = FindString(String$,Right$,Pos1)
  ProcedureReturn Mid(String$,Pos1,Pos2-Pos1)
EndProcedure
Procedure GotExt(File$,Pattern$)
  Protected i, Result, Ext$ = LCase(GetExtensionPart(File$))
  For i=1 To CountString(Pattern$,",")+1
    If StringField(Pattern$,i,",") = Ext$
      Result = #True
      Break
    EndIf
  Next
  ProcedureReturn Result
EndProcedure
Procedure UploadImage(File$,Service=#imageshack) ;todo: check size
  Protected Result$, URL$;, d1$, d2$
  Delay(20):WindowEvent() ;to fix the cursor bug
  SetGadgetText(#Text,"Please wait, uploading image...")
  Select Service
    Case #imageshack ;{ 
      If Not GotExt(File$,"jpg,jpeg,png,gif,bmp,tif,tiff,swf")
        SetGadgetText(#Text,"Imageshack.us does not support this image type!")
        Delay(3000)
      Else
        Result$ = HttpPostMultipart("imageshack.us","/","","fileupload",File$)
        URL$ = ExtraxtString(Result$,"imageshack.us][img=","]")
        If URL$
          SetClipboardText(URL$)
          SetGadgetText(#Text,"Success, URL now copied to clipboard!")
        Else
          SetGadgetText(#Text,"Failed, something went wrong!")
        EndIf
        Delay(3000)
      EndIf
      ;}
    Case #freeimagehosting ;{
      If Not GotExt(File$,"gif,jpg,jpeg,bmp,png")
        SetGadgetText(#Text,"Freeimagehosting.net does not support this image type!")
        Delay(3000)
      Else
        Result$ = HttpPostMultipart("freeimagehosting.net","/upload.php","","attached",File$) ;Sorry
        URL$ = ExtraxtString(Result$,"/][img]","[")
        If URL$
          SetClipboardText(URL$)
          SetGadgetText(#Text,"Success, URL now copied to clipboard!")
        Else
          SetGadgetText(#Text,"Failed, something went wrong!")
        EndIf
        Delay(3000)
      EndIf
    ;}
    Case #tinypic ;{
      If Not GotExt(File$,"gif,jpg,jpeg,bmp,png")
        SetGadgetText(#Text,"Tinypic.com does not support this image type!")
        Delay(3000)
      Else
        Result$ = HttpPostMultipart("s3.tinypic.com","/upload.php","action=upload&file_type=image","the_file",File$)
        Result$ = HttpGet("tinypic.com","/"+StringField(ExtraxtString(Result$,"<strong><a href="+#DQ$,#DQ$),4,"/"))
        If FindString(Result$,"Upload Failed",1)
          SetGadgetText(#Text,"ERROR!!")
        EndIf
        URL$ = ExtraxtString(Result$,"[IMG]","[")
        If URL$
          SetClipboardText(URL$)
          SetGadgetText(#Text,"Success, URL now copied to clipboard!")
        Else
          SetGadgetText(#Text,"Failed, something went wrong!")
        EndIf
        Delay(3000)
      EndIf
    ;}
  EndSelect
  SetGadgetText(#Text,DefaultText$)
EndProcedure

;{ Open window
OpenWindow(#Main,0,0,300,100,"JLC's Image uploader v0.1 Alpha",#PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
StickyWindow(#Main,#True)
EnableWindowDrop(#Main,#PB_Drop_Files,#PB_Drag_Link)
CreateGadgetList(WindowID(#Main))
TextGadget(#Text,0,30,300,60,DefaultText$,#PB_Text_Center)
SetGadgetFont(#Text,FontID(LoadFont(#PB_Any,"Arial",14)))
If CreatePopupMenu(#SysMenu)
  MenuItem(#SysMenu_Show,"Show")
  MenuItem(#SysMenu_Settings,"Settings")
  MenuItem(#SysMenu_Exit,"Exit")
EndIf
;}

InitNetwork()

If ProgramParameter(0)
  ;todo: make sure only one instance, for now let's just end it
  UploadImage(ProgramParameter(0))
  End
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_WindowDrop
      ;EventDropImage() ;Put into send buffer :D
      UploadImage(EventDropFiles(),#tinypic)
  EndSelect
ForEver

Posted: Mon Oct 27, 2008 8:58 am
by dige
How about with proxy support?

Posted: Mon Oct 27, 2008 10:44 am
by Joakim Christiansen
dige wrote:How about with proxy support?
I'm not sure how to do it manually when using "low level network functions" like this, but if I use the Windows API instead I think they have support for proxy. But I wont bother with that now, maybe some other day...

Posted: Tue Oct 28, 2008 10:07 am
by Tranquil
Maybe you take a look on this thread: http://www.purebasic.fr/english/viewtopic.php?t=13520&

I used this procedure some time ago and it works fine with a HTTPProxy connect and its easy to use. Create your connection using this procedures and you can use the connectionID as its your own opened network connection.

Just simple.

Re: Drag and drop Image uploader (works with imageshack, etc

Posted: Fri Oct 21, 2011 11:41 pm
by jesperbrannmark
I am using this routine for all my HTTP POST traffic and it works fine on both PC and Mac.
BUT I notice that people using AVG this doesnt work properly. It either works randomly or not at all. As soon as I inactivate AVG everything works fine.
No log in AVG about any detections or anything. Anyone got any suggestion? We must be able to do HTTP POST without data being corrupted - right?

Re: Drag and drop Image uploader (works with imageshack, etc

Posted: Fri Oct 21, 2011 11:44 pm
by jesperbrannmark
And the answer is probably partly here http://forums.avg.com/in-en/avg-forums? ... &id=107059 ... what crap..
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited