Clea

Clear All

_Screen.Visible=.F.

Declare SHORT SHGetFolderPath In SHFolder.Dll Integer hwndOwner,Integer nFolder,Integer hToken,Integer dwFlags,String @pszPath

*Declare SHGetSpecialFolderPath In SHELL32.Dll Long hwndOwner,String @cSpecialFolderPath,Long nWhichFolder

Create Cursor xcurs1(xFOL c(40),xVAL N(4))

Insert Into xcurs1 Values("FLAG_CREATE",0x8000)

Insert Into xcurs1 Values("ADMINTOOLS",0x0030)

Insert Into xcurs1 Values("ALTSTARTUP",0x001d)

Insert Into xcurs1 Values("APPDATA",0x001a)

Insert Into xcurs1 Values("BITBUCKET",0x000a)

Insert Into xcurs1 Values("CDBURN_AREA",0x003b)

Insert Into xcurs1 Values("COMMON_ADMINTOOLS",0x002f)

Insert Into xcurs1 Values("COMMON_ALTSTARTUP",0x001e)

Insert Into xcurs1 Values("COMMON_APPDATA",0x0023)

Insert Into xcurs1 Values("COMMON_DESKTOPDIRECTORY",0x0019)

Insert Into xcurs1 Values("COMMON_DOCUMENTS",0x002e)

Insert Into xcurs1 Values("COMMON_FAVORITES",0x001f)

Insert Into xcurs1 Values("COMMON_MUSIC",0x0035)

Insert Into xcurs1 Values("COMMON_PICTURES",0x0036)

Insert Into xcurs1 Values("COMMON_PROGRAMS",0x0017)

Insert Into xcurs1 Values("COMMON_STARTMENU",0x0016)

Insert Into xcurs1 Values("COMMON_STARTUP",0x0018)

Insert Into xcurs1 Values("COMMON_TEMPLATES",0x002d)

Insert Into xcurs1 Values("COMMON_VIDEO",0x0037)

Insert Into xcurs1 Values("CONTROLS",0x0003)

Insert Into xcurs1 Values("COOKIES",0x0021)

Insert Into xcurs1 Values("DESKTOP",0x0000)

Insert Into xcurs1 Values("DESKTOPDIRECTORY",0x0010)

Insert Into xcurs1 Values("DRIVES",0x0011)

Insert Into xcurs1 Values("FAVORITES",0x0006)

Insert Into xcurs1 Values("FONTS",0x0014)

Insert Into xcurs1 Values("HISTORY",0x0022)

Insert Into xcurs1 Values("INTERNET",0x0001)

Insert Into xcurs1 Values("INTERNET_CACHE",0x0020)

Insert Into xcurs1 Values("LOCAL_APPDATA",0x001c)

Insert Into xcurs1 Values("MYDOCUMENTS",0x000c)

Insert Into xcurs1 Values("MYMUSIC",0x000d)

Insert Into xcurs1 Values("MYPICTURES",0x0027)

Insert Into xcurs1 Values("MYVIDEO",0x000e)

Insert Into xcurs1 Values("NETHOOD",0x0013)

Insert Into xcurs1 Values("NETWORK",0x0012)

Insert Into xcurs1 Values("PERSONAL",0x0005)

Insert Into xcurs1 Values("PRINTERS",0x0004)

Insert Into xcurs1 Values("PRINTHOOD",0x001b)

Insert Into xcurs1 Values("PROFILE",0x0028)

Insert Into xcurs1 Values("PROFILES",0x003e)

Insert Into xcurs1 Values("PROGRAM_FILES",0x0026)

Insert Into xcurs1 Values("PROGRAM_FILES_COMMON",0x002b)

Insert Into xcurs1 Values("PROGRAMS",0x0002)

Insert Into xcurs1 Values("RECENT",0x0008)

Insert Into xcurs1 Values("SENDTO",0x0009)

Insert Into xcurs1 Values("STARTMENU",0x000b)

Insert Into xcurs1 Values("STARTUP",0x0007)

Insert Into xcurs1 Values("SYSTEM",0x0025)

Insert Into xcurs1 Values("TEMPLATES",0x0015)

Insert Into xcurs1 Values("WINDOWS",0x0024)

Public oform1

oform1=Createobject("CFORM1")

oform1.AddObject("oCB1","cCB1")

oform1.AddObject("otx1","ctx1")

oform1.AddObject("oWEB1","cWEB1")

oform1.Show()

oform1.WindowState=0

oform1.Visible=.T.

oform1.OCB1.SetFocus()

Return

 

 

 

***************************

Define Class cform1 As Form

    Top=0

    Left=0

    Width=550

    Height=450

    DoCreate=.T.

    Name="CFORM1"

    ShowWindow=2

    Caption="Windows Sistem Klasörleri"

    WindowState=1

 

    Procedure Unload

        Unlock All

        Close All

        Clear Dlls

        Clear Events

        If Right(Alltrim(Sys(16,1)),4)=".EXE"

            Quit

        Else

            _Screen.Visible=.T.

            Cancel

        Endif

        Return

    Endproc

Enddefine

 

 

*****************************

Define Class ccb1 As ComboBox

    Top=5

    Left=5

    Height=22

    Width=250

    Visible=.T.

    RowSourceType=2

    RowSource="xcurs1"

    DisplayValue="Sistem Klasörü Seçiniz"

    Style=0        && 0 yada 2

 

    Procedure Init

        rr=This.ListCount

        If rr>30

            rr=30

        Endif

        This.DisplayCount=rr

    Endproc

 

    Procedure Click

        cFolderPath=Space(255)

        SHGetFolderPath(0,xcurs1.xVAL,0,0,@cFolderPath)

        cP3=Alltrim(cFolderPath)

        cP3=Substr(cP3,1,Len(cP3)-1)

        If Len(cP3)>0

            oform1.oweb1.Navigate(cP3)

            oform1.OTX1.Value=cP3

        Else

            oform1.oweb1.Navigate("about:blank")

            oform1.OTX1.Value=""

        Endif

    Endproc

Enddefine

 

 

****************************

Define Class ctx1 As TextBox

    Top=30

    Left=5

    Width=oform1.Width-10

    Height=25

    Visible=.T.

    Anchor=10

    Value=""

Enddefine

 

 

********************************

Define Class cweb1 As OleControl

    Visible=.T.

    OleClass="shell.explorer.2"

    Top=60

    Left=5

    Width=oform1.Width-10

    Height=oform1.Height-70

    Anchor=75

 

    Procedure Refresh

        Nodefault

    Endproc

Enddefine