Solved

.jpg file in image software

Posted on 2001-09-01
8
517 Views
Last Modified: 2012-08-13
how can i open a .jpg file (which displayed in picture box or image control) on double clicking to open in this file in photoshop or paintbrush etc. and after edit the file back to vb form .
0
Comment
Question by:sar1478
8 Comments
 
LVL 4

Accepted Solution

by:
wileecoy earned 50 total points
ID: 6448413
The basic premise is that you use the file association in windows (found in the registry) to open the default application and load the jpg.

Then, after saving and closing the application (probably a shell command and wait for completion) you would simply reload the jpg file and it would reload the updated file.

Another option would be to double click on it and offer the user the "Open With" windows dialog box and let them select what application to use.  It might also be easier to load the file.

If this is the type of solution you are looking for, just hell and I will see what I can do.

hth.

Wileecoy.
0
 
LVL 4

Expert Comment

by:wileecoy
ID: 6448519
Okay - I didn't wait for you to let me know if that is what you wanted.  It interesting - so here it is.

Save the text from the following message into a file and name it "WhatEverYouWant.frm".

Start a new standard project.
Add components:
1.  Windows Common Dialog Controls
2.  Windows Common Controls

Remove the existing empty form (Form1)
Add the "WhatEverYouWant.frm"
press F5 - you will get an error about the startup.
Change the startup to your form in the dialog box that pops up with the error.

There are instructions on a label on the form.

It works on mine - hope it works on yours.

0
 
LVL 4

Expert Comment

by:wileecoy
ID: 6448520
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmAssoUtil
   Caption         =   "File Association Utility"
   ClientHeight    =   8832
   ClientLeft      =   1140
   ClientTop       =   1500
   ClientWidth     =   7692
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   8832
   ScaleWidth      =   7692
   Begin VB.PictureBox Picture1
      Height          =   2136
      Left            =   144
      ScaleHeight     =   2088
      ScaleWidth      =   7380
      TabIndex        =   12
      Top             =   2520
      Width           =   7428
   End
   Begin MSComctlLib.ListView lvwAsso
      Height          =   3960
      Left            =   108
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   4788
      Width           =   7488
      _ExtentX        =   13208
      _ExtentY        =   6985
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      FullRowSelect   =   -1  'True
      GridLines       =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.CommandButton Command2
      Caption         =   "Find JPG"
      Height          =   300
      Left            =   6588
      TabIndex        =   9
      Top             =   2160
      Width           =   876
   End
   Begin VB.CommandButton Command1
      Caption         =   "Open Application"
      Height          =   300
      Left            =   4212
      TabIndex        =   8
      Top             =   1188
      Width           =   3252
   End
   Begin VB.TextBox Text1
      Height          =   288
      Index           =   3
      Left            =   108
      TabIndex        =   7
      Top             =   2160
      Width           =   6456
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   2
      Left            =   108
      TabIndex        =   6
      Top             =   1656
      Width           =   7356
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   1
      Left            =   2160
      TabIndex        =   5
      Top             =   1188
      Width           =   2028
   End
   Begin VB.TextBox Text1
      Enabled         =   0   'False
      Height          =   288
      Index           =   0
      Left            =   108
      TabIndex        =   4
      Top             =   1188
      Width           =   2028
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   72
      Top             =   2412
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "Exit"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1260
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   72
      Width           =   1005
   End
   Begin VB.CommandButton cmdList
      Caption         =   "List"
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   7.8
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   108
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   72
      Width           =   1005
   End
   Begin VB.Label lblMessage
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   216
      Left            =   2592
      TabIndex        =   11
      Top             =   108
      Width           =   60
   End
   Begin VB.Label Label1
      Caption         =   "Enter path of JPG file below, or find by clicking ""Find JPG"" button to the right."
      Height          =   264
      Left            =   108
      TabIndex        =   10
      Top             =   1944
      Width           =   7392
   End
   Begin VB.Label lblProgress
      Caption         =   "In progress...."
      BeginProperty Font
         Name            =   "MS Sans Serif"
         Size            =   9.6
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   252
      Left            =   108
      TabIndex        =   3
      Top             =   864
      Width           =   2016
   End
End
Attribute VB_Name = "frmAssoUtil"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' AssoUtil.frm
'
' By Herman Liu
'
' Adapted By Norm Floria
'
Option Explicit

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SecurityAttributes
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Boolean
End Type

Private 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
   
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, _
    lpcbName As Long, ByVal lpReserved As Long, ByVal lpClass As String, _
    lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
   
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
    (ByVal mkey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
    lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
   
Private Declare Function RegEnumValueType Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, _
    ByVal null1 As Long, ByVal null2 As Long) As Long
   
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As Byte, _
    lpcbData As Long) As Long
   
Private Declare Function RegEnumValueString Lib "advapi32.dll" Alias "RegEnumValueA" _
    (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, _
    lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, lpData As String, _
    lpcbData As Long) As Long
       
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_LOCAL_MACHINE = &H80000002

  ' Reg key security attribute
Private Const KEY_QUERY_VALUE = &H1&
Private Const KEY_SET_VALUE = &H2&
Private Const KEY_ALL_ACCESS = &H3F
Private Const KEY_CREATE_SUBKEY = &H4&
Private Const KEY_ENUMERATE_SUBKEY = &H8&
Private Const KEY_NOTIFY = &H10&
Private Const KEY_CREATE_LINK = &H20
Private Const READ_CONTROL = &H20000
Private Const WRITE_OWNER = &H80000
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const STANDARD_RIGHTS_READ = READ_CONTROL
Private Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Private Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Private Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or _
      KEY_ENUMERATE_SUBKEY Or KEY_NOTIFY
Private Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUBKEY

   ' Data types
Private Const REG_NONE = 0
Private Const REG_SZ = 1                 ' Unicode null terminated string
Private Const REG_EXPAND_SZ = 2
Private Const REG_BINARY = 3             ' Binary
Private Const REG_DWORD = 4              ' 32-bit number
Private Const REG_DWORD_LITTLE_ENDIAN = 4
Private Const REG_DWORD_BIG_ENDIAN = 5
Private Const REG_LINK = 6
Private Const REG_MULTI_SZ = 7
Private Const REG_RESOURCE_LIST = 8
Private Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Private Const REG_RESOURCE_REQUIREMENTS_LIST = 10

Private Const OPTION_NON_VOLATILE = &H0    ' Info is stored in a file and is preserved

Private Const MainKey = HKEY_LOCAL_MACHINE
Private Const SubKey = "SOFTWARE\Classes"
Private Const ShellSubKey = "Shell\Open\Command"

Dim mLVIndex As Integer
Dim mStage As Integer
Dim mStopFlag As Boolean
Dim mresult
Private Const ERROR_SUCCESS = 0&

