Penulis Topik: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7  (Dibaca 15184 kali)

Offline Devran Code

  • Pro10
  • ***
  • Tulisan: 30
  • Reputation: 58
  • Jenis kelamin: Pria
  • [#] Santri Reformer [#]
    • Lihat Profil
    • Bilmedia Antivirus
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #20 pada: Juni 16, 2012, 12:28:52 PM »
saya masih bingung mas :(
Anda tak sendiri, berkembanglah dan teruslah berimajinasi.
I LOVE ISLAM

Offline Galang Kuatir

  • Pro1
  • *
  • Tulisan: 1
  • Reputation: 29
  • Jenis kelamin: Pria
    • Lihat Profil
    • Nesaba Site
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #21 pada: Juli 29, 2012, 07:17:33 PM »
Windows 7 Ultimate 32 bit, Nggak bisa ???  :( :(
Raih cita-cita setinggi langit!!!!

UDAH GITU AJA

Offline ZeroNawazaki

  • Pro10
  • ***
  • Tulisan: 78
  • Reputation: 111
  • Jenis kelamin: Pria
  • Newbie
    • Lihat Profil
    • http://zero.heck.in
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #22 pada: Agustus 13, 2012, 02:08:39 PM »

:D ini ada source buat mendapatkan direktory aktif di windows vista atau windows 7, source ini berguna sekali bagi agan yang lagi mengembangkan antivirus buat kebutuhan RTP nya, dari thread" sebelumnya banyak menanyakan gimana cara bikin RTP dan cara mendapatkan direktory yg aktif di Windows 7, dari source yang bisa dipake di Windows XP rupanya tidak berfungsi di Windows 7, karena di Windows 7 classname" di Windows Explorer berbeda dengan yang ada di Windows XP, untuk itu kita harus menyesuaikan classnamenya yg ada di Windows 7 agar bisa mendapatkan lokasi directory aktif yang sedang dibuka melalui Windows Explorer.

 ;) Kode ini udah aq test sendiri di Windows 7 SP1 x64 bit - bisa berfungsi dengan baik  ;)

berikut kodenya :

Kode: [Pilih]
'HH        HH                                AA                    kk                    RRRRRRRRRR
'HH        HH                              AA  AA                  kk                    RR        RR
'HH        HH    aaaaaa    pp  pppp        AA  AA        cccccc    kk    kk    eeeeee    RR        RR
'HHHHHHHHHHHH  aa      aa  pppp    pp      AA  AA      cc      cc  kk  kk    ee      ee  RRRRRRRRRR
'HH        HH    aaaaaaaa  pp      pp    AA      AA    cc          kkkk      eeeeeeeeee  RR    RR
'HH        HH  aa      aa  pp      pp    AAAAAAAAAA    cc          kk  kk    ee          RR      RR
'HH        HH  aa    aaaa  pppp    pp  AA          AA  cc      cc  kk  kk    ee      ee  RR      RR
'HH        HH    aaaa  aa  pp  pppp    AA          AA    cccccc    kk    kk    eeeeee    RR        RR
'                          pp
'                          pp       [ Smadaver Community ]
'
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Private Declare Function SendMessageTimeoutString Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As String, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Const WM_GETTEXT = &HD

Private Function GetText(ByVal hwnd As Long) As String
    Dim sText As String
    sText = Space$(1024)
    If SendMessageTimeoutString(hwnd, WM_GETTEXT, 1024, sText, SMTO_ABORTIFHUNG, 1000, 0) <> 0 Then
        GetText = Left$(sText, InStr(sText, vbNullChar) - 1)
    End If
End Function

Private Function DapatkanDirektoryAktif()
    On Error Resume Next
    Dim hand1 As Long
    Dim hand2 As Long
    Dim hand3 As Long
    Dim hand4 As Long
    Dim hand5 As Long
    Dim hand6 As Long
    Dim hand7 As Long
    Dim hand8 As Long
    Dim LokasiPath As String

    hand1 = FindWindow("ExploreWClass", vbNullString)
    hand2 = FindWindow("CabinetWClass", vbNullString)
    If hand1 = GetForegroundWindow Then
        hand3 = FindWindowEx(hand1, 0&, "WorkerW", vbNullString)
    ElseIf hand2 = GetForegroundWindow Then
        hand3 = FindWindowEx(hand2, 0&, "WorkerW", vbNullString)
    End If
    hand4 = FindWindowEx(hand3, 0&, "ReBarWindow32", vbNullString)
    hand5 = FindWindowEx(hand4, 0&, "Address Band Root", vbNullString)
    hand6 = FindWindowEx(hand5, 0&, "msctls_progress32", vbNullString)
    hand7 = FindWindowEx(hand6, 0&, "Breadcrumb Parent", vbNullString)
    hand8 = FindWindowEx(hand7, 0&, "ToolbarWindow32", vbNullString)
   
    LokasiPath = Replace(GetText(hand8), Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115) + Chr(58) + Chr(32), "")
   
    If PathFileExists(LokasiPath) = 1 Then
        DapatkanDirektoryAktif = LokasiPath
    Else
        DapatkanDirektoryAktif = ""
    End If
   
End Function

Cara makenya tinggal kita taruh hasilnya, misalkan di komponent text atau di variabel, klo disini aq simpen hasilnya di komponent text + Timer
Kode: [Pilih]
Text1.Text = DapatkanDirektoryAktif


Tambahan :

Source ini digunakan untuk mendapatkan direktori aktif saat dialog browse open dan save file muncul, lumayan buat RTP  :D


Kode: [Pilih]
Private Function GetDirektoryAktifBrowse()
    On Error Resume Next
    Dim hand1 As Long
    Dim hand2 As Long
    Dim hand3 As Long
    Dim hand4 As Long
    Dim hand5 As Long
    Dim hand6 As Long
    Dim hand7 As Long
    Dim hand8 As Long
    Dim LokasiPath As String
    Dim Teks As String * 255
    GetWindowText GetForegroundWindow, Teks, 255

    hand1 = FindWindow("#32770", Teks)
    If hand1 = GetForegroundWindow Then
        hand2 = FindWindowEx(hand1, 0&, "WorkerW", vbNullString)
        hand3 = FindWindowEx(hand2, 0&, "ReBarWindow32", vbNullString)
        hand4 = FindWindowEx(hand3, 0&, "Address Band Root", vbNullString)
        hand5 = FindWindowEx(hand4, 0&, "msctls_progress32", vbNullString)
        hand6 = FindWindowEx(hand5, 0&, "Breadcrumb Parent", vbNullString)
        hand7 = FindWindowEx(hand6, 0&, "ToolbarWindow32", vbNullString)

        LokasiPath = Replace(GetText(hand7), Chr(65) + Chr(100) + Chr(100) + Chr(114) + Chr(101) + Chr(115) + Chr(115) + Chr(58) + Chr(32), vbNullString)

        If PathFileExists(LokasiPath) = 1 Then
            GetDirektoryAktifBrowse = LokasiPath
        Else
            GetDirektoryAktifBrowse = ""
        End If

    End If

End Function


 :D Jangan lupa creditnya buat anak" Smadaver, Maju terus programmer indonesia  :-bd


masih pake Timer ya? :D
:D Apa yang anda baca?

Offline derit

  • Pro10
  • ***
  • Tulisan: 22
  • Reputation: 52
  • Jenis kelamin: Pria
    • Lihat Profil
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #23 pada: Desember 09, 2012, 12:41:59 PM »
bagian sini eror
If SendMessageTimeoutString(hwnd, WM_GETTEXT, 1024, sText, SMTO_ABORTIFHUNG, 1000, 0)  :'(

Maulana_id

  • Pengunjung
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #24 pada: Mei 24, 2013, 11:31:52 AM »
Kalo error di bagian SMTO_ABORTIFHUNG tambahkan aja code ini

Public Const SMTO_ABORTIFHUNG = &H2   :)

