Adblock breaks this site

Released [VB6] Functions

Discussion in 'Programming General' started by Terrankiller, Oct 31, 2007.

Thread Tools

Thread Tools

  • Thread ID:
  1. Terrankiller

    Terrankiller Ex-Administrator
    Retired Administrator Visual Basic Programmers

    Joined:
    May 7, 2005
    Posts:
    1,286
    Referrals:
    1
    Sythe Gold:
    1
    Released [VB6] Functions
    I am releasing a couple good VB6 functions. These functions guarantee you a kick *** vb program/rs cheat.
    Code:
    'ReadFile
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function ReadFile(FilePath as String) As String

   On Error Resume Next

   Open FilePath For Input As #1
   
      ReadFile = Input(LOF(1), 1)
      
   Close #1

End Function
    Code:
    'WriteFile
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function WriteFile(FilePath As String, Text As String)

   On Error Resume Next

   Open FilePath For Output As #2
   
      Print #2, Text
   
   Close #2

End Function
    Code:
    'WriteLog
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function WriteLog(FilePath As String, Text As String)

   On Error Resume Next
   
   Open (FilePath) For Append As #3
   
      Print #3, Text
   
   Close #3
   
End Function
    Code:
    Public Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Const KEYEVENTF_EXTENDEDKEY = &H1

Public Const KEYEVENTF_KEYUP = &H2

'KeyPress, KeyPressCustom
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function KeyPress(ByVal Key As String)

   keybd_event Asc(Key), 0, 0, 0
   
   keybd_event Asc(Key), 0, KEYEVENTF_KEYUP, 0
   
End Function

Public Function KeyPressCustom(ByVal Key As Byte)

   keybd_event Key, 0, 0, 0
   
   keybd_event Key, 0, KEYEVENTF_KEYUP, 0

End Function
    Code:
    'RandomInt (Random Integer)
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function RandomInt(ByVal Low As Long, ByVal High As Long) As Long

   Randomize: RandomInt = Int((High - Low + 1) * Rnd) + Low
  
End Function
    Code:
    'RangeInt (Range Integer)
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function RangeInt(ByVal Int1 As Long, ByVal Int2 As Long, ByVal Range As Long) As Boolean

   If Abs(Int1 - Int2) <= Range then RangeInt = True

End Function
    Code:
    Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Type POINTAPI

   X As Long

   Y As Long

End Type

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'MoveMouseSmooth
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function MoveMouseSmooth(X As Long, Y As Long, Steps As Long)

   On Error Resume Next

   Dim MP As POINTAPI
   
   Do Until Steps = 0
   
      GetCursorPos MP

      If MP.X = X And MP.Y = Y Then Exit Function
      
      MP.X = tmppos.X + ((X - MP.X) / Steps)
      
      MP.Y = tmppos.Y + ((Y - MP.Y) / Steps)
      
      SetCursorPos MP.X, MP.Y
      
      Steps = Steps - 1
      
      Wait (1)
      
   Loop
   
End Function
    Code:
    Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Type POINTAPI

   X As Long

   Y As Long

End Type

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'RandomInt (Random Integer)
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function RandomInt(ByVal Low As Long, ByVal High As Long) As Long

   Randomize: RandomInt = Int((High - Low + 1) * Rnd) + Low
  
End Function

'RangeInt (Range Integer)
'Written by: Terrankiller

Public Function RangeInt(Int1 As Long, Int2 As Long, Range As Long) As Boolean

   If Abs(Int1 - Int2) <= Range then RangeInt = True

End Function

'MoveMouseSmoothEx
'Written by: Terrankiller

