Rabu, 05 Oktober 2011

Belajar Microsoft Visual Basic

Diposting oleh Yusuf Hadiyana di 10.42 |

Check For a File

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

Low and Upper Case

‘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$)

Show Your IP Address

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

Permutasi

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

Enkripsi Searah

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

Enkripsi

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

Menu Pop Up

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

Load Picture

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

Sleep With Visual Basic

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

Find Something

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

Bermain Animasi Dengan VB

Dim FrameCount As Long
Private Sub Command1_Click()
Timer1.Enabled = False
If LoadGif(Text1, Image1) Then
     FrameCount = 0
     Timer1.Interval = CLng(Image1(0).Tag)
     Timer1.Enabled = True
End If
End Sub
Private Sub Command2_Click()
   Timer1.Enabled = False
End Sub
Private Sub Command3_Click()
   Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Text1.Text = App.Path & IIf(Right(App.Path, 1) = “\”, “”, “\”) & “clip.gif”
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
    If FrameCount < TotalFrames Then
        Image1(FrameCount).Visible = False
        FrameCount = FrameCount + 1
        Image1(FrameCount).Visible = True
        Timer1.Interval = CLng(Image1(FrameCount).Tag)
    Else
        FrameCount = 0
        For i = 1 To Image1.Count – 1
            Image1(i).Visible = False
        Next i
        Image1(FrameCount).Visible = True
        Timer1.Interval = CLng(Image1(FrameCount).Tag)
    End If
End Sub

Animasi Bola

Dim FrameCount As Long
Private Sub Command1_Click()
Timer1.Enabled = False
If LoadGif(Text1, Image1) Then
     FrameCount = 0
     Timer1.Interval = CLng(Image1(0).Tag)
     Timer1.Enabled = True
End If
End Sub
Private Sub Command2_Click()
   Timer1.Enabled = False
End Sub
Private Sub Command3_Click()
   Timer1.Enabled = True
End Sub
Private Sub Form_Load()
Text1.Text = App.Path & IIf(Right(App.Path, 1) = “\”, “”, “\”) & “ball.gif”
Timer1.Enabled = False
End Sub
Private Sub Timer1_Timer()
    If FrameCount < TotalFrames Then
        Image1(FrameCount).Visible = False
        FrameCount = FrameCount + 1
        Image1(FrameCount).Visible = True
        Timer1.Interval = CLng(Image1(FrameCount).Tag)
    Else
        FrameCount = 0
        For i = 1 To Image1.Count – 1
            Image1(i).Visible = False
        Next i
        Image1(FrameCount).Visible = True
        Timer1.Interval = CLng(Image1(FrameCount).Tag)
    End If
End Sub

Mouse Limit

Option Explicit Private Type RECT left As Integer top As Integer right As Integer bottom As Integer End Type Private Type POINT x As Long y As Long End Type Private Declare Sub ClipCursor Lib “user32″ (lpRect As Any) Private Declare Sub GetClientRect Lib “user32″ (ByVal hWnd As _ Long, lpRect As RECT) Private Declare Sub ClientToScreen Lib “user32″ (ByVal hWnd As _ Long, lpPoint As POINT) Private Declare Sub OffsetRect Lib “user32″ (lpRect As RECT, _ ByVal x As Long, ByVal y As Long) Public Sub LimitCursorMovement(ctl As Object) Dim client As RECT Dim upperleft As POINT Dim lHwnd As Long On Error Resume Next lHwnd = ctl.hWnd If lHwnd = 0 Then Exit Sub GetClientRect ctl.hWnd, client upperleft.x = client.left upperleft.y = client.top ClientToScreen ctl.hWnd, upperleft OffsetRect client, upperleft.x, upperleft.y ClipCursor client End Sub Public Sub ReleaseLimit() ‘Releases the cursor limits ‘Be sure to call on unloading the form ClipCursor ByVal 0& End Sub Private Sub cmdNormal_Click() ReleaseLimit End Sub Private Sub cmdSetLimit_Click() LimitCursorMovement Me End Sub Private Sub Form_Load() ReleaseLimit End Sub Private Sub Form_Unload(Cancel As Integer) ReleaseLimit End Sub

Spash Screen

Option Explicit
Private Sub Form_KeyPress(KeyAscii As Integer)
    Unload Me
End Sub
Private Sub Form_Load()
   ‘ lblVersion.Caption = “Version ” & App.Major & “.” & App.Minor & “.” & App.Revision
‘ lblProductName.Caption = App.Title
End Sub
Private Sub Frame1_Click()
    Unload Me
End Sub
Private Sub Timer1_Timer()
Dim counter As Double
counter = 0
Do
    counter = counter + 0.005
    Label2.Width = counter
Loop While Not (Label1.Width = Label2.Width)
frmSplash.Hide
Form5.Show
Timer1.Enabled = False
End Sub

Folder Customizer

Dim opcolor As String
Dim opcolor2 As String
Private Sub cmdfolder_Click()
folder = BrowseForFolder(folder, Me.hwnd, “&Select a directory:”)
Command4_Click
End Sub
Private Sub Command1_Click()
folder = BrowseForFolder(folder, Me.hwnd, “&Select a directory:”)
If folder = “” Then
Exit Sub
End If
wrt$ = “{BE098140-A513-11D0-A3A4-00C04FD706EC}”
r% = WritePrivateProfileString(wrt$, “IconArea_Image”, vbNullString, (folder.Text) + “\desktop.ini”)
r% = WritePrivateProfileString(wrt$, “IconArea_text”, vbNullString, (folder.Text) + “\desktop.ini”)
If r% = 1 Then
FileAttribHide folder.Text & “\desktop.ini”
setFolderRead folder.Text
Label18.Caption = “XXXXXXXXXXXXXXXXXXXXXXXXXXXXX”
End If
End Sub
Private Sub Command2_Click()
If Command2.Caption <> “&Finish” Then
If MsgBox(“Exit the wizard without completion !”, 64 + vbYesNo) = vbYes Then
End
End If
Else
MsgBox “This Wizard has been developed by Ramky for more goodies visit http://www.programmervb.wordpress.com “, 64
End
End If
End Sub
Private Sub Command3_Click()
If folder.Text = “” Then
cmdfolder_Click
Else
wrt$ = “{BE098140-A513-11D0-A3A4-00C04FD706EC}”
r% = WritePrivateProfileString(wrt$, “IconArea_Image”, (img.Text), (folder.Text) + “\desktop.ini”)
r% = WritePrivateProfileString(wrt$, “IconArea_text”, opcolor, (folder.Text) + “\desktop.ini”)
If r% = 1 Then
FileAttribHide folder.Text & “\desktop.ini”
setFolderRead folder.Text
Command3.Enabled = False
Command2.Caption = “&Finish”
Label14.Visible = False
Label9.Visible = False
Label10.Visible = False
Label11.Visible = False
Label14.Visible = False
textcolor.Visible = False
img.Visible = False
folder.Visible = False
Command5.Visible = False
Command4.Visible = False
Line3.Visible = False
cmdfolder.Visible = False
Label18.Visible = True
Label19.Visible = True
Label13.Visible = True
End If
If r% <> 1 Then MsgBox “Error in writing”, vbCritical
GoTo nex
back = 1
nex:
If back = 1 Then
Command1.Enabled = True
cmdfolder.Enabled = True
Frame1.Visible = False
Frame2.Top = -120
Frame2.Left = -120
Frame2.Visible = True
back = 2
End If
End If
End Sub
Private Sub Command4_Click()
CommonDialog1.CancelError = False
CommonDialog1.DialogTitle = “Select Your Picture”
CommonDialog1.Filter = “jpeg(*.jpg)|*.jpg|png(*.png)|*.png|Gif(*.Gif)|*.Gif|Bitmap(*.bmp)|*.bmp” ‘|MID(*.mid)|*.mid|AU(*.au)|*.au|”
CommonDialog1.FileName = “”
CommonDialog1.ShowOpen
img = CommonDialog1.FileName
Command5_Click
End Sub
Private Sub Command5_Click()
CommonDialog1.CancelError = False
CommonDialog1.Flags = 3
CommonDialog1.ShowColor
opcolor = CommonDialog1.Color
textcolor.ForeColor = CommonDialog1.Color
End Sub
Private Sub Command6_Click()
CommonDialog1.CancelError = False
CommonDialog1.Flags = 3
CommonDialog1.ShowColor
opcolor2 = CommonDialog1.Color
End Sub
Private Sub Form_Load()
Height = 6330
Width = 8160
End Sub
Private Sub Frame2_DragDrop(Source As Control, X As Single, Y As Single)
End Sub

Create Domain

Private Sub Check1_Click()
If Check1.Value = 1 Then
lblDomainName.Visible = True
txtDomainName.Visible = True
End If
If Check1.Value = 0 Then
lblDomainName.Visible = False
txtDomainName.Visible = False
End If
End Sub
Private Sub cmdGenerate_Click()
Dim responce
        Dim i As Integer
If Check1.Value = 1 Then
responce = MsgBox(“Do you want to create ” & txtDomainName.Text & ” DOMAIN user”, vbYesNo)
    If responce = vbYes Then
        For i = Val(txtUserStart.Text) To Val(txtUserEnd.Text)
            Shell “net user ” & txtUserPrefix & Format(i, “0000″) & txtUserPostfix & ” ” & txtPassPrefix & Format(i, “0000″) & txtPassPostfix & ” /ADD ” & txtDomainName.Text & ” /DOMAIN”, vbHide
        Next i
    End If
Else
responce = MsgBox(“Do you want to create LOCAL user”, vbYesNo)
    If responce = vbYes Then
        For i = Val(txtUserStart.Text) To Val(txtUserEnd.Text)
            Shell “net user ” & txtUserPrefix & Format(i, “0000″) & txtUserPostfix & ” ” & txtPassPrefix & Format(i, “0000″) & txtPassPostfix & ” /ADD”, vbHide
        Next i
    End If
End If
End Sub
Private Sub Label11_Click()
End Sub
Private Sub txtUserEnd_Change()
txtPassEnd.Text = txtUserEnd.Text
End Sub
Private Sub txtUserStart_Change()
txtPassStart.Text = txtUserStart.Text
End Sub

Change Your Desktop

Private Declare Function SystemParametersInfo Lib “user32″ Alias “SystemParametersInfoA” (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As String, ByVal fuWinIni As Long) As Long
‘constants to be used with the above api
Private Const SPI_SETDESKWALLPAPER = 20
Private Const SPIF_UPDATEINIFILE = &H1

‘will hold the path to the image
Private imagePath As String

Private Sub cmdBrowse_Click()
    ‘just your basic code to get a dialog box open to
    ‘select a image and get the path
    ‘
    ‘the picture must be a BITMAP Image File
    ‘
    dlg.Filter = “Image Files (*.bmp)|*.bmp”

    ‘set a custom title to the dialog
    dlg.DialogTitle = “Select the image to load.”
    ‘show the dialog
    dlg.ShowOpen
    ‘the path to get the image from
    imagePath = dlg.FileName
    ‘view the selected picture into the picturebox
    ‘control
    pic.Picture = LoadPicture(imagePath)

