开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Internet/网络编程 > 浏览器 > 查看源码
frmFlashgetDownload.frm
资源名称：IE_VB.rar　[点击查看]
上传用户：davilee3
上传日期：2015-04-22
资源大小：986k
文件大小：20k
源码类别：

浏览器

开发平台：

Visual Basic

frmFlashgetDownload.frm：源码内容
  1. VERSION 5.00
  2. Begin VB.Form frmFlashgetDownload 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "下载批量文件"
  5.    ClientHeight    =   2100
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6030
  9.    BeginProperty Font 
  10.       Name            =   "宋体"
  11.       Size            =   9
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   0   'False
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    HasDC           =   0   'False
  19.    Icon            =   "frmFlashgetDownload.frx":0000
  20.    LinkTopic       =   "Form1"
  21.    MaxButton       =   0   'False
  22.    MinButton       =   0   'False
  23.    NegotiateMenus  =   0   'False
  24.    ScaleHeight     =   2100
  25.    ScaleWidth      =   6030
  26.    ShowInTaskbar   =   0   'False
  27.    StartUpPosition =   1  'CenterOwner
  28.    Begin VB.Frame Frame1 
  29.       BorderStyle     =   0  'None
  30.       Caption         =   "Frame1"
  31.       BeginProperty Font 
  32.          Name            =   "MS Sans Serif"
  33.          Size            =   8.25
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   735
  41.       Left            =   60
  42.       TabIndex        =   9
  43.       Top             =   810
  44.       Width           =   5895
  45.       Begin VB.TextBox txtBeginPos 
  46.          BeginProperty Font 
  47.             Name            =   "MS Sans Serif"
  48.             Size            =   8.25
  49.             Charset         =   0
  50.             Weight          =   400
  51.             Underline       =   0   'False
  52.             Italic          =   0   'False
  53.             Strikethrough   =   0   'False
  54.          EndProperty
  55.          Height          =   300
  56.          Left            =   1680
  57.          TabIndex        =   1
  58.          Text            =   "Text2"
  59.          Top             =   0
  60.          Width           =   615
  61.       End
  62.       Begin VB.TextBox txtEndPos 
  63.          BeginProperty Font 
  64.             Name            =   "MS Sans Serif"
  65.             Size            =   8.25
  66.             Charset         =   0
  67.             Weight          =   400
  68.             Underline       =   0   'False
  69.             Italic          =   0   'False
  70.             Strikethrough   =   0   'False
  71.          EndProperty
  72.          Height          =   300
  73.          Left            =   2640
  74.          TabIndex        =   2
  75.          Text            =   "Text3"
  76.          Top             =   0
  77.          Width           =   615
  78.       End
  79.       Begin VB.TextBox txtStarLength 
  80.          BeginProperty Font 
  81.             Name            =   "MS Sans Serif"
  82.             Size            =   8.25
  83.             Charset         =   0
  84.             Weight          =   400
  85.             Underline       =   0   'False
  86.             Italic          =   0   'False
  87.             Strikethrough   =   0   'False
  88.          EndProperty
  89.          Height          =   300
  90.          Left            =   4440
  91.          TabIndex        =   3
  92.          Text            =   "Text4"
  93.          Top             =   0
  94.          Width           =   735
  95.       End
  96.       Begin VB.CheckBox chkStar 
  97.          Appearance      =   0  'Flat
  98.          Caption         =   "通配符1:(*)"
  99.          BeginProperty Font 
  100.             Name            =   "MS Sans Serif"
  101.             Size            =   8.25
  102.             Charset         =   0
  103.             Weight          =   400
  104.             Underline       =   0   'False
  105.             Italic          =   0   'False
  106.             Strikethrough   =   0   'False
  107.          EndProperty
  108.          ForeColor       =   &H80000008&
  109.          Height          =   195
  110.          Left            =   0
  111.          TabIndex        =   12
  112.          TabStop         =   0   'False
  113.          Top             =   45
  114.          Value           =   1  'Checked
  115.          Width           =   1455
  116.       End
  117.       Begin VB.CheckBox Check2 
  118.          Appearance      =   0  'Flat
  119.          Caption         =   "通配符2:(*1)"
  120.          Enabled         =   0   'False
  121.          BeginProperty Font 
  122.             Name            =   "MS Sans Serif"
  123.             Size            =   8.25
  124.             Charset         =   0
  125.             Weight          =   400
  126.             Underline       =   0   'False
  127.             Italic          =   0   'False
  128.             Strikethrough   =   0   'False
  129.          EndProperty
  130.          ForeColor       =   &H80000008&
  131.          Height          =   195
  132.          Left            =   0
  133.          TabIndex        =   11
  134.          Top             =   480
  135.          Width           =   1455
  136.       End
  137.       Begin VB.CommandButton cmdAuto 
  138.          Caption         =   "Auto"
  139.          BeginProperty Font 
  140.             Name            =   "MS Sans Serif"
  141.             Size            =   8.25
  142.             Charset         =   0
  143.             Weight          =   400
  144.             Underline       =   0   'False
  145.             Italic          =   0   'False
  146.             Strikethrough   =   0   'False
  147.          EndProperty
  148.          Height          =   300
  149.          Left            =   5280
  150.          TabIndex        =   10
  151.          Top             =   0
  152.          Width           =   615
  153.       End
  154.       Begin VB.Label Label2 
  155.          Caption         =   "通配符长度"
  156.          BeginProperty Font 
  157.             Name            =   "MS Sans Serif"
  158.             Size            =   8.25
  159.             Charset         =   0
  160.             Weight          =   400
  161.             Underline       =   0   'False
  162.             Italic          =   0   'False
  163.             Strikethrough   =   0   'False
  164.          EndProperty
  165.          Height          =   255
  166.          Left            =   3480
  167.          TabIndex        =   15
  168.          Top             =   45
  169.          Width           =   975
  170.       End
  171.       Begin VB.Label Label3 
  172.          Caption         =   "从"
  173.          BeginProperty Font 
  174.             Name            =   "MS Sans Serif"
  175.             Size            =   8.25
  176.             Charset         =   0
  177.             Weight          =   400
  178.             Underline       =   0   'False
  179.             Italic          =   0   'False
  180.             Strikethrough   =   0   'False
  181.          EndProperty
  182.          Height          =   255
  183.          Left            =   1440
  184.          TabIndex        =   14
  185.          Top             =   45
  186.          Width           =   255
  187.       End
  188.       Begin VB.Label Label4 
  189.          Caption         =   "到"
  190.          BeginProperty Font 
  191.             Name            =   "MS Sans Serif"
  192.             Size            =   8.25
  193.             Charset         =   0
  194.             Weight          =   400
  195.             Underline       =   0   'False
  196.             Italic          =   0   'False
  197.             Strikethrough   =   0   'False
  198.          EndProperty
  199.          Height          =   255
  200.          Left            =   2400
  201.          TabIndex        =   13
  202.          Top             =   45
  203.          Width           =   255
  204.       End
  205.    End
  206.    Begin VB.CommandButton cmdGetUrl 
  207.       Caption         =   "当前URL"
  208.       BeginProperty Font 
  209.          Name            =   "MS Sans Serif"
  210.          Size            =   8.25
  211.          Charset         =   0
  212.          Weight          =   400
  213.          Underline       =   0   'False
  214.          Italic          =   0   'False
  215.          Strikethrough   =   0   'False
  216.       EndProperty
  217.       Height          =   300
  218.       Left            =   4980
  219.       TabIndex        =   8
  220.       Top             =   420
  221.       Width           =   975
  222.    End
  223.    Begin VB.TextBox txtUrl 
  224.       BeginProperty Font 
  225.          Name            =   "宋体"
  226.          Size            =   9
  227.          Charset         =   134
  228.          Weight          =   400
  229.          Underline       =   0   'False
  230.          Italic          =   0   'False
  231.          Strikethrough   =   0   'False
  232.       EndProperty
  233.       Height          =   285
  234.       Left            =   540
  235.       OLEDropMode     =   2  'Automatic
  236.       TabIndex        =   0
  237.       Text            =   "Text1"
  238.       Top             =   60
  239.       Width           =   5415
  240.    End
  241.    Begin VB.CommandButton cmdCancel 
  242.       Cancel          =   -1  'True
  243.       Caption         =   "取消"
  244.       BeginProperty Font 
  245.          Name            =   "MS Sans Serif"
  246.          Size            =   8.25
  247.          Charset         =   0
  248.          Weight          =   400
  249.          Underline       =   0   'False
  250.          Italic          =   0   'False
  251.          Strikethrough   =   0   'False
  252.       EndProperty
  253.       Height          =   375
  254.       Left            =   5100
  255.       TabIndex        =   6
  256.       Top             =   1680
  257.       Width           =   855
  258.    End
  259.    Begin VB.CommandButton cmdOk 
  260.       Caption         =   "确定"
  261.       Default         =   -1  'True
  262.       BeginProperty Font 
  263.          Name            =   "MS Sans Serif"
  264.          Size            =   8.25
  265.          Charset         =   0
  266.          Weight          =   400
  267.          Underline       =   0   'False
  268.          Italic          =   0   'False
  269.          Strikethrough   =   0   'False
  270.       EndProperty
  271.       Height          =   375
  272.       Left            =   4140
  273.       TabIndex        =   5
  274.       Top             =   1680
  275.       Width           =   855
  276.    End
  277.    Begin VB.Label lblSample 
  278.       BeginProperty Font 
  279.          Name            =   "MS Sans Serif"
  280.          Size            =   8.25
  281.          Charset         =   0
  282.          Weight          =   400
  283.          Underline       =   0   'False
  284.          Italic          =   0   'False
  285.          Strikethrough   =   0   'False
  286.       EndProperty
  287.       Height          =   255
  288.       Left            =   60
  289.       TabIndex        =   7
  290.       Top             =   420
  291.       Width           =   3735
  292.    End
  293.    Begin VB.Label Label1 
  294.       Caption         =   "URL:"
  295.       BeginProperty Font 
  296.          Name            =   "MS Sans Serif"
  297.          Size            =   8.25
  298.          Charset         =   0
  299.          Weight          =   400
  300.          Underline       =   0   'False
  301.          Italic          =   0   'False
  302.          Strikethrough   =   0   'False
  303.       EndProperty
  304.       Height          =   255
  305.       Left            =   60
  306.       TabIndex        =   4
  307.       Top             =   90
  308.       Width           =   495
  309.    End
  310. End
  311. Attribute VB_Name = "frmFlashgetDownload"
  312. Attribute VB_GlobalNameSpace = False
  313. Attribute VB_Creatable = False
  314. Attribute VB_PredeclaredId = True
  315. Attribute VB_Exposed = False
  316. '---------------------------------------------------------------------------------------
  317. ' Module    : frmFlashgetDownload
  318. ' DateTime  : 200x-x-xx xx:xx
  319. ' Author    : Lingll
  320. ' Purpose   :
  321. '---------------------------------------------------------------------------------------
  323. Option Explicit
  325. Private vTxtBeginPos  As cNumberTextBox
  326. Private vTxtEndPos As cNumberTextBox
  327. Private vTxtStarLength As cNumberTextBox
  330. Private Sub chkStar_Click()
  331. chkStar.Value = 1
  332. End Sub
  334. Private Sub cmdAuto_Click()
  335. Dim tstr$, tVal&
  336. tstr = txtUrl.SelText
  337. If tstr <> "" Then
  338.     tVal = Val(tstr)
  339.     txtUrl.SelText = "(*)"
  340.     txtStarLength.Text = Len(tstr)
  341.     txtBeginPos.Text = "1"
  342.     txtEndPos.Text = tVal
  343. End If
  345. End Sub
  347. Private Sub cmdCancel_Click()
  348. Unload Me
  349. End Sub
  351. Private Sub cmdGetUrl_Click()
  352. If loadedBrowserCount > 0 Then
  353.     txtUrl.Text = webbState(gActiveWebIndex).webForm.GetWebUrl
  354. End If
  355. End Sub
  357. Private Sub cmdOk_Click()
  358. Call AddUrl
  359. Unload Me
  360. End Sub
  362. Private Sub Form_Load()
  363. Dim tCtl As Control
  364. For Each tCtl In Me.Controls
  365.     tCtl.FontName = "宋体"
  366.     tCtl.FontSize = 9
  367. Next tCtl
  369. lblSample.Caption = "例如:http://sample.net/sample(*)(*1).htm"
  371. Call IniTextBox
  372. End Sub
  375. Private Sub IniTextBox()
  376. Set vTxtBeginPos = New cNumberTextBox
  377. Set vTxtEndPos = New cNumberTextBox
  378. Set vTxtStarLength = New cNumberTextBox
  380. vTxtBeginPos.NumberTextBox = txtBeginPos
  381. vTxtEndPos.NumberTextBox = txtEndPos
  382. vTxtStarLength.NumberTextBox = txtStarLength
  384. txtUrl.Text = ""
  385. txtUrl.Appearance = 0
  386. End Sub
  389. Private Sub AddUrl()
  390. On Error GoTo due
  391. Dim objjc As JCCATCHLib.JetCarNetscape
  392. Set objjc = New JCCATCHLib.JetCarNetscape
  394. Dim i&
  395. Dim tPos1&, tPos2&
  396. Dim tZero$
  397. Dim tUrlArr(), tUrl As String
  398. tPos1 = vTxtBeginPos.TextVal
  399. tPos2 = vTxtEndPos.TextVal
  400. tUrl = txtUrl.Text
  401. ReDim tUrlArr(0 To (tPos2 - tPos1) * 2 + 2)
  402. tUrlArr(0) = ""
  403. tZero = String(vTxtStarLength.TextVal, "0")
  404. For i = tPos1 To tPos2
  405.     tUrlArr((i - tPos1) * 2 + 1) = Replace(tUrl, "(*)", Format(i, tZero))
  406.     tUrlArr((i - tPos1) * 2 + 2) = ""
  407. Next i
  409. objjc.AddUrlList tUrlArr
  411. Exit Sub
  412. due:
  413.     MsgBox Err.Description
  415. End Sub
  417. Private Sub txtUrl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  418. If Data.GetFormat(vbCFText) Then
  419.     txtUrl.Text = Data.GetData(vbCFText)
  420. End If
  421. End Sub
  425. '
  426. ''---------------------------------------------------------------------------------------
  427. '' Procedure : GetImageUrl
  428. '' DateTime  : 2005-5-9 23:46
  429. '' Author    : Lingll
  430. '' Purpose   : 获得img的url,供外部使用
  431. ''---------------------------------------------------------------------------------------
  432. 'Public Function GetImageUrl() As String
  433. '
  434. '
  435. 'Dim tHtml$, tFrag$, tSUrl$
  436. 'Dim tPos&
  437. 'tHtml = GetCFHtml()
  438. 'tFrag = GetFragment(tHtml)
  439. 'tSUrl = GetSourceURL(tHtml)
  440. '
  441. 'tPos = IsImageDrop(tFrag)
  442. 'If tPos > 0 Then
  443. '    GetImageUrl = GetImgUrl(tSUrl, tFrag)
  444. 'End If
  445. '
  446. '
  447. 'End Function
  448. '
  449. '
  450. ''---------------------------------------------------------------------------------------
  451. '' Procedure : GetImgUrl
  452. '' DateTime  : 2005-5-10 15:55
  453. '' Author    : Lingll
  454. '' Purpose   : 获得img的url,供内部使用
  455. ''---------------------------------------------------------------------------------------
  456. 'Private Function GetImgUrl(vUrl$, vHtml$) As String
  457. 'On Error Resume Next
  458. '    Dim tPos1&, tPos2&, tPos3&
  459. '    Dim tOrgSrc$
  460. '
  461. '    tPos1 = InStr(1, vHtml, "<IMG ", vbTextCompare)
  462. '    If tPos1 > 0 Then
  463. '        tPos3 = InStr(tPos1, vHtml, ">", vbTextCompare)
  464. '        tPos1 = InStr(tPos1 + 1, vHtml, "src=", vbTextCompare)
  465. '        If tPos1 > 0 Then
  466. '            Select Case Mid$(vHtml, tPos1 + 4, 1)
  467. '                Case "'"
  468. '                    tPos2 = InStr(tPos1 + 5, vHtml, "'")
  469. '                    If tPos2 > 0 And tPos2 < tPos3 Then
  470. '                        tOrgSrc = Mid$(vHtml, tPos1 + 5, tPos2 - tPos1 - 5)
  471. '                    End If
  472. '                Case """"
  473. '                    tPos2 = InStr(tPos1 + 5, vHtml, """")
  474. '                    If tPos2 > 0 And tPos2 < tPos3 Then
  475. '                        Debug.Print tPos2 - tPos1 - 5
  476. '                        tOrgSrc = Mid$(vHtml, tPos1 + 5, tPos2 - tPos1 - 5)
  477. '                    End If
  478. '                Case Else
  479. '                    tPos2 = InStr(tPos1 + 1, vHtml, " ")
  480. '                    If tPos2 <= 0 Or tPos2 > tPos3 Then
  481. '                        tPos2 = tPos3
  482. '                    End If
  483. '                    tOrgSrc = Mid$(vHtml, tPos1 + 4, tPos2 - tPos1 - 4)
  484. '            End Select
  485. '
  486. '            If tOrgSrc <> vbNullString Then
  487. '                GetImgUrl = GetRealUrl(vUrl, tOrgSrc)
  488. '            End If
  489. '        End If
  490. '    End If
  491. '
  492. 'End Function
  493. '
  494. '
  495. ''---------------------------------------------------------------------------------------
  496. '' Procedure : GetRealUrl
  497. '' DateTime  : 2005-5-10 16:21
  498. '' Author    : Lingll
  499. '' Purpose   :
  500. ''---------------------------------------------------------------------------------------
  501. 'Private Function GetRealUrl(ByVal vSrcUrl$, ByVal vOrgUrl$) As String
  502. '
  503. 'Dim tPos1&, tPos1Pre&, tPos2&, tPosStart&
  504. '
  505. 'If InStr(1, vOrgUrl, "://") > 0 Then
  506. '    GetRealUrl = vOrgUrl
  507. 'ElseIf InStr(1, vOrgUrl, ":") > 0 Then
  508. '    GetRealUrl = vOrgUrl
  509. 'Else
  510. '    vOrgUrl = Replace(vOrgUrl, "", "/")
  511. '    vSrcUrl = Replace(vSrcUrl, "", "/")
  512. '    If Right$(vSrcUrl, 1) <> "/" Then
  513. '        tPos1 = InStrRev(vSrcUrl, "/")
  514. '        If tPos1 > 0 Then
  515. '            vSrcUrl = Left$(vSrcUrl, tPos1)
  516. '        End If
  517. '    End If
  518. '    tPosStart = InStr(1, vSrcUrl, "://")
  519. '    tPos1 = InStr(1, vOrgUrl, "../")
  520. '    tPos1Pre = 0
  521. '    tPos2 = Len(vSrcUrl)
  522. '    While tPos1 > 0
  523. '        tPos2 = InStrRev(vSrcUrl, "/", tPos2 - 1)
  524. '
  525. '        tPos1Pre = tPos1
  526. '        tPos1 = InStr(tPos1 + 1, vOrgUrl, "../")
  527. '    Wend
  528. '    If tPos1Pre > 0 Then
  529. '        GetRealUrl = Left$(vSrcUrl, tPos2) & Replace(Mid$(vOrgUrl, tPos1Pre + 3), "./", "")
  530. '    ElseIf tPos1Pre = 0 Then
  531. '        GetRealUrl = vSrcUrl & Replace(vOrgUrl, "./", "")
  532. '    End If
  533. 'End If
  534. '
  535. 'End Function
  536. '
  537. '
  538. ''---------------------------------------------------------------------------------------
  539. '' Procedure : GetCFHtml
  540. '' DateTime  : 2005-5-10 15:50
  541. '' Author    : Lingll
  542. '' Purpose   :
  543. ''---------------------------------------------------------------------------------------
  544. 'Public Function GetCFHtml(Data As DataObject) As String
  545. '    Dim tArr() As Byte
  546. '    Dim tstr$
  547. '    Dim FMT As FORMATETC, STM As STGMEDIUM
  548. '    With FMT
  549. '       .cfFormat = CF_HTML
  550. '       .TYMED = TYMED_HGLOBAL
  551. '       .dwAspect = DVASPECT_CONTENT
  552. '       .lindex = -1
  553. '    End With
  554. '
  555. '    If m_DragDropDataObject.GetData(FMT, STM) = 0 Then
  556. '       'GetCFHtml = StrConv(pvStringFromhGlobal(STM.Data), vbUnicode)
  557. '       tArr = pvStringFromhGlobal(STM.Data)
  558. '       GetCFHtml = UTF8_Decode(tArr)
  559. '       ReleaseStgMedium STM
  560. '    End If
  561. '
  562. 'End Function
  563. '
  564. ''---------------------------------------------------------------------------------------
  565. '' Procedure : GetFragment
  566. '' DateTime  : 2005-5-9 23:52
  567. '' Author    : Lingll
  568. '' Purpose   : 获得在 "<!--StartFragment-->","<!--EndFragment-->"之间的东西
  569. ''---------------------------------------------------------------------------------------
  570. 'Private Function GetFragment(vHtml$) As String
  571. '    Dim tPos1&, tPos2&
  572. '
  573. '    tPos1 = InStr(1, vHtml, cfhtml_Tag_Start, vbTextCompare)
  574. '    If tPos1 > 0 Then
  575. '        tPos2 = InStr(tPos1, vHtml, cfhtml_Tag_End, vbTextCompare)
  576. '        If tPos2 > 0 Then
  577. '            GetFragment = Mid$(vHtml, tPos1 + Len(cfhtml_Tag_Start), tPos2 - tPos1 - Len(cfhtml_Tag_Start))
  578. '        End If
  579. '    End If
  580. 'End Function
  581. '
  582. '
  583. ''---------------------------------------------------------------------------------------
  584. '' Procedure : GetSourceURL
  585. '' DateTime  : 2005-5-10 16:02
  586. '' Author    : Lingll
  587. '' Purpose   :
  588. ''---------------------------------------------------------------------------------------
  589. 'Private Function GetSourceURL(vHtml$) As String
  590. '
  591. '    Dim tPos1&, tPos2&
  592. '    tPos1 = InStr(1, vHtml, cfhtml_Tag_SourceURL, vbTextCompare)
  593. '    If tPos1 > 0 Then
  594. '        tPos2 = InStr(tPos1, vHtml, vbNewLine)
  595. '        If tPos2 > 0 Then
  596. '            GetSourceURL = Mid$(vHtml, tPos1 + Len(cfhtml_Tag_SourceURL), tPos2 - tPos1 - Len(cfhtml_Tag_SourceURL))
  597. '        End If
  598. '    End If
  599. '
  600. 'End Function
  601. '
  602. ''---------------------------------------------------------------------------------------
  603. '' Procedure : IsImageDrop
  604. '' DateTime  : 2005-5-9 23:57
  605. '' Author    : Lingll
  606. '' Purpose   :
  607. ''---------------------------------------------------------------------------------------
  608. 'Public Function IsImageDrop(vImghtml$) As Long
  609. 'Dim FMT As FORMATETC
  610. '    With FMT
  611. '       .cfFormat = vbCFDIB
  612. '       .TYMED = TYMED_HGLOBAL
  613. '       .dwAspect = DVASPECT_CONTENT
  614. '       .lindex = -1
  615. '    End With
  616. '    If m_DragDropDataObject.QueryGetData(FMT) = 0 Then
  617. '        IsImageDrop = InStr(1, vImghtml, "<IMG ", vbTextCompare)
  618. '    Else
  619. '        IsImageDrop = 0
  620. '    End If
  621. 'End Function
  622. '
  623. '
  624. '
  625. '
  626. ''---------------------------------------------------------------------------------------
  627. '' Procedure : GetHtmlTag
  628. '' DateTime  : 2005-5-10 18:38
  629. '' Author    : Lingll
  630. '' Purpose   : url,text,img
  631. ''---------------------------------------------------------------------------------------
  632. 'Public Function GetHtmlDragDropType() As String
  633. 'Dim FMT As FORMATETC
  634. 'Dim isHtml As Boolean, isDIB As Boolean, isUrl As Boolean, isText As Boolean
  635. 'With FMT
  636. '   .TYMED = TYMED_HGLOBAL
  637. '   .dwAspect = DVASPECT_CONTENT
  638. '   .lindex = -1
  639. 'End With
  640. '
  641. 'FMT.cfFormat = CF_HTML
  642. 'isHtml = (m_DragDropDataObject.QueryGetData(FMT) = 0)
  643. '
  644. 'FMT.cfFormat = vbCFDIB
  645. 'isDIB = (m_DragDropDataObject.QueryGetData(FMT) = 0)
  646. '
  647. 'FMT.cfFormat = CF_URL
  648. 'isUrl = (m_DragDropDataObject.QueryGetData(FMT) = 0)
  649. '
  650. 'FMT.cfFormat = vbCFText
  651. 'isText = (m_DragDropDataObject.QueryGetData(FMT) = 0)
  652. '
  653. 'If isHtml And isDIB Then
  654. '    GetHtmlDragDropType = "img"
  655. 'ElseIf isUrl Then
  656. '    GetHtmlDragDropType = "url"
  657. 'ElseIf isText Then
  658. '    GetHtmlDragDropType = "text"
  659. 'End If
  660. '
  661. 'End Function