Public Function MoveMouseSmoothEx(X As Long, Y As Long, Steps As Long, MinSleep As Long, MaxSleep As Long, Range As Long, ForcePow As Long)

   On Error Resume Next

   Dim MP As POINTAPI

   X = X + RandomInt(-Range, Range)
   
   Y = Y + RandomInt(-Range, Range)
   
   Do Until Steps = 0
   
      GetCursorPos MP

      If RangeInt(MP.X, X, Range) = True And RangeInt(MP.Y, Y, Range) = True Then Exit Function
      
      MP.X = (tmppos.X + ((X - tmppos.X) / Steps) + RandomInt(-ForcePow, ForcePow)
      
      MP.Y = (tmppos.Y + ((Y - tmppos.Y) / Steps) + RandomInt(-ForcePow, ForcePow)
      
      SetCursorPos MP.X, MP.Y
      
      Wait RandomInt(MinSleep, MaxSleep)
      
      Steps = Steps - 1
      
   Loop
   
End Function
    Code:
    Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Const Pi = 3.141592654

Public Type POINTAPI

   X As Long

   Y As Long

End Type

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'MoveMouseCurve
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function MoveMouseCurve(X As Long, Y As Long, Steps As Long, Arch As Long)

   Dim TmpX As Long, TmpY As Long, Step As Long, MP As POINTAPI

   GetCursorPos MP

   Randomize Timer: X = X + 5 * Rnd - 2

   Randomize Timer: Y = Y + 5 * Rnd - 2

   Randomize Timer: r1 = Round(5 * Rnd)

   Randomize Timer: r2 = Round(5 * Rnd)

   Randomize Timer: Arch1 = Round(Arch * Rnd)

   Randomize Timer: Arch2 = Round(Arch * Rnd)

   If MP.X > X Then w = 1 Else w = -1

   If MP.Y > Y Then q = 1 Else q = -1

   For i = 1 To Steps

      CP = (i / Steps)

      TmpX = MP.X + (X - MP.X) * CP + (w * Sin(Pi * r1 * CP) * Arch1)

      TmpY = MP.Y + (Y - MP.Y) * CP + (q * Sin(Pi * r2 * CP) * Arch2)

      SetCursorPos TmpX, TmpY

      Wait (1)

   Next i

End Function
    Code:
    Public Declare Function IsCharUpper Lib "user32" Alias "IsCharUpperA" (ByVal cChar As Byte) As Long

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'SmartType
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function SmartType(Text As String, Pause As Long, Mistake As Long, Enter As Boolean)

   Dim NewLetter As String
   
   Randomize
   
   For i = 1 To Len(Text)
   
      If Int(Mistake * Rnd) = 0 Then
      
         If SmartMistake(Mid(Text, i, 1), NewLetter) = True Then
            
            SendKeys NewLetter
            
            Wait (Int(Rnd * Pause))
         
            SendKeys "{BS}"
            
            Wait (Int(Rnd * Pause))
            
         End If
         
      End If
            
      SendKeys (Mid$(Text, i, 1))
      
      Wait (Int(Rnd * Pause))
      
   Next i
   
   If Enter = True Then SendKeys "{ENTER}"
   
End Function

'SmartMistake
'Written by: Terrankiller & Jazz

'Thanks to Jazz for the backbone code ;) (Lol)

Public Function SmartMistake(Letter As String, MistakenLetter As String) As Boolean

   Dim Char As String, Char2() As String, Upper As Boolean, Found As Boolean

   Randomize
   
   Char = "abcdefghijklmnopqrstuvwxyz1234567890"
   
   Char2() = Split("sq|vn|xv|sf|wr|dg|fh|gj|uo|hk|jl|k;|n,|bm|ip|o[|wa|et|ad|ry|yi|cb|qe|zc|tu|xsa|`2|13|24|35|46|57|68|79|80|9-", "|")
   
   Upper = IsCharUpper(Asc(Letter))
   
   If IsNumeric(Letter) = False Then LCase (Letter)
   
   For c = 1 To Len(Char)
   
      If Mid(Char, c, 1) = Letter Then
      
         MistakenLetter = Mid(Char2(c - 1), Int(Len(Char2(c - 1)) * Rnd + 1), 1)
      
         c = Len(Char)
         
         Found = True
         
         SmartMistake = True
      
      End If
   
   Next c
   
   If Upper = True Then UCase (Mistake)
   
   If Found = False Then MistakenLetter = Letter: If Upper = True Then UCase (MistakenLetter): SmartMistake = False

End Function
    Code:
    Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'TypeText
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function TypeText(Text As String, Pause As Long)

   On Error Resume Next
   
   Randomize
   
   For i = 1 To Len(Text)
      
      SendKeys (Mid$(Text, i, 1))
      
      Wait (Int(Rnd * Pause))
      
   Next i
   
End Function
    Code:
    Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Function Wait(TimeOut)

   Dim TimeNow As Long

   On Error Resume Next
  
   TimeNow = timeGetTime()
  
   Do
  
      DoEvents
    
   Loop While TimeNow + TimeOut > timeGetTime()
  
End Function

'TypeText
'Written by: Terrankiller
'http://www.terrankiller.com

Public Function TypeTextEx(Text As String, Pause As Long, Mistake As Long)

   On Error Resume Next
   
   Randomize
   
   For i = 1 To Len(Text)
   
      If Int(Mistake * Rnd) = 0 Then
      
         SendKeys (Mid("abcdefghijklmnopqrstuvwxyz", Int(Rnd * 26) + 1, 1))
         
         Wait (Int(Rnd * Pause))
         
         SendKeys "{BS}"
         
         Wait (Int(Rnd * Pause))
         
      End If
      
      SendKeys (Mid$(Text, i, 1))
      
      Wait (Int(Rnd * Pause))
      
   Next i
   
End Function
     
    Terrankiller, Oct 31, 2007
    #1
  2. Blupig

    Blupig BEEF TOILET
    $5 USD Donor

    Joined:
    Nov 23, 2006
    Posts:
    7,145
    Referrals:
    16
    Sythe Gold:
    1,609
    Discord Unique ID:
    178533992981594112
    Valentine's Singing Competition Winner Member of the Month Winner MushyMuncher Gohan has AIDS Extreme Homosex World War 3 I'm LAAAAAAAME
    Off Topic Participant
    Released [VB6] Functions
    You should make a TK.dll :eek:
     
    Blupig, Nov 4, 2007
    #2
  3. Slixr

    Slixr Newcomer

    Joined:
    Nov 2, 2007
    Posts:
    7
    Referrals:
    0
    Sythe Gold:
    0
    Released [VB6] Functions
    Terrain, can you release your silent mouse function again? i really need it
     
    Slixr, Nov 5, 2007
    #3
< [Source]Sorting a ListView | Vb6 >


 
 
Adblock breaks this site