Ceriwis  

Go Back   Ceriwis > HOBI > Komputer & Teknologi > Programming

Programming Share, tanya jawab, saling bantu antar programmer dengan berbagai macam bahasa pemrograman.

Reply
 
Thread Tools
  #1  
Old 20th November 2011
Permenkaret Permenkaret is offline
Ceriwiser
 
Join Date: Nov 2011
Posts: 351
Rep Power: 14
Permenkaret mempunyai hidup yang Normal
Default [Ask] mengenai script VB yg di share

Yth agan2 senior & para master ceriwiser, noobie mo minta tolong... sy wktu itu smpt ngeliat & copy script VB dr slah satu trit di forum ini.... tp sy lupa nge-bookmark link tritnya & sy jg lupa nma tritnya.. sy sdh cari2 disini tp masi ga nemu jg... trit nya ngeshare ttg script yg bikin koneksi iNet anti drop & anti kick & scriptnya sprti ini:




Spoiler for script:





Quote:







' @purpose auto re-dial connection

' @author mindhack at your mind

' @license GPL



Dim oDialer : Set oDialer = New Dialer



If oDialer.IsOpen() = True Then

' force the existing connection to close

oDialer.Close()

End If



oDialer.KeepOpen()



Class NetworkStatistic

REM #netstat -e

REM -- output ---------------------------------------------------

REM Interface Statistics

REM

REM Received Sent

REM

REM Bytes 12062314 7767926

REM Unicast packets 69633 68664

REM Non-unicast packets 0 4

REM Discards 0 0

REM Errors 0 0

REM Unknown protocols 0

REM -- end of output ---------------------------------------------



Dim oConsole



Dim InputByteTotal

Dim OutputByteTotal



Dim LastInputByteTotal

Dim LastOutputByteTotal



Dim InitInputByteTotal

Dim InitOutputByteTotal



Dim MaxInputByte

Dim MaxOutputByte



Dim AvgInputByte

Dim AvgOutputByte



Dim InputByte

Dim OutputByte



Dim LastTime

Dim InitTime



Sub Class_Initialize

Set oConsole = New Console

' "BYTE" or "BIT" ? BIT is not yet supported

Unit = "BYTE"

InitTime = Now()

LastTime = InitTime

InitInputByteTotal = 0

InitOutputByteTotal = 0

LastInputByteTotal = 0

LastOutputByteTotal = 0

MaxInputByte = 0

MaxOutputByte = 0

AvgInputByte = 0

AvgOutputByte = 0

End Sub



Function GetByteTotal

Dim cResult

Dim iInputByteTotal, cInputByteTotal

Dim iOutputByteTotal, cOutputByteTotal

Dim iPos, iPos2, iPos3, iPos4



cResult = oConsole.Exec("netstat -e")



iPos = InStr(cResult, "Bytes")

cInputByteTotal = Trim(Mid(cResult, iPos + Len("Bytes") + 1))

iPos2 = InStr(cInputByteTotal, " ")



cOutputByteTotal = Trim(Mid(cInputByteTotal, iPos2 + 1))

iPos3 = InStr(cOutputByteTotal, VbCrLf)



cInputByteTotal = Trim(Left(cInputByteTotal, iPos2))

cOutputByteTotal = Trim(Left(cOutputByteTotal, iPos3))



InputByteTotal = CLng(cInputByteTotal)

OutputByteTotal = CLng(cOutputByteTotal)

LastTime = Now()



End Function



Function Calculate

Dim TimeDiff, TimeDiffInit

TimeDiff = DateDiff("s", LastTime, Now())

TimeDiffInit = DateDiff("s", InitTime, Now())

If LastInputByteTotal = 0 Then

InputByte = 0

OutputByte = 0

LastInputByteTotal = InputByteTotal

LastOutputByteTotal = OutputByteTotal

InitInputByteTotal = InputByteTotal

InitOutputByteTotal = OutputByteTotal

Else

InputByte = InputByteTotal - LastInputByteTotal

OutputByte = OutputByteTotal - LastOutputByteTotal



AvgInputByte = InputByteTotal - InitInputByteTotal

AvgOutputByte = OutputByteTotal - InitOutputByteTotal



LastInputByteTotal = InputByteTotal

LastOutputByteTotal = OutputByteTotal



If TimeDiff = 0 Then

TimeDiff = 1

End If

If TimeDiffInit = 0 Then

TimeDiffInit = 1

End If



InputByte = InputByte / TimeDiff

OutputByte = OutputByte / TimeDiff



