Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Test your home network speed.

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Mel Bishop
    replied
    Fixed. (I hope)

    Many thanks for the help at: http://www.powerbasic.com/support/pb...ad.php?t=39318

    Code:
    REM ***********************************************************     '
    REM * Get a reasonably accurate speed measure of your network *     '
    REM ***********************************************************     '
                                                                        '
        #INCLUDE "win32api.inc"                                         '
        DECLARE FUNCTION BrowseForFolder(LONG, STRING) AS STRING        '
        DECLARE FUNCTION ClearFileCache (STRING) AS LONG                '
        DECLARE SUB      ShowResults    (LONG)                          '
                                                                        '
        %NOMMIDS          = 1                                           '
        %NOGDI            = 1                                           '
        %FILE_BUFFERSIZE  = 65536                                       ' Base size
        %OneMB            = 1048576                                     ' Avoids typing errors <smile>
        $sFile            = "c:\test"                                   '
        GLOBAL f$, f1$                                                  '
        GLOBAL Start, Finish, Difference AS DOUBLE                      '
        GLOBAL bytes, bps, packets       AS LONG                        '
        GLOBAL FileName, TestPacket      AS STRING                      '
                                                                        '
    FUNCTION PBMAIN                                                     '
        LOCAL x, y, z                    AS LONG                        '
                                                                        '
    '*******************************************************************'
        FOR x = 0 TO 255                                                '<:  Build up the test
        TestPacket$ = TestPacket$ + CHR$(x)                             ' |  packet.
        NEXT x                                                          '<:
                                                                        '
        f1$ = "###,###,###"                                             '
        f$  = "##,###.#######"                                          '
                                                                        '
        Packets = 50000                                                 '   Write 50K packets
                                                                        '
    '*******************************************************************'
        COLOR 14,1                                                      '
        CLS                                                             '
        FileName = browseforfolder(0, "Select destination folder...")   '   Output path/filename
        IF FileName = "" THEN EXIT FUNCTION                             '
        IF RIGHT$(FileName,1) <> "\" THEN FileName = FileName+"\"       '
        FileName = FileName + "SpeedTest.txt"                           '
                                                                        '
    '*******************************************************************'
                                                                        '
        CLS                                                             '
        LOCATE 10, 1 : PRINT;"  Path/File Name: ";FileName              '
        LOCATE  1, 5 : COLOR 0,7 : PRINT;" Write test " : COLOR 14,1    '
                                                                        '
        OPEN FileName FOR BINARY AS #1                                  '
        Start = TIMER                                                   '
        FOR x = 1 TO Packets                                            '<: Test the write speed
        PUT$ #1,TestPacket$                                             ' |
        NEXT x                                                          '<:
        CLOSE #1                                                        '
        finish = TIMER                                                  '
        z = ClearFileCache( FileName )                                  '
                                                                        '
        Difference = Finish - Start                                     '   In seconds
        bytes = (LEN(TestPacket$) * Packets) / difference               '
        bps = bytes * 8                                                 '
        ShowResults(1)                                                  '
                                                                        '
    '*******************************************************************'
        z = ClearFileCache( FileName )                                  '
                                                                        '
        LOCATE  1,45 : COLOR 0,7 : PRINT;" Read test: "; : COLOR 14,1   '
                                                                        '
        OPEN FileName FOR BINARY AS #1                                  '   Now perform a read test
        Start = TIMER                                                   '
        TestPacket$ = ""                                                '
        GET$ #1,LOF(1),TestPacket$                                      '   Read entire file.
        CLOSE #1                                                        '
        Finish = TIMER                                                  '
        z = ClearFileCache( FileName )                                  '
                                                                        '
        Difference = Finish - Start                                     '
        bytes = LEN(TestPacket$) / difference                           '   Bytes per second
        bps = bytes * 8                                                 '   Bits per second
                                                                        '
        ShowResults(2)                                                  '
                                                                        '
        KILL FileName                                                   '   Kill off the test file.
        WAITKEY$                                                        '
        END FUNCTION                                                    '
                                                                        '
    SUB ShowResults(which AS LONG)                                      '
        LOCAL col AS LONG, j AS QUAD                                               '
        IF which = 1 THEN                                               '
        col = 1                                                         '
        ELSE                                                            '
        col = 40                                                        '
        END IF                                                          '
        
        j = LEN(TestPacket$)
        IF which = 1 THEN j = j * packets
                                                                        '
        LOCATE  3,Col: PRINT;"   Packet Length: ";USING$(f1$,j)         '
        LOCATE  4,Col: PRINT;"      Time Start: ";USING$(f$,Start);     '
        LOCATE  5,Col: PRINT;"     Time Finish: ";USING$(f$,Finish);    '
        LOCATE  6,Col: PRINT;" Time Difference: ";USING$(f$,Difference);'
        LOCATE  7,Col: PRINT;"Bytes per second: ";USING$(f1$,bytes);    '
        LOCATE  8,Col: PRINT;" Bits per second: ";USING$(f1$,bps)       '
        END SUB                                                         '
                                                                        '
    REM ******************************                                  '
    REM * Select a folder            *                                  '
    REM * Ripped from another thread *                                  '
    REM ******************************                                  '
                                                                        '
    FUNCTION BrowseForFolder(hWndOwner AS LONG, _                       '
                               sPrompt AS STRING) AS STRING             '
     LOCAL lpIDList AS LONG                                             '
     LOCAL szPath AS ASCIIZ * %MAX_PATH, udtBI AS BrowseInfo            '
     udtBI.hWndOwner = hWndOwner                                        '
     udtBI.lpszTitle = STRPTR(sPrompt)                                  '
     udtBI.ulFlags   = %BIF_RETURNONLYFSDIRS                            '
     lpIDList = SHBrowseForFolder(udtBI)                                '
     IF lpIDList THEN                                                   '
       SHGetPathFromIDList BYVAL lpIDList, szPath                       '
       CoTaskMemFree lpIDList                                           '
       FUNCTION = szPath                                                '
     END IF                                                             '
    END FUNCTION                                                        '
                                                                        '
    REM *********************************************************************
    REM * Borrowed from David Roberts at:                                   *
    REM * http://www.powerbasic.com/support/pbforums/showthread.php?t=35260 *
    REM *********************************************************************
    REM * I wanted to read the file from the disk instead of the cache.     *
    REM *********************************************************************
    FUNCTION ClearFileCache( FileName AS STRING ) AS LONG               '
    LOCAL hSys, hPB, Chunk, lRes AS LONG                                '
    LOCAL Buffer    AS DWORD PTR                                        '
    LOCAL FileSize  AS QUAD                                             '
    LOCAL nbLoaded  AS DWORD                                            '
    DIM zFile       AS ASCIIZ * 256                                     '
                                                                        '
      zFile = FileName                                                  '
      ' Open file without buffering - ie bypass the filecache           '
      hSys = CreateFile( zFile, %GENERIC_READ, 0, _                     '
                         BYVAL 0, %OPEN_EXISTING, _                     '
                         %FILE_FLAG_SEQUENTIAL_SCAN OR _                '
                         %FILE_FLAG_NO_BUFFERING, BYVAL 0 )             '
      IF hSys < 0 THEN                                                  '
        lRes = GetLastError                                             '
        IF lRes = %ERROR_FILE_NOT_FOUND THEN                            '
          PRINT;"Unable to find" + " " + FileName                       '
        ELSE                                                            '
          PRINT;STR$( lRes ) + " " + "Unknown error on opening file"    '
        END IF                                                          '
        FUNCTION = %True                                                '
        EXIT FUNCTION                                                   '
      END IF                                                            '
                                                                        '
      hPB = FREEFILE                                                    '
      OPEN HANDLE hSys AS #hPB ' from a RTFMish remark by MCM           '
        FileSize = LOF( #hPB )                                          '
      CLOSE #hPB                                                        '
                                                                        '
      ' Chunk reading set to file size rounded up to
      ' next 64KB if file size less than 8MB else set to 8MB.
      IF FileSize < 128 * %FILE_BUFFERSIZE THEN ' ie 8MB
        Chunk = ( FileSize\65536 - 1 * _
                ( FileSize MOD 65536 > 0 ) ) * _
                 %FILE_BUFFERSIZE ' multiples of 64KB
      ELSE
        Chunk = 128 * %FILE_BUFFERSIZE ' ie 8Mb
      END IF
    
      DO
        Buffer = VirtualAlloc( BYVAL %Null, _
                                     Chunk, _
                                     %MEM_RESERVE OR _
                                     %MEM_TOP_DOWN, _
                                     %PAGE_READWRITE )
        IF Buffer = 0 THEN
          lRes = GetLastError
          IF lRes = %ERROR_NOT_ENOUGH_MEMORY THEN
            Chunk = Chunk\2
           IF Chunk = %FILE_BUFFERSIZE / 2 THEN
                 PRINT; "Not enough memory for file reading"
              FUNCTION = %True
              EXIT FUNCTION
            END IF
          ELSE
            PRINT; STR$( lRes ) + " " + "Unknown error allocating memory for file reading"
            FUNCTION = %True
            EXIT FUNCTION
          END IF
        ELSE
          VirtualAlloc BYVAL Buffer, Chunk, %MEM_COMMIT, %PAGE_READWRITE
          EXIT LOOP
        END IF
      LOOP
      ' OK, lets read the file
      DO
        IF ISFALSE ReadFile( hSys, BYVAL Buffer, BYVAL Chunk, nbLoaded, BYVAL 0 ) THEN
          PRINT; "Error on reading file"
          FUNCTION = %True
          EXIT FUNCTION
        END IF
      'LOOP UNTIL nbLoaded = 0
      LOOP UNTIL nbLoaded < Chunk ' Saves a ReadFile
      CloseHandle( hSys )
      VirtualFree BYVAL Buffer, %Null, %MEM_RELEASE
    
    END FUNCTION

    Leave a comment:


  • Mel Bishop
    started a topic Test your home network speed.

    Test your home network speed.

    Deleted. Something blew up as usual.
    Last edited by Mel Bishop; 13 Dec 2008, 03:52 PM.
Working...
X