Public Function FileExist(asPath as string) as Boolean
If UCase(Dir(asPath))=Ucase(trimPath(asPath)) then
FileExist=true
Else

FileExist=False
End If
End Function

Public Function TrimPath(ByVal asPath as string) as string

if Len(asPath)=0 then Exit Function
Dim x as integer
Do

x=Instr(asPath,”\”)
if x=0 then Exit Do
asPath=Right(asPath,Len(asPath)-x)
Loop
TrimPath=asPath
End Function

Private sub command1_Click()
if fileExist(Text1.text) then
Label1=”YES”
else
Label1=”NO”
End if
End Sub

Private sub form_Load()
End sub

‘add 2 command buttons and 1 text

Private Sub Command1_Click()
    Text1.Text = CapFirst$(Text1.Text)
End Sub

Private Sub Command2_Click()
    Text1.Text = LCase$(Text1.Text)
End Sub

‘add 1 module
Declare Function CapFirst$ Lib “CAPFIRST.DLL” Alias “CAPFIRST” (ByVal St$)

Add Microsoft Winsock Control 6.0 component
Insert 1 Textbox
Insert 2 Command Buttons Rename Caption as Display and Clear

Private Sub Command1_Click()
If Text1.Text = “” Then
    Command1.Enabled = False
    Text1.Text = Winsock1.LocalIP
Else
    Command1.Enabled = True
End If
End Sub

Private Sub Command2_Click()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = True
Else
    Command1.Enabled = False
End If
End Sub

Private Sub Form_Load()
Text1.Text = “”
If Text1.Text = “” Then
    Command1.Enabled = False
Else
    Command1.Enabled = True
End If
Text1.Text = Winsock1.LocalIP
End Sub

Option Explicit

Dim id As Integer
Dim N As Integer
Dim perm() As Integer

Function Engine(i As Integer)
   Dim t As Integer
   Dim j As Integer
  
   id = id + 1
   perm(i) = id
   If (id = N) Then stampaj
   For j = 1 To N
      If (perm(j) = 0) Then
         Engine (j)
      End If
   DoEvents
   Next j
   id = id - 1
   perm(i) = 0
End Function

Private Sub cmdClear_Click()
  List1.Clear
End Sub

Private Sub cmdGen_Click()
  If Val(txtLength.Text) > Len(txtChar.Text) Then
    MsgBox “Jumlah Permutasi Salah”
    Exit Sub
  End If
  
  If Len(txtChar.Text) = 0 Or (Val(txtLength.Text) = 0) Then Exit Sub
 
  Dim i As Integer
  N = Val(txtLength.Text)
  ReDim perm(N)
  For i = 1 To N
     perm(i) = 0
  Next i
  If ChSave.Value = 1 Then
     MsgBox “Disimpan pada hasil.txt”
     Open App.Path + “\hasil.txt” For Output As #1
  End If
  Engine 0
  If ChSave.Value = 1 Then Close #1
 
End Sub

Sub Form_Load()
   On Error Resume Next
   id = -1
  
End Sub

Sub stampaj()
   Dim i As Integer
   Dim result As String
   result = “”
   For i = 1 To N
      result = result & CStr(Mid$(txtChar.Text, perm(i), 1))
   Next i
   List1.AddItem result
   If ChSave.Value = 1 Then Print #1, result
End Sub

Public Function Hash(ByVal text As String) As String
a = 1
For i = 1 To Len(text)
    a = Sqr(a * i * Asc(Mid(text, i, 1))) ‘Numeric Hash
Next i
Rnd (-1)
Randomize a ’seed PRNG

For i = 1 To 16
    Hash = Hash & Chr(Int(Rnd * 256))
Next i
End Function

Private Sub Form_Load()
  MsgBox Hash(“EmZ-2509″)    ‘Yang dihasilkan: ‰°’r¿¾ ©Ì¿ÂX*¤W
  End
End Sub