AvgInputByte = AvgInputByte / TimeDiffInit

AvgOutputByte = AvgOutputByte / TimeDiffInit

End If



' to bit

InputByte = 8 * InputByte

OutputByte = 8 * OutputByte

AvgInputByte = 8 * AvgInputByte

AvgOutputByte = 8 * AvgOutputByte



If MaxInputByte < InputByte Then

MaxInputByte = InputByte

End If



If MaxOutputByte < OutputByte Then

MaxOutputByte = OutputByte

End If

End Function



Function Write

GetByteTotal

Calculate

oConsole.OverWrite "" & _

"MAX " & FormatNumber(MaxInputByte,0) & _

"/" & FormatNumber(MaxOutputByte,0) & _

" AVG " & FormatNumber(AvgInputByte,0) & _

"/" & FormatNumber(AvgOutputByte,0) & _

" BIT " & FormatNumber(InputByte,0) & _

"/" & FormatNumber(OutputByte,0) & _

""

End Function

End Class





Class Console



Function Exec(cCommand)

' @purpose execute command and return command output as string

Dim oShell, cOut, oExec



Set oShell = WScript.CreateObject ("WScript.shell")

Set oExec = oShell.Exec(cCommand)



cOut = ""



Do Until oExec.StdOut.AtEndOfStream

cOut = cOut & oExec.StdOut.ReadLine() & VbCrLf

Loop



Set oShell = Nothing



Exec = Trim(cOut)

End Function



Function PassThru(cCommand)

' @purpose execute command and write output directly to console

Dim oShell, cOut, oExec



Set oShell = WScript.CreateObject ("WScript.shell")

Set oExec = oShell.Exec(cCommand)



cOut = ""



Do Until oExec.StdOut.AtEndOfStream

Write oExec.StdOut.ReadLine()

Loop



Set oShell = Nothing



PassThru = True

End Function



Function OverWrite(cText)

Dim iLenght

iLenght = 80

cText = FormatDateTime(Now(), 0) & " " & cText

If Len(cText) > iLenght Then

cText = Left(cText, iLenght)

ElseIf Len(cText) < iLenght Then

cText = cText & String(iLenght - Len(cText), " ")

End If

WScript.StdOut.Write String(iLenght, Chr(8)) & cText

End Function



Function Write(cText)

' @purpose write somethis to console, prepended by timestamp

WScript.Echo FormatDateTime(Now(), 0) & " " & cText

End Function

End Class



Class Dialer



' number of milisecond to wait before check connection status

Dim iKeepOpenWait

' idle timeout, not yet implemented

Dim iIdleTimeOut



Dim cConnectionName

Dim cUsername

Dim cPassword

Dim oNetworkStatistic

Dim oConsole



Sub Class_Initialize

Set oConsole = New Console



iKeepOpenWait = 1000

cConnectionName = "top"

cUsername = ""

cPassword = ""

Set oNetworkStatistic = New NetworkStatistic

End Sub



Function Open

Dim cResult

oConsole.Write "Connecting .."

cResult = oConsole.Exec("rasdial """ & cConnectionName & """ " & cUsername & " " & cPassword)

If InStr(cResult, "Successfully connected to ") = 0 Then

oConsole.Write cResult

End If

End Function



Function Close

Dim cResult

oConsole.Write "Disconnecting .."

cResult = oConsole.Exec("rasdial /DISCONNECT")

If InStr(cResult, "Command completed successfully") = 0 Then

oConsole.Write cResult

End If

End Function



Function IsOpen

Dim cResult

cResult = oConsole.Exec("rasdial")

If InStr(cResult, "No connections") > 0 Then

IsOpen = False

Else

IsOpen = True

End If

End Function



Function KeepOpen

Do While True

If IsOpen = False Then

WScript.StdOut.WriteBlankLines 1

Open

End If

oNetworkStatistic.Write

WScript.Sleep iKeepOpenWait

Loop

End Function

End Class





---------------------------

echo off

:loop

rasdial.exe x

ping localhost -n y >nul

goto loop

----------------------------





x = nama dialup y = waktu loop

SAVE AS *.bat

Good luck..











klo agan2 ada yg bookmark link tritnya tlong di post ya... ato mngkin master2 skalian ada yg udh tau field2 mana yg hrus sy isi (tlong di bold) supaya scriptnya bs brjalan... mohon noobie dbntu ya.. thanks sblumnya.



*maaf @TS asli, sy bnr2 lupa .



Reply With Quote
Reply


Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off


 


All times are GMT +7. The time now is 12:01 PM.


no new posts