Størrelse på Url

prøv at se her :
http://msdn.microsoft.com/library/default.asp?url=/workshop/networking/wininet/reference/functions/InternetCanonicalizeUrl.asp

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wcesdkr/htm/_wcesdk_win32_internetopenurl.asp

jelzin101>> Kan du ikke lave et eksempel til mig. ;)

sjh > vil du have længden af URL\'en eller størrelsen på det dokument url\'en refererer til?

/Jennemaan

Størrelsen i byte, og ikke kun den urlen refererer til, jeg skal bruge en kode eks:

Function URLSize(url As String) As Long
  URLSize = (URL Størrelsen i byte)
End Function

Jeg prøver igen:

Vil du have længden (i bytes) af URL\'en (som er en tekststreng)

eller

Vil du have størrelsen (i bytes) på den fil som url\'en refererer til?

/Jennemaan

Dim URLSize As Integer
URLSize=Len(\"http://www.eksperten.dk/index.phtml
\")

Det skal virke lige som FileLen, det skal bare være til URLfile

Private Sub Form_Load()
  Me.Caption = FileLen(\"C:\\autoexec.bat\")
End Sub

skulle det ikke være api ?

jo, men den skal virke lige som FileLen

FÅ DET LO.. TIL AT FUNKE. Hjæææææææææææææælp

\'-------------------------------------- Module1 --------------------------------------
Declare Function FtpFindFirstFile Lib \"wininet.dll\" Alias \"FtpFindFirstFileA\" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Declare Sub InternetCloseHandle Lib \"wininet.dll\" (ByVal hInet As Long)
Declare Function InternetOpenA Lib \"wininet.dll\" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare Function InternetOpenUrlA Lib \"wininet.dll\" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare Sub InternetReadFile Lib \"wininet.dll\" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long)

Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INET_RELOAD = &H80000000

Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Public Function URLSize(URL As String) As Long
Dim WFD As WIN32_FIND_DATA
Dim hInet As Long, hURL As Long, FileSize As Long
  hInet = InternetOpenA(\"VB-Tec:INET\", 0, vbNullString, vbNullString, 0)
  hURL = InternetOpenUrlA(hInet, URL, vbNullString, 0, INET_RELOAD, 0)
  FtpFindFirstFile hURL, URL, WFD, 0, 0
  FileSize = (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
  InternetCloseHandle hURL
  InternetCloseHandle hInet
URLSize = FileSize
End Function
\'-------------------------------------- Module1 --------------------------------------

\'-------------------------------------- Form1 --------------------------------------
Private Sub Command1_Click()
Me.Caption = URLSize(\"http://www.eksperten.dk/index.phtml\")
End Sub
\'-------------------------------------- Form1 --------------------------------------

Er der ikke nogle der kan hjælpe mig med at få det til at virke.???

Denne her virker.

Dog skal du være opmærksom på at den \"hænger\" hvis den ikke kan finde den pågældende URL (enten fordi at filen ikke eksisterer, eller at serveren ikke giver et response, f.eks. pga. cookies, el. lign). Hvis dette er tilfældet vil den først returnere 0 bytes efter en given timeout (mener at det er størrelsesorden 1 min).

Test den f.eks. på URLSize(\"http://www.microsoft.dk\").

/Jennemaan


Option Explicit


Declare Sub InternetCloseHandle Lib \"wininet.dll\" (ByVal hInet As Long)
Declare Function InternetOpenA Lib \"wininet.dll\" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare Function InternetOpenUrlA Lib \"wininet.dll\" (ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare Function InternetReadFile Lib \"wininet.dll\" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Boolean

Public Const MAX_PATH = 260
Public Const MAXDWORD = &HFFFF
Public Const INET_RELOAD = &H80000000



Public Function URLSize(URL As String) As Long
   
    Dim hInet As Long, hURL As Long, FileSize As Long, sBuffer As String, lNumBytesToRead As Long, lNumberOfBytesRead As Long, Result As String
    hInet = InternetOpenA(\"VB-Tec:INET\", 0, vbNullString, vbNullString, 0)
    hURL = InternetOpenUrlA(hInet, URL, vbNullString, 0, INET_RELOAD, 0)
    lNumBytesToRead = 1024
    sBuffer = Space$(lNumBytesToRead)
    Do While InternetReadFile(hURL, sBuffer, lNumBytesToRead, lNumberOfBytesRead)
        If lNumberOfBytesRead = 0 Then
            Exit Do
        Else
            Result = Result & Left$(sBuffer, lNumberOfBytesRead)
        End If
        lNumBytesToRead = 1024
        sBuffer = Space$(lNumBytesToRead)
    Loop
    InternetCloseHandle hURL
    InternetCloseHandle hInet
    URLSize = Len(Result)
End Function

Jo, men nu skulle jeg ikke downloade dokumentet men finde størrelsen på dokumentet.

Hvis det var en fil på 3MB skulle jeg jo vente i langtid for at få størrelsen på filen, så den duer ikke.

Hermed en funktion der alene bruger winsock.

Smid hele koden ind i et modul og leg løs.

/Jennemaan

Option Explicit

Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Long
    iMaxUdpDg As Long
    lpVendorInfo As Long
End Type
Public Declare Function WSAStartup Lib \"wsock32.dll\" (ByVal wVersionRequested As Integer, lpWSAData _
    As WSADATA) As Long
Public Declare Function WSACleanup Lib \"wsock32.dll\" () As Long
Public Const AF_INET = 2
Public Const SOCK_STREAM = 1
Public Declare Function gethostbyname Lib \"wsock32.dll\" (ByVal name As String) As Long
Public Type hostent
    h_name As Long
    h_aliases As Long
    h_addrtype As Integer
    h_length As Integer
    h_addr_list As Long
End Type
Public Declare Function htons Lib \"wsock32.dll\" (ByVal hostshort As Integer) As Integer
Public Declare Function socket Lib \"wsock32.dll\" (ByVal af As Long, ByVal prototype As Long, _
    ByVal protocol As Long) As Long
Public Type sockaddr
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
Public Declare Function connect Lib \"wsock32.dll\" (ByVal s As Long, name As sockaddr, ByVal namelen _
    As Long) As Long
Declare Function ioctlsocket Lib \"wsock32.dll\" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Public Const FIONBIO = &H8004667E
Public Declare Function send Lib \"wsock32.dll\" (ByVal s As Long, buf As Any, ByVal Length As Long, _
    ByVal flags As Long) As Long
Public Declare Function recv Lib \"wsock32.dll\" (ByVal s As Long, buf As Any, ByVal Length As Long, _
    ByVal flags As Long) As Long
Public Declare Function closesocket Lib \"wsock32.dll\" (ByVal s As Long) As Long
Public Declare Sub CopyMemory Lib \"kernel32.dll\" Alias \"RtlMoveMemory\" (Destination As Any, Source _
    As Any, ByVal Length As Long)
Public Const SOCKET_ERROR = -1

\' Define a useful macro.
Public Function MAKEWORD(ByVal bLow As Byte, ByVal bHigh As Byte) As Integer
    MAKEWORD = Val(\"&H\" & Right(\"00\" & Hex(bHigh), 2) & Right(\"00\" & Hex(bLow), 2))
End Function


Function URLSize(URL As String) As Long

Dim wsockinfo As WSADATA  \' info about Winsock
Dim sock As Long          \' the socket descriptor
Dim pHostinfo As Long    \' pointer to info about the host computer
Dim hostinfo As hostent  \' info about the host computer
Dim pIPAddress As Long    \' pointer to host\'s IP address
Dim ipAddress As Long    \' host\'s IP address
Dim sockinfo As sockaddr  \' settings for the socket
Dim buffer As String      \' buffer for sending and receiving data
Dim reply As String      \' accumulates server\'s reply
Dim retval As Long        \' generic return value

Dim strHost As String
Dim strPath As String
Dim lPos As Long
Dim strTmp As String

Dim lTimeOut As Long
Dim lStart As Long

lTimeOut = 10 \'10 seconds timeout

\'First we need to find the host and path from the URL
URL = Replace(URL, \"http://\", \"\")
\'Find position of first \"/\" in URL
lPos = InStr(1, URL, \"/\")
If lPos = 0 Then
    strHost = URL
    strPath = \"/\"
Else
    strHost = Mid(URL, 1, lPos - 1)
    strPath = Mid(URL, lPos)
End If

   
\' Begin a Winsock session.
retval = WSAStartup(MAKEWORD(2, 2), wsockinfo)
If retval <> 0 Then
    Debug.Print \"Unable to initialize Winsock! --\"; retval
    Exit Function
End If
   
\' Get information about the server to connect to.
pHostinfo = gethostbyname(strHost)
If pHostinfo = 0 Then
    Debug.Print \"Unable to resolve host!\"
    GoTo Cleanup
End If
   
\' Copy information about the server into the structure.
CopyMemory hostinfo, ByVal pHostinfo, Len(hostinfo)
If hostinfo.h_addrtype <> AF_INET Then
    Debug.Print \"Couldn\'t get IP address of host!\"
    GoTo Cleanup
End If
\' Get the server\'s IP address out of the structure.
CopyMemory pIPAddress, ByVal hostinfo.h_addr_list, 4
CopyMemory ipAddress, ByVal pIPAddress, 4
   
\' Create a socket.
sock = socket(AF_INET, SOCK_STREAM, 0)
If sock = SOCKET_ERROR Then
    Debug.Print \"Unable to create socket!\"
    GoTo Cleanup
End If
   
\' Make a connection to host:80 (where the web server listens).
With sockinfo
    \' Use Internet Protocol (IP)
    .sin_family = AF_INET
    \' Connect to port 80.
    .sin_port = htons(80)
    \' Connect to this IP address.
    .sin_addr = ipAddress
    \' Padding characters.
    .sin_zero = String(8, vbNullChar)
End With

retval = connect(sock, sockinfo, Len(sockinfo))
If retval <> 0 Then
    Debug.Print \"Unable to connect!\"
    GoTo Cleanup
End If
   
\' Send an HTTP/GET request for the / document.

buffer = \"GET \" & strPath & \" HTTP/1.0\" & vbCrLf & \"Accept: image/gif,image/x-xbitmap,image/jpeg,image/pjpeg,*/*\" & vbCrLf & \"User-Agent: Jennemaans URLSizer 1.0\" & vbCrLf & \"Host: \" & strHost & vbCrLf & vbCrLf

retval = send(sock, ByVal buffer, Len(buffer), 0)

\' Make the socket non-blocking, so calls to recv don\'t halt the program waiting for input.
retval = ioctlsocket(sock, FIONBIO, 1)
   
lStart = Timer
Do
    buffer = Space(512)
    retval = recv(sock, ByVal buffer, Len(buffer), 0)
    If retval <> 0 And retval <> SOCKET_ERROR Then
        reply = reply & Left(buffer, retval)
    End If
    \' Process background events so the program doesn\'t appear to freeze.
    DoEvents
   
   
   
Loop Until retval = 0 Or (InStr(1, reply, \"Content-Length\", vbTextCompare) > 0 And Len(reply) > (InStr(1, reply, \"Content-Length\", vbTextCompare) + 100)) Or (retval = -1 And lTimeOut + lStart < Timer)
   
\'get position of content length reply
lPos = InStr(1, reply, \"Content-Length\", vbTextCompare)
If lPos > 0 Then
    strTmp = Mid(reply, lPos + 15, InStr(lPos, reply, vbCrLf, vbTextCompare) - (lPos + 15))
    URLSize = CLng(Trim(strTmp))
ElseIf retval = -1 Then
    URLSize = -1 \'timeout
End If
   
   
\' Perform the necessary cleanup at the end.
Cleanup:
    retval = closesocket(sock)
    retval = WSACleanup()
End Function

jennemaan >>Jeg kan ikke få det til at virke helt, 7MB fil bliver til 182. ???

Private Sub Command1_Click()
Me.Caption = URLSize(\"http://download.microsoft.com/msdownload/sbn/vbcce/vb5ccein.exe\")
End Sub

sjh > det er fordi at hvis du prøver at sætte en debug.print på reply (efter loopen) så ser indholdet således ud:

HTTP/1.1 301 Error
Location: http://msdl.microsoft.com/msdownload/sbn/vbcce/vb5ccein.exe
Server: Microsoft-IIS/5.0
Content-Type: text/html
Content-Length: 182

<head><title>Document Moved</title></head>
<body><h1>Object Moved</h1>This document may be found <a HREF=\"http://msdl.microsoft.com/msdownload/sbn/vbcce/vb5ccein.exe\">here</a></body>

Dvs at det er en gal URL (som iøvrigt fylder 182 bytes) ;o)

/Jennemaan

Her er noget der kan bruges. Men jeg har prøvet at pille den del ud som jeg skal bruge men så funker den bare ikke.

http://www.planet-source-code.com/xq/ASP/txtCodeId.10403/lngWId.1/qx/vb/scripts/ShowCode.htm

Hvis der er en der vil hjælpe mig med at pille den del af koden ud så er der 719 point hjemme. :)

Nu har jeg fået lavet det som jeg ville ha det. :)


Private Declare Function InternetOpen Lib \"wininet\" Alias \"InternetOpenA\" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib \"wininet.dll\" Alias \"InternetConnectA\" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nProxyPort As Integer, ByVal lpszUserName As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib \"wininet\" (ByVal hInet As Long) As Integer

Private Declare Function HttpOpenRequest Lib \"wininet.dll\" Alias \"HttpOpenRequestA\" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib \"wininet.dll\" Alias \"HttpSendRequestA\" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, sOptional As Any, ByVal lOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib \"wininet.dll\" Alias \"HttpQueryInfoA\" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Long

Private Declare Function StrFormatByteSize Lib \"shlwapi\" Alias \"StrFormatByteSizeA\" (ByVal dw As Long, ByVal pszBuf As String, ByRef cchBuf As Long) As String

Private Function UrlSplit(UrlNewFile As String, UrlFilePath As String)
Dim UrlPos As Long
  If Left$(LCase(UrlNewFile), 7) = \"http://\" Then
    UrlNewFile = Right$(UrlNewFile, Len(UrlNewFile) - 7)
      ElseIf Left$(LCase(UrlNewFile), 6) = \"ftp://\" Then
    UrlNewFile = Right$(UrlNewFile, Len(UrlNewFile) - 6)
  End If
    UrlPos = InStr(1, UrlNewFile, \"/\")
  If UrlPos > 0 Then
    UrlFilePath = Right$(UrlNewFile, Len(UrlNewFile) - UrlPos + 1)
    UrlNewFile = Left$(UrlNewFile, UrlPos - 1)
  End If
End Function

Function UrlInfo(UrlFile As String) As String
Dim UrlBuffer As String * 1024
Dim UrlBufferLength As Long
Dim UrlFilePath As String
Dim UrlInternetSession As Long
Dim UrlInternetConnect As Long
Dim UrlRequest As Long
Dim UrlNewFile As String

UrlNewFile = UrlFile
UrlSplit UrlNewFile, UrlFilePath

  UrlInternetSession = InternetOpen(\"URL Info\", 0, vbNullString, vbNullString, 0)
  UrlInternetConnect = InternetConnect(UrlInternetSession, UrlNewFile, 0, vbNullString, vbNullString, 3, 0, 0)
  UrlRequest = HttpOpenRequest(UrlInternetConnect, \"HEAD\", UrlFilePath, \"HTTP/1.0\", vbNullString, 0, &H80000000, 0)

  If CBool(UrlRequest) Then
    UrlBuffer = Space(1024)
    UrlBufferLength = Len(UrlBuffer)
    HttpSendRequest UrlRequest, vbNullString, 0, 0, 0
    HttpQueryInfo UrlRequest, 22, ByVal UrlBuffer, UrlBufferLength, 0
  End If
 
  InternetCloseHandle UrlRequest
  InternetCloseHandle UrlInternetConnect
  InternetCloseHandle UrlInternetSession

UrlInfo = UrlBuffer
End Function

Function UrlLen(UrlBuffer As String) As Long
Dim UrlPos As Long
UrlPos = InStr(1, LCase(UrlBuffer), \"content-length: \")
  If UrlPos > 0 Then
    UrlPos = UrlPos + 16
    UrlLen = Mid$(UrlBuffer, UrlPos, InStr(UrlPos, UrlBuffer, vbCrLf) - UrlPos)
      Else
    UrlLen = 0
  End If
End Function

Function FormatByteSize(ByteSize As Long) As String
Dim Buffer As String
Dim Result As String
  Buffer = Space$(255)
  Result = StrFormatByteSize(ByteSize, Buffer, Len(Buffer))
    If InStr(Result, vbNullChar) > 1 Then
      FormatByteSize = Left$(Result, InStr(Result, vbNullChar) - 1)
    End If
End Function

Private Sub Command1_Click()
Dim UrlFile As String

\'UrlFile = \"http://msdl.microsoft.com/msdownload/sbn/vbcce/vb5ccein.exe\"
UrlFile = \"http://www.zarr.net/vb/download/download.asp?id=198\"

Me.Caption = FormatByteSize(UrlLen(UrlInfo(UrlFile)))
End Sub

mange tak for pts.