Function EncDec(inData As Variant, Optional inPW As Variant = “”) As Variant
     On Error Resume Next
     Dim arrSBox(0 To 255) As Integer
     Dim arrPW(0 To 255) As Integer
     Dim Bi As Integer, Bj As Integer
     Dim mKey As Integer
     Dim i As Integer, j As Integer
     Dim x As Integer, y As Integer
     Dim mCode As Byte, mCodeSeries As Variant
   
     EncDec = “”
     If Trim(inData) = “” Then
         Exit Function
     End If
   
     If inPW <> “” Then
         j = 1
         For i = 0 To 255
             arrPW(i) = Asc(Mid$(inPW, j, 1))
             j = j + 1
             If j > Len(inPW) Then
                  j = 1
             End If
         Next i
     Else
         For i = 0 To 255
             arrPW(i) = 0
         Next i
     End If
    
     For i = 0 To 255
         arrSBox(i) = i
     Next i
    
     j = 0
     For i = 0 To 255
         j = (arrSBox(i) + arrPW(i)) Mod 256
         x = arrSBox(i)
         arrSBox(i) = arrSBox(j)
         arrSBox(j) = x
     Next i
    
     mCodeSeries = “”
     Bi = 0: Bj = 0
     For i = 1 To Len(inData)
         Bi = (Bi + 1) Mod 256
         Bj = (Bj + arrSBox(Bi)) Mod 256
         ‘ Tukar
         x = arrSBox(Bi)
         arrSBox(Bi) = arrSBox(Bj)
         arrSBox(Bj) = x

         ’siapkan kunci untuk XOR
         mKey = arrSBox((arrSBox(Bi) + arrSBox(Bj)) Mod 256)

         ‘gunakan operasi XOR
         mCode = Asc(Mid$(inData, i, 1)) Xor mKey
         mCodeSeries = mCodeSeries & Chr(mCode)
     Next i
     EncDec = mCodeSeries
End Function