End Sub
Private Sub cmdSetWallPaper_Click()
    ‘set the parameters to change the wallpaper to
    ‘the image you selected
    SystemParametersInfo SPI_SETDESKWALLPAPER, 0, imagePath, SPIF_UPDATEINIFILE
End Sub

Create Domain With VB

VbFtp

Module:
Option Explicit
Declare Function GetProcessHeap Lib “kernel32″ () As Long
Declare Function HeapAlloc Lib “kernel32″ (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib “kernel32″ (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
Declare Sub CopyMemory1 Lib “kernel32″ Alias “RtlMoveMemory” ( _
         hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib “kernel32″ Alias “RtlMoveMemory” ( _
         hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)
Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Public Const ERROR_NO_MORE_FILES = 18
Public Declare Function InternetFindNextFile Lib “wininet.dll” Alias “InternetFindNextFileA” _
    (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Public Declare Function FtpFindFirstFile Lib “wininet.dll” Alias “FtpFindFirstFileA” _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, _
      lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Public Declare Function FtpGetFile Lib “wininet.dll” Alias “FtpGetFileA” _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
      ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpPutFile Lib “wininet.dll” Alias “FtpPutFileA” _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
      ByVal lpszRemoteFile As String, _
      ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpSetCurrentDirectory Lib “wininet.dll” Alias “FtpSetCurrentDirectoryA” _
    (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
‘ Initializes an application’s use of the Win32 Internet functions
Public Declare Function InternetOpen Lib “wininet.dll” Alias “InternetOpenA” _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
‘ User agent constant.
Public Const scUserAgent = “vb wininet”
‘ Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000
‘ Opens a HTTP session for a given site.
Public Declare Function InternetConnect Lib “wininet.dll” Alias “InternetConnectA” _
(ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib “wininet.dll” Alias “InternetGetLastResponseInfoA” ( _
    lpdwError As Long, _
    ByVal lpszBuffer As String, _
    lpdwBufferLength As Long) As Boolean
‘ Number of the TCP/IP port on the server to connect to.
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080
Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5
Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44
‘ Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3
‘ Opens an HTTP request handle.
Public Declare Function HttpOpenRequest Lib “wininet.dll” Alias “HttpOpenRequestA” _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
‘ Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
‘ Sends the specified request to the HTTP server.
Public Declare Function HttpSendRequest Lib “wininet.dll” Alias “HttpSendRequestA” (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer
‘ Queries for information about an HTTP request.
Public Declare Function HttpQueryInfo Lib “wininet.dll” Alias “HttpQueryInfoA” _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
‘ The possible values for the lInfoLevel parameter include:
Public Const HTTP_QUERY_CONTENT_TYPE = 1
Public Const HTTP_QUERY_CONTENT_LENGTH = 5
Public Const HTTP_QUERY_EXPIRES = 10
Public Const HTTP_QUERY_LAST_MODIFIED = 11
Public Const HTTP_QUERY_PRAGMA = 17
Public Const HTTP_QUERY_VERSION = 18
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Public Const HTTP_QUERY_FORWARDED = 30
Public Const HTTP_QUERY_SERVER = 37
Public Const HTTP_QUERY_USER_AGENT = 39
Public Const HTTP_QUERY_SET_COOKIE = 43
Public Const HTTP_QUERY_REQUEST_METHOD = 45
Public Const HTTP_STATUS_DENIED = 401
Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407
‘ Add this flag to the about flags to get request header.
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000
‘ Reads data from a handle opened by the HttpOpenRequest function.
Public Declare Function InternetReadFile Lib “wininet.dll” _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetWriteFile Lib “wininet.dll” _
        (ByVal hFile As Long, ByVal sBuffer As String, _
        ByVal lNumberOfBytesToRead As Long, _
        lNumberOfBytesRead As Long) As Integer
Public Declare Function FtpOpenFile Lib “wininet.dll” Alias _
        “FtpOpenFileA” (ByVal hFtpSession As Long, _
        ByVal sFileName As String, ByVal lAccess As Long, _
        ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function FtpDeleteFile Lib “wininet.dll” _
    Alias “FtpDeleteFileA” (ByVal hFtpSession As Long, _
    ByVal lpszFileName As String) As Boolean
Public Declare Function InternetSetOption Lib “wininet.dll” Alias “InternetSetOptionA” _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetSetOptionStr Lib “wininet.dll” Alias “InternetSetOptionA” _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer
‘ Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib “wininet.dll” _
(ByVal hInet As Long) As Integer
‘ Queries an Internet option on the specified handle
Public Declare Function InternetQueryOption Lib “wininet.dll” Alias “InternetQueryOptionA” _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer
‘ Returns the version number of Wininet.dll.
Public Const INTERNET_OPTION_VERSION = 40
‘ Contains the version number of the DLL that contains the Windows Internet
‘ functions (Wininet.dll). This structure is used when passing the
‘ INTERNET_OPTION_VERSION flag to the InternetQueryOption function.
Public Type tWinInetDLLVersion
    lMajorVersion As Long
    lMinorVersion As Long
End Type
‘ Adds one or more HTTP request headers to the HTTP request handle.
Public Declare Function HttpAddRequestHeaders Lib “wininet.dll” Alias “HttpAddRequestHeadersA” _
(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lModifiers As Long) As Integer
‘ Flags to modify the semantics of this function. Can be a combination of these values:
‘ Adds the header only if it does not already exist; otherwise, an error is returned.
Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000
‘ Adds the header if it does not exist. Used with REPLACE.
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
‘ Replaces or removes a header. If the header value is empty and the header is found,
‘ it is removed. If not empty, the header value is replaced
Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
Form:
Dim bActiveSession As Boolean
Dim hOpen As Long, hConnection As Long
Dim dwType As Long
Dim EnumItemNameBag As New Collection
Dim EnumItemAttributeBag As New Collection

Private Sub Form_Load()
    bActiveSession = False
    hOpen = 0
    hConnection = 0
    chkPassive.Value = 1
    optBin.Value = 1
    dwType = FTP_TRANSFER_TYPE_BINARY
    Dim imgI As ListImage
    Set imgI = ImageList1.ListImages.Add(, “open”, LoadPicture(“open.bmp”))
    Set imgI = ImageList1.ListImages.Add(, “closed”, LoadPicture(“closed.bmp”))
    Set imgI = ImageList1.ListImages.Add(, “leaf”, LoadPicture(“leaf.bmp”))
    Set imgI = ImageList1.ListImages.Add(, “root”, LoadPicture(“root.bmp”))
    TreeView1.ImageList = ImageList1
    TreeView1.Style = tvwTreelinesPictureText
    EnableUI (False)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    cmdClosehOpen_Click
End Sub
Private Sub cmdInternetOpen_Click()
    If Len(txtProxy.Text) <> 0 Then
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, txtProxy.Text, vbNullString, 0)
    Else
        hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
    End If
    If hOpen = 0 Then ErrorOut Err.LastDllError, “InternetOpen”
    EnableUI (True)
End Sub
Private Sub cmdClosehOpen_Click()
    If hConnection <> 0 Then InternetCloseHandle (hConnection)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)
    hConnection = 0
    hOpen = 0
    If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
    bActiveSession = False
    ClearTextBoxAndBag
    EnableUI (False)
End Sub
Private Sub cmdConnect_Click()
    If Not bActiveSession And hOpen <> 0 Then
        If txtServer.Text = “” Then
            MsgBox “Please enter a server name!”
            Exit Sub
        End If
        Dim nFlag As Long
        If chkPassive.Value Then
            nFlag = INTERNET_FLAG_PASSIVE
        Else
            nFlag = 0
        End If
        hConnection = InternetConnect(hOpen, txtServer.Text, INTERNET_INVALID_PORT_NUMBER, _
        txtUser, txtPassword, INTERNET_SERVICE_FTP, nFlag, 0)
        If hConnection = 0 Then
            bActiveSession = False
            ErrorOut Err.LastDllError, “InternetConnect”
        Else
            bActiveSession = True
            EnableUI (CBool(hOpen))
            FillTreeViewControl (txtServer.Text)
            FtpEnumDirectory (“”)
            If EnumItemNameBag.Count = 0 Then Exit Sub
            FillTreeViewControl (txtServer.Text)
       End If
    End If
End Sub
Private Sub cmdDisconnect_Click()
    bDirEmpty = True
    If hConnection <> 0 Then InternetCloseHandle hConnection
    hConnection = 0
    ClearBag
    TreeView1.Nodes.Remove txtServer.Text
    bActiveSession = False
    EnableUI (True)
End Sub
Private Sub ClearTextBoxAndBag()
    txtServer.Text = “”
    txtUser.Text = “”
    txtPassword.Text = “”
    txtProxy.Text = “”
    ClearBag
End Sub
Private Sub ClearBag()
    Dim Num As Integer
    For Num = 1 To EnumItemNameBag.Count
        EnumItemNameBag.Remove 1
    Next Num
    For Num = 1 To EnumItemAttributeBag.Count
        EnumItemAttributeBag.Remove 1
    Next Num
End Sub
Private Sub FillTreeViewControl(strParentKey As String)
    Dim nodX As Node
    Dim strImg As String
    Dim nCount As Integer, i As Integer
    Dim nAttr As Integer
    Dim strItem As String

    If EnumItemNameBag.Count = 0 And strParentKey = txtServer.Text Then
        Set nodX = TreeView1.Nodes.Add(, tvwFirst, txtServer.Text, txtServer.Text, “root”)
        Exit Sub
    End If
    nCount = EnumItemAttributeBag.Count
    If nCount = 0 Then Exit Sub
    For i = 1 To nCount
        nAttr = EnumItemAttributeBag.Item(i)
        strItem = EnumItemNameBag(i)
        If nAttr = FILE_ATTRIBUTE_DIRECTORY Then
            strImg = “closed”
        Else
            strImg = “leaf”
        End If
        Set nodX = TreeView1.Nodes.Add(strParentKey, tvwChild, strParentKey & “/” & strItem, _
            strParentKey & “/” & strItem, strImg)
    Next
    nodX.EnsureVisible
End Sub
Private Sub cmdGet_Click()
    Dim bRet As Boolean
    Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
    Dim szTempString As String
    Dim nPos As Long, nTemp As Long
    Dim nodX As Node
    Set nodX = TreeView1.SelectedItem
    If bActiveSession Then
        If nodX Is Nothing Then
            MsgBox “Please select the item to GET!”
            Exit Sub
        End If
        szTempString = TreeView1.SelectedItem.Text
        szFileRemote = szTempString
        nPos = 0
        nTemp = 0
        Do
            nTemp = InStr(1, szTempString, “/”, vbBinaryCompare)
            If nTemp = 0 Then Exit Do
            szTempString = Right(szTempString, Len(szTempString) – nTemp)
            nPos = nTemp + nPos
        Loop
        szDirRemote = Left(szFileRemote, nPos)
        szFileRemote = Right(szFileRemote, Len(szFileRemote) – nPos)
        szFileLocal = File1.Path
        rcd szDirRemote
        bRet = FtpGetFile(hConnection, szFileRemote, szFileLocal & “/” & szFileRemote, False, _
        INTERNET_FLAG_RELOAD, dwType, 0)
        File1.Refresh
        If bRet = False Then ErrorOut Err.LastDllError, “FtpGetFile”
    Else
        MsgBox “Not in session”
    End If
End Sub
Private Sub cmdPut_Click()
    Dim bRet As Boolean
    Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
    Dim szTempString As String
    Dim nPos As Long, nTemp As Long
    Dim nodX As Node
    Set nodX = TreeView1.SelectedItem

    If bActiveSession Then
        If nodX Is Nothing Then
            MsgBox “Please select a remote directory to PUT to!”
            Exit Sub
        End If
        If nodX.Image = “leaf” Then
            MsgBox “Please select a remote directory to PUT to!”
            Exit Sub
        End If
        If File1.FileName = “” Then
            MsgBox “Please select a local file to put”
            Exit Sub
        End If
        szTempString = nodX.Text
        szDirRemote = Right(szTempString, Len(szTempString) – Len(txtServer.Text))
        szFileRemote = File1.FileName
        szFileLocal = File1.Path & “\” & File1.FileName
        If (szDirRemote = “”) Then szDirRemote = “\”
        rcd szDirRemote

        bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, _
         dwType, 0)
        If bRet = False Then
            ErrorOut Err.LastDllError, “FtpPutFile”
            Exit Sub
        End If

        Dim nodChild As Node, nodNextChild As Node
        Set nodChild = nodX.Child
        Do
          If nodChild Is Nothing Then Exit Do
          Set nodNextChild = nodChild.Next
            TreeView1.Nodes.Remove nodChild.Index
            If nodNextChild Is Nothing Then Exit Do
            Set nodChild = nodNextChild
        Loop
        If nodX.Image = “closed” Then
            nodX.Image = “open”
        End If
        FtpEnumDirectory (nodX.Text)
        FillTreeViewControl (nodX.Text)
   End If
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
    On Error GoTo ErrProc
    Dir1.Path = Drive1.Drive
    Exit Sub
ErrProc:
    Drive1.Drive = “c:”
    Dir1.Path = Drive1.Drive
End Sub
Private Sub rcd(pszDir As String)
    If pszDir = “” Then
        MsgBox “Please enter the directory to CD”
        Exit Sub
    Else
        Dim sPathFromRoot As String
        Dim bRet As Boolean
        If InStr(1, pszDir, txtServer.Text) Then
        sPathFromRoot = Mid(pszDir, Len(txtServer.Text) + 1, Len(pszDir) – Len(txtServer.Text))
        Else
        sPathFromRoot = pszDir
        End If
        If sPathFromRoot = “” Then sPathFromRoot = “/”
        bRet = FtpSetCurrentDirectory(hConnection, sPathFromRoot)
        If bRet = False Then ErrorOut Err.LastDllError, “rcd”
    End If
End Sub
Function ErrorOut(dError As Long, szCallFunction As String)
    Dim dwIntError As Long, dwLength As Long
    Dim strBuffer As String
    If dError = ERROR_INTERNET_EXTENDED_ERROR Then
        InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
        strBuffer = String(dwLength + 1, 0)
        InternetGetLastResponseInfo dwIntError, strBuffer, dwLength

        MsgBox szCallFunction & ” Extd Err: ” & dwIntError & ” ” & strBuffer


    End If
    If MsgBox(szCallFunction & ” Err: ” & dError & _
        vbCrLf & “Close Connection and Session?”, vbYesNo) = vbYes Then
        If hConnection Then InternetCloseHandle hConnection
        If hOpen Then InternetCloseHandle hOpen
        hConnection = 0
        hOpen = 0
        If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
        bActiveSession = False
        ClearTextBoxAndBag
        EnableUI (False)
    End If
End Function
Private Sub EnableUI(bEnabled As Boolean)
    txtServer.Enabled = bEnabled
    txtUser.Enabled = bEnabled
    txtPassword.Enabled = bEnabled
    cmdConnect.Enabled = bEnabled And Not bActiveSession
    cmdDisconnect.Enabled = bEnabled And bActiveSession
    chkPassive.Enabled = bEnabled
    cmdClosehOpen.Enabled = bEnabled
    cmdInternetOpen.Enabled = Not bEnabled
    txtProxy.Enabled = Not bEnabled
    optBin.Enabled = bEnabled
    optAscii.Enabled = bEnabled
    cmdGet.Enabled = bEnabled And bActiveSession
    cmdPut.Enabled = bEnabled And bActiveSession
End Sub
Private Sub FtpEnumDirectory(strDirectory As String)

    ClearBag
    Dim hFind As Long
    Dim nLastError As Long
    Dim dError As Long
    Dim ptr As Long
    Dim pData As WIN32_FIND_DATA

    If Len(strDirectory) > 0 Then rcd (strDirectory)
    pData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindFirstFile(hConnection, “*.*”, pData, 0, 0)
    nLastError = Err.LastDllError

    If hFind = 0 Then
        If (nLastError = ERROR_NO_MORE_FILES) Then
            MsgBox “This directory is empty!”
        Else
            ErrorOut nLastError, “FtpFindFirstFile”
        End If
        Exit Sub
    End If

    dError = NO_ERROR
    Dim bRet As Boolean
    Dim strItemName As String

    EnumItemAttributeBag.Add pData.dwFileAttributes
    strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) – 1)
    EnumItemNameBag.Add strItemName
    Do
        pData.cFileName = String(MAX_PATH, 0)
        bRet = InternetFindNextFile(hFind, pData)
        If Not bRet Then
            dError = Err.LastDllError
            If dError = ERROR_NO_MORE_FILES Then
                Exit Do
            Else
                ErrorOut dError, “InternetFindNextFile”
                InternetCloseHandle (hFind)
               Exit Sub
            End If
        Else
            EnumItemAttributeBag.Add pData.dwFileAttributes
            strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) – 1)
            EnumItemNameBag.Add strItemName
       End If
    Loop

    InternetCloseHandle (hFind)
End Sub
Private Sub optAscii_Click()
    dwType = FTP_TRANSFER_TYPE_ASCII
End Sub
Private Sub optBin_Click()
    dwType = FTP_TRANSFER_TYPE_BINARY
End Sub
Private Sub TreeView1_DblClick()
    Dim nodX As Node
    Set nodX = TreeView1.SelectedItem
    If Not bActiveSession Then
        MsgBox “No in session!”
        Exit Sub
    End If
    If nodX Is Nothing Then
        MsgBox “no Selection to enumerate”
    End If
    If nodX.Image = “closed” Then
        nodX.Image = “open”
        FtpEnumDirectory (nodX.Text)
        FillTreeViewControl (nodX.Text)
    Else
        If nodX.Image = “open” Then
            nodX.Image = “closed”
            Dim nodChild As Node, nodNextChild As Node
            Set nodChild = nodX.Child
            Do
            Set nodNextChild = nodChild.Next
                TreeView1.Nodes.Remove nodChild.Index
                If nodNextChild Is Nothing Then Exit Do
                Set nodChild = nodNextChild
            Loop
        End If
    End If
End Sub

Jam Analog

‘Buat Form dan 1 Timer
Option Explicit
Dim xgen, ygen, xmin, ymin, xsec, ysec, xhor, yhor As Double
Dim h, m, s As Date
‘control the minute ‘
Function mint()
If s >= 0 And s < 12 Then
    Call findminangle(CDbl(m))
ElseIf s >= 12 And s < 24 Then
    Call findminangle(CDbl(m) + 0.2)
ElseIf s >= 24 And s < 36 Then
    Call findminangle(CDbl(m) + 0.4)
ElseIf s >= 36 And s <= 48 Then
    Call findminangle(CDbl(m) + 0.6)
ElseIf s >= 48 And s <= 59 Then
    Call findminangle(CDbl(m) + 0.8)
End If
xmin = xgen
ymin = ygen
Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xmin, ymin), RGB(255, 24, 32)
End Function
‘control the second
Function secnd()
    Call findminangle(CDbl(s))
    xsec = xgen
    ysec = ygen
    Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xsec, ysec), RGB(100, 100, 100)

