Test your home network speed.

[Mel Bishop]

Deleted. Something blew up as usual.

[Mel Bishop]

Fixed. (I hope)

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

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