I've finally come up with a simple solution for dragging & dropping a URL.
It's not perfect, but it does the job. Mostly just a tweak of some Help file examples.
Thanks also to AutoBert, for his StringRegExp and example that set me on the right path.
I have seen this requested for many times, so enjoy!
It goes without saying, that any improvements are welcome.
Dropbox For URLs.au3
#include <GUIConstantsEx.au3>
#include <GuiRichEdit.au3>
#include <MsgBoxConstants.au3>
#include <WindowsConstants.au3>
Global $hGui, $g_hRichEdit
Example()
Func Example()
Local $cnt, $URL, $val, $text
Local $iMsg, $state = $WS_CAPTION + $WS_POPUP + $WS_CLIPSIBLINGS + $WS_SYSMENU
$hGui = GUICreate(StringTrimRight(@ScriptName, 4), 160, 100, -1, -1, $state, $WS_EX_TOPMOST)
$g_hRichEdit = _GUICtrlRichEdit_Create($hGui, "", 10, 10, 140, 80, BitOR($ES_MULTILINE, $WS_VSCROLL, $ES_AUTOVSCROLL))
GUISetState(@SW_SHOW)
_GUICtrlRichEdit_SetEventMask($g_hRichEdit, $ENM_LINK)
_GUICtrlRichEdit_AutoDetectURL($g_hRichEdit, True)
$cnt = 0
While True
$iMsg = GUIGetMsg()
Select
Case $iMsg = $GUI_EVENT_CLOSE
_GUICtrlRichEdit_Destroy($g_hRichEdit)
ExitLoop
Case Else
If $cnt = 20 Then
$text = _GUICtrlRichEdit_GetText($g_hRichEdit)
If $text <> "" Then
$val = StringRegExp($text, "(?s)((ftp|http|https):\/\/(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?)", 2)
If UBound($val) > 0 Then
$URL = $text
ClipPut($URL)
;MsgBox(0, "URL", $URL, 0, $hGui)
Else
_GUICtrlRichEdit_SetText($g_hRichEdit, "Only URL's are supported!")
;MsgBox(0, "Not URL", "Only URL's are supported!", 0, $hGui)
EndIf
Sleep(600)
_GUICtrlRichEdit_SetText($g_hRichEdit, "")
EndIf
$cnt = 0
Else
$cnt = $cnt + 1
EndIf
EndSelect
WEnd
EndFunc ;==>Example
GUIDelete($hGui)
Exit
I also wanted a version that would work with an earlier version of AutoIt (v3.3.0.0), to use with updates for some older scripts (programs).
The following works fine on my Win XP laptop, but fails (also when compiled) on my Win 7 Netbook.
I found a RichEdit example in the GUICtrlCreateEdit function (Example 2) in the AutoIt v3.3.0.0 Help file, and modified that to suit my script.
Failure is no doubt due to 'MSCOMCT2.OCX' missing from the System32 folder, at the very least.
Any solution to getting the following to work on Win 7 would be greatly appreciated. Perhaps a different '.OCX' file etc.
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <EditConstants.au3>
#include <StaticConstants.au3>
Global $oMyError
RichEditExample()
Exit
; Rich edit control EXAMPLE using GUICtrlCreateObj
; Author: Kåre Johansson
; AutoIt Version: 3.1.1.55
; Description: Very Simple example: Embedding RICHTEXT object
; Needs: MSCOMCT2.OCX in system32 but it's probably already there
; Date: 3 jul 2005
Func RichEditExample()
Local $cnt, $DropBoxGUI, $GUIActiveX, $msg, $oRP, $state, $text, $URL, $val
$oMyError = ObjEvent("AutoIt.Error", "MyErrFunc")
$oRP = ObjCreate("RICHTEXT.RichtextCtrl.1")
If @error Then Return
$state = $WS_CAPTION + $WS_POPUP + $WS_CLIPSIBLINGS + $WS_SYSMENU
$DropBoxGUI = GUICreate(StringTrimRight(@ScriptName, 4), 160, 100, -1, -1, $state, $WS_EX_TOPMOST)
$GUIActiveX = GUICtrlCreateObj($oRP, 0, 0, 140, 80)
GUICtrlSetPos($GUIActiveX, 5, 5, 150, 90)
$cnt = 0
With $oRP; Object tag pool
.OLEDrag()
.Font = 'Arial'
.Text = @CRLF & @CRLF & " Drag & Drop a URL here."
.SelBold = True
.BackColor = 0xff00
;.FileName = @ScriptDir & '\RichText.rtf'
;$oRP.AboutBox()
;$oRP.SelBold = False
;$oRP.SelItalic = False
;$oRP.SelUnderline = False
;$oRP.SelFontSize = 8
;$oRP.SaveFile(@ScriptDir & "\RichText.rtf", 0)
EndWith
GUISetState(@SW_SHOW)
While 1
$msg = GUIGetMsg()
Select
Case $msg = $GUI_EVENT_CLOSE
GUIDelete($DropBoxGUI)
ExitLoop
Case Else
If $cnt = 20 Then
$text = $oRP.Text
If $text <> "" Then
If $text = @CRLF & @CRLF & " Drag & Drop a URL here." Then
Sleep(2000)
Else
$val = StringRegExp($text, "(?s)((ftp|http|https):\/\/(\w+:{0,1}\w*@)?(\S+)(:[0-9]+)?(\/|\/([\w#!:.?+=&%@!\-\/]))?)", 2)
If UBound($val) > 0 Then
$URL = $text
ClipPut($URL)
;MsgBox(0, "URL", $URL, 0, $hGui)
Sleep(600)
Else
With $oRP
.Text = "Only URL's are supported!"
EndWith
;MsgBox(0, "Not URL", "Only URL's are supported!", 0, $hGui)
Sleep(1500)
EndIf
EndIf
With $oRP
.Text = ""
.SelBold = False
EndWith
EndIf
$cnt = 0
Else
$cnt = $cnt + 1
EndIf
EndSelect
WEnd
EndFunc ;==>RichEditExample
Func MyErrFunc()
MsgBox(0, "AutoItCOM Test", "We intercepted a COM Error !" & @CRLF & @CRLF & _
"err.description is: " & @TAB & $oMyError.description & @CRLF & _
"err.windescription:" & @TAB & $oMyError.windescription & @CRLF & _
"err.number is: " & @TAB & Hex($oMyError.number, 8) & @CRLF & _
"err.lastdllerror is: " & @TAB & $oMyError.lastdllerror & @CRLF & _
"err.scriptline is: " & @TAB & $oMyError.scriptline & @CRLF & _
"err.source is: " & @TAB & $oMyError.source & @CRLF & _
"err.helpfile is: " & @TAB & $oMyError.helpfile & @CRLF & _
"err.helpcontext is: " & @TAB & $oMyError.helpcontext , 5)
; Will automatically continue after 5 seconds
Local $err = $oMyError.number
If $err = 0 Then $err = -1
SetError($err) ; to check for after this function returns
EndFunc ;==>MyErrFunc
And a slower embedded IE based version. This has an error in latest AutoIt, but works fine in v3.3.0.0.
#include <Constants.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <IE.au3>
Local $DropboxGUI, $GUIActiveX, $loaded, $loops, $oBody, $oIE, $sHTML, $timeout, $urlpage
_IEErrorHandlerRegister()
$oIE = _IECreateEmbedded()
$DropboxGUI = GUICreate("URL Dropbox", 140, 140, -1, -1, _
$WS_OVERLAPPED + $WS_VISIBLE + $WS_CLIPSIBLINGS + $WS_SYSMENU, $WS_EX_TOPMOST)
$GUIActiveX = GUICtrlCreateObj($oIE, 5, 5, 125, 100)
$oBody = _IETagNameGetCollection($oIE, "body", 0)
_IEDocInsertHTML($oBody, "", "afterbegin")
$loaded = _IEPropertyGet($oIE, "locationurl")
$urlpage = $loaded
$loops = 0
$sHTML = ""
$sHTML &= "<HTML>" & @CR
$sHTML &= "<HEAD>" & @CR
$sHTML &= "<TITLE>Drag And Drop Example</TITLE>" & @CR
$sHTML &= "</HEAD>" & @CR
$sHTML &= "<BODY>" & @CR
$sHTML &= "</BODY>" & @CR
$sHTML &= "</HTML>"
_IELoadWaitTimeout(1)
While 1
$msg = GUIGetMsg()
Select
Case $msg = $GUI_EVENT_CLOSE
; Quit, Close or Exit window
GUIDelete($DropboxGUI)
ExitLoop
Case Else
;;;
If $loops = 10 Then
$loops = 0
$loaded = _IEPropertyGet($oIE, "locationurl")
If $loaded <> $urlpage Then
_IEAction($oIE, "stop")
_IEDocWriteHTML($oIE, $sHTML)
If $loaded = "res://ieframe.dll/navcancl.htm" Then $loaded = ""
$urlpage = $loaded
_IEBodyWriteHTML($oIE, '<p style="WORD-WRAP: normal; WORD-BREAK: break-all; FONT-SIZE: 8px">' & $loaded & '</p>')
EndIf
Else
$loops = $loops + 1
EndIf
EndSelect
WEnd
Exit
