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: