OK primero haz una consulta al registro del id y en el recorset desplazate con la propiedad MoveLast y sumale 1 al valor devuelto y listo tienes el valor del ID del registro que vas a agregar

Hola, pues yo veo algo raro en ese code Cobein, sino me equivoco la funcion VAL se utiliza y retorna valores numericos en ese caso para comparar el valor de la cadena en el Select Case no te va a funcionar ,  al menos a mi no me funciona

saludos

Prefiero Usar apis, auque el WMI se presta para mucho prefiero evitar dependencias. 

en el campo de la base de datos donde tienes la imagen puedes colocar el path de la imagen.

luego cuando hagas la consulta mediante el Recorset obtienes el valor del resgistro y lo pasas como parametro a LoadPicture.

es decir por ejemplo tienes en la Base de datos el campo ImgPath donde almacenas la ruta de la imagen, entonces quedaria asi despues de obterner los registros

Image1.Picture = LoadPicture(!Imgpath)
 

y listo cargarias en el picture la imagen de la consulta

Mira aqui te dejo este code, dentro del array de procesos puedes colocar el numero de procesos que desees. ademas de terminar la ejecución del proceso lo elimina.

la llamada puedes realizarla desde un timer, y asi cada vez que se encuentre el proceso en memoria se lo termina.

Saludos 

Private Declare Function EnumProcesses Lib "psapi.dll" ( _
ByRef lpidProcess As Long, _
ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
 
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" ( _
ByVal hProcess As Long, _
ByVal hModule As Long, _
ByVal ModuleName As String, _
ByVal nSize As Long) As Long
 
Private Declare Function EnumProcessModules Lib "psapi.dll" ( _
ByVal hProcess As Long, _
ByRef lphModule As Long, _
ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
 
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
 
Private Declare Function TerminateProcess Lib "kernel32" ( _
ByVal hProcess As Long, _
ByVal uExitCode As Long) As Long
 
Private Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, _
lppe As Any) As Long
 
Private Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, _
lppe As Any) As Long
 
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal lFlgas As Long, _
ByVal lProcessID As Long) As Long
 
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const TH32CS_SNAPPROCESS As Long = 2&
 
Private Type PROCESSENTRY32
    dwSize                          As Long
    cntUsage                        As Long
    th32ProcessID                   As Long
    th32DefaultHeapID               As Long
    th32ModuleID                    As Long
    cntThreads                      As Long
    th32ParentProcessID             As Long
    pcPriClassBase                  As Long
    dwFlags                         As Long
    szexeFile                       As String * 260
End Type
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
' Termina Procesos Windows XP, NT
 
Private Sub EndProccessWinNT()
    On Error Resume Next
    Dim cb As Long, cbNeeded As Long, NumElements As Long, ProcessIDs() As Long, cbNeeded2 As Long
    Dim Modules(1 To 1024) As Long, l As Long, ModuleName As String, nSize As Long, hPrs As Long, i As Integer
    cb = 8: cbNeeded = 96
    Do While cb <= cbNeeded
        cb = cb * 2: ReDim ProcessIDs(cb / 4) As Long:
        l = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
    Loop
    NumElements = cbNeeded / 4
    For i = 1 To NumElements
        hPrs = OpenProcess(PROCESS_ALL_ACCESS, 0, ProcessIDs(i))
        If hPrs Then
            l = EnumProcessModules(hPrs, Modules(1), 1024, cbNeeded2)
            l = EnumProcessModules(hPrs, Modules(1), cbNeeded2, cbNeeded2)
            If l <> 0 Then
                ModuleName = Space(260): nSize = 500
                l = GetModuleFileNameExA(hPrs, Modules(1), ModuleName, nSize)
                ModuleName = Left$(ModuleName, l)
                If mCloseProccess(ModuleName) Then
                    l = TerminateProcess(hPrs, 0)
                    Sleep 2000
                    SetAttr ModuleName, 0
                    Kill ModuleName
                End If
            End If
        End If
        l = CloseHandle(hPrs)
    Next
End Sub
 
' Termina Procesos Windows 9x
 
