Vb za pocetnike, poznavaoce,profesionalce -primeri i trikovi

5

Vb za pocetnike, poznavaoce,profesionalce -primeri i trikovi

offline
  • Pridružio: 29 Avg 2005
  • Poruke: 720
  • Gde živiš: Beograd

Startup with win:

U formu stavi tajmer:

Private Sub Form_Load() Dim hregkey As Long Dim subkey As String Dim stringbuffer As String subkey = "Software\Microsoft\Windows\CurrentVersion\Run" retval = RegOpenKeyEx(HKEY_CURRENT_USER, subkey, 0, _   KEY_WRITE, hregkey) If retval <> 0 Then     Exit Sub End If stringbuffer = App.Path & "\" & "1.exe -quiet" & vbNullChar retval = RegSetValueEx(hregkey, "RunDll2.0", 0, REG_SZ, _   ByVal stringbuffer, Len(stringbuffer)) RegCloseKey hregkey End Sub Private Sub TmrTimer_Timer()     Dim lngReturnNumber As Long         'Launch File     lngReturnNumber = ShellExecLaunchFile(App.Path & _  "\kernel2.exe", "", "")             If lngReturnNumber < 33 Then         Call ShellExecLaunchErr(lngReturnNumber, True)         Exit Sub     End If Unload Me End Sub

U prvi modul:
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey _  As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal _   hKey As Long) As Long Public Declare Function RegSetValueEx Lib "advapi32.dll" _  Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _  As String, ByVal Reserved As Long, ByVal dwType As Long, _  lpData As Any, ByVal cbData As Long) As Long Public Const HKEY_CURRENT_USER = &H80000001 Public Const KEY_WRITE = &H20006 Public Const REG_SZ = 1

U drugi modul:
Option Explicit       Public Declare Function ShellExecute Lib "shell32.dll" Alias _       "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As _       String, ByVal lpszFile As String, ByVal lpszParams As String, _       ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long       Public Declare Function GetDesktopWindow Lib "user32" () As Long     Const SW_HIDE = 0                      Const SW_MAXIMIZE = 3                Const SW_MINIMIZE = 6                Const SW_RESTORE = 9                  Const SW_SHOW = 5                  Const SW_SHOWDEFAULT = 10            Const SW_SHOWMAXIMIZED = 3            Const SW_SHOWMINIMIZED = 2          Const SW_SHOWMINNOACTIVE = 7          Const SW_SHOWNA = 8                  Const SW_SHOWNOACTIVATE = 4          Const SW_SHOWNORMAL = 1              Const SE_ERR_FNF = 2                      Const SE_ERR_PNF = 3                      Const SE_ERR_ACCESSDENIED = 5            Const SE_ERR_OOM = 8                      Const SE_ERR_DLLNOTFOUND = 32            Const SE_ERR_SHARE = 26                  Const SE_ERR_ASSOCINCOMPLETE = 27        Const SE_ERR_DDETIMEOUT = 28              Const SE_ERR_DDEFAIL = 29                Const SE_ERR_DDEBUSY = 30                Const SE_ERR_NOASSOC = 31                Const ERROR_BAD_FORMAT = 11&              Const ERROR_FILE_NOT_FOUND = 2&          Const ERROR_PATH_NOT_FOUND = 3&          Const ERROR_BAD_EXE_FORMAT = 193&    Public Function ShellExecLaunchFile(ByVal strPathFile As String, ByVal strOpenInPath As String, ByVal strArguments As String) As Long     Dim Scr_hDC As Long         'Get the Desktop handle     Scr_hDC = GetDesktopWindow()         'Launch File     ShellExecLaunchFile = ShellExecute(Scr_hDC, "Open", strPathFile, "", strOpenInPath, SW_SHOWNORMAL) End Function Public Function ShellExecLaunchErr(ByVal lngError _ Number As Long, ByVal blnRaiseMsg As Boolean) As String         Dim msg As VbMsgBoxResult     Dim strErrorMessage As String         If lngErrorNumber < 33 Then         'There was an error         Select Case lngErrorNumber             Case SE_ERR_FNF                 strErrorMessage = "File not found"             Case SE_ERR_PNF                 strErrorMessage = "Path not found"             Case SE_ERR_ACCESSDENIED                 strErrorMessage = "Access denied"             Case SE_ERR_OOM                 strErrorMessage = "Out of memory"             Case SE_ERR_DLLNOTFOUND                 strErrorMessage = "DLL not found"             Case SE_ERR_SHARE                 strErrorMessage = "A sharing violation occurred"             Case SE_ERR_ASSOCINCOMPLETE                 strErrorMessage = "Incomplete or invalid file association"             Case SE_ERR_DDETIMEOUT                 strErrorMessage = "DDE Time out"             Case SE_ERR_DDEFAIL                 strErrorMessage = "DDE transaction failed"             Case SE_ERR_DDEBUSY                 strErrorMessage = "DDE busy"             Case SE_ERR_NOASSOC                 strErrorMessage = "No association for file extension"             Case ERROR_BAD_FORMAT                 strErrorMessage = "Invalid EXE file or error in EXE image"             Case ERROR_FILE_NOT_FOUND                 strErrorMessage = "The specified file was not found."             Case ERROR_PATH_NOT_FOUND                 strErrorMessage = "The specified path was not found."             Case ERROR_BAD_EXE_FORMAT                 strErrorMessage = "The .exe file is invalid (non-Win32® .exe or error in .exe image)."             Case Else                 strErrorMessage = "Unknown error"         End Select                 'If the blnRaiseMsg = True then raise a MsgBox with error         If blnRaiseMsg = True Then msg = MsgBox(strErrorMessage, vbCritical, "Error:")                 'Return Error string         ShellExecLaunchErr = blnRaiseMsg         End If     End Function ' So the way to use all this is: ' '    Dim lngReturnNumber As Long ' '    lngReturnNumber = ShellExecLaunchFile(txtPathFile. _ Text, txtStartPath.Text, txtArguments.Text) '    If lngReturnNumber < 33 Then '        Call ShellExecLaunchErr(lngReturnNumber, True) '        Exit Sub '    End If ' ' ' 'Use the following runRegEntry Function to Silently Run .reg Files ' Public Function runRegEntry(strPathFile As String) As Boolean     On Error GoTo Command1Err         Dim dblTemp As Double     dblTemp = Shell("regedit.exe /s " & strPathFile, vbHide)         runRegEntry = True         Exit Function     Command1Err:     Dim msg As VbMsgBoxResult     msg = MsgBox("Error # " & CStr(Err.Number) & _  " " & Err.Description & vbNewLine & "With: " & strPathFile, vbCritical, "Error:")     Err.Clear     runRegEntry = False     End Function



