API tools faq
paste
Advertisement
deseven

ntest2

deseven
Jun 12th, 2012
519
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
PureBasic 14.33 KB | None | 0 0
raw download clone embed print report
  1. ; NetTest2
  2.  
  3.  
  4. ; Globals
  5. CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  6.   Global TempDir$ = "/tmp/"
  7. CompilerElse
  8.   Global Sys32Path$ = GetEnvironmentVariable("WINDIR") + "\system32\"
  9.   Global TempDir$ = GetEnvironmentVariable("TEMP") + "\"
  10. CompilerEndIf
  11.  
  12. Global BgColor = $eeeeee
  13. Global CurrentStep = 0
  14. Global PingRunning,DNSRunning,RXRunning,TXRunning,StatsRunning=#False
  15. Global PingThread,DNSThread,RXThread,TXThread,StatsThread,SizeOfUpload,SizeOfDownload,UploadFileName$
  16. Global PingResult,DNSResult,RXResult,TXResult,FinRx,RXSpeed.d,FinTX,TXSpeed.d,StatsResult
  17. Global OSVersionFull$,PingLoss,PingLat.d
  18. Global Version.s = "103"
  19.  
  20. ; Procedures
  21. Structure EchoResult
  22.   Reply.ICMP_ECHO_REPLY
  23.   Buffer.l[20000]
  24. EndStructure
  25.  
  26. Procedure Ping(Address$,Timeout,StringToSend$)
  27.   hPort = IcmpCreateFile_()
  28.   Result = IcmpSendEcho_(hPort,inet_addr_(@Address$),@StringToSend$,Len(StringToSend$),0,@ECHO.EchoResult,SizeOf(EchoResult),Timeout)
  29.   IcmpCloseHandle_(hPort)
  30.   If Result = 0
  31.     ProcedureReturn -1
  32.   Else
  33.     ProcedureReturn ECHO\Reply\RoundTripTime
  34.   EndIf
  35. EndProcedure
  36.  
  37. Procedure DoPing(Dummy)
  38.   PingRunning=#True
  39.   PingLoss = 0
  40.   PingLat.d = 0
  41.   STS$ = ""
  42.   STSb$ = "EchoThisMessageAsFastAsYouCan..." ;32 bytes
  43.   For b=1 To 400                            ; 12800 bytes
  44.     STS$ = STS$ + STSb$
  45.   Next
  46.   For a=1 To 100
  47.     CurrentPing = Ping("195.191.221.2",1000,STS$)
  48.     Delay(100)
  49.     ;Debug CurrentPing
  50.     SetGadgetState(20,GetGadgetState(20)+1)
  51.     If CurrentPing >= 0
  52.       PingLat.d = PingLat.d + CurrentPing
  53.     Else
  54.       PingLoss = PingLoss + 1
  55.     EndIf
  56.   Next
  57.   If PingLoss = 100
  58.     PingResult = 0
  59.   Else
  60.     PingLat.d = PingLat.d/(100-PingLoss)
  61.     PingResult = 1
  62.   EndIf
  63.   CurrentStep = 1
  64.   ;Debug PingLoss
  65. EndProcedure
  66.  
  67. Procedure DoDNS(Dummy)
  68.   DNSRunning=#True
  69.   SetGadgetState(21,1)
  70.   If ReceiveHTTPFile("http://home-nadym.ru/",TempDir$+"ntdns.tmp") = 0
  71.     DNSResult = 0
  72.     SetGadgetState(21,100)
  73.   Else
  74.     DeleteFile(TempDir$+"ntdns.tmp")
  75.     DNSResult = 1
  76.     SetGadgetState(21,100)
  77.   EndIf
  78.   CurrentStep = 2
  79. EndProcedure
  80.  
  81. Procedure DoRX(Dummy)
  82.   RXRunning=#True
  83.   OpenFTP(0,"services.home-nadym.ru","anon","anony")
  84.   If IsFTP(0)
  85.     SetFTPDirectory(0,"pub")
  86.     ExamineFTPDirectory(0)
  87.     While NextFTPDirectoryEntry(0)
  88.       If FTPDirectoryEntryName(0) = "big.file"
  89.         SizeOfDownload = FTPDirectoryEntrySize(0)
  90.       EndIf
  91.     Wend
  92.     StartRX = ElapsedMilliseconds()
  93.     If ReceiveFTPFile(0,"big.file",TempDir$+"ntrx.tmp")
  94.       FinRX = ElapsedMilliseconds()-StartRX
  95.       RXSpeed.d = ((SizeOfDownload/(FinRX/1000))/1024/1024)*8
  96.       If FileSize(TempDir$+"ntrx.tmp") = SizeOfDownload
  97.         RXResult = 1
  98.       Else
  99.         RXResult = 0
  100.       EndIf
  101.     Else
  102.       RXResult = 0
  103.     EndIf
  104.     CloseFTP(0)
  105.   Else
  106.     RXResult = 0
  107.     ;MessageRequester("Error!","Failed to open FTP... [Code: 4]")
  108.   EndIf
  109.   DeleteFile(TempDir$+"ntrx.tmp")
  110.   CurrentStep = 3
  111. EndProcedure
  112.  
  113. Procedure DoTX(Dummy)
  114.   TXRunning=#True
  115.   UploadFileName$ = Chr(Random(25)+97)+Chr(Random(25)+97)+Chr(Random(25)+97)+Chr(Random(25)+97)+Chr(Random(25)+97)+"."+Chr(Random(25)+97)+Chr(Random(25)+97)+Chr(Random(25)+97)
  116.   CreateFile(1,TempDir$+UploadFileName$)
  117.   For a=1 To 400000
  118.     WriteStringN(1,"000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000")
  119.   Next
  120.   CloseFile(1)
  121.   Global SizeOfUpload = FileSize(TempDir$+UploadFileName$)
  122.   OpenFTP(0,"services.home-nadym.ru","anon","anony")
  123.   If IsFTP(0)
  124.     SetFTPDirectory(0,"pub")
  125.     StartTX = ElapsedMilliseconds()
  126.     SendFTPFile(0,TempDir$+UploadFileName$,UploadFileName$)
  127.     FinTX = ElapsedMilliseconds()-StartTX
  128.     TXSpeed.d = ((SizeOfUpload/(FinTX/1000))/1024/1024)*8
  129.     CloseFTP(0)
  130.     OpenFTP(0,"services.home-nadym.ru","anon","anony")
  131.     SetFTPDirectory(0,"pub")
  132.     ExamineFTPDirectory(0)
  133.     While NextFTPDirectoryEntry(0)
  134.       If FTPDirectoryEntryName(0) = UploadFileName$
  135.         If FTPDirectoryEntrySize(0) = SizeOfUpload
  136.           TXResult = 1
  137.         Else
  138.           TXResult = 0
  139.         EndIf
  140.         DeleteFTPFile(0,UploadFileName$)
  141.       EndIf
  142.     Wend
  143.     CloseFTP(0)
  144.   Else
  145.     Global TXResult = 0
  146.   EndIf
  147.   DeleteFile(TempDir$+UploadFileName$)
  148.   CurrentStep = 4
  149. EndProcedure
  150.  
  151. Procedure DetectOS()
  152.   CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  153.     OSVersionFull$ = "Linux"
  154.   CompilerElse
  155.     Select OSVersion()
  156.       Case #PB_OS_Windows_NT3_51
  157.         OSVersionFull$ = "NT3"
  158.  
  159.       Case #PB_OS_Windows_NT_4
  160.         OSVersionFull$ = "NT4"
  161.  
  162.       Case #PB_OS_Windows_ME
  163.         OSVersionFull$ = "ME"
  164.      
  165.       Case #PB_OS_Windows_95
  166.         OSVersionFull$ = "95"
  167.      
  168.       Case #PB_OS_Windows_98
  169.         OSVersionFull$ = "98"
  170.  
  171.       Case #PB_OS_Windows_2000
  172.         OSVersionFull$ = "2k"
  173.  
  174.       Case #PB_OS_Windows_XP
  175.         OSVersionFull$ = "XP"
  176.      
  177.       Case #PB_OS_Windows_Server_2003
  178.         OSVersionFull$ = "2k3"
  179.  
  180.       Case #PB_OS_Windows_Vista
  181.         OSVersionFull$ = "Vista"
  182.  
  183.       Case #PB_OS_Windows_Server_2008
  184.         OSVersionFull$ = "2k8"
  185.      
  186.       Case #PB_OS_Windows_7
  187.         OSVersionFull$ = "7"
  188.      
  189.       Default
  190.         OSVersionFull$ = "fail"
  191.     EndSelect
  192.   CompilerEndIf
  193. EndProcedure
  194.  
  195. Procedure DoStats(Dummy)
  196.   StatsRunning=#True
  197.   SetGadgetState(24,1)
  198.   SendPP$ = Str(PingLoss)
  199.   SendPT$ = Str(Round(PingLat.d,#PB_Round_Nearest))
  200.   DetectOS()
  201.   UploadFileName$ = ""
  202.   For i = 1 To 24
  203.     UploadFileName$ = UploadFileName$ + Chr(65+Random(1)*32+Random(25))
  204.   Next
  205.   SendString$ = "http://home-nadym.ru/nettest-stats-collector.php?m=1&v="+Version+"&pt="+SendPT$+"ms"+"&pp="+SendPP$+"&rx="+Str(RXSpeed.d)+"Mbits&tx="+Str(TXSpeed.d)+"Mbits&w="+OSVersionFull$+"&a="+UploadFileName$
  206.   ReceiveHTTPFile(SendString$,TempDir$+"ntstat.tmp")
  207.   DeleteFile(TempDir$+"ntstat.tmp")
  208.   UploadFileName$ = UploadFileName$+".txt"
  209.   CreateFile(12,TempDir$+UploadFileName$)
  210.   CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  211.     Pid = RunProgram("/sbin/ifconfig","-a",TempDir$,#PB_Program_Open|#PB_Program_Read|#PB_Program_Hide)
  212.   CompilerElse
  213.     Pid = RunProgram(Sys32Path$+"ipconfig.exe","/all",TempDir$,#PB_Program_Open|#PB_Program_Read|#PB_Program_Hide)
  214.   CompilerEndIf  
  215.   If ProgramRunning(Pid)
  216.     While ProgramRunning(Pid)
  217.       If AvailableProgramOutput(Pid) > 0
  218.         WriteStringN(12,ReadProgramString(Pid))
  219.       EndIf
  220.     Wend
  221.   Else
  222.     WriteStringN(12,"`ipconfig /all` failed")
  223.   EndIf
  224.   CloseFile(12)
  225.   OpenFTP(0,"services.home-nadym.ru","anon","anony")
  226.   SetFTPDirectory(0,"pub")
  227.   SendFTPFile(0,TempDir$+UploadFileName$,UploadFileName$)
  228.   CloseFTP(0)
  229.   DeleteFile(TempDir$+UploadFileName$)
  230.   ; don't need to check the result, for now
  231.   StatsResult = 1
  232.   SetGadgetState(24,100)
  233.   CurrentStep = 5
  234. EndProcedure
  235.  
  236. Procedure SetTransferStatus(Mode)
  237.   If Mode = 1
  238.     While IsThread(RXThread)
  239.       If IsFTP(0)
  240.         If FTPProgress(0) > 0
  241.           CurPercent.d = FTPProgress(0)/(SizeOfDownload/100)
  242.           Delay(500)
  243.           SetGadgetState(22,Round(CurPercent.d,#PB_Round_Nearest))
  244.         EndIf
  245.       EndIf
  246.     Wend
  247.     SetGadgetState(22,100)
  248.   Else
  249.     While IsThread(TXThread)
  250.       If IsFTP(0)
  251.         If FTPProgress(0) > 0
  252.           CurPercent.d = FTPProgress(0)/(SizeOfUpload/100)
  253.           Delay(500)
  254.           SetGadgetState(23,Round(CurPercent.d,#PB_Round_Nearest))
  255.         EndIf
  256.       EndIf
  257.     Wend
  258.     SetGadgetState(23,100)
  259.   EndIf
  260. EndProcedure
  261.  
  262.  
  263. ; UI
  264.  
  265.  
  266. ; logo & icons
  267. ImgLogo = CatchImage(0,?ImgLogo)
  268. ImgOk = CatchImage(1,?ImgOk)
  269. ImgFail = CatchImage(2,?ImgFail)
  270. ImgWork = CatchImage(3,?ImgWork)
  271. ImgTodo = CatchImage(4,?ImgTodo)
  272.  
  273. DataSection
  274.   ImgLogo: IncludeBinary "S:\misc\work\inter\NetTest2-win\logo.bmp"
  275.   ImgOk:   IncludeBinary "S:\misc\work\inter\NetTest2-win\icons\ok.bmp"
  276.   ImgFail: IncludeBinary "S:\misc\work\inter\NetTest2-win\icons\fail.bmp"
  277.   ImgWork: IncludeBinary "S:\misc\work\inter\NetTest2-win\icons\work.bmp"
  278.   ImgTodo: IncludeBinary "S:\misc\work\inter\NetTest2-win\icons\todo.bmp"
  279. EndDataSection
  280.  
  281.  
  282. ; Window
  283. If OpenWindow(0,#PB_Ignore,#PB_Ignore,300,200,"NetTest 3.0.3 b"+Version,#PB_Window_ScreenCentered | #PB_Window_SystemMenu)
  284.   SetWindowColor(0,BgColor)
  285.   StickyWindow(0,1)
  286.   SetActiveWindow(0)
  287.   BringWindowToTop_(WindowID(0))
  288.   ImageGadget(0,10,10,60,60,ImgLogo)
  289.   ButtonGadget(1,100,150,100,40,"Начать проверку",#PB_Button_Default)
  290. Else
  291.   MessageRequester("Error!","Can't create window... [Code: 11]")
  292. EndIf
  293.  
  294.  
  295. ; Events
  296. Repeat
  297.   ev = WaitWindowEvent(100)
  298.   If #PB_Event_Gadget And EventGadget()=1 And EventType() = #PB_EventType_LeftClick
  299.     If IsGadget(50)
  300.       HideGadget(50,1)
  301.     EndIf
  302.     HideGadget(0,1)
  303.     HideGadget(1,1)
  304.     TextGadget(10,10,10,60,20,"Ping: ")
  305.     SetGadgetColor(10,#PB_Gadget_BackColor,BgColor)
  306.     TextGadget(11,10,40,60,20,"DNS: ")
  307.     SetGadgetColor(11,#PB_Gadget_BackColor,BgColor)
  308.     TextGadget(12,10,70,60,20,"RX Trans: ")
  309.     SetGadgetColor(12,#PB_Gadget_BackColor,BgColor)
  310.     TextGadget(13,10,100,60,20,"TX Trans: ")
  311.     SetGadgetColor(13,#PB_Gadget_BackColor,BgColor)
  312.     TextGadget(14,10,130,60,20,"Send stats: ")
  313.     SetGadgetColor(14,#PB_Gadget_BackColor,BgColor)
  314.     ProgressBarGadget(20,70,10,190,15,0,100,#PB_ProgressBar_Smooth)
  315.     ImageGadget(30,270,10,16,16,ImgWork)
  316.     ProgressBarGadget(21,70,40,190,15,0,100,#PB_ProgressBar_Smooth)
  317.     ImageGadget(31,270,40,16,16,ImgTodo)
  318.     ProgressBarGadget(22,70,70,190,15,0,100,#PB_ProgressBar_Smooth)
  319.     ImageGadget(32,270,70,16,16,ImgTodo)
  320.     ProgressBarGadget(23,70,100,190,15,0,100,#PB_ProgressBar_Smooth)
  321.     ImageGadget(33,270,100,16,16,ImgTodo)
  322.     ProgressBarGadget(24,70,130,190,15,0,100,#PB_ProgressBar_Smooth)
  323.     ImageGadget(34,270,130,16,16,ImgTodo)
  324.     TextGadget(15,10,165,280,20,"Пожалуйста, дождитесь выполнения тестов...",#PB_Text_Center)
  325.     StartTests=1
  326.   EndIf
  327.   If StartTests = 1
  328.     StartTests = 0
  329.     ;Debug CurrentStep
  330.     ;Debug PingThread
  331.     If CurrentStep = 0
  332.       If InitNetwork()
  333.         ; Step 1 - ping
  334.         PingThread = CreateThread(@DoPing(),Dummy)
  335.       Else
  336.         TextGadget(15,10,165,280,20,"Не найден TCP/IP стэк... [Code: 12]",#PB_Text_Center)
  337.       EndIf
  338.     EndIf
  339.     If CurrentStep = 1 And PingResult = 1
  340.       ; Step 2 - DNS
  341.       DNSThread = CreateThread(@DoDNS(),Dummy)
  342.     EndIf
  343.     If CurrentStep = 2
  344.       ; Step 3 - RX
  345.       RXThread = CreateThread(@DoRX(),Dummy)
  346.       CreateThread(@SetTransferStatus(),1)
  347.     EndIf
  348.     If CurrentStep = 3
  349.       ; Step 4 - TX
  350.       TXThread = CreateThread(@DoTX(),Dummy)
  351.       CreateThread(@SetTransferStatus(),2)
  352.     EndIf
  353.     If CurrentStep = 4
  354.       ; Step 5 - Stats
  355.       StatsThread = CreateThread(@DoStats(),Dummy)
  356.     EndIf
  357.     If CurrentStep = 5
  358.       ; Start Over
  359.       ;CurrentStep = 0
  360.       PingThread = CreateThread(@DoPing(),Dummy)
  361.     EndIf
  362.   EndIf
  363.   If PingRunning=#True
  364.     If IsThread(PingThread) = 0
  365.       PingRunning=#False
  366.       If PingResult=0
  367.         ImageGadget(30,270,10,16,16,ImgFail)
  368.         ImageGadget(31,270,40,16,16,ImgFail)
  369.         ImageGadget(32,270,70,16,16,ImgFail)
  370.         ImageGadget(33,270,100,16,16,ImgFail)
  371.         ImageGadget(34,270,130,16,16,ImgFail)
  372.         TextGadget(15,10,165,280,20,"Ping: 100% потерь... [Code: 13]",#PB_Text_Center)
  373.       Else
  374.         ImageGadget(30,270,10,16,16,ImgOk)
  375.         ImageGadget(31,270,40,16,16,ImgWork)
  376.         StartTests = 1
  377.       EndIf
  378.     EndIf
  379.   EndIf
  380.   If DNSRunning=#True
  381.     If IsThread(DNSThread) = 0
  382.       DNSRunning=#False
  383.       If DNSResult = 0
  384.         ImageGadget(31,270,40,16,16,ImgFail)
  385.         ImageGadget(32,270,70,16,16,ImgWork)
  386.         TextGadget(15,10,165,280,20,"DNS не доступен... [Code: 14]",#PB_Text_Center)
  387.       Else
  388.         ImageGadget(31,270,40,16,16,ImgOk)
  389.         ImageGadget(32,270,70,16,16,ImgWork)
  390.         StartTests = 1
  391.       EndIf
  392.     EndIf
  393.   EndIf
  394.   If RXRunning=#True
  395.     If IsThread(RXThread) = 0
  396.       RXRunning=#False
  397.       If RXResult = 0
  398.         ImageGadget(32,270,70,16,16,ImgFail)
  399.         ImageGadget(33,270,100,16,16,ImgFail)
  400.         ImageGadget(34,270,130,16,16,ImgFail)
  401.         TextGadget(15,10,165,280,20,"Не удалось скачать файл... [Code: 15]",#PB_Text_Center)
  402.       Else
  403.         ImageGadget(32,270,70,16,16,ImgOk)
  404.         ImageGadget(33,270,100,16,16,ImgWork)
  405.         StartTests = 1
  406.       EndIf
  407.     EndIf
  408.   EndIf
  409.   If TXRunning=#True
  410.     If IsThread(TXThread) = 0
  411.       TXRunning=#False
  412.       If TXResult=0
  413.         ImageGadget(33,270,100,16,16,ImgFail)
  414.         ImageGadget(34,270,130,16,16,ImgFail)
  415.         TextGadget(15,10,165,280,20,"Не удалось закачать файл... [Code: 16]",#PB_Text_Center)
  416.       Else
  417.         ImageGadget(33,270,100,16,16,ImgOk)
  418.         ImageGadget(34,270,130,16,16,ImgWork)
  419.         StartTests = 1
  420.       EndIf
  421.     EndIf  
  422.   EndIf
  423.   If StatsRunning=#True
  424.     If IsThread(StatsThread) = 0
  425.       StatsRunning=#False
  426.       ImageGadget(34,270,130,16,16,ImgOk)
  427.       HideGadget(10,1)
  428.       HideGadget(11,1)
  429.       HideGadget(12,1)
  430.       HideGadget(13,1)
  431.       HideGadget(14,1)
  432.       HideGadget(20,1)
  433.       HideGadget(21,1)
  434.       HideGadget(22,1)
  435.       HideGadget(23,1)
  436.       HideGadget(24,1)
  437.       HideGadget(30,1)
  438.       HideGadget(31,1)
  439.       HideGadget(32,1)
  440.       HideGadget(33,1)
  441.       HideGadget(34,1)
  442.       HideGadget(15,1)
  443.       EditorGadget(50,10,10,280,130,#PB_Editor_ReadOnly)
  444.       AddGadgetItem(50,1,"Пинг:")
  445.       AddGadgetItem(50,2,"Потери пакетов - "+Str(PingLoss)+"%")
  446.       AddGadgetItem(50,3,"Средняя задержка - "+Str(Round(PingLat.d,#PB_Round_Nearest))+"ms")
  447.       AddGadgetItem(50,4,"")
  448.       AddGadgetItem(50,5,"Входящая скорость:")
  449.       AddGadgetItem(50,6,"~"+Str(RXSpeed.d)+"Мбит")
  450.       AddGadgetItem(50,7,"")
  451.       AddGadgetItem(50,8,"Исходящая скорость:")
  452.       AddGadgetItem(50,9,"~"+Str(TXSpeed.d)+"Мбит")
  453.       Global PingResult,DNSResult,RXResult,TXResult,FinRx,RXSpeed.d,FinTX,TXSpeed.d = 0
  454.       Global PingRunning,DNSRunning,RXRunning,TXRunning,StatsRunning=#False
  455.       ;Global PingThread,DNSThread,RXThread,TXThread,StatsThread = 0
  456.       HideGadget(1,0)
  457.     EndIf  
  458.   EndIf
  459. Until ev=#PB_Event_CloseWindow
  460.  
  461. ; IDE Options = PureBasic 4.60 (Windows - x86)
  462. ; CursorPosition = 282
  463. ; FirstLine = 259
  464. ; Folding = --
  465. ; EnableXP
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!