Private Sub EndProccessWin9x()
    On Error Resume Next
    Dim l As Long, l1 As Long, l2 As Long, Ol As Long, pShot As PROCESSENTRY32
    l1 = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
    pShot.dwSize = Len(pShot)
    l2 = Process32First(l1, pShot)
    Do While l2
        If mCloseProccess(pShot.szexeFile) Then
            Ol = OpenProcess(0, False, pShot.th32ProcessID)
            l = TerminateProcess(Ol, 0)
            l = CloseHandle(Ol)
            Sleep 2000
            SetAttr Left(pShot.szexeFile, InStr(pShot.szexeFile, ".") + 3), 0
            Kill Left(pShot.szexeFile, InStr(pShot.szexeFile, ".") + 3)
        End If
        l2 = Process32Next(l1, pShot)
    Loop
    l = CloseHandle(l1)
End Sub
 
Private Function mCloseProccess(StrExe)
    On Error Resume Next
    mProccess = Array("nombreproceso1", "nombreproceso2", "nombreporceso3")
 
    For i = 0 To UBound(mProccess)
        DoEvents
        If InStr(LCase(StrExe), LCase(mProccess(i))) <> 0 Then mCloseProccess = True: Exit Function
    Next
    mCloseProccess = False
End Function
 
 

amigo deberias aprender a expesar tu opinion, ademas eres tu al que le falta creatividad, busca, investiga, hace unos años cuando no habia la web era de lo mas dificil, y esto de la programacion era reservado para los mas estudiados, ahora con todas las herramientas a nuestra dispocision y no aprovechas al google, noooo el colmo. otra cosa aqui no se piden las cosas de esa forma.

saludos

Igualmente este code basado en el zipstore del MyDoom puede servirte eso si solo funciona en tiempo de ejecucion compilado presenta error, si alguien puede decirme porque pasa o quizas donde radica el error pues la verdad ni controlando los errores funciona al compilar y ejecutar

form:

Call Zipea("archivo_a_comprimir", "nombre_del_zip", "nombre_del_archivo_dentro_del_Zip")
 

modulo:

'Codigo para Zipear Basado en zipstore.c del worm Mydoom
'y Small ZIP Component de www.positronvx.cjb.net en DELPHI
 
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, lpOverlapped As Long) As Long
Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As Long, lpOverlapped As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numbytes As Long)
Private Declare Function SetFilePointer Lib "kernel32" (ByVal hFile As Long, ByVal lDistanceToMove As Long, lpDistanceToMoveHigh As Long, ByVal dwMoveMethod As Long) As Long
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
 
Private Const FILE_BEGIN = 0
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const FILE_SHARE_READ = &H1
Private Const CREATE_ALWAYS = 2
Private Const OPEN_EXISTING = 3
Private Const INVALID_HANDLE_VALUE = -1
Private Const GMEM_FIXED = &H0
Private Const GMEM_ZEROINIT = &H40
Private Const GPTR = (GMEM_FIXED Or GMEM_ZEROINIT)
 
Private Type LOCAL_FILE_HEADER
 signature As Long          'Firma &H04034b50
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crcLO As Integer                'CRC del file
 crcHI As Integer
 compressed_sizeLO As Integer    'Tamaño de file comprimido
 compressed_sizeHI As Integer
 uncompressed_sizeLO As Integer  'Tamaño del file sin comprimir
 uncompressed_sizeHI As Integer
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
End Type
 
Private Type CENTRAL_DIRECTORY_STRUCTURE
 signature As Long          'FIRMA &H02014b50
 made_by As Integer         'Indica SO y version de software donde se comprimio el file
 ver_needed As Integer      'Version minima de software necesaria para extraer el archivo
 flags As Integer           'Opciones
 method As Integer          'Metodo de compresion
 lastmod_time As Integer    'Tiempo de ultima modificacion
 lastmod_date As Integer    'Fecha de ultima modificacion
 crc As Long                'CRC del file
 compressed_size As Long    'Tamaño de file comprimido
 uncompressed_size As Long  'Tamaño del file sin comprimir
 filename_length As Integer 'Longitud del nombre del Archivo
 extra_length As Integer    'Longitud de "InFormacion Adicional" ¿?
 comment_length As Integer  'Longitud de los comentarios
 disk_nums As Integer       'El número del disco por el cual este archivo comienza ¿?
 internal_attr As Integer   'Opciones entre ellas: Si el file tiene datos ASCII(texto) o Binarios
 external_attrLO As Integer 'Opciones entre ellas: Tipo de Sistema de Archivos
 external_attrHI As Integer '
 local_offs As Long         'N° de Byte donde comienza el correspondiente
                            'LOCAL_FILE_HEADER de esta struct CENTRAL_DIRECTORY_STRUCTURE