End Function
‘control the hour
Function hr()

    If m >= 0 And m < 12 Then
        Call findminangle(CDbl(h) * 5)
    ElseIf m >= 12 And m < 24 Then
        Call findminangle(5 * (CDbl(h) + 0.2))
    ElseIf m >= 24 And m < 36 Then
        Call findminangle(5 * (CDbl(h) + 0.4))
    ElseIf m >= 36 And m < 48 Then
        Call findminangle(5 * (CDbl(h) + 0.6))
    ElseIf m >= 48 And m <= 59 Then
        Call findminangle(5 * (CDbl(h) + 0.8))
    End If
    xhor = xgen
    yhor = ygen
    If xhor >= Form1.ScaleWidth / 2 And yhor >= Form1.ScaleHeight / 2 Then

        Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor – 200, yhor – 200), RGB(0, 0, 255)
    ElseIf xhor <= Form1.ScaleWidth / 2 And yhor >= Form1.ScaleHeight / 2 Then
        Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor + 200, yhor – 200), RGB(0, 0, 255)
    ElseIf xhor <= Form1.ScaleWidth / 2 And yhor <= Form1.ScaleHeight / 2 Then
        Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor + 200, yhor + 200), RGB(0, 0, 255)
    ElseIf xhor >= Form1.ScaleWidth / 2 And yhor <= Form1.ScaleHeight / 2 Then
        Line (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2)-(xhor – 200, yhor + 200), RGB(0, 0, 255)
    End If

End Function
‘draw the clock
Function drawdig()
    Dim i As Integer
    Circle (Form1.ScaleWidth / 2, Form1.ScaleHeight / 2), 1411, RGB(255, 34, 34)
    For i = 5 To 60
        Call findminangle(CDbl(i))
        Form1.CurrentX = xgen – TextWidth(i / 5) / 2
        Form1.CurrentY = ygen – TextWidth(i / 5) / 2
        Form1.Print i / 5
        i = i + 4
    Next
End Function
‘find the co-ordinate
Function findminangle(p As Double)
    Dim temp As Double

    temp = 60 – (p – 15)
    temp = temp * 60 * 0.1
    temp = (22 * temp) / (7 * 180)

    xgen = (Form1.ScaleWidth / 2) + (1000 * Cos(temp))
    ygen = (Form1.ScaleHeight / 2) – (1000 * Sin(temp))

End Function
Private Sub Timer1_Timer()
Form1.Cls
Call drawdig
Form1.Caption = Time()
h = Hour(Time())
m = Minute(Time())
s = Second(Time())
Call mint
Call secnd
Call hr
End Sub

Melihat Data Excell dengan VB

Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim k As Integer
j = Val(Text2.Text)
k = Val(Text3.Text)
Set xlBook = GetObject(Text1.Text)
List1.Clear
For i = 1 To k
List1.AddItem xlBook.WorkSheets(1).Cells(i, j).Value
Next
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
Text1.Text = File1.Path & “\” & File1.FileName
End Sub
Private Sub Form_Load()
File1.Pattern = “*.xls”
End Sub

Melihat Code Character

