Jag skulle vilja ladda ner ner 4 st olika txt filer och sedan lägga in dom i varsin label, Just nu så använder jag mig av denna för att ladda ner en txtfil. Går det att få den att ladda ner 4st olika....
Och sedan så skulle jag vilja att om den inte kan ladda ner/hitta filen så ska den skriva ut "< Ej Tillgänglig >" i label...
Private Sub Command1_Click()
'Kod
Dim hOpen As Long, hOpenUrl, lNumberOfBytesRead As Long
Dim bDoLoop As Boolean, bRet As Boolean
Dim sReadBuffer As String * 2048, sBuffer As String
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
hOpenUrl = InternetOpenUrl(hOpen, "http:///driftstatus/webbserver.txt", vbNullString, 0, _
INTERNET_FLAG_RELOAD, 0)
bDoLoop = True
While bDoLoop
sReadBuffer = vbNullString
bRet = InternetReadFile(hOpenUrl, sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
If hOpenUrl <> 0 Then InternetCloseHandle (hOpenUrl)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
sBuffer = Split(sBuffer, vbNewLine)(0)
'Första raden i version.txt ligger nu i sBuffer.
'MsgBox sBuffer, vbOKOnly, "Se om det finns en programuppdatering."
Label6.Caption = sBuffer
Command1.Enabled = False
End Sub
sFil1 = DownloadFile("http://www.medialabs.nu/fil1.txt")
sFil2 = DownloadFile("http://www.medialabs.nu/fil2.txt")
sFil3 = DownloadFile("http://www.medialabs.nu/fil3.txt")
sFil4 = DownloadFile("http://www.medialabs.nu/fil4.txt")
Private Function DownloadFile(sUrl As String) As String
Dim hInternetSession As Long
Dim hUrlFile As Long
Dim sReadBuffer As String * 4096
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
Dim bDoLoop As Boolean
hInternetSession = InternetOpen(App.Title, 0&, vbNullString, vbNullString, 0&)
hUrlFile = InternetOpenUrl(hInternetSession, sUrl, vbNullString, 0&, &H80000000, 0&)
bDoLoop = True
While bDoLoop
bDoLoop = CBool(InternetReadFile(hUrlFile, sReadBuffer, 4096, lNumberOfBytesRead))
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
InternetCloseHandle hUrlFile
InternetCloseHandle hInternetSession
DownloadFile = sBuffer
End Function
Till det andra måste jag nog undersöka saken lite nogrannare. :)
Ser ut ungefär lika. Enda skillnaden är ett lite smartare sätt att ladda ner filer med (en funktion) plus lite finare kod. ;)
Private Function DownloadFile(sUrl As String) As String
Dim hInternetSession As Long
Dim hUrlFile As Long
Dim sReadBuffer As String * 4096
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
Dim bDoLoop As Boolean
hInternetSession = InternetOpen(App.Title, 0&, vbNullString, vbNullString, 0&)
hUrlFile = InternetOpenUrl(hInternetSession, sUrl, vbNullString, 0&, &H80000000, 0&)
bDoLoop = True
While bDoLoop
bDoLoop = CBool(InternetReadFile(hUrlFile, sReadBuffer, 4096, lNumberOfBytesRead))
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
InternetCloseHandle hUrlFile
InternetCloseHandle hInternetSession
DownloadFile = sBuffer
End Function
Till det andra måste jag nog undersöka saken lite nogrannare. :)
Ser ut ungefär lika. Enda skillnaden är ett lite smartare sätt att ladda ner filer med (en funktion) plus lite finare kod. ;)
tack så mycket, fungerar utmärkt, fortsätt och klura på min andra fråga :)
Har nu verifierat att det inte går att få reda på med tanke på att om sidan inte finns så skickar servern en annan istället. Däremot så kan du kolla om en speciell text på 404-sidan finns med i strängen. T.ex. på din sida (https://www.medialabs.nu) kan du göra såhär:
Private Function DownloadFile(sUrl As String) As String
Dim hInternetSession As Long
Dim hUrlFile As Long
Dim sReadBuffer As String * 4096
Dim sBuffer As String
Dim lNumberOfBytesRead As Long
Dim bDoLoop As Boolean
hInternetSession = InternetOpen(App.Title, 0&, vbNullString, vbNullString, 0&)
hUrlFile = InternetOpenUrl(hInternetSession, sUrl, vbNullString, 0&, &H80000000, 0&)
If hUrlFile = 0 Then
InternetCloseHandle hInternetSession
DownloadFile = "< Server nere >"
Exit Function
End If
bDoLoop = True
While bDoLoop
bDoLoop = CBool(InternetReadFile(hUrlFile, sReadBuffer, 4096, lNumberOfBytesRead))
sBuffer = sBuffer & Left$(sReadBuffer, lNumberOfBytesRead)
If Not CBool(lNumberOfBytesRead) Then bDoLoop = False
Wend
InternetCloseHandle hUrlFile
InternetCloseHandle hInternetSession
If CBool(InStr(1, sBuffer, "404 - File Not Found", vbTextCompare)) Then
DownloadFile = "< Ej tillgänglig >"
Else
DownloadFile = sBuffer
End If
End Function
Så länge det står "404 - File Not Found" någonstans i din 404-fil på servern och det inte står så i filen du ska ladda ner så ska det fungera. :)
R// Så om du ändrar i din 404-fil så måste du ha kvar texten "404 - File Not Found" (utan citattecken). Om du vill kan du ju ha det i en kommentar. :)
R2// Förbättring i funktionen. Gör så att den märker om servern är nere
R3// "404 - File Not Found" behöver inte stå med bokstäverna så. Det kan stå "404 - FiLE NoT FouND" för allt vad koden bryr sig. ;)
Nu undrar jag om det är möjlig att göra så att man slipper ladda ner filen, för jag har inte möjlighet att sätta in txtfilen på mailservern. Går det att få koden kontakta mailservern på Tex adressen Mail.medialabs.se och se omden får kontakt?
Private Function IsContact(sServer As String) As Boolean
Dim hInternetSession As Long
Dim hUrlFile As Long
hInternetSession = InternetOpen(App.Title, 0&, vbNullString, vbNullString, 0&)
hUrlFile = InternetOpenUrl(hInternetSession, iif(LCase$(Left$(sServer, 4)) = "http", sServer, "http://" & sServer) , vbNullString, 0&, &H80000000, 0&)
If hUrlFile = 0 Then
InternetCloseHandle hInternetSession
IsContact = False
Else
InternetCloseHandle hUrlFile
InternetCloseHandle hInternetSession
IsContact = True
End If
End Function
Denna funktion använder du
If IsContact("http://mail.medialabs.se") Then
' Servern är inte nere
Else
' Servern är nere
End If