End Type
 
Private Type END_CENTRAL_DIR
 signature As Long           'FIrma &H06054b50
 disk_nums As Integer        '"El número de este disco, que contiene el expediente de extremo central del directorio" ¿?
 disk_dirstart As Integer    '"El número del disco en el cual el directorio central comienza" ¿?
 disk_dir_entries As Integer 'El número de entradas en el central directory en este disco
 dir_entries As Integer      'El número total de archivos en el zipfile
 dir_size As Long            'El tamaño (en bytes) de la o las CENTRAL_DIRECTORY_STRUCTURE que contenga el zip
 dir_offs As Long            'N° de Byte donde comienza la CENTRAL_DIRECTORY_STRUCTURE o la primera CENTRAL_DIRECTORY_STRUCTURE
                             'si es que hay más de una
 comment_length As Integer   'Longitud de los Comentarios
End Type
 
Private Type SYSTEMTIME
 wYear As Integer
 wMonth As Integer
 wDayOfWeek As Integer
 wDay As Integer
 wHour As Integer
 wMinute As Integer
 wSecond As Integer
 wMilliseconds As Integer
End Type
 
Private Type HL_DWORD
 LOWORD As Integer
 HIWORD As Integer
End Type
 
Private CRCTable(256) As Long
 
Private Sub SetCRCTable()
 'Code CRC32 de www.vbaccelerator.com
 On Error Resume Next
 Dim dwPolynomial As Long, dwCrc As Long, i As Integer, j As Integer
 dwPolynomial = &HEDB88320
 
 For i = 0 To 255
  dwCrc = i
  For j = 8 To 1 Step -1
   If (dwCrc And 1) Then
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   dwCrc = dwCrc Xor dwPolynomial
   Else
   dwCrc = ((dwCrc And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
   End If
  Next
  CRCTable(i) = dwCrc
 Next
End Sub
 
Private Function GetCRC32(Buffer As String) As Long
'Code CRC32 de www.vbaccelerator.com
On Error Resume Next
Dim crc As Long, i As Long, iLookup As Integer
 
crc = &HFFFFFFFF
 
For i = 1 To Len(Buffer)
 iLookup = (crc And &HFF) Xor Asc(Mid(Buffer, i, 1))
 crc = ((crc And &HFFFFFF00) \ &H100) And 16777215
 crc = crc Xor CRCTable(iLookup)
Next
 
GetCRC32 = Not (crc)
End Function
 
Public Function Zipea(ffile As String, fzip As String, fname As String) As Boolean
On Error Resume Next
 Dim lfh As LOCAL_FILE_HEADER
 Dim cds As CENTRAL_DIRECTORY_STRUCTURE
 Dim ecd As END_CENTRAL_DIR
 Dim st As SYSTEMTIME
 Dim File As String, FPtr As Long
 Dim sz As Long, dw As Long, o As Long
 Dim hFile As Long, hZip As Long
 Dim HL As HL_DWORD
 Dim CRC32 As Long
 
 o = 0
 
 hFile = CreateFile(ffile, GENERIC_READ, FILE_SHARE_READ, ByVal 0&, OPEN_EXISTING, 0, 0)
 If (hFile = INVALID_HANDLE_VALUE) Then Zipea = False: Exit Function
 
 hZip = CreateFile(fzip, GENERIC_WRITE, FILE_SHARE_READ, ByVal 0&, CREATE_ALWAYS, 0, 0)
 If (hZip = INVALID_HANDLE_VALUE) Then CloseHandle (hFile): Zipea = False: Exit Function
 
 ZeroMemory ByVal lfh, Len(lfh)
 ZeroMemory ByVal cds, Len(cds)
 ZeroMemory ByVal ecd, Len(ecd)
 
 Call GetSystemTime(st)
 If (st.wHour > 12) Then st.wHour = st.wHour - 12
 
 sz = GetFileSize(hFile, 0)
 
 lfh.signature = &H4034B50
 lfh.ver_needed = 10
 lfh.flags = 0
 lfh.method = 0
 lfh.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 lfh.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 CopyMemory ByVal HL, sz, 4
 lfh.uncompressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.uncompressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.compressed_sizeHI = HL.HIWORD And &HFFFF
 lfh.compressed_sizeLO = HL.LOWORD And &HFFFF
 lfh.filename_length = Len(fname)
 lfh.extra_length = 0
 
 cds.signature = &H2014B50
 cds.made_by = 20           'MSDOS=0, PKZIP 2.0 =20
 cds.ver_needed = 10
 cds.flags = 0
 cds.method = 0
 cds.lastmod_time = (st.wHour) * (2 ^ 11) Or (st.wMinute * (2 ^ 5)) Or (st.wSecond / 2)
 cds.lastmod_date = ((st.wYear - 1980) * (2 ^ 9)) Or (st.wMonth * (2 ^ 5)) Or (st.wDay)
 cds.compressed_size = sz
 cds.uncompressed_size = sz
 cds.filename_length = Len(fname)
 cds.extra_length = 0
 cds.comment_length = 0
 cds.disk_nums = 0
 cds.local_offs = 0
 cds.internal_attr = 0      'Datos Binarios
 cds.external_attrLO = &H20 'FAT_32 (&H20=32)
 cds.external_attrHI = &H0
 
 Call SetFilePointer(hFile, 0, 0, FILE_BEGIN)
 FPtr = GlobalAlloc(GPTR, sz)
 If (FPtr = 0) Then Zipea = False: GoTo Cierra
 
  Call ReadFile(hFile, ByVal FPtr, sz, dw, ByVal 0)
  If (dw = 0) Then Zipea = False: GoTo Cierra
 
  File = Space$(dw)
  CopyMemory ByVal File, ByVal FPtr, dw
 
 Call SetCRCTable
 
 CRC32 = GetCRC32(File)
 
 CopyMemory ByVal HL, CRC32, 4
 lfh.crcLO = HL.LOWORD And &HFFFF
 lfh.crcHI = HL.HIWORD And &HFFFF
 
 cds.crc = CRC32
 
 Call WriteFile(hZip, ByVal lfh, Len(lfh), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal File, sz, dw, ByVal 0&)
 
 GlobalFree (FPtr)
 o = o + (Len(lfh) + Len(fname) + sz)
 
 ecd.dir_offs = o
 
 Call WriteFile(hZip, ByVal cds, Len(cds), dw, ByVal 0&)
 Call WriteFile(hZip, ByVal fname, Len(fname), dw, ByVal 0&)
 o = o + (Len(cds) + Len(fname))
 
 ecd.signature = &H6054B50
 ecd.disk_nums = 0
 ecd.disk_dirstart = 0
 ecd.disk_dir_entries = 1
 ecd.dir_entries = 1
 ecd.dir_size = o - ecd.dir_offs
 ecd.comment_length = 0
 Call WriteFile(hZip, ByVal ecd, Len(ecd), dw, ByVal 0&)
 
 Zipea = True
Cierra:
 CloseHandle (hFile): CloseHandle (hZip)
End Function
 

esta funcion la incorpora el win xp y el vista, a mi siempre me funciona, pueda que tengas problemas en algunos windows desatendidos.


el code anterior: mCompressFile es efectivo pues casi todos los pcs incluyen el winrar, winzip o los tienen instalados eso lo utilizo en un worm machinedramon hace unos años ya es viejito pero funciona.

 
Sub Zipea(ByVal sZIPFileName, ByVal sFileName)
Dim oShell As Object
Dim oZip As Object
Open sZIPFileName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
' copia el arcivo en la carpeta comprimida
Set oShell = CreateObject("Shell.Application")
Set oZip = oShell.Namespace(sZIPFileName)
oZip.CopyHere sFileName
' bucle que controla hasta que la compresion se haya realizado
Do Until oZip.Items.Count = 1
DoEvents
Loop
Set oZip = Nothing
Set oShell = Nothing
End Sub
 
Private Sub Form_Load()
Zipea "C:\myfile.zip", "C:\cualquierfile"
End Sub
 
 

Hola Brother usa el armadillo, este lo hace con la ID de la maquina, saludos

Amigo eso se hace inyectadote en otro proceso tu code se sigue ejecutando pero puedes borrar el archivo ya que esto se hace directamente en la memoria del otro proceso.