Private Function ChrCode(txt As String) As String
Dim x As Long
Dim outstring As String
For x = 1 To Len(txt$)
outstring$ = outstring$ + “Chr(” + CStr(Asc(Mid(txt$, x, 1))) + “) + “
Next x
outstring$ = Trim(outstring$)
outstring$ = Mid(outstring$, 1, Len(outstring$) – 2)
ChrCode$ = outstring$
End Function
Private Sub Command1_Click()
If Text1 = “” Then Exit Sub
Text2.Text = ChrCode(Text1.Text)
End Sub
Private Sub Command2_Click()
Text1.Text = “”
End Sub
Private Sub Command3_Click()
If Text2 = “” Then Exit Sub
Clipboard.SetText Text2.Text
End Sub
Private Sub Command4_Click()
Text2.Text = “”
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unload Me
End
End Sub

Belajar Input Teks di List

Private Sub cmdHapus_Click()
LstList.RemoveItem (LstList.ListIndex)
End Sub
Private Sub cmdHapusSemua_Click()
LstList.Clear
End Sub
Private Sub cmdInput_Click()
LstList.AddItem txtInput.Text
txtInput.Text = “”
End Sub
Private Sub cmdKeluar_Click()
End
End Sub

Counter Time

Private Sub Command1_Click()
intbatas = 5
Me.Timer1.Interval = 1000
Me.Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
intbatas = 5
Dim inttout As Integer
Dim dtm As Date
dtm = DateAdd(“s”, intbatas, Now)
Do Until Now >= dtm
DoEvents
inttout = Second(dtm) – Second(Now)
Me.Caption = “TimeOut:” & inttout
Loop
Unload Me
End Sub
Private Sub Timer1_Timer()
intbatas = intbatas – 1
If intbatas <= 0 Then
Me.Timer1.Enabled = False
Unload Me
Else
Me.Caption = “TimeOut:” & intbatas
End If
End Sub

Program Load Gambar

Radio Tuner Dengan VB

‘Thank’s Mackay for your sharing about Radio Tuner with VB
‘by Peter
Form
Option Explicit
‘Sintonizador de emisoras de radios
‘latinas en internet.
‘Creado por E. Mackay D. feb. 2008
Dim nEmisora As String
Dim nRadioPais As String
Private Sub cmdEscuchar_Click()
On Local Error Resume Next
If cmdEscuchar.Caption = “Escuchar” Then
   Image1(0) = Image1(1)    ‘Rojo
Tuneador.Enabled = False
cmdEscuchar.Caption = “Detener”
         WMPradio.URL = nEmisora
        WMPradio.Controls.Play
   Else
cmdEscuchar.Caption = “Escuchar”
     Image1(0) = Image1(3)   ‘Gris
Tuneador.Enabled = True
WMPradio.Controls.Stop
Escuchar.Panels(1).Text = “”
lblRadioPais.Caption = “”
   End If
End Sub
Private Sub Form_Load()
Image1(0) = Image1(3)    ‘Gris
Escuchar.Panels(1).Width = Me.Width – 100
Call Emisoras
‘Emisora buffer Radio HRN de Honduras
nEmisora = “http://206.17.135.195/VACILON_LIVE”
End Sub
Private Sub Emisoras()
Dim strVar As String

‘Abre archivo para leer
On Local Error Resume Next
’Sept. 2, 2007
Open UnArchivo For Input As #1
Do While Not EOF(1)
        Line Input #1, strVar
‘Procesa linea a linea, si la linea es valida
   If strVar <> “” Then Call Separar(strVar)
   Loop
Close #1
End Sub
Private Sub Separar(sRlinea As String)
Dim sNum, iPos As Long
Dim strFinal, lesStr As String
lesStr = sRlinea
On Local Error Resume Next
For sNum = 1 To 4
    iPos = InStr(lesStr, “|”)

   strFinal = Trim(Left(lesStr, iPos – 1))

Select Case sNum
’Numero en la lista
Case 1
ListaURL.Add strFinal
’Nombre de emisora
Case 2
ListaURL.Add strFinal
’Pais de origen
Case 3
ListaURL.Add strFinal
’Url de emisora
Case 4
ListaURL.Add strFinal
End Select
    lesStr = Right(sRlinea, Len(lesStr) – iPos)
Next sNum
’Programacion
ListaURL.Add lesStr
’
End Sub
Private Sub Tuneador_Scroll()
On Local Error GoTo Fuera
’Muestra instantaneamente la emisora y el pais
Escuchar.Panels(1).Text = ListaURL((Tuneador.Value * 5) + 2) & ” en ” & ListaURL((Tuneador.Value * 5) + 3)
nEmisora = ListaURL((Tuneador.Value * 5) + 4)
        nRadioPais = Escuchar.Panels(1).Text
Exit Sub
Fuera:
MsgBox “Solo hay ” & ListaURL.Count / 5 & ” estaciones listadas.”, vbInformation + vbOKOnly, “AVISO”
Tuneador.Value = (ListaURL.Count / 5) – 1
End Sub
Private Sub WMPradio_OpenStateChange(ByVal NewState As Long)
Escuchar.Panels(1).Text = WMPradio.Status
If Left(WMPradio.Status, 3) = “Rep” Then
lblRadioPais.Caption = Trim(nRadioPais)
   Image1(0) = Image1(2)    ‘Verde
    Else
lblRadioPais.Caption = “”
   Image1(0) = Image1(1)    ‘Rojo
    End If

End Sub
Module
Option Explicit
‘Marzo 2008
‘hp1ml@hotmail.com
‘Para escuchar emisoras de radio latinas en internet
‘……………………..
‘Configuracion del string por paises
Public UnArchivo As String
Public Type TVNAME
    nIdice As Long
    Canal As String
    dirURL As String
    nBitrate As Integer
    namePais As String
    nRata As Integer
    nStatus As Integer
End Type
Public ListaURL As New Collection
Public CanalPorPais As New Collection
Public Type POINTAPI
   x As Long
   y As Long