saran dari saya pakai yg di bawah ini aja
masukan 1 textbox, 1 timer dengan interval =100
tambahkan referensi Microsoft Internet Controls

Kode: [Pilih]
'*********************************************************************
'*  Author : Maulana Yusuf [Maulana Technology Software]
'*  Facebook : facebook.com/maulanalways / facebook.com/MysoftId
'*  Twitter : @maulanayusuf_id
'*  Site : http://mysoft-id.blogspot.com
'*  Copyright (c) 2013 Maltech Soft. All rights reserved
'***********************************************************************
Private Declare Function GetForegroundWindow Lib "user32" () As Long

Public DirToScan As String
Public TmpPath As String

Private IExplorer As InternetExplorer
Private CurWnd As New ShellWindows

Private Sub Timer1_Timer()
    On Error Resume Next
    
    For Each IExplorer In CurWnd

        If IExplorer.Busy Then GoTo IEBusy
        
        If IExplorer.hWnd = GetForegroundWindow Then
            DirToScan = vbNullString
            DirToScan = ValidatePath(IExplorer.LocationURL)
            Text1.Text = DirToScan
        Else
            GoTo IEBusy
        End If
        
        If DirToScan = TmpPath Then
            GoTo IEBusy
        ElseIf DirToScan <> vbNullString Or DirToScan <> TmpPath Then
            'disini isi dengan code scan
        End If
        
IEBusy:

    Next

    TmpPath = vbNullString
    TmpPath = DirToScan

    On Error GoTo 0
End Sub
'untuk membetulkan path yg gak karuan!!
Private Function ValidatePath(ByRef sPath As String) As String
    On Error Resume Next
    Dim i As Long

    sPath = Replace(sPath, "file:///", "")
    sPath = Replace(sPath, "/", ChrW$(92))

    For i = 32 To 255
        If InStr(sPath, "%") <> 0 Then
            sPath = Replace(sPath, "%" & Hex$(i), ChrW$(i), , , vbBinaryCompare)
        End If
    Next i

    ValidatePath = sPath
End Function

« Edit Terakhir: Juni 14, 2013, 11:30:32 PM oleh maulana_id »

Offline hamaboi789

  • Pro1
  • *
  • Tulisan: 2
  • Reputation: 0
    • Lihat Profil
Re: (Share) Mendapatkan Direktory Aktif - Windows Vista & 7
« Jawab #25 pada: Januari 01, 2018, 12:14:50 PM »
;) Yup bener sekali, klo mau make kode diatas buat RTP antivirus, jangan lupa check dulu Windows yang digunakan, klo windowsnya Vista atw 7 silahkan pake kode diatas, nah klo windowsnya XP bisa pke kode di thread sebelah..  :-bd
ohh iya , kalau Ingin Check dulu Windows yang digunakan Misalnya Menggunakan punya TS , maka akan ke scan
jika memakai Windows XP berarti source berbeda dengan ts dong , nah jika Ingin di bedakan dengan Source code Windows 7 sama XP gimana yah penerapannya ?