Private Sub Command1_Click()
    Dim FilePath() As String
    Dim sPath As String
    FilePath = Split(Text1(2).Text, "%1", -1, vbTextCompare)
    sPath = Left(FilePath(0), Len(FilePath(0)) - 3) & """ """ & Text1(3).Text & """"
    ShellAndWait (sPath)
    Picture1.Picture = LoadPicture(Text1(3).Text)
End Sub

Private Sub Command2_Click()
     On Error GoTo errhandler
     Dim gcdg As Object
     Set gcdg = CommonDialog1
     gcdg.Filter = "(*.jpg Picture Files)|*.jpg|(*.*)|*.*|"
     gcdg.FilterIndex = 1
     gcdg.DefaultExt = "jpg"
     gcdg.Flags = cdlOFNFileMustExist
     gcdg.FileName = ""
     gcdg.CancelError = True
     gcdg.ShowOpen
     If gcdg.FileName = "" Then
         Exit Sub
     End If
     Text1(3).Text = gcdg.FileName
     Picture1.Picture = LoadPicture(Text1(3).Text)
     Exit Sub
   
errhandler:
     If Err <> 32755 Then
         MsgBox "cmdDialogFileSpec_Click"
     End If
End Sub

Private Sub Form_Load()
     ' Configure ListView control.
    lvwAsso.ListItems.Clear
    lvwAsso.ColumnHeaders.Clear
    lvwAsso.ColumnHeaders.Add , , "Ext", 1000
    lvwAsso.ColumnHeaders.Add , , "Title Ref", (3000)
    lvwAsso.ColumnHeaders.Add , , "Association", (Me.Width - 4200)
    lvwAsso.LabelEdit = lvwManual
    lvwAsso.FullRowSelect = True
    lvwAsso.HideSelection = False
    lvwAsso.HideColumnHeaders = False
    lvwAsso.View = lvwReport
    lblProgress.Visible = False
   
    lblMessage = "1. Press 'List' Button" & vbCrLf & _
                 "2. Double-Click the 'JPG' format in the listview" & vbCrLf & _
                 "3. Enter the path of the JGP file or press 'Find JPG' button." & vbCrLf & _
                 "4. Press 'Open Application' Button"
   
   
End Sub
Private Sub cmdList_Click()
    Dim mlistitem As ListItem
    Dim colSubKeys As Collection
    Dim arrAsso() As String
    Dim mkey As Long
    Dim mBuffer As String * 256
    Dim mBufSize As Long
    Dim mClassBuffer As String
    Dim mClassBufSize As Long
    Dim typLastWriteTime As FILETIME
    Dim SubKeyName As String
    Dim SubKeyValue As String
    Dim mValType As Long
    Dim mIndex As Integer
    Dim mKeyRef As String
    Dim mCtn As Integer
    Dim mHasOne As Boolean
    Dim mPercent As Integer
    Dim tmp As String, mChr As String
    Dim i As Integer, j As Integer
   
    Set colSubKeys = New Collection
   
    If RegOpenKeyEx(MainKey, SubKey, 0&, KEY_ALL_ACCESS, mkey) <> 0& Then
        Exit Sub
    End If

    lvwAsso.Visible = True
    lblProgress.Visible = True
    DoEvents
    Screen.MousePointer = vbHourglass
    mStopFlag = False
   
       ' Enumerate the Subkey's colSubKeys
    mIndex = 0
    Do
        mClassBuffer = ""
        mClassBufSize = 0
        mBufSize = 256
        SubKeyName = Space$(mBufSize)
        mresult = RegEnumKeyEx(mkey, mIndex, SubKeyName, mBufSize, 0, mClassBuffer, _
                mClassBufSize, typLastWriteTime)
        If mresult <> 0& And mresult <> 234 Then
            If Left(SubKeyName, 10) = "          " Then
                Exit Do
            End If
        End If
        SubKeyName = Left$(SubKeyName, InStr(SubKeyName, Chr$(0)) - 1)
        If Left$(SubKeyName, 1) = "." Then
             colSubKeys.Add SubKeyName
        End If
        mIndex = mIndex + 1
    Loop
       
    lvwAsso.ListItems.Clear
       ' Recursively get information on the keys.
    For i = 1 To colSubKeys.Count
        ListEntryValues0 MainKey, SubKey & "\" & colSubKeys(i)
    Next i
    RegCloseKey mkey
   
    mCtn = lvwAsso.ListItems.Count
    lblProgress.Visible = False
    If mCtn = 0 Then
         Screen.MousePointer = vbDefault
         MsgBox "No file association found"
         Exit Sub
    End If
   
       ' Fill commands in Listview.
       ' We start from 1 as ListItems is 1-based
    For i = 1 To mCtn
         mKeyRef = lvwAsso.ListItems(i).SubItems(1)
         mLVIndex = i
         DoEnumSubKeys MainKey, SubKey & "\" & mKeyRef & "\" & ShellSubKey
    Next i
   
       ' Check and delete those items without a command, if any
    ReDim arrAsso(mCtn - 1, 2)
    mHasOne = False
    For i = 1 To mCtn
         If Len(Trim(lvwAsso.ListItems(i).SubItems(2))) > 0 Then
              arrAsso(i - 1, 0) = lvwAsso.ListItems(i).Text
              arrAsso(i - 1, 1) = lvwAsso.ListItems(i).SubItems(1)
              arrAsso(i - 1, 2) = lvwAsso.ListItems(i).SubItems(2)
         Else
              mHasOne = True
         End If
    Next i
    If mHasOne Then
         lvwAsso.ListItems.Clear
         For i = 0 To UBound(arrAsso)
             If Len(Trim(arrAsso(i, 2))) > 0 Then
                   Set mlistitem = lvwAsso.ListItems.Add(, , Text:=arrAsso(i, 0))
                   mlistitem.SubItems(1) = arrAsso(i, 1)
                   mlistitem.SubItems(2) = arrAsso(i, 2)
             End If
         Next i
    End If
    mCtn = lvwAsso.ListItems.Count
   
    lblProgress.Visible = False
    Screen.MousePointer = vbDefault
    If mCtn > 0 Then
         MsgBox "Listing completed.  Total  " & CStr(mCtn)
           ' Let hightlight visible
         If Not Me.WindowState = 1 Then
              lvwAsso.SetFocus
         End If
    Else
         MsgBox "No file association found"
    End If
End Sub

Private Sub DoEnumSubKeys(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey As Long
    Dim colSubKeys As Collection
    Dim colSubKeyValues As Collection
   
    Dim mBuffer As String * 256
    Dim mBufSize As Long
    Dim mClassBuffer As String * 256
    Dim mClassBufSize As Long
    Dim typLastWriteTime As FILETIME
   
    Dim SubKeyName As String
    Dim SubKeyValue As String
    Dim mValType As Long
    Dim mIndex As Integer
    Dim i As Integer
    Dim tmp As String, mChr As String
   
    Dim Ok As Boolean
   
    Set colSubKeys = New Collection
   
    If RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey) <> 0& Then
        mStopFlag = True
        Exit Sub
    End If

    tmp = ""
    For i = Len(inSubKey) To 1 Step -1
        mChr = Mid(inSubKey, i, 1)
        If mChr = "\" Then
            Exit For
        End If
        tmp = mChr & tmp
    Next i
   
    ListEntryValues1 inMainKey, inSubKey
   
       ' Enumerate the Subkey's colSubKeys
    mIndex = 0
    Do
        mClassBuffer = ""
        mClassBufSize = 0
        mBufSize = 256
        SubKeyName = Space$(mBufSize)
        mresult = RegEnumKeyEx(mkey, mIndex, SubKeyName, mBufSize, 0, mClassBuffer, _
                mClassBufSize, typLastWriteTime)
        If mresult <> 0& Then
             Exit Do
        End If
        SubKeyName = Left$(SubKeyName, InStr(SubKeyName, Chr$(0)) - 1)
        If Len(Trim(SubKeyName)) > 0 Then
             colSubKeys.Add SubKeyName
        End If
        mIndex = mIndex + 1
    Loop
    RegCloseKey mkey
       
       ' Recursively get information on the keys.
    For i = 1 To colSubKeys.Count
        If mStopFlag Then
             Exit Sub
        End If
        DoEnumSubKeys inMainKey, inSubKey & "\" & colSubKeys(i)
    Next i
End Sub

Private Sub ListEntryValues0(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey
    Dim mEntry As String
    Dim mEntryLength As Long
    Dim mDataType As Long
    Dim arrDataByte(1 To 1024) As Byte
    Dim mDataByteLength As Long
    Dim mDataByteValue As String
    Dim i As Integer
    Dim mIndex As Integer
    Dim NetSubKey As String, mChr As String
    Dim mlistitem As ListItem
   
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey)
    If mresult <> 0 Then
        Exit Sub
    End If
   
    NetSubKey = ""
    For i = Len(inSubKey) To 1 Step -1
        mChr = Mid(inSubKey, i, 1)
        If mChr = "\" Then
            Exit For
        End If
        NetSubKey = mChr & NetSubKey
    Next i
    mIndex = 0
    'Here is where you would add an if statment to only continue if
    '  NetSubKey is the file type (extension) that you want to find.
    '  ex: If lcase(NetSubKey) = ".jpg" then
    '          Do
    '              mEntryLength = 1024... etc
    Do
        mEntryLength = 1024
        mDataByteLength = 1024
        mEntry = Space$(mEntryLength)
        mresult = RegEnumValue(mkey, mIndex, mEntry, mEntryLength, 0, _
           mDataType, arrDataByte(1), mDataByteLength)
        If mresult <> 0 Then                  ' No more
            Exit Do
        End If

        mEntry = Left$(mEntry, mEntryLength)
          ' Note if value is "(No value set)" then the following
          ' will not be displayed, i.e. as if no entry exists.
        If mEntry = "" And mDataByteLength > 0 Then            ' (Default)
             If mDataType = REG_SZ Then
                  mDataByteValue = ""
                  For i = 1 To mDataByteLength - 1
                        mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
                  Next i
                  If Trim(mDataByteValue) <> "" Then
                        Set mlistitem = lvwAsso.ListItems.Add(, , Text:=NetSubKey)
                        mlistitem.SubItems(1) = mDataByteValue
                  End If
             End If
             Exit Do
        End If
        mIndex = mIndex + 1
    Loop
    RegCloseKey mkey
End Sub

Private Sub ListEntryValues1(ByVal inMainKey As Long, ByVal inSubKey As String)
    Dim mkey As Long
    Dim mEntry As String
    Dim mEntryLength As Long
    Dim mDataType As Long
    Dim arrDataByte(1 To 1024) As Byte
    Dim mDataByteLength As Long
    Dim mDataByteValue As String
    Dim i As Integer
    Dim mIndex As Integer
   
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0&, KEY_ALL_ACCESS, mkey)
    If mresult <> 0 Then
        Exit Sub
    End If
   
    mIndex = 0
    mEntryLength = 1024
    mDataByteLength = 1024
    mEntry = Space$(mEntryLength)
    mresult = RegEnumValue(mkey, mIndex, mEntry, mEntryLength, 0, _
          mDataType, arrDataByte(1), mDataByteLength)
    If mresult <> 0 Then                  ' No more
        Exit Sub
    End If

    mEntry = Left$(mEntry, mEntryLength)
          ' Note if value is "(No value set)" then the following
          ' will not be displayed, i.e. as if no entry exists.
    If mEntry = "" And mDataByteLength > 0 Then            ' (Default)
         If mDataType = REG_SZ Then
              mDataByteValue = ""
              For i = 1 To mDataByteLength - 1
                    mDataByteValue = mDataByteValue & Chr$(arrDataByte(i))
              Next i
              If Trim(mDataByteValue) <> "" Then
                    lvwAsso.ListItems(mLVIndex).SubItems(2) = mDataByteValue
              Else
                    lvwAsso.ListItems(mLVIndex).SubItems(2) = ""
              End If
         End If
    End If
    RegCloseKey mkey
End Sub

' Here we resize lvwAsso and picProgressContainer only
Private Sub Form_Resize()
    Dim h As Single, w As Single
       ' Avoid runtime error
    h = Me.ScaleHeight - lvwAsso.Top
    If h < 150 Then
         h = 150
    End If
    lvwAsso.Move 0, lvwAsso.Top, Me.ScaleWidth, h
    w = (lvwAsso.ColumnHeaders(1).Width + lvwAsso.ColumnHeaders(2).Width + 200)
    If Me.Width > w Then
        lvwAsso.ColumnHeaders(3).Width = (Me.Width - w)
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdCancel_Click()
    lvwAsso.Visible = True
End Sub

Private Function GetRegEntry(ByVal inMainKey As Long, ByVal inSubKey As String, ByVal inEntry As String) As String
    Dim mkey As Long
    Dim mBuffer As String * 255
    Dim mBufSize As Long
    mresult = RegOpenKeyEx(inMainKey, inSubKey, 0, KEY_READ, mkey)
    If mresult = 0 Then
          mBufSize = Len(mBuffer)
          mresult = RegQueryValueEx(mkey, inEntry, 0, REG_SZ, mBuffer, mBufSize)
          If mresult = 0 Then
                If mBuffer <> "" Then
                     GetRegEntry = Mid$(mBuffer, 1, mBufSize)
                End If
                RegCloseKey mkey
          Else                    ' Value may be simply not exist, not an error
                GetRegEntry = ""
          End If
    Else
          MsgBox "Unable to open " & inSubKey
          GetRegEntry = ""
    End If
End Function

'**************************************
' Name: Best Shell & Wait (No API's!)
' By: Matt Roberts
'
' Inputs:FileName - The name of the file
'     you wish to run with any required switch
'     es included.
'
' Returns:True if the file was run and
'     returned.
'False If there was a file open or save error.
'EXAMPLE: ShellAndWait ("notepad.exe c:\temp\teset.txt)
'

Function ShellAndWait(FileName As String)
    Dim objScript
    Dim shellapp
    On Error GoTo ERR_OpenForEdit
    Set objScript = CreateObject("WScript.Shell")
        shellapp = objScript.Run(FileName, 1, True)
        ShellAndWait = True
EXIT_OpenForEdit:
        Exit Function
ERR_OpenForEdit:
        MsgBox Err.Number & Err.Description
        GoTo EXIT_OpenForEdit
    End Function
Private Sub lvwAsso_DblClick()
    Text1(0).Text = lvwAsso.SelectedItem.Text
    Text1(1).Text = lvwAsso.SelectedItem.SubItems(1)
    Text1(2).Text = lvwAsso.SelectedItem.SubItems(2)
End Sub
0
 

Author Comment

by:sar1478
ID: 6448617
Can you povide sample or example working application.
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 4

Expert Comment

by:wileecoy
ID: 6448824
The above code is a working application.

Follow the instructions in my second previous comment, and copy and paste the code in my first previous comment, and you should have a form with all the code.

Let me know what kind of problems you are having.  If it is bad enough, I could e-mail the code to you, I guess.

Wileecoy.
0
 

Author Comment

by:sar1478
ID: 6454162
dear wileecoy

please mail me the working code.
 my mail address is viv2575@hotmail.com
0
 
LVL 49

Expert Comment

by:DanRollins
ID: 7205372
Hi sar1478,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:

    Accept wileecoy's comment(s) as an answer.

sar1478, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you.  DO NOT accept this comment as an answer.

EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
0
 
LVL 5

Expert Comment

by:Netminder
ID: 7240863
Per recommendation, force-accepted.

Netminder
CS Moderator
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Suggested Solutions

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now