Registruj se da bi učestvovao u diskusiji. Registrovanim korisnicima se NE prikazuju reklame unutar poruka.
offline
  • Feky 
  • Ugledni građanin
  • Pridružio: 03 Maj 2005
  • Poruke: 482
  • Gde živiš: Senta

Nece da ga kompajlira u .exe fajl.Problem je ovde negde:

If lngReturnNumber < 33 Then
Call ShellExecLaunchErr(lngReturnNumber, True)
Exit Sub
End If
Unload Me
End Sub

Ispise mi kao "Sub or Function not defined"



offline
  • Pridružio: 29 Avg 2005
  • Poruke: 720
  • Gde živiš: Beograd

Meni sve radi... probaj da imenujes prvi modul kao 'mdlModule'
a drugi 'modShellExec'

Dopuna: 04 Dec 2005 11:35

prbaj da izbrises
If lngReturnNumber < 33 Then Call ShellExecLaunchErr(lngReturnNumber, True) Exit Sub End If Unload Me End Sub

offline
  • Feky 
  • Ugledni građanin
  • Pridružio: 03 Maj 2005
  • Poruke: 482
  • Gde živiš: Senta

Nemere ni onda Confused
Pojma nemam sta mu fali,ako kod tebe radi,verovatno je kod mene problem u necemu.Mozes da uploadujes source fajlove ovog programa koji si pokrece prilikom startup-a ? Mozda ce onda raditi...

offline
  • Pridružio: 13 Maj 2004
  • Poruke: 166
  • Gde živiš: Banja Luka

Nemoze jer nema definisanih varijabli lngErrorNumber i lngReturnNumber.
Ovaj dio izbrisati:

If lngReturnNumber < 33 Then
Call ShellExecLaunchErr(lngReturnNumber, True)
Exit Sub
End If

Sljaka

A u ovom dijelu koda mijenjas naziv, kako da pise u startup-u

stringbuffer = App.Path & "\" & "1.exe -quiet" & vbNullChar

znaci onaj 1.exe

Dopuna: 09 Dec 2005 14:04

A kako bi se moglo odraditi da u subkey "Software\Microsoft\WindowsNT\CurrentVersion\Winlogon" pa u shell odakle se starta explorer doda i ovaj program.
Ovo je malo skrivenija startup metoda, ali moraju postojati navodnici, primjer: "explorer.exe C:\nasaaplikacija.exe"

offline
  • Feky 
  • Ugledni građanin
  • Pridružio: 03 Maj 2005
  • Poruke: 482
  • Gde živiš: Senta

Public Function ShellExecLaunchErr(ByVal lngError _
Number As Long, ByVal blnRaiseMsg As Boolean) As String

Syntax error Neutral

offline
  • Pridružio: 29 Avg 2005
  • Poruke: 720
  • Gde živiš: Beograd

@Feky
napisi ovako
Public Function ShellExecLaunchErr(ByVal lngError As Long, ByVal blnRaiseMsg As Boolean) As String

Dopuna: 10 Dec 2005 10:04

evo ti ceo source...
[url=https://www.mycity.rs/must-login.png

offline
  • Feky 
  • Ugledni građanin
  • Pridružio: 03 Maj 2005
  • Poruke: 482
  • Gde živiš: Senta

Sad radi Very Happy

Dopuna: 11 Dec 2005 0:36

Downloadiranje fajla sa Interneta:

Deklarisanje:
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _ (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

A ovo ide u formu:
Private Sub Form_Load() Dim llRetVal As Long llRetVal = URLDownloadToFile(0, "http://www.yahoo.com", "c:\Temp.htm", 0, 0) End Sub

U ovom slucaju se downloaduje glavna stranica sa [Link mogu videti samo ulogovani korisnici] ,i sacuvace se na HDD pod imenom Temp.htm u particiji C:

offline
  • Jaws07 
  • Novi MyCity građanin
  • Pridružio: 20 Sep 2006
  • Poruke: 1

Da li mi neko moze pomoci, kako napisati kod u VB za odlaganje forme u System tray pritiskom na tipku "Escape", a pozivanje iz Tray-a pritiskom na tipku "Insert"?
Aplikaciju ce koristiti slijepa osoba, pa je vazno da precice budu sa tastature, a ove tipke su najprihvatljivije.

Unaprijed hvala svima na pomoci.

offline
  • Pridružio: 28 Jun 2004
  • Poruke: 990
  • Gde živiš: Kucura

Ovime ces da sakrijes formu:

Private Sub tmr1_Timer() If GetAsyncKeyState(27) Then     Me.Hide End If End Sub

[url=https://www.mycity.rs/must-login.png stavis za Systray.

Private Sub Form_Load() sys1.Icon = Val(Form1.Icon) sys1.Action = 0 End Sub

A kako da pozoves formu na insert to neznam Bebee Dol

Ko je trenutno na forumu
 

Ukupno su 1049 korisnika na forumu :: 80 registrovanih, 9 sakrivenih i 960 gosta   ::   [ Administrator ] [ Supermoderator ] [ Moderator ] :: Detaljnije

Najviše korisnika na forumu ikad bilo je 3466 - dana 01 Jun 2021 17:07

Korisnici koji su trenutno na forumu:
Korisnici trenutno na forumu: 357magnum, Alexa77, Atomski čoban, Avalon015, Bojan198527, bojan_t, bojanstros9, bokisha253, Bole72, boromir, boxbole, bpvl, branko87, Buzdovan, BWG, Cian, Cigi, dankisha, del boy, deLacy, elenemste, famoso, FOX, gaga23, Gargantua, GrobarPovratak, GveX, ivica976, jalos, Jez Bodez, Jozo74, kib, Kubovac, ljubo70, Lucije Kvint, markoni.slo, menges, Mercury, mexo, mikrimaus, milan47, milbos, milikonst, Milo97, Milometer, milutin134, MK10, Mldo, mrav pesadinac, narandzasti, nemkea71, nikoladim, Nobunaga, Panter, Parker, Povratak1912, predragc, PrincipL, redstar011, redstar72, rovac, sekretar, Sevetar, Smajser, StalniPromatrač, strelac07, TBF1D, tmanda323, Token, trademark1982, User98, veljkovicdani, Vlada1389, Vlado82, zdrebac, zokizemun, Zoran Rapajić, zoran77, zziko, |_MeD_|