FreeBasic

Пример загружает версию компилятора 0.17 по HTTP с сайта SourceForge.
Платформы: Windows
Автор: Zippy, создано в 2006 году.

'download files, Windows only
' requires IE 4.0 or better
' tested using fb v.16b,
'   and fb v.17b from CVS (11/2006)
'
#INCLUDE Once "windows.bi"
#INCLUDE Once "win\wininet.bi"
'
Declare Function dlfile(sURL As String,LFileName As String) As Integer
Dim As String sURL,LFileName
Dim As Integer res
'
sURL="http://prdownloads.sourceforge.net/fbc/FB-v0.17b-jul-30-testing-win32.zip?download"
LFileName=exepath & "\" & "fb17b.zip"
'
Screenres 640,150,24,1
res=dlfile(sURL,LFileName)
'
If res>0 Then
        Locate 1,1
        Print LFileName;"  ..downloaded"
        Print " Size:";res;" bytes"
Else
    Print "Error encountered: ";res
End If
'
Print:Print "Sleeping to Exit.."
Beep
Sleep
End
'
'
Function dlfile(sURL As String,LFileName As String) As Integer
        Dim As HINTERNET hOpen,hFile
        Dim As Integer ctot,nret,res,tbsize,t
        Dim As String tbuff,ts
        Dim As String scUserAgent = "Zippy"
        Dim As Byte Ptr mybuff
        mybuff = Allocate(1024)
'        
        'Create an internet connection
        Locate 8,26
        Print "Getting Internet Connection";
        hOpen=InternetOpen(scUserAgent,INTERNET_OPEN_TYPE_DIRECT,NULL,NULL,0)
        If hOpen=0 Then Return -1 'failed..
'        
        'Open the url
        Locate 8,1
        Print Space(79);
        Locate 8,35
        Print "Opening URL";
        hFile = InternetOpenUrl(hOpen,sURL,NULL,0,INTERNET_FLAG_RELOAD,0)
        If hFile=0 Then Return -2 'failed..
'        
        'Let's get the file size..
        ' I think this requires IE 4.0 engine, not 3.0
        tbuff=space(32)
        tbsize=32
        res=HttpQueryInfo(hFile,_
                          HTTP_QUERY_CONTENT_LENGTH,_
                          Strptr(tbuff),_
                          @tbsize,_
                          NULL)

        tbsize=val(Trim(tbuff))
        'if res=FALSE or tbsize<1 then return -3 'failed, but don't care..
        If tbsize>0 Then
                t=40-(Len(sURL)/2)
                t=iif(t<1,1,t)
                Locate 8,t
                Print Left(sURL,80);
                t=40-(Len(LFileName)/2)
                t=iif(t<1,1,t)
                Locate 14,t
                Print LFileName;
                Color Rgb(0,0,255),0 
                Locate 10,4
                Print Chr(221);
                Locate 10,76
                Print Chr(222);
                Color Rgb(0,255,0),0
        End If
'        
        Open LFileName For Binary Access Write As #1
        nret=99 
        While nret>0 
                res=InternetReadFile(hFile,mybuff,1024,@nret)
                If nret>0 Then
                        Put #1,,mybuff[0],nret
                        ctot+=nret
                        If tbsize>0 Then
                                Locate 10,5 + Int(ctot/tbsize*70)
                                Print Chr(219);
                                ts=str(ctot) & " bytes of " & Str(tbsize)
                                Locate 12,(40-len(ts)/2)
                                Print ts;
                        Else
                                Locate 1,1
                                Print "Retrieved ";ctot;" bytes ";
                        End If
                End If
        Wend
        Close #1
'        
        InternetCloseHandle(hFile)
        InternetCloseHandle(hOpen)
        Deallocate mybuff
        Return tbsize
End Function