End Type
‘Para desplegar mas lineas en un combobox
Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Public Declare Function SendMessage Lib _
   “user32″ Alias “SendMessageA” _
   (ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
Public Declare Function MoveWindow Lib _
   “user32″ (ByVal hWnd As Long, _
   ByVal x As Long, ByVal y As Long, _
   ByVal nWidth As Long, _
   ByVal nHeight As Long, _
   ByVal bRepaint As Long) As Long
Public Declare Function GetWindowRect Lib _
   “user32″ (ByVal hWnd As Long, _
   lpRect As RECT) As Long
Public Const CB_SHOWDROPDOWN = &H14F
Public Const CB_GETITEMHEIGHT = &H154
Sub main()
UnArchivo = App.Path & “\allradio.dat”      ‘channelTV.txt”          ‘”\get3test.htm”
        frmTuner.Show
End Sub

Membuat Animasi Huruf

Private Sub cmdkeluar_Click()
Unload Me
End Sub
Private Sub form_load()
Label1.FontBold = True
Label1.Left = 240
Label1.Top = 240
Timer1.Interval = 200
End Sub
Private Sub Timer1_Timer()
Label1.Top = Label1.Top + 100
If Label1.Top > 3000 Then
Label1.Top = 240
End If
End Sub

Belajar Fungsi VB

Private Sub OK_Click()
Dim userMsg As String
userMsg = InputBox(“What is your message?”, “Message Entry Form”, “Enter your messge here”, 500, 700)
If userMsg <> “” Then
message.Caption = userMsg
Else
message.Caption = “No Message”
End If
End Sub

Program Menghitung Lama Parkir

Dim awal, akhir As Date
Dim lama As Double
Private Sub cmd_keluar_Click()
End
End Sub
Private Sub txt_bg_change()
Ado_parkir.RecordSource = “Select*from tb_parkir where no_polisi=” ‘”&txt_bg.text&”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
If .PageCount <> 0 Then
If !Status = “T” Then
TXT_MULAI.Text = !jam_masuk
cmd_mulai.Caption = “&Stop”
cmd_mulai.SetFocus
Else
MsgBox “Nomor Polisi Yang Telah tersimpan Silahkan Anda Tekan Tombol Mulai”, vbInformation + vbOKOnly, “BG”
cmd_mulai.SetFocus
End If
Else
TXT_MULAI.Text = “”
TXT_SELESAI.Text = “”
TXT_TOTAL.Text = “”
TXT_BIAYA.Text = “”
cmd_mulai.Caption = “&Mulai”
End If
End With
End Sub
Private Sub txt_bg_keypress(KeyASCII As Integer)
If KeyASCII = 13 Then cmd_mulai.SetFocus
End Sub
Private Sub cmd_mulai_Click()
Dim biaya As Integer
If TXT_BG.Text = “” Then
MsgBox “Masukkan Nomor BG Terlebih Dahulu”, vbInformation + vbOKOnly, “Information”
TXT_BG.SetFocus
Else
If cmd_mulai.Caption = “&Mulai” Then
awal = Time
TXT_MULAI.Text = awal
cmd_mulai.Caption = “&Simpan”
ElseIf cmd_mulai.Caption = “&Simpan” Then
Ado_parkir.RecordSource = “Select*from tb_parkir”
Ado_parkir.Refresh
With Ado_parkir.Recordset
.AddNew
!no_polisi = TXT_BG.Text
!jam_masuk = TXT_MULAI.Text
.Update
End With
cmd_mulai.Caption = “&Mulai”
TXT_MULAI.Text = “”
TXT_BG.Text = “”
TXT_BG.SetFocus
ElseIf cmd_mulai.Caption = “&Stop” Then
akhir = Time
TXT_SELESAI.Text = akhir
cmd_mulai.Caption = “&Lama”
ElseIf cmd_mulai.Caption = “&Lama” Then
Ado_parkir.RecordSource = “Select jam_masuk from”
tb_parkir where no_polisi=’”&txt_bg.text&”‘”
Ado_parkir.Refresh
lama = akhir – Ado_parkir.Recordset!jam_masuk
TXT_TOTAL.Text = Format(lama, “hh:mm:ss”)
cmd_mulai.Caption = “&Biaya”
ElseIf cmd_mulai.Caption = “&Biaya” Then
biaya = 50000 * lama
TXT_BIAYA.Text = Format(biaya, “Rp #,#”)
Ado_parkir.RecordSource = “select*from tb_parkir”
where ado_parkir=’”&txt_bg.text&”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
!jam_keluar = TXT_SELESAI.Text
!biaya = biaya
!Status = “Y”
.Update
End With
cmd_mulai.Caption = “&Parkir”
ElseIf cmd_mulai.Caption = “&Parkir” Then
TXT_MULAI.Text = “”
TXT_SELESAI.Text = “”
TXT_TOTAL.Text = “”
TXT_BG.Text = “”
TXT_BIAYA.Text = “”
TXT_BG.SetFocus
cmd_mulai.Caption = “&Mulai”
End If
End If
End Sub
Private Sub cmd_cari_click()
On Error GoTo Error:
Cari = InputBox(“Masukkan Nomor Polisi Yang Akan Dicari:”, “Cari No.Polisi”)
If Cari <> Empty Then
ado_parkir.RecordSource=”Select*from tb_parkir where no_polisi=’”&Cari”‘”
Ado_parkir.Refresh
With Ado_parkir.Recordset
If !Status = “T” Then
TXT_BG.Text = !no_polisi
TXT_MULAI.Text = !jam_masuk
cmd_mulai.Caption = “&Stop”
TXT_SELESAI.Text = “”
TXT_BIAYA.Text = “”
TXT_TOTAL.Text = “”
Else
TXT_BG.Text = !no_polisi
TXT_MULAI.Text = “”
TXT_SELESAI = “”
TXT_BIAYA = “”
TXT_TOTAL = “”
cmd_mulai.Caption = “&Mulai”
End If
Exit Sub
Error:
MsgBox “No.Polisi Yang Anda Cari Tidak Ada!”, vbQuestion + vbOKOnly, “Pencarian”
TXT_BG.SetFocus
End With
End If

End Sub

Belajar Pemrograman Borland C++

Diposting oleh Yusuf Hadiyana di 05.55 |

By. Yusuf Hadiyana

LATIHAN PEMROGRAMAN KOMPUTER
MODUL I – INPUT/OUTPUT & JENIS DATA

Memulai Borland C++ 5.02
• Jalankan Borland C++ 5.02,
• Buat project baru:
pilih menu: File-New-Project… -> dialog New Target pada Project Path and Name, isikan nama proyeknya lengkap
contoh: c:\saya\proyek1.ide
pada Target Type, pilih: Application [.exe]
pada Platform, pilih: DOS (Standard)
(boleh pula memilih Target Type EasyWin [.exe] dengan Platform Windows 3.x (16))
pada Target Model, pilih: Large
hilangkan tanda centang pada Frameworks – Class Library
klik tombol OK

• Muncul proyek baru dengan target proyek1.exe dan file proyek1.cpp
Klik dobel pada proyek1.cpp untuk mengeditnya
Siap untuk menuliskan programnya
• Untuk menjalankan program (pilih salah satu):
1. pilih menu: Debug-Run
2. tekan tombol Ctrl-F9
3. klik tombol di toolbar yang bergambar kilat kuning

LATIHAN PEMROGRAMAN KOMPUTER
MODUL II – INPUT/OUTPUT & JENIS DATA

Program kombinasi input-output: data diri

Dalam membuat program, usahakan agar mudah dimengerti, yaitu dengan memberi nama
variabel yang mempunyai arti, memberi keterangan, dan membuat program terstruktur dengan
baik.

Output menggunakan stream: Hello World! dalam C++
#include <iostream.h>
main()
{
cout << “Hello world!\nWe’re in C++ now”;
}
Jalankan, dan selamat! Anda telah berhasil membuat program pertama dalam bahasa C++.
Gantilah isi programnya menjadi:
cout << “Hello world!” << endl
<< “We’re in C++ now”;
Hasilnya sama dengan sebelumnya. Apakah fungsi dari endl?
Input string menggunakan stream: program nama
#include <iostream.h>
main()
{
char nama[80];
cout << “Masukkan nama: “;
cin >> nama;
cout << “Halo ” << nama << endl
<< “Betul kan, kamu si ” << nama;
}
Menggantikan fungsi apakah cin dan cout
Program input ke variabel bilangan: menghitung akar
#include <iostream.h>
#include <math.h>
main()
{
int a;
float b;
cout << “Masukkan nilai a = “;
cin >> a;
b = sqrt(a);
cout << “akar dari a = ” << b;
}
Gantilah tipe variabel a menjadi bilangan riil. Periksalah apakah ada bagian lain yang perlu
dimodifikasi akibat pergantian tersebut?

LATIHAN PEMROGRAMAN KOMPUTER
MODUL III – STRUKTUR PEMROGRAMAN: PENCABANGAN

Pencabangan tunggal: IF

Buatlah program di bawah ini. Jika umur diisi lebih dari 60 tahun maka akan ditampilkan
komentar.

#include <iostream.h>
main()
{ int umur;
cout << “Masukkan umurmu = “;
cin >> umur;
if umur >= 60
cout << “Halo mbah” << endl;
cout << “Jadi umurmu ” << umur << ” tahun”;
}

Kompilelah program tersebut, error apakah yang muncul dan bagaimana yang benar? Perbaiki
program tersebut dan jalankan beberapa kali dengan mengisikan nilai umur yang bervariasi.
Tambahkan baris berikut setelah baris cout << “Halo mbah…, untuk memberi komentar tambahan
jika umur lebih dari 60 tahun

cout << “Salam buat cucumu ya” << endl;

Jalankan dengan mengisikan umur 80 tahun, lalu jalankan lagi untuk umur 20 tahun. Mengapa
komentar tambahan selalu muncul untuk umur berapapun (tidak sesuai dengan yang diinginkan)
serta bagaimana yang benar?

Buatlah program sesuai contoh berikut

#include <iostream.h>
main()
{ int tahun, umur;
cout << “Masukkan tahun kelahiranmu = “;
cin >> tahun;
umur = 2003-tahun;
cout << “Umurmu ” << umur << ” tahun\n”;
if (umur < 17);
{ cout << “Kamu belum sweet seventeen\n”;
cout << “Belum cukup umur\n”; }
}

Kompile program tersebut, tidak ada compile error (kecuali beberapa warning). Jalankan dan
isikan tahun kelahiran 1988 dan 1975 serta nilai lain. Kesalahan apakah yang terjadi dan
bagaimana yang benar?

Pencabangan ganda: IF-ELSE
Buatlah program untuk menentukan apakah seseorang lulus atau tidak menggunakan nilainya

#include <iostream.h>
main()
{ int N;
cout << “Masukkan nilai (0 s/d 100) = “;
cin >> N;
if (N >= 50)
cout << “Lulus”
else (N < 50)
cout << “Tidak lulus”;
}

Error apa yang muncul waktu dikompile dan bagaimana yang benar? Perbaiki dan jalankan
dengan mengisikan beberapa nilai N.

Pencabangan bertingkat: IF-ELSE-IF
Buatlah program untuk memberi nilai huruf berikut.

#include <iostream.h>
main()
{ int N;
cout << “Masukkan nilai = “;
cin >> N;
cout << “Nilai huruf = “;
if (N >= 80)
cout << “A”;
if (N >= 60)
cout << “B”;
if (N >= 40)
cout << “C”;
if (N < 40)
cout << “D”;
}

Jalankan dan isikan nilai 15, 25, 50, 75, dan 100. Hasilnya tidak sesuai dengan yang seharusnya,
jelaskan mengapa bisa terjadi seperti itu. Perbaiki program di atas dengan struktur pencabangan
bertingkat: if … else if … else if …. dst.(6). Buat flowchart dari program tersebut.

Kondisi kombinatorial
Perbaiki program di atas dengan kondisi yang merupakan kombinasi logika, misalnya: jika N
lebih dari atau sama dengan 60 tetapi kurang dari 80 maka …, tanpa menggunakan pencabangan
bertingkat. Buat flowchart dari program tersebut.

Buat flowchart dari program di bawah ini.

#include <iostream.h>
main()
{ int N;
cout << “Masukkan nilai = “;
cin >> N;
cout << “Nilai huruf = “;
if (N >= 40)
if (N >= 60)
if (N >= 80)
cout << “A”;
else
cout << “B”;
else
cout << “C”;
else
cout << “D”;
}

Menu: Program konversi suhu
Buatlah program untuk menghitung konversi suhu dari C ke F atau R dan sebaliknya. Program
dimulai dengan mengisikan suhu yang akan dikonversi, kemudian menampilkan pilihan (menu)
sebagai berikut:
Pilih konversi berikut:
A. Celcius ke Fahrenheit
B. Fahrenheit ke Celcius
C. Celcius ke Reamur
D. Reamur ke Celsius
E. Fahrenheit ke Reamur
F. Reamur ke Fahrenheit
Setelah dipilih, maka program melakukan perhitungan konversi sesuai dengan yang dipilih dan
menampilkan hasilnya. Gunakan struktur pencabangan IF untuk program tersebut. Buat dahulu
flowchartnya baru programnya.

LATIHAN PEMROGRAMAN KOMPUTER
MODUL IV – STRUKTUR PEMROGRAMAN: LOMPATAN & KALANG

Pencabangan

Jalankan program berikut dan isikan umur = 20, 19, 21, 23, dst. Bagaimana keluarannya?. Bagian mana yang salah dan bagaimana modifikasinya?

#include <iostream.h>
main()
{ int umur;
cout << “Masukkan umur anda = “;
cin >> umur;
if (umur = 20)
cout << “Umur anda tepat duapuluh tahun”;
else
cout << “Umur anda bukan duapuluh tahun”;
}

Pencabangan berganda: SWITCH
Jalankan program berikut dan isikan kategori = A,B,C,D, atau E. Bagaimana keluarannya?. Modifikasilah agar menjadi benar.

#include <iostream.h>
main() {
char kategori;
float diskon;
cout << “Kategori pelanggan (A/B/C/D/E) = “;
cin >> kategori;
switch (kategori) {
case ‘A’:
diskon = 40;
case ‘B’:
diskon = 25;
case ‘C’:
case ‘D’:
diskon = 10;
default:
diskon = 0;
}
cout << “Diskon = ” << diskon << “%”;
}

Lompatan: label dan goto
Buatlah program di bawah ini. Jalankan dan tulislah tampilan yang muncul. Terangkan fungsi
dari label dan goto.

#include <iostream.h>
main()
{
cout << “Ini langkah pertama” << endl;
goto LABEL2;
LABEL1:
cout << “Ini langkah kedua” << endl;
goto LABEL3;
LABEL2:
cout << “Ini langkah ketiga” << endl;
goto LABEL1;
LABEL3:
cout << “Ini langkah keempat” << endl;
}

Pencabangan & lompatan untuk perulangan

#include <iostream.h>
#include <conio.h>
main()
{ float C, F;
int tombol;
Ulangi
cout << “Masukkan suhu dalam Celcius = “;
cin >> C;
F = 1.8*C+32;
cout << “Suhu dalam Fahrenheit = ” << F
<< endl;
cout << “Apakah mau mengulangi (Y/T)? “;
tombol = getch();
cout << endl;
if (tombol == ‘Y’)
goto Ulangi;
cout << “Selesai”;
}

Kompile program di atas, ada error yaitu kesalahan dalam menulis label, bagaimana yang benar? Perbaiki dan jalankan. Modifikasi program tersebut untuk dapat mengulangi jika diberi
jawaban karakter Y maupun y. Apakah fungsi dari getch()

Kalang bersyarat “periksa-jalankan” : WHILE

#include <iostream.h>
#include <conio.h>
main()
{ char nama[80];
int tombol;
while ((tombol == ‘Y’)||(tombol == ‘y’)) {
cout << “Masukkan nama anda = “;
cin >> nama;
cout << “Halo ” << nama << endl << endl;
cout << “Apakah mau mengulangi (Y/T)? “;
tombol = getch();
cout << endl << endl;
}
cout << “Selesai”;
}

Jalankan program di atas, apa yang terjadi dan mengapa bisa begitu?. Bagaimana yang benar?. Perbaiki dan jalankan.

Kalang bersyarat “jalankan- periksa”: DO-WHILE
#include <iostream.h>
#include <conio.h>
main()
{ char nama[80];
int tombol, cacah = 0;
float nilai, jumlah = 0, rerata;
cout << “Menghitung rerata nilai\n”;
cout << “Masukkan nilai, “
<< “isikan negatif jika selesai\n\n”;
do {
cacah++;
cout << “Data ke-” << cacah << ” = “;
cin >> nilai;
jumlah = jumlah+nilai;
} while (nilai >= 0);
rerata = jumlah/cacah;
cout << “\nBanyaknya data = ” << cacah;
cout << “\nJumlah = ” << jumlah;
cout << “\nRerata = ” << rerata;
}

Apa fungsi instruksi cacah++.

Jalankan program di atas dan masukkan beberapa nilai untuk dihitung reratanya, akhiri masukan
dengan memberikan nilai negatif (jangan cuma tanda minus thok). Periksa jawabannya, apakah
jawaban yang diperoleh sudah benar? Perbaiki program tersebut agar menjadi benar.

Buatlah program untuk menghitung jumlah & rerata nilai, tetapi dengan memasukkan dahulu
berapa banyaknya nilai yang akan dimasukkan. Tampilannya adalah sbb (huruf tebal adalah nilai
yang diisikan melalui keyboard). Buatlah dalam 2 versi, pertama menggunakan kalang WHILE, dan kedua menggunakan kalang DO-WHILE.

Banyaknya nilai = 3
Data ke-1 = 10
Data ke-2 = 9
Data ke-3 = 8
Jumlah = 27
Rerata = 9

Menu: Program konversi suhu dengan SWITCH
Buat pula program yang sama dengan pada bagian akhir Modul III menggunakan struktur
SWITCH, Buat dahulu flowchartnya baru programnya.

LATIHAN PEMROGRAMAN KOMPUTER
MODUL V – STRUKTUR PEMROGRAMAN: KALANG FOR

Kalang FOR untuk perulangan
#include <iostream.h>
main()
{
int i;
for (i=1; i<=20; i++) {
cout << “kalang ke-” << i << endl;
}
}
Jalankan program di atas dan lihat hasilnya. Perhatian fungsi dari ketiga bagian pada struktur for
(yang dibatasi dengan tanda titik-koma) dengan mengubah baris for di atas menjadi:
(a) for (i=10; i<=20; i++) {
(b) for (i=1; i<=10; i++) {
(c) for (i=1; i<=20; i=i+2) {
Jelaskan fungsi masing-masing bagian pada baris for

LATIHAN PEMROGRAMAN KOMPUTER
MODUL VI – VARIABEL LARIK: STRING

Sekup variabel dalam kalang FOR
#include <iostream.h>
main()
{
int i = 5;
cout << “di luar kalang i = ” << i << endl;
for (i=1; i<=10; i++) {
cout << “di dalam kalang i = ” << i << endl;
}
cout << “di luar kalang i = ” << i << endl;
}

Jalankan program di atas dan lihat hasilnya. Gantilah pernyataan for di atas menjadi:
for (int i=1; i<=10; i++) {
jalankan program tersebut dan perhatikan nilai i yang ditampil-kan. Apa pengaruh pendefinisian
variabel i di dalam kalang for. Gantilah pernyataan for di atas dengan menghilangkan bagian
inisialisasi kalang for menjadi:
for (; i<=10; i++) {
jalankan program tersebut dan lihat nilai i yang ditampilkan. Apakah yang terjadi apabila tidak
dilakukan inisialisasi pada kalang for.

Operasi pada string: Kutak-katik nama
#include <stdio.h>
#include <iostream.h>
#include <string.h>
main()
{
char nama[80], nama2[80], tulisan[80];
int panjang, posisi;
cout << “Masukkan nama = “;
gets(nama);
strcpy(tulisan,”Halo “);
cout << strcat(tulisan,nama) << endl;
if (strcmp(nama,”Fella”) == 0) {
cout << “Namamu Fella kan” << endl; }
else {
cout << “Namamu bukan Fella” << endl; }
panjang = strlen(nama);
cout << “panjang namamu ” << panjang << endl;
posisi = strcspn(nama,”z”);
if (posisi < panjang) {
cout << “Huruf z pada posisi ” << posisi
<< endl; }
else {
cout << “Tidak ada huruf z nya” << endl; }
strcpy(nama2,nama);
cout << strupr(nama2) << endl;
cout << strlwr(nama2) << endl;
cout << strrev(nama2) << endl;
cout << strset(nama2,’x') << endl;
}

Jalankan program di atas dan jelaskan kegunaan dari fungsi berikut ini: strlen(), strcpy(), strcat(),
strcmp(),strlen(), strcspn(), strupr(), strlwr(), strrev(), dan strset(). Gantilah baris:
gets(nama);
menjadi:
cin >> nama;
Apakah efeknya pada waktu program dijalankan?

LATIHAN PEMROGRAMAN KOMPUTER
MODUL VII – FUNGSI

Fungsi untuk memotong-motong program

#include <iostream.h>
int N;
float jumlah, rerata, data[100];
void Masukkan_Data() {
cout << “Banyaknya nilai = “;
cin >> N;
for (int i=0; i<N; i++) {
cout << “Nilai ke-” << (i+1) << ” = “;
cin >> data[i];
}
}
void Hitung_Rerata() {
jumlah = 0;
for (int i=0; i<N; i++) {
jumlah = jumlah+data[i];
}
rerata = jumlah/N;
}
void Tampilkan_Hasil() {
cout << “Jumlah = ” << jumlah << endl;
cout << “Rerata = ” << rerata << endl;
}
main()
{
Masukkan_Data();
Hitung_Rerata();
Tampilkan_Hasil();
}

Fungsi dengan nilai kembalian (return value) : Bisection
Review kembali program bisection pada Modul V. Modifikasi program tersebut dengan
menggunakan fungsi, yaitu dengan menambahkan fungsi berikut sebelum main().
double y(double x)
{
return x*x-2*x-3;
}
Kemudian gantilah instruksi yang digunakan untuk mengitung nilai-nilai yL, yC, dan, yU
menjadi berikut ini:
yL = y(xL);
yC = y(xC);
yU = y(xU);
Jalankan dan periksa hasilnya. Apabila program tersebut digunakan untuk persamaan yang lain
yaitu exp(x) – 2*x – 2 = 0, apakah yang harus diubah dalam program tersebut? (akar persamaan
tersebut kira-kira adalah = 1.67835).

Program konversi suhu
Berikut ini adalah program untuk mengkonversi suhu dalam Celcius ke Fahrenheit menggunakan
fungsi.
#include <iostream.h>
float Suhu_C, Suhu_F; // definisikan
variabel
float C_ke_F(float C) {
float F;
F = 1.8*C+32.0;
return F;
}
void Mengisi_Input() {
cout << “Isikan nilai Suhu C = “; // tampilkan tulisan
cin >> Suhu_C; // isikan nilai Suhu C
}
void Mengkonversi() {
Suhu_F = C_ke_F(Suhu_C); // hitung nilai Suhu F
}
void Menampilkan_Hasil() {
cout << “Temperatur ” << Suhu_C << ” C = “
<< Suhu_F << ” F” << endl;
}
main() {
Mengisi_Input();
Mengkonversi();
Menampilkan_Hasil();
}
Jalankan program di atas dan lihat hasilnya. Pindahkan keempat fungsi yang ada ke bagian bawah
setelah akhir dari program utama main() lalu kompilelah. Error apa yang muncul? Lalu
tambahkan pendefinisian keempat fungsi tadi di atas main():

float C_ke_F(float C);
void Mengisi_Input();
void Mengkonversi();
void Menampilkan_Hasil();

Jalankan dan jelaskan apa guna definisi fungsi tersebut.

Buatlah program untuk menghitung konversi suhu dari C ke F atau R dan sebaliknya. Program
dimulai dengan menampilkan pilihan (menu) sebagai berikut:

Pilih konversi berikut:
A. Celcius ke Fahrenheit
B. Fahrenheit ke Celcius
C. Celcius ke Reamur
D. Reamur ke Celsius
E. Fahrenheit ke Reamur
F. Reamur ke Fahrenheit
X. Selesai

Setelah dipilih, lalu mengisikan suhu yang akan dikonversi, kemudian program melakukan
perhitungan konversi sesuai dengan yang dipilih dan menampilkan hasilnya. Gunakan struktur
pemrograman fungsi untuk masing-masing jenis konversi.

Sekup variabel di dalam fungsi
#include <iostream.h>
int X = 10;
void SebuahFungsi()
{
cout << “Di dalam fungsi, X = “
<< X << endl;
}
main()
{
cout << “Di dalam program utama, X = “
<< X << endl;
SebuahFungsi();
cout << “Keluar ke program utama lagi, X = “
<< X << endl;
}

(a) Jalankan program di atas dan perhatikan hasilnya. Tambahkan sebaris di atas cout dalam
SebuahFungsi dengan:
(b) X = 20;
(c) int X = 20;
Apakah yang terjadi pada X untuk ketiga kasus tersebut

Pelewatan parameter pada pemanggilan fungsi
#include <iostream.h>
void Gandakan(int A, int *B, int &C)
{
A = A*2;
*B = *B*2;
C = C*2;
}
main()
{
int X = 1, Y = 10, Z = 6;
cout << “Sebelum fungsi Gandakan dipanggil\n”
<< “X = ” << X << endl
<< “Y = ” << Y << endl
<< “Z = ” << Z << endl;
Gandakan(X, &Y, Z);
cout << “Setelah fungsi Gandakan dipanggil\n”
<< “X = ” << X << endl
<< “Y = ” << Y << endl
<< “Z = ” << Z << endl;
}

Variabel manakah yang akan diubah nilainya ketika dijadikan parameter yang dilewatkan pada
fungsi Gandakan.

Overloading, pendefinisian fungsi dengan nama sama
#include <iostream.h>
float HitungLuas(float R);
{
return 3.14159*R*R;
}
float HitungLuas(float P, float L)
{
return float P*L;
}
main()
{
float Radius, Luas, Panjang, Lebar;
cout << “Radius lingkaran = “;
cin >> Radius;
cout << “Panjang segiempat = “;
cin >> Panjang;
cout << “Lebar segiempat = “;
cin >> Lebar;
Luas = HitungLuas(Radius);
cout << “Luas lingkaran = ” << Luas << endl;
Luas = HitungLuas(Panjang, Lebar);
cout << “Luas segiempat = ” << Luas << endl;
}
Apakah yang menyebabkan terjadinya error pada program di atas?. Perbaikilah. Mengapa
tidak terjadi error ketika 2 buah fungsi menggunakan nama yang sama?.

Fungsi penukaran dua buah variabel
#include <iostream.h>
void Tukarkan(int Angka1, int Angka2)
{
int temp = Angka1;
Angka1 = Angka2;
Angka2 = temp;
}
main()
{
int X = 1, Y = 99;
cout << “Sebelum ditukarkan”;
cout << “\nX = ” << X << “, Y = ” << Y;
Tukarkan(X, Y);
cout << “\nSetelah ditukarkan”;
cout << “\nX = ” << X << “, Y = ” << Y;
}
Mengapa nilai X dan Y tidak bertukaran pada program di atas, dan bagaimana cara
memperbaikinya. Cobalah program sorting di bawah ini, dengan masih menggunakan fungsi
Tukarkan di atas.

void Cetak(int D[])
{
for (int i=0; i<6; i++)
cout << D[i] << ” “;
cout << endl;
}
main()
{
int Data[6] = {10, 3, 5, 20, 15, 7};
cout << “Sebelum disortir:\n”;
Cetak(Data);
cout << “Proses sortir:\n”;
for (int i=0; i<5; i++) {
for (int j=4; j>=i; j–) {
if (Data[j+1] < Data[j])
Tukarkan(Data[j], Data[j+1]);
Cetak(Data);
}
cout << “—–\n”;
}
}

—–selamat belajar——

Selasa, 23 November 2010

Sejarah Mobil

Diposting oleh Yusuf Hadiyana di 07.15 |

Mobil (kependekan dari otomobil yang berasal dari bahasa Yunani 'autos' (sendiri) dan Latin 'movére' (bergerak)) adalah kendaraan beroda empat atau lebih yang membawa mesin sendiri. Jenis mobil termasuk bus, van, truk. Pengoperasian mobil disebut menyetir.

Sejarah

Replika Benz Motorwagen 1886.

Kendaraan tenaga uap pertama dibuat pada akhir abad 18. Nicolas-Joseph Cugnot dengan sukses mendemonstrasikan kendaraan tersebut pada tahun 1769. Kendaraan pertama menggunakan tenaga mesin uap, mungkin peningkatan mesin uap yang paling dikenal, dikembangkan di Birmingham, Inggris oleh Lunar Society. Dan juga di Birmingham mobil tenaga bensin pertama kali dibuat di Britania pada tahun 1896 oleh Frederick William Lanchester yang juga mematenkan rem cakram. Pada tahun 1890-an, etanol digunakan sebagai sumber tenaga di A.S.

Kepopuleran

Penemuan Cugnot penggunaannya dilihat secara rendah di tempat asalnya Prancis, dan penemuan tersebut diteruskan ke Britania, di mana Richard Trevithick menjalankan gerobak-uap di tahun 1801. Kendaraan tersebut dianggap aneh pada awalnya, namun penemuan dalam dekade setelahnya, seperti rem tangan, transmisi multi-kecepatan, dan peningkatan kecepatan dan setir, membuatnya sukses.
Sekarang ini, Amerika memiliki mobil lebih banyak dari negara lainnya. Jepang memimpin dalam pembuatan mobil, tetapi penduduk Jepang tidak mampu membiayai menjalankan mobil karena tempat parkir yang jarang dan harga bahan bakar yang mahal

Inovasi

Mobil "Velo" Karl Benz (1894).

Paten mobil pertama di Amerika Serikat diberikan kepada Oliver Evans pada 1789; pada 1804 Evans mendemonstrasikan mobil pertamanya, yang bukan hanya mobil pertama di AS tapi juga merupakan kendaraan amfibi pertama, yang kendaraan tenaga-uapnya sanggup jalan di darat menggunakan roda dan di air menggunakan roda padel.
Umumnya mobil pertama mesin pembakaran dalam yang menggunakan bensin dibuat hampir bersamaan pada 1886 oleh penemu Jerman yang bekerja secara terpisah. Carl Benz pada 3 Juli 1886 di Mannheim, dan Gottlieb Daimler dan Wilhelm Maybach di Stuttgart.
Pada 5 November 1895, George B. Selden diberikan paten AS untuk mesin mobil dua tak. Paten ini memberi dampak negatif pada perkembangan industri mobil di AS. Penerobosan spektakuler dilakukan oleh Berta Benz pada 1888. Mesin-uap, listrik, dan bensin bersaing untuk beberapa dekade, dengan mesin bensin pembakaran dalam meraih dominasi pada 1910-an.
Garis-produksi skala besar pembuatan mobil harga terjangkau dilakukan oleh Oldsmobil pada 1902, dan kemudian dikembangkan besar-besaran oleh Henry Ford pada 1910-an. Dalam periode dari 1900 ke pertengahan 1920-an perkembangan teknologi otomotif sangat cepat, disebabkan oleh jumlah besar (ratusan) pembuat mobil kecil yang semuanya bersaing untuk meraih perhatian dunia.
Pengembangan utama termasuk penyalaan elektronik dan self-starter elektronik (keduanya oleh Charles Kettering, untuk Perusahaan mobil Cadillac di tahun 1910-1911), suspensi independen, dan rem empat ban.

Ford Model T adalah salah satu mobil pertama yang harganya terjangkau konsumen (1927).

Pada tahun 1930-an, kebanyakan teknologi dalam permobilan sudah diciptakan, walaupun sering diciptakan kembali di kemudian hari dan diberikan kredit ke orang lain. Misalnya, pengemudian roda-depan diciptakan kembali oleh Andre Citroën dalam peluncuran Traction Avant pada 1934, meskipun teknologi ini sudah muncul beberapa tahun sebelumnya dalam mobil yang dibuat oleh Alvis dan Cord, dan di dalam mobil balap oleh Miller (dan mungkin telah muncul pada awal 1897).
Setelah 1930, jumlah produsen mobil berkurang drastis berpasan dengan industri saling bergabung dan matang. Sejak 1960, jumlah produsen hampir tetap, dan inovasi berkurang. Dalam banyak hal, teknologi baru hanya perbaikan dari teknologi sebelumnya. Dengam pengecualian dalam penemuan manajemen mesin, yang masuk pasaran pada 1960-an, ketika barang-barang elektronik menjadi cukup murah untuk produksi massal dan cukup kuat untuk menangani lingkungan yang kasar pada mobil. Dikembangkan oleh Bosch, alat elektronik ini dapat membuat buangan mobil berkurang secara drastis sambil meningkatkan efisiensi dan tenaga.

Keamanan

Kecelakaan mobil hampir sama tua dengan mobil itu sendiri. Joseph Cugnot menabrak mobil tenaga-uapnya "Fardier" dengan tembok pada 1770. Kecelakaan mobil fatal pertama kali yang dicatat adalah Bridget Driscoll pada 17 Agustus 1896 di London dan Henry Bliss pada 13 September 1899 di New York City.
Setiap tahun lebih dari sejuta orang tewas dan sekitar 50 juta orang terluka dalam lalu lintas (menurut perkiraan WHO). Penyebab utama kecelakaan adalah pengemudi mabuk atau dalam pengaruh obat, tidak perhatian, terlalu lelah, bahaya di jalan (seperti salju, lubang, hewan, dan pengemudi teledor). Fasilitas keamanan telah dibuat khusus di mobil selama bertahun-tahun.
Mobil memiliki dua masalah keamanan dasar: Mereka memiliki pengemudi yang sering kali berbuat kesalahan dan ban yang kehilangan gesekan ketika pengereman mendekati setengah gravitasi. Kontrol otomatis telah diusulkan dan dibuat contoh.
Riset awal memfokuskan pada peningkatan rem dan mengurangi bahaya api sistem bahan bakar. Riset sistematik dalam keamanan tabrakan dimulai pada 1958 di Ford Motor Company. Sejak itu, banyak riset memfokuskan pada penyerapan energi luar dengan panel yang mudah hancur dan mengurangi gerakan manusia pada ruang penumpang.
Ada tes standar keamananan mobil, seperti EuroNCAP dan USNCAP. Ada juga tes yang dibantu oleh industri asuransi.
Meskipun peningkatan dalam teknologi, angka kematian dari kecelakaan mobil tetap tinggi, di AS sekitar 40.000 orang meninggal setiap tahun, angka yang tetap bertumbuh sesuai dengan peningkatan populasi dan perjalanan, dengan tren yang sama di Eropa. Angka kematian diperkirakan akan menjadi dua kali lipat di seluruh dunia pada 2020. Angka yang lebih banyak dari kematian adalah luka dan cacat.

Senin, 08 November 2010

10 Pesawat Tercepat di Dunia

Diposting oleh Yusuf Hadiyana di 09.46 |

Mungkin banyak dari kita pernah naik pesawat dan merasakan betapa cepatnya pesawat itu yang mampu menempuh ribuan kilometer dalam waktu beberapa jam. Akan tetapi pesawat yang biasanya kita naik ternyata tidak ada apa-apanya dibandingin dengan kecepatan pesawat-pesawat dibawah ini yang bahkan ada yang bisa menempuh jarak 28.000km/ jam. Mari lihat seperti apakah pesawat-pesawat tercepat di dunia.

1. Space Shuttle

Banyak dari kita sudah mengetahui apa itu Space Shuttle. Bagi yang masih belum tau, space shuttle adalah mesin yang digunakan sebagai roket pendorong untuk pesawat ulang laik. Roket pendorong pertama ini dibuat oleh NASA Amerika di tahun 1981. Roket ini mempunyai kecepatan 20.000 miles per jam (sekitar 32.000km/jam) dengan kecepatan rata-rata 17.500 miles per jam (sekitar 28.000km/jam)

2. X-43A

Pesawat X-43A dibuat oleh NASA dan hanya dipergunakan pada waktu-waktu tertentu seperti untuk observasi, untuk mata-mata, dan l ainnya. Pesawat ini adalah pesawat yang tercepat di tahun 2004 dimana dia memecahkan rekor tercepat dunia penerbangan yakni 7500 miles per jam (12.000km/jam)

3. X-15

Pesawat lain yang dibuat oleh NASA adalah X-15 yang merupakan pesawat yang dibuat kembali pada tahun 1959. Dengan adanya huruf "X" didepan nama pesawat, itu menunjukkan bahwa pesawat tersebut adalh pesawat percobaan (X=Experiment=Percobaan). Kecepatan pesawat ini adalah 4.510 miles /jam (7.300 km/jam)

4. SR-71 Blackbird

Pesawat ini awalnya adalah merupakan rancangan Clarence Kelly Johnon di tahun 1966. Kemudian, dikembangkan oleh NASA. Kecepatan pesawat ini adalah 2.200 miles/jam (3550km/jam)

5. MiG-25R Fox Bat-B

Pesawat ini dibuat oleh Rusia di tahun 1960 yang kemudian dikenal dengan sebutan Mikoyan_Gurevich. Pesawat ini menjadi andalan bagi angkatan udara negara Aljazair dan Suriah. Pesawat ini mampu menempuh jarak 2.000 km/ jam

6. X-2

Pesawat yang dikenal dengan nama bintang buster ini adalah pesawat percobaan yang dibangun dan di produksi oleh Amerika di tahun 1955. Kecepatan yang mampu ditempuh oleh pesawat ini adalah 1.900 km/jam

7. XB-70 Valkyrie

Pesawat ini merupakan pesawat pembom strategis pertama yang dimiliki oleh Amerika. Pesawat ini mampu melakukan perjalanan hampir ke seluruh dunia dan mampu melesat dengan kecepatan rata-rata 1.890 km/jam

8. F-15 Eagle

Pesawat yang dibuat oleh Amerika pada tahun 1972 ini bertujuan untuk menempuh jarak jauh seperti ke Jepang, Arab Saudi, dan Israel. Kecepatan rata-rata dari pesawat ini adalah 1.875 km/jam

9. MiG-31 Foxhound

MiG31 merupakan kelanjutan dari pesawat MiG25 yang telah pernah di rilis sebelumnya. Kecepatan dari pesawat ini bisa mencapai 1.750 km/jam

10. F-111 Aardvark

Kalau pesawat-pesawat diatas di dominasi oleh Amerka, pesawat F-111 ini dibuat oleh angkatan udara Australia. Pesawat ini bisa menempuh rata-rata 1.650 km/ jam

Sabtu, 06 November 2010

10 kendaraan tercepat di dunia

Diposting oleh Yusuf Hadiyana di 23.14 |

Dari segala kendaraan yang ada di juka bumi ini, tenyata ada juga berbagai kendaraan yang memiliki kecepatan yang sangat mengagumkan dan jauh berbeda dengan kecepatan kendaraan lain yang sejenis. Dan kami akan segera menampilkanya pada anda. Tapi sebelumnya kami beritahukan bahwa urutan kendaraan tercepat ini bukan disusun berdasarkan urutan kecepatanya, melainkan disusun berdasarkan kategori kendaranya, jadi yang kami tampilkan adalah 10 kendaraan tercepat di kategori yang berbeda. Okelah, mari kita simak kendaraan-kendaraan ytercepat di bawah ini

1. USS Albacore (AGSS-569): Fastest Underwater Vehicle in the World

Pada kecepatan 25 knot di permukaan dan 33 knot saat menyelam, USS Albacore (AGSS-569) adalah kendaraan tercepat bawah air di dunia. Kapal ini adalah kapal selam penelitian unik yang dipelopori Amerika versi titisan air mata bentuk lambung kapal selam modern. Ditetapkan pada tahun 1952 dan diluncurkan pada tahun 1953.

2. Aquada: Fastest Amphibious Car in the World

The Aquada adalah kendaraan amfibi tercepat yang pernah dibuat, dilengkapi dengan HSA (High Speed Amfibi) teknologi dari perusahaan Inggris, Gibbs Technologies. Di darat, ia mampu kecepatan maksimum 160 km / jam atau 100 mph dan 50 km / h atau 30 mph (26 knot) di atas air. Kendaraan dilengkapi dengan pertengahan terpasang mesin bensin V6, yang mengemudikan roda belakang. Ini adalah kendaraan amfibi kecepatan tinggi. Mesin unik ini dikembangkan di Inggris dan Detroit dan diperkirakan akan mulai dijual di Amerika Serikat tahun ini dengan harga $ 85,000.

3. Bob Windt’s Hovercraft: Fastest Hovercraft in the World

The World’s Hovercraft Speed Record pada 18 September 1995 yang diselenggarakan di Portugal dimenangkankan oleh Bob Windt dari AS dengan kecepatan 137,4 km / jam atau 85,87 mph. Windt mantan insinyur penerbangan di McDonnell Douglas, adalah pendiri Universal Hovercraft dan dianggap sebagai “sang godfather” hovercraft pribadi oleh Saluran Belajar Junkyard Wars.

4. Bentley Continental GT: Fastest Car on Ice

Bentley Continental GT saat ini adalah mobil tercepat di dunia dilandasan es memecahkan rekor sebelumnya 296 km / h (184 mph) dicapai oleh Bugatti EB110 Supersport. Mobil mengagumkan ini dilengkapi dengan 6.0L,

twin-turbocharged W12 engine, memproduksi 552 hp (412 kW) dan dengan kecepatan tertinggi dari 198 mph (319 km / jam). Pada tahun 2007, Bentley Continental GT Speed dikemudikan oleh empat kali World Rally Champion Juha Kankkunen catatan kecepatannya pada landasan beku es di Laut Baltik dekat Oulu, Finlandia Itu rata-rata 321.6km / h (199,86 mph) dalam kedua arah pada “kilometer terbang”, mencapai kecepatan maksimum 331 km / h (207 mph).

5. Hayabusa: Fastest Motorcycle in the World

Hayabusa didesain oleh Suzuki adalah motor tercepat di dunia. dengan mesin 1300CC menghasilkan 175 horsepower dan memiliki batas kecepatan sampai 189 mph. Hayabusa berarti Peregrine Falcon dan juga dikenal sebagai GSX1300R di beberapa negara. pertama kali diperkenalkan oleh sepeda motor Suzuki pada tahun 1999. Memiliki 1340 cc (81,7 cu in) inline-4 mesin dan diuji secara konsisten produksi sebagai sepeda motor tercepat di dunia. modelnya yg tahun 2008 dijual US $ 11.999.

6. Kenworth T400 Bandag Bullet: Fastest Truck in the World

Bandag Bullet yang memecahkan rekor dunia untuk satu kilometer lari. Dengan berbasis Delapan ton T400 Kenworth Bandag Bullet melaju mulai kilometer 18,6 detik dengan kecepatan terminal lebih dari 300 km / jam.

Truck ini bisa secepat itu karena memiliki dua twin-turbo, nitro disuntikkan V8 mesin diesel dengan total kapasitas 24 liter (1500 cubic inches), yang menghasilkan 1100bhp dan 5.600 ft / lb torsi masing-masing.

7. SSC Ultimate Aero: Fastest Car in the World

SSC Ultimate Aero dengan kecepatan yang tercatat tercepat 413 km / jam atau 257 mph saat ini merupakan mobil tercepat di dunia produksi mobil. Berbekal Twin-Turbo V8 Engine dengan hp 1183 dan dibanrol dengan harga dasar $ 650.000. Diverifikasi pada tahun 2007 oleh Guinness World Records, SSC Ultimate Aero mengambil pimpinan sebagai mobil tercepat di dunia mengalahkan Bugatti Veyron.

8. TGV (Train a Grande Vitesse): Fastest Conventional Train in the World

TGV Prancis (Train a Grande Vitesse) adalah kereta konvensional tercepat di dunia, dengan menggunakan logam powered roda naik di rel logam. Pada April 2007, TGV memecahkan rekor 1990-nya sendiri dengan kecepatan baru 574,8 km / jam 357,18 mph.Namanya bisa diartikan “kereta berkecepatan tinggi” dalam bahasa Prancis Ini juga memegang dunia kecepatan rata-rata tertinggi

untuk Transportasi layanan penumpang reguler.

9. JR-Maglev: Fastest Non-conventional Train in the World

Jepang mempunyai JR-Maglev,kereta non-konvensional tercepat di dunia, dengan kecepatan mencapai 581 km / h (361 mph) pada medan laju magnet-pengangkatan. Catatan ini dicapai pada 2 Desember 2003. Catatan ini adalah rekor dunia kecepatan untuk menguji kereta api dalam keadaan berisi penumpang.

10. Thrust SSC: Fastest Land Vehicle in the World

The Thrust SSC (Supersonic Car) buatan Inggris yang dirancang dan dibangun sebagai jet mobil. Kendaraan cepat luar biasa ini memegang the World land Speed Record, yang ditetapkan pada 15 Oktober 1997 Ini mencapai kecepatan 1.228 km / jam atau 763 mph dan menjadi kendaraan pertama di darat secara resmi memecahkan Sound Barrier. Mobil ini dikemudikan pertama kali oleh Andy Green di Black Rock Desert, Nevada,USA. Hal ini didukung oleh dua afterburning Rolls-Royce Spey mesin turbofan, seperti yang digunakan di British F-4 Phantom II jet tempur. Benda canggih ini mempunyai 16,5 m (54 kaki) panjang, 3,7 m (12 kaki) lebar dan berat 10,5 ton (10,7 t).Didukung dengan mesin kembar yang mengembangkan dorongan 223 kN (50.000 lbf) dan membakar sekitar 4 Imperial galon per detik (18,2 l / detik atau 4,8 US galon / s). konsumsi bahan bakar adalah sekitar 5.500 l/100 km atau 0,04 mpg U.S

10 motor tercepat di dunia

Diposting oleh Yusuf Hadiyana di 23.10 |

1. Dodge Tomahawk

Engine: 10-cylinder 90-degree V-type
Top speed: 350 miles per hour (560 km/h)
Power: 500 horsepower (370 kW) @ 5600 rpm (45 kW/L)
Transmission: 2-speed manual

2. Suzuki Hayabusa

Engine: 1340 cc (82 cu in), 4-stroke, four-cylinder, liquid-cooled, DOHC, 16-valve
Top Speed: 248 miles per hour (397 km/h)
Power: 197 horsepower (147 kW) @ 6750 rpm 147kW
Transmission: 6-speed, constant mesh

3. MTT Turbine Superbike Y2K

Engine: 227 miles per hour (365 km/h)
Top Speed: Rolls-Royce 250-C20 turbo shaft
Power: 320 horsepower (239 kW) @ 52,000 rpm
Transmission: 2-speed automatic

4. Honda CBR1100XX Blackbird

Engine: 1137cc liquid-cooled inline four-cylinder
Top Speed: 190 miles per hour (310km/h)
Power: 114 kW (153 hp) @ 10,000 rpm
Transmission: Close-ratio 6-speed

5. Yamaha YZF R1

Engine: Forward Inclined Parallel 4-cylinder, 20 valves, DOHC, liquid-cooled
Top Speed: 186miles per hour (297 km/h)
Power: 128.2 horsepower (95.6 kW) at 10000 rpm
Transmission: Constant mesh 6-speed

6. MV Agusta F4 1000 R

Engine: liquid cooled, inline, 4 cylinder, DOHC, 16 radial valves
Top Speed: 185 mph (299 km/h)
Power: 174 horsepower (128 kW)
Transmission: multi-disc wet clutch, 6 speed cassette gearbox

7. Kawasaki Ninja ZX-11/ZZ-R1100

Engine: 1052 cc 4-stroke, 4-cylinder, DOHC, liquid-cooled
Top Speed: 176 miles per hour (283km/h)
Power: 108 kW (147 PS) @ 10,500 rpm
Transmission: 6 speed

8. Aprilia RSV 1000R Mille

Engine: 998 cc 60 degree V-twin engine
Top Speed: 175 miles per hour (281 km/h)
Power: 105.24 kW (143.09 PS; 141.13 hp) @ 10000 rpm
Transmission: 6 speed, chain drive

9. BMW K 1200 S

Engine: 16 valves, 4 cylinders, DOHC, horizontal in-line, liquid cooled
Top Speed: 174 miles per hour (278 km/h)
Power: 164.94 horsepower (120.4 kW) @ 10250 RPM
Transmission: 6 speed manual

10. Ducati 1098s

Engine: L-twin cylinder, 4 valves per cylinder Desmodromic, liquid cooled
Top Speed: 169 miles per hour (271 km/h)
Power: 119.3 kW (160.0 bhp) @ 9750 rpm
Transmission: 6 speed Chain

Obrol Bersama