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
