Potrebna 2 mala kod za Visual Basic 6.0.
Prikazujem rezultate 1 do 3 od 3

Tema: Potrebna 2 mala kod za Visual Basic 6.0.

  1. #1
    Login Killer
    Guest

    Podrazumevano Potrebna 2 mala kod za Visual Basic 6.0.

    Posto sam resio da napravim program za instalaciju mog programa pa mi je potreban kod za Restartovanje racunara i kod za pravljenje precice na desktop.



  2. #2
    Obećava
    Učlanjen
    08.01.2004.
    Lokacija
    Cuprija
    Poruke
    79
    Reputaciona moć
    51

    Podrazumevano Re: Potrebna 2 mala kod za Visual Basic 6.0.

    Dodaj jedan class modul i u njega ubaci ovo



    ' This module reads and writes registry keys. Unlike the
    ' internal registry access methods of VB, it can read and
    ' write any registry keys with string values.

    Option Explicit
    '---------------------------------------------------------------
    '-Registry API Declarations...
    '---------------------------------------------------------------
    Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
    Private Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByRef lpSecurityAttributes As SECURITY_ATTRIBUTES, ByRef phkResult As Long, ByRef lpdwDisposition As Long) As Long
    Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
    Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
    Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long

    '---------------------------------
    'My API Declarations and Variables
    '---------------------------------

    Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
    Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
    Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
    Private My_Windows_Path As String
    Private My_System_Path As String
    Private My_Computer_Name As String

    '---------------------------------------------------------------
    '- Registry Api Constants...
    '---------------------------------------------------------------
    ' Reg Data Types...
    Const REG_SZ = 1 ' Unicode nul terminated string
    Const REG_EXPAND_SZ = 2 ' Unicode nul terminated string
    Const REG_DWORD = 4 ' 32-bit number

    ' Reg Create Type Values...
    Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted

    ' Reg Key Security Options...
    Const READ_CONTROL = &H20000
    Const KEY_QUERY_VALUE = &H1
    Const KEY_SET_VALUE = &H2
    Const KEY_CREATE_SUB_KEY = &H4
    Const KEY_ENUMERATE_SUB_KEYS = &H8
    Const KEY_NOTIFY = &H10
    Const KEY_CREATE_LINK = &H20
    Const KEY_READ = KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS + KEY_NOTIFY + READ_CONTROL
    Const KEY_WRITE = KEY_SET_VALUE + KEY_CREATE_SUB_KEY + READ_CONTROL
    Const KEY_EXECUTE = KEY_READ
    Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
    KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
    KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL

    ' Reg Key ROOT Types...
    Const HKEY_CLASSES_ROOT = &H80000000
    Const HKEY_CURRENT_USER = &H80000001
    Const HKEY_LOCAL_MACHINE = &H80000002
    Const HKEY_USERS = &H80000003
    Const HKEY_PERFORMANCE_DATA = &H80000004

    ' Return Value...
    Const ERROR_NONE = 0
    Const ERROR_BADKEY = 2
    Const ERROR_ACCESS_DENIED = 8
    Const ERROR_SUCCESS = 0

    '---------------------------------------------------------------
    '- Registry Security Attributes TYPE...
    '---------------------------------------------------------------
    Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
    End Type

    ' The resource string will be loaded into a control's property as follows:
    ' Object Property
    ' Form Caption
    ' Menu Caption
    ' TabStrip Caption, ToolTipText
    ' Toolbar ToolTipText
    ' ListView ColumnHeader.Text

    Private Sub LoadResStrings(frm As Form)
    On Error Resume Next

    Dim ctl As Control
    Dim obj As Object

    'set the form's caption
    If IsNumeric(frm.Tag) Then
    frm.Caption = LoadResString(CInt(frm.Tag))
    End If

    'set the controls' captions using the caption
    'property for menu items and the Tag property
    'for all other controls
    For Each ctl In frm.Controls
    Err.Clear
    If TypeName(ctl) = "Menu" Then
    If IsNumeric(ctl.Caption) Then
    If Err = 0 Then
    ctl.Caption = LoadResString(CInt(ctl.Caption))
    End If
    End If
    ElseIf TypeName(ctl) = "TabStrip" Then
    For Each obj In ctl.Tabs
    Err.Clear
    If IsNumeric(obj.Tag) Then
    obj.Caption = LoadResString(CInt(obj.Tag))
    End If
    'check for a tooltip
    If IsNumeric(obj.ToolTipText) Then
    If Err = 0 Then
    obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
    End If
    End If
    Next
    ElseIf TypeName(ctl) = "Toolbar" Then
    For Each obj In ctl.Buttons
    Err.Clear
    If IsNumeric(obj.Tag) Then
    obj.ToolTipText = LoadResString(CInt(obj.Tag))
    End If
    Next
    ElseIf TypeName(ctl) = "ListView" Then
    For Each obj In ctl.ColumnHeaders
    Err.Clear
    If IsNumeric(obj.Tag) Then
    obj.Text = LoadResString(CInt(obj.Tag))
    End If
    Next
    Else
    If IsNumeric(ctl.Tag) Then
    If Err = 0 Then
    ctl.Caption = LoadResString(CInt(ctl.Tag))
    End If
    End If
    'check for a tooltip
    If IsNumeric(ctl.ToolTipText) Then
    If Err = 0 Then
    ctl.ToolTipText = LoadResString(CInt(ctl.ToolTipText))
    End If
    End If
    End If
    Next

    End Sub

    '-------------------------------------------------------------------------------------------------
    'sample usage - Debug.Print UpodateKey(HKEY_CLASSES_ROOT, "keyname", "newvalue")
    '-------------------------------------------------------------------------------------------------
    Private Function UpdateKey(KeyRoot As Long, KeyName As String, SubKeyName As String, SubKeyValue As String) As Boolean
    Dim rc As Long ' Return Code
    Dim hKey As Long ' Handle To A Registry Key
    Dim hDepth As Long '
    Dim lpAttr As SECURITY_ATTRIBUTES ' Registry Security Type

    lpAttr.nLength = 50 ' Set Security Attributes To Defaults...
    lpAttr.lpSecurityDescriptor = 0 ' ...
    lpAttr.bInheritHandle = True ' ...

    '------------------------------------------------------------
    '- Create/Open Registry Key...
    '------------------------------------------------------------
    rc = RegCreateKeyEx(KeyRoot, KeyName, _
    0, REG_SZ, _
    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, lpAttr, _
    hKey, hDepth) ' Create/Open //KeyRoot//KeyName

    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Errors...

    '------------------------------------------------------------
    '- Create/Modify Key Value...
    '------------------------------------------------------------
    If (SubKeyValue = "") Then SubKeyValue = " " ' A Space Is Needed For RegSetValueEx() To Work...

    ' Create/Modify Key Value
    rc = RegSetValueEx(hKey, SubKeyName, _
    0, REG_SZ, _
    SubKeyValue, LenB(StrConv(SubKeyValue, vbFromUnicode)))

    If (rc <> ERROR_SUCCESS) Then GoTo CreateKeyError ' Handle Error
    '------------------------------------------------------------
    '- Close Registry Key...
    '------------------------------------------------------------
    rc = RegCloseKey(hKey) ' Close Key

    UpdateKey = True ' Return Success
    Exit Function ' Exit
    CreateKeyError:
    UpdateKey = False ' Set Error Return Code
    rc = RegCloseKey(hKey) ' Attempt To Close Key
    End Function

    '-------------------------------------------------------------------------------------------------
    'sample usage - Debug.Print GetKeyValue(HKEY_CLASSES_ROOT, "COMCTL.ListviewCtrl.1\CLSID", "")
    '-------------------------------------------------------------------------------------------------
    Private Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String) As String
    Dim i As Long ' Loop Counter
    Dim rc As Long ' Return Code
    Dim hKey As Long ' Handle To An Open Registry Key
    Dim hDepth As Long '
    Dim sKeyVal As String
    Dim lKeyValType As Long ' Data Type Of A Registry Key
    Dim tmpVal As String ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long ' Size Of Registry Key Variable

    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...

    tmpVal = String$(1024, 0) ' Allocate Variable Space
    KeyValSize = 1024 ' Mark Variable Size

    '------------------------------------------------------------
    ' Retrieve Registry Key Value...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
    lKeyValType, tmpVal, KeyValSize) ' Get/Create Key Value

    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors

    tmpVal = Left$(tmpVal, InStr(tmpVal, Chr(0)) - 1)

    '------------------------------------------------------------
    ' Determine Key Value Type For Conversion...
    '------------------------------------------------------------
    Select Case lKeyValType ' Search Data Types...
    Case REG_SZ, REG_EXPAND_SZ ' String Registry Key Data Type
    sKeyVal = tmpVal ' Copy String Value
    Case REG_DWORD ' Double Word Registry Key Data Type
    For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
    sKeyVal = sKeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
    Next
    sKeyVal = Format$("&h" + sKeyVal) ' Convert Double Word To String
    End Select

    GetKeyValue = sKeyVal ' Return Value
    rc = RegCloseKey(hKey) ' Close Registry Key
    Exit Function ' Exit

    GetKeyError: ' Cleanup After An Error Has Occured...
    GetKeyValue = vbNullString ' Set Return Val To Empty String
    rc = RegCloseKey(hKey) ' Close Registry Key
    End Function

    Private Sub Get_Details_Of_This_Computer()
    Dim rc As Long
    Dim lpBuffer As String
    Dim nSize As Long
    nSize = 255
    lpBuffer = Space$(nSize)
    rc = GetWindowsDirectory(lpBuffer, nSize)
    If (rc <> 0) Then
    My_Windows_Path = Left$(lpBuffer, InStr(lpBuffer, Chr(0)) - 1)
    Else
    My_Windows_Path = ""
    End If
    lpBuffer = Space$(nSize)
    rc = GetSystemDirectory(lpBuffer, nSize)
    If (rc <> 0) Then
    My_System_Path = Left$(lpBuffer, InStr(lpBuffer, Chr(0)) - 1)
    Else
    My_System_Path = ""
    End If
    lpBuffer = Space$(nSize)
    rc = GetComputerName(lpBuffer, nSize)
    If (rc <> 0) Then
    My_Computer_Name = Left$(lpBuffer, InStr(lpBuffer, Chr(0)) - 1)
    Else
    My_Computer_Name = ""
    End If
    End Sub

    Private Sub Class_Initialize()
    Get_Details_Of_This_Computer
    End Sub

    Public Sub Shutdown_the_Computer()
    If IsThisNT = 1 Then 'win9x
    ExitWindowsEx 1, 0
    ElseIf IsThisNT = 2 Then 'XP
    Shell My_System_Path & "\tsshutdn.exe 00 /SERVER:" & My_Computer_Name & " /POWERDOWN /DELAY:00", vbHide
    Else 'NT,2000,2003
    MsgBox "Still I don't know how to shutdown a NT, 2000 or 2003 Operating System", vbInformation, "Sorry!"
    End If
    End Sub
    Public Sub Restart_the_Computer()
    If IsThisNT = 1 Then 'win9x
    ExitWindowsEx 2, 0
    ElseIf IsThisNT = 2 Then 'XP
    Shell My_System_Path & "\shutdown.exe -r -f -t 00", vbNormalFocus
    Else 'NT,2000,2003
    MsgBox "Still I don't know how to restart a NT, 2000 or 2003 Operating System", vbInformation, "Sorry!"
    End If
    End Sub
    Public Sub Log_Off()
    If IsThisNT = 1 Then 'win9x
    ExitWindowsEx 0, 0
    ElseIf IsThisNT = 2 Then 'XP
    Shell My_System_Path & "\shutdown.exe -l -f -t 00", vbNormalFocus
    'Shell My_System_Path & "\logoff.exe",vbNormalFocus can also log off a user from Windows XP
    Else 'NT,2000,2003
    MsgBox "Still I don't know how to log-off a user from NT, 2000 or 2003 Operating System", vbInformation, "Sorry!"
    End If
    End Sub
    Private Function IsThisNT() As Integer
    If (GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows NT\CurrentVersion", "ProductName") = "") Then
    IsThisNT = 1 ' win9x
    ElseIf (GetKeyValue(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows NT\CurrentVersion", "ProductName") = "Microsoft Windows XP") Then
    IsThisNT = 2 'XP
    Else
    IsThisNT = 3
    End If
    End Function









    U command butonu ili sta vec ubaci ovo


    OLM.Restart_the_Computer

    Za shut down ti je

    OLM.Shutdown_the_Computer



    Za log off je

    OLM.Log_Off

    Pozdrav!!!!

  3. #3
    Obećava
    Učlanjen
    08.01.2004.
    Lokacija
    Cuprija
    Poruke
    79
    Reputaciona moć
    51

    Podrazumevano Re: Potrebna 2 mala kod za Visual Basic 6.0.

    Zasto se mucis imas na netu koliko hoces programa za pravljnje instalacija
    Imas i ovde na krstarici/sowtware
    Potrazi malo nacices sigurno

    Ako ti nesto zatrebu u medjuvremenu poseti www.freevbcode.com imas svega i svacega

    Pozdrav
    Srecno!!!

Slične teme

  1. Visual Basic
    Autor M_ilan u forumu Programiranje
    Odgovora: 1
    Poslednja poruka: 14.02.2007., 13:41
  2. Visual Basic
    Autor BIVSI ZEKEN u forumu Programiranje
    Odgovora: 37
    Poslednja poruka: 24.12.2006., 13:23
  3. mala pomoc za visual basic
    Autor ksauyit u forumu Programiranje
    Odgovora: 20
    Poslednja poruka: 03.01.2006., 21:08
  4. Visual Basic 5.0
    Autor nidzesi u forumu Softver
    Odgovora: 1
    Poslednja poruka: 07.05.2005., 20:16
  5. VISUAL BASIC
    Autor u forumu Programiranje
    Odgovora: 4
    Poslednja poruka: 14.02.2004., 12:40

Pravila za slanje poruka

  • Ne možete kreirati novu temu
  • Ne možete poslati odgovor
  • Ne možete dodati priloge
  • Ne možete prepraviti svoju poruku
  •