Private Sub Form_Load()
  Dim Encrypt As String, Decrypt As String
 
  Encrypt = EncDec(“admin”, “win”)
  Decrypt = EncDec(“™D`­>”, “win”)
  MsgBox “Hasil enkripsi : ” & Encrypt & _
    vbCrLf & “Hasil dekripsi : ” & Decrypt
  End
End Sub

Option Explicit

Private Declare Function SendMessage Lib “user32″ Alias _
   “SendMessageA” (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Const LB_GETITEMRECT = &H198
Private Const LB_ERR = (-1)

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Public Function GetRClickedItem(MyList As Control, _
   X As Single, Y As Single) As Long

  ‘PURPOSE: Determine which item was right clicked in a list
  ‘box, from the list_box’s mouse down event.  YOU MUST CALL THIS
  ‘FROM THE MOUSEDOWN EVENT, PASSING THE X AND Y VALUES FROM THAT
  ‘EVENT TO THIS FUNCTION

    ‘MYLIST: ListBox Control
    ‘X, Y: X and Y position from MyList_MouseDown

    ‘RETURNS:  ListIndex of selected item, or -1 if
    ‘a) There is no selected item, or b) an error occurs.

    Dim clickX As Long, clickY As Long
    Dim lRet As Long
    Dim CurRect As RECT
    Dim l As Long

    ‘Control must be a listbox
    If Not TypeOf MyList Is ListBox Then
        GetRClickedItem = LB_ERR
        Exit Function
    End If

    ‘get x and y in pixels
    clickX = X Screen.TwipsPerPixelX
    clickY = Y Screen.TwipsPerPixelY

    ‘Check all items in the list to see if it was clicked on
    For l = 0 To MyList.ListCount - 1

      ‘get current selection as rectangle
      lRet = SendMessage(MyList.hwnd, LB_GETITEMRECT, l, CurRect)

      ‘If the position of the click is in the this list item
       ‘then that’s  our Item

     If (clickX >= CurRect.Left) And (clickX <= CurRect.Right) _
       And (clickY >= CurRect.Top) And _
          (clickY <= CurRect.Bottom) Then

            GetRClickedItem = l
            Exit Function
        End If
    Next l
End Function

Private Sub Form_Load()
  List1.AddItem “Merah”
  List1.AddItem “Kuning”
  List1.AddItem “Hijau”
  mnuPopUp.Visible = False
End Sub

Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lItem As Long

If Button = vbRightButton Then
    lItem = GetRClickedItem(List1, X, Y)
                                        
        If lItem <> -1 Then
            List1.ListIndex = lItem
            PopupMenu mnuPopUp
        End If
End If

End Sub

Private Sub Command1_Click()
With Me.CommonDialog1
.DialogTitle = “Ambil Gambar”
.Filter = “JPEG|*.jpg”
.ShowOpen

If .FileName <> “” Then
Set Me.Picture1.Picture = Nothing
Me.Picture1.Picture = LoadPicture(.FileName)
End If
End With
End Sub

‘Private Sub Form_Load()
‘Me.Picture1.Picture = LoadPicture(“D:\gbr_motor\bikes_honda_01.jpg”)
‘End Sub

Option Explicit

Private Declare Sub Sleep Lib “kernel32″ (ByVal dwMilliseconds As Long)

Private Sub Form_Click()
   Me.Caption = “Sleeping”
   Call Sleep(20000)
   Me.Caption = “Awake”
End Sub

Private Sub Label1_Click()
   Me.Caption = “Sleeping”
   Call Sleep(20000)
   Me.Caption = “Awake”
End Sub

Form

Option Explicit

Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Sub cmdActivate_Click()
   Dim nRet As Long
   Dim Title As String

   nRet = AppActivatePartial(Trim(txtTitle.Text), _
          Val(frmMethod.Tag), CBool(chkCase.Value))
   If nRet Then
      lblResults.Caption = “Found: &&H” & Hex$(nRet)
      Title = Space$(256)
      nRet = GetWindowText(nRet, Title, Len(Title))
      If nRet Then
         lblResults.Caption = lblResults.Caption & _
            “, “”" & Left$(Title, nRet) & “”"”
      End If
   Else
      lblResults.Caption = “Search Failed”
   End If
End Sub

Private Sub Form_Load()

   txtTitle.Text = “”
   lblResults.Caption = “”
   optMethod(0).Value = True
End Sub

Private Sub optMethod_Click(Index As Integer)

   frmMethod.Tag = Index
End Sub

Module

Option Explicit

Private Declare Function EnumWindows Lib “user32″ (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib “user32″ Alias “GetClassNameA” (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib “user32″ Alias “GetWindowTextA” (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function IsIconic Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function IsWindowVisible Lib “user32″ (ByVal hWnd As Long) As Long
Private Declare Function ShowWindow Lib “user32″ (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetForegroundWindow Lib “user32″ (ByVal hWnd As Long) As Long

Private Const SW_RESTORE = 9

Private m_hWnd As Long
Private m_Method As FindWindowPartialTypes
Private m_CaseSens As Boolean
Private m_Visible As Boolean
Private m_AppTitle As String

Public Enum FindWindowPartialTypes
   FwpStartsWith = 0
   FwpContains = 1
   FwpMatches = 2
End Enum

Public Function AppActivatePartial(AppTitle As String, Optional Method As FindWindowPartialTypes = FwpStartsWith, Optional CaseSensitive As Boolean = False) As Long
   Dim hWndApp As Long
 
   hWndApp = FindWindowPartial(AppTitle, Method, CaseSensitive, True)
   If hWndApp Then
    
      If IsIconic(hWndApp) Then
         Call ShowWindow(hWndApp, SW_RESTORE)
      End If
      Call SetForegroundWindow(hWndApp)
      AppActivatePartial = hWndApp
   End If
End Function

Public Function FindWindowPartial(AppTitle As String, _
   Optional Method As FindWindowPartialTypes = FwpStartsWith, _
   Optional CaseSensitive As Boolean = False, _
   Optional MustBeVisible As Boolean = False) As Long
  
   m_hWnd = 0
   m_Method = Method
   m_CaseSens = CaseSensitive
   m_AppTitle = AppTitle
 
   If m_CaseSens = False Then
      m_AppTitle = UCase$(m_AppTitle)
   End If
 
   Call EnumWindows(AddressOf EnumWindowsProc, MustBeVisible)
   FindWindowPartial = m_hWnd
End Function

Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
   Static WindowText As String
   Static nRet As Long

   If lParam Then
      If IsWindowVisible(hWnd) = False Then
         EnumWindowsProc = True
         Exit Function
      End If
   End If

   WindowText = Space$(256)
   nRet = GetWindowText(hWnd, WindowText, Len(WindowText))
   If nRet Then
   
      WindowText = Left$(WindowText, nRet)
      If m_CaseSens = False Then
         WindowText = UCase$(WindowText)
      End If
  
      Select Case m_Method
         Case FwpStartsWith
            If InStr(WindowText, m_AppTitle) = 1 Then
               m_hWnd = hWnd
            End If
         Case FwpContains
            If InStr(WindowText, m_AppTitle) <> 0 Then
               m_hWnd = hWnd
            End If
         Case FwpMatches
            If WindowText = m_AppTitle Then
               m_hWnd = hWnd
            End If
      End Select
   End If
 
   EnumWindowsProc = (m_hWnd = 0)
End Function