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 www.yahoo.com ,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 612 korisnika na forumu :: 5 registrovanih, 1 sakriven i 606 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: _Rade, bato, cikadeda, JOntra, slonic_tonic