[ deniah @ 03.09.2009. 21:13 ] @
Dali postoji neki nacin da utvrdim koji je difolt program za .txt fajlove na sistemu a da ne ide preko provjere u registru? |
[ deniah @ 03.09.2009. 21:13 ] @
[ Aleksandar Ružičić @ 03.09.2009. 21:55 ] @
ako neces da citas iz registrija (a ne vidim zasto ne bi) imas sijaset drugih nacina, recimo mozes da napises kod koji ce da pozove ShellExecute nekog txt fajla sto ce da otvori taj fajl u default editoru, onda mozes da uhvatis screenshot i da koristis OCR metode da iscupas naziv programa iz njegovog titlebara...
[ Eurora3D Team @ 04.09.2009. 01:31 ] @
U , al si mu dao predlog :) , moze uz to sve da ide i neka muzika ... :)
Mozes da npr. pronadjes koji su procesi aktivni pre i posle ShellExecute , ili jos bolje koji su prozori i sa kojim naslovima aktivni ... mada, ovo su sve indirektni nacini. Zasto nebi citao registre kad ih i windows cita svaki put kad se klikne na fajl ... [ Marko_L @ 04.09.2009. 11:53 ] @
Pa možeš i preko FindExecutable API funkcije, recimo ovako nešto (ovo će raditi za bilo koju ekstenziju)
Code: Const MAX_FILENAME_LEN = 260 Private Declare Function FindExecutable Lib "shell32.dll" _ Alias "FindExecutableA" (ByVal lpFile As String, _ ByVal lpDirectory As String, ByVal lpResult As String) As Long Private Function GetDefaultApp(sFilePath As String) As String If Dir(sFilePath) = "" Or sFilePath = "" Then GetDeafaultApp = "" MsgBox "Ne postoji fajl", vbCritical Exit Function End If Dim I As Integer Dim sText As String sText = String(MAX_FILENAME_LEN, 32) I = FindExecutable(sFilePath, vbNullString, sText) If I > 32 Then GetDefaultApp = Left$(sText, InStr(sText, Chr$(0)) - 1) Else GetDefaultApp = "" MsgBox "Ovaj fajl nije asociran ni sa jednim programom", vbInformation End If End Function a onda pozivaš funkciju sa putanjom do fajla za koji hoćeš da vidiš sa čime se otvara po defaultu. Recimo za text fajl Code: Dim sResult As String sResult = GetDefaultApp("C:\proba.txt") If sResult = "" Then Exit Sub 'ako nije doslo do greske, sada imamo putanju 'do default aplikacije u varijabli sResult MsgBox sResult Naravno, da bi ovo, mora da postoji fajl preko koga si tražio default program, u ovom slučaju proba.txt na C disku. Mada, uvek možeš da iskoristiš trik, recimo napraviš na C disku fajl koji se zove ovojesamozaproveru.txt i uvek preko njega proveravaš :) Naravno, ovo važi samo u slučaju da proveravaš jednu ekstenziju... u suprotnom bi morao da imaš gomilu fajlova na C. [ Marko_L @ 04.09.2009. 12:08 ] @
E sad mi pade napamet kako ovo može elegantno da se reši bez ostavljanja lažnog fajla na C disku i da radi sa bilo kojom ekstenzijom. Izmenimo funkciju tako da ona prvo napravi lažni fajl sa željenom ekstenzijom, nađe default aplikaciju i onda ga obriše... prosto i jednostavno.
Code: Private Function GetDefaultApp(sExtension As String) As String Dim fn As Integer Dim I As Integer Dim sFilePath As String Dim sText As String sFilePath = "C:\ovojesamozaproveru." & sExtension fn = FreeFile Open sFilePath For Output As #fn Print #fn, "blablabla" Close #fn sText = String(MAX_FILENAME_LEN, 32) I = FindExecutable(sFilePath, vbNullString, sText) If I > 32 Then GetDefaultApp = Left$(sText, InStr(sText, Chr$(0)) - 1) Else GetDefaultApp = "" MsgBox "Ovaj fajl nije asociran ni sa jednim programom", vbInformation End If Kill sFilePath End Function I onda je pozivamo na isti način samo što umesto putanje do nekog fajla, prosleđujemo željenu ekstenziju. Recimo za text fajl Code: Dim sResult As String sResult = GetDefaultApp("txt") If sResult = "" Then Exit Sub MsgBox sResult za bitmape bi bilo Code: sResult = GetDefaultApp("bmp") itd. Mislim, znam da nije ovo traženo, ali možda nekome bude od koristi. [ dava @ 04.09.2009. 16:39 ] @
Evo jos jedno rjesenje:
Komanda za command prompt assoc .txt vraca default-ni program za otvaranje date extenzije. Ti iz svog programa odvalis ovu komandu: Citat: Shell "cmd /k assoc .txt > d:\1 & exit" > d:\1 ovo je reditrkcija odgovora u fajl sa imenom 1 kojeg ce kreirati na d: & exit ovo je komanda da zatvori cmd prozor Znaci dobices odgovor u fajlu d:\1 i sve sto trebas je da ga procitas, a on kod mene izgleda ovako: .txt=Ultraedit.txt Mozes uraditi i da se odgovor vraca direktno tvom programu. [ Marko_L @ 04.09.2009. 19:46 ] @
E da, i to je ok rešenje, bavo dava. Mi Windows programeri ponekad zaboravljamo na surovu moć konzole :)
Samo jedna stvar, umesto Code: Shell "cmd /k assoc .txt > d:\1 & exit" koristite Code: Shell "cmd /k assoc .txt > d:\1" & "&" & "exit" Da me ubiješ ne znam zašto, ali ovo prvo ne radi na nekim mašinama. [ Shadowed @ 04.09.2009. 19:51 ] @
Mozes i da preusmeris izlaz konzole u svoj program pa izbegnes pravljenje tog izlaznog fajla. Ima negde na forumu objasnjenje, pisao je ranije mladenovicz.
[ dava @ 04.09.2009. 20:54 ] @
Marko_L primjetio sam nekada/negdje da zeza, ali sad sam se sjetio da sam negdje vidjeo ovako:
Code: Shell "cmd /c assoc .txt > d:\1" Vjerovatno je ovo c close ili tako nesto. Evo redirekcija: Code: ' Module Option Explicit Private Declare Function CreatePipe Lib "kernel32" (phReadPipe As Long, phWritePipe As Long, lpPipeAttributes As _ SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO) Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, _ ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, _ ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, _ lpProcessInformation As PROCESS_INFORMATION) As Long Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, _ lpNumberOfBytesRead As Long, lpOverlapped As Any) As Long 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type Private Type PROCESS_INFORMATION hProcess As Long hThread As Long dwProcessId As Long dwThreadId As Long End Type Private Type STARTUPINFO cb As Long lpReserved As Long lpDesktop As Long lpTitle As Long dwX As Long dwY As Long dwXSize As Long dwYSize As Long dwXCountChars As Long dwYCountChars As Long dwFillAttribute As Long dwFlags As Long wShowWindow As Integer cbReserved2 As Integer lpReserved2 As Byte hStdInput As Long hStdOutput As Long hStdError As Long End Type Private Type OVERLAPPED ternal As Long ternalHigh As Long offset As Long OffsetHigh As Long hEvent As Long End Type Private Const STARTF_USESHOWWINDOW = &H1 Private Const STARTF_USESTDHANDLES = &H100 Private Const SW_HIDE = 0 Private Const EM_SETSEL = &HB1 Private Const EM_REPLACESEL = &HC2 Public Function Redirect(cmdLine As String, objTarget As Object) Dim pa As SECURITY_ATTRIBUTES Dim pra As SECURITY_ATTRIBUTES Dim tra As SECURITY_ATTRIBUTES Dim pi As PROCESS_INFORMATION Dim sui As STARTUPINFO Dim hRead As Long Dim hWrite As Long Dim bRead As Long Dim lpBuffer(1024) As Byte Dim i%, t$ pa.nLength = Len(pa) pa.lpSecurityDescriptor = 0 pa.bInheritHandle = True pra.nLength = Len(pra) tra.nLength = Len(tra) If CreatePipe(hRead, hWrite, pa, 0) <> 0 Then sui.cb = Len(sui) GetStartupInfo sui sui.hStdOutput = hWrite sui.hStdError = hWrite sui.dwFlags = STARTF_USESHOWWINDOW Or STARTF_USESTDHANDLES sui.wShowWindow = SW_HIDE If CreateProcess(vbNullString, cmdLine, pra, tra, True, 0, Null, vbNullString, sui, pi) <> 0 Then SetWindowText objTarget.hwnd, "" Do Erase lpBuffer() If ReadFile(hRead, lpBuffer(0), 1023, bRead, ByVal 0&) Then SendMessage objTarget.hwnd, EM_SETSEL, -1, 0 SendMessage objTarget.hwnd, EM_REPLACESEL, False, lpBuffer(0) Redirect = objTarget DoEvents Else CloseHandle pi.hThread CloseHandle pi.hProcess Exit Do End If CloseHandle hWrite Loop CloseHandle hRead End If End If End Function A sa forme pozivas: Code: Rezultat = Redirect(komanda, Text1) [ Aleksandar Ružičić @ 04.09.2009. 22:01 ] @
ali ja i dalje ne vidim zasto se to ne bi procitalo iz registrija...
@eurora: bio sam sarkastican :) [ deniah @ 04.09.2009. 23:42 ] @
Hvala svima na odgovorima. Pisem program koji ima ugradjen tekst editor, ali sam ostavio mogucnost da se po zelji koristi difolt tekst editor ili da se precizira neki treci.
Najvjerovatnije cu ici preko registra. [ Eurora3D Team @ 05.09.2009. 16:12 ] @
Citat: Aleksandar Ružičić: ali ja i dalje ne vidim zasto se to ne bi procitalo iz registrija... @eurora: bio sam sarkastican :) Znam :) @deniah ljudi ovoliko ispisase a ti sad preko registara ... Evo kod za citanje preko registara. Testirao sam na WinXP-u Code: Const HKEY_CLASSES_ROOT = &H80000000 Const ERROR_SUCCESS = 0& Const REG_SZ = 1 Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Sub Command1_Click() Dim hKey As Long Dim lResult As Long Dim strBuf As String, strVal As String Dim lDataBufSize As Long strVal = ".txt" For i = 1 To 2 If Not ERROR_SUCCESS = RegOpenKey(HKEY_CLASSES_ROOT, strVal, hKey) Then GoTo err lDataBufSize = 260 strBuf = String(lDataBufSize, " ") If Not ERROR_SUCCESS = RegQueryValueEx(hKey, "", 0&, 0&, ByVal strBuf, lDataBufSize) Then GoTo err If lDataBufSize < 1 Then GoTo err strBuf = Left(strBuf, lDataBufSize - 1) RegCloseKey hKey strVal = strBuf & "\shell\open\command" Next MsgBox strBuf, vbInformation ' u strBuff je komandna linija kojom se otvaraju txt fajlovi Exit Sub err: MsgBox "Greska" End Sub [Ovu poruku je menjao Eurora3D Team dana 05.09.2009. u 18:04 GMT+1] [ deniah @ 05.09.2009. 19:04 ] @
Citat: Da, u pravu si. Ipak ispade da je tako najlakse. [ Eurora3D Team @ 06.09.2009. 00:59 ] @
Izgleda da jeste. Jedino obrati paznju da iz mog koda dobijes kao rezultat celu komandnu liniju (cije je notepad.exe samo jedan deo) tako da ces morati da je parsiras da bi dobio samo ime programa.
Copyright (C) 2001-2024 by www.elitesecurity.org. All rights reserved.
|