Mensajes

Ya Ejecutaste CMD como administrador?

no te lo habia dicho hace rato????

Ya Ejecutaste CMD como administrador?

si eso tambien me di cuenta, alguna respuesta a este problema   

grande che, Leandro eres un excelente programador estuve hace algún tiempo viendo la forma de hacerlo sin compilar a p-code, pero me rendi, buen trabajo  

PD. es mejor hacerlo sin depender de componentes externos y usando objeto Shell.Application no siempre funciona, generalmente no se puede usar en los windows desatendidos

Este código es de MachineDramon [Gedzac], excelente codigo basado en el zip store del I-Wom mydoom.a.

para que trabaje debes compilarlo en p-code  

Código (vb) [Seleccionar] Expandir

If Zipea("myfile", "nombrefile.zip", "nombrefile") = True Then msgbox "Compresion de Archivo Exitosa"

Código (vb) [Seleccionar] Expandir

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




holas  todos !! ie posible elaborare un bat que ejecute un comando  at tutti  i dias para que abra una pagina specifica??
I.e  tutti i dias 10.30  www.google.com


grazie
Gino

http://foro.elhacker.net/analisis_y_diseno_de_malware/crear_comando_infinito_con_at-t190062.0.html,

mira esto tambien te puede servir

http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=1&txtCodeId=7270

en vb si usas librerias como estas siempre seras dependiente de ellas, como dice el post anterior es mejor a puro vb pero requiere de tiempo, igualmente si la necesitas en tu aplicacion compilada puedes agregarla como recurso luego la extraes y la registras y ya.

saludos espero te haya sido de ayuda

si claro que se puede hacer, en el momento solo te puedo ayudar con este code pero el problema es que depemde de una dll externa "VIC32", igual aqui te dejo el codigo, y la libreria.

Código (vb) [Seleccionar] Expandir

Declare Function jpeginfo Lib "VIC32.DLL" (ByVal Fname As String, jdat As JpegData) As Long
Declare Function allocimage Lib "VIC32.DLL" (image As imgdes, ByVal wid As Long, ByVal leng As Long, ByVal BPPixel As Long) As Long
Declare Function loadjpg Lib "VIC32.DLL" (ByVal Fname As String, desimg As imgdes) As Long
Declare Sub freeimage Lib "VIC32.DLL" (image As imgdes)
Declare Function savebmp Lib "VIC32.DLL" (ByVal Fname As String, srcimg As imgdes, ByVal compression As Long) As Long

' Image descriptor
Type imgdes
   ibuff As Long
   stx As Long
   sty As Long
   endx As Long
   endy As Long
   buffwidth As Long
   palette As Long
   colors As Long
   imgtype As Long
   bmh As Long
   hBitmap As Long
End Type

Type JpegData
    ftype As Long
    width As Long
    length As Long
    comps As Long
    precision As Long
    sampfac0 As Long
    sampfac1 As Long
    sampfac2 As Long
    sampfac3 As Long
    vbitcount As Long
End Type


Public Sub Main()


Dim tmpimage As imgdes
   Dim rcode As Long
   Dim jdat As JpegData     ' Reserve space for JPEG file info
   Dim bmp_fname As String
   Dim jpg_fname As String

   bmp_fname = "pathmyfilebmp.bmp"
   jpg_fname = "pathmyfile.jpg"

   ' Get info on the file we're to load
   rcode = jpeginfo(jpg_fname, jdat)
   If (rcode <> NO_ERROR) Then
      MsgBox "Cannot find file", 0, "Error encountered!"
      Exit Sub
   End If
   
   ' Allocate space for an image
   rcode = allocimage(tmpimage, jdat.width, jdat.length, jdat.vbitcount)
   If (rcode <> NO_ERROR) Then
     MsgBox "Not enough memory", 0, "Error encountered!"
     Exit Sub
   End If
   
   ' Load image
   rcode = loadjpg(jpg_fname, tmpimage)
   If (rcode <> NO_ERROR) Then
      freeimage tmpimage ' Free image on error
      MsgBox "Cannot load file", 0, "Error encountered!"
      Exit Sub
   End If

   ' Save image
   rcode = savebmp(bmp_fname, tmpimage, 0)
   freeimage tmpimage
End Sub

Descargar DLL

mira esto es lo que necesitas, creo que el autor es EON

Código (vb) [Seleccionar] Expandir

Private Const PAGE_READWRITE As Long = &H4
Private Const MEM_RELEASE As Long = &H8000
Private Const MEM_COMMIT As Long = &H1000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const INFINITE As Long = &HFFFFFF

Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, lpThreadAttributes As Long, ByVal dwStackSize As Long, lpStartAddress As Long, lpParameter As Any, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Private Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Private 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 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 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

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


Public Function Inyecta(RutaDll As String, Pid As Long) As Integer
Dim proc As Long
Dim nload As Long
Dim rems As Long
Dim longi As Long
Dim RemThread As Long
Dim Tid As Long

On Error GoTo Error

proc = OpenProcess(PROCESS_ALL_ACCESS, False, Pid)
nload = GetProcAddress(GetModuleHandle("kernel32.dll"), "LoadLibraryA")
rems = VirtualAllocEx(proc, 0, Len(RutaDll), MEM_COMMIT, PAGE_READWRITE)
WriteProcessMemory proc, ByVal rems, ByVal RutaDll, Len(RutaDll), longi
CreateRemoteThread proc, ByVal 0, 0, ByVal nload, ByVal rems, 0, Tid
WaitForSingleObject rems, INFINITE
CloseHandle proc
CloseHandle rems
Inyecta = 0
Exit Function
Error:
Inyecta = 1
End Function

Public Function GET_PID(szProcess As String)
    On Error Resume Next

    Dim PROCCESS_ID As Long
    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 = Process32Next(l1, pShot)
    Do While l2
        If InStr(pShot.szexeFile, szProcess) <> 0 Then
            PROCCESS_ID = pShot.th32ProcessID
            GET_PID = PROCCESS_ID
        End If
        l2 = Process32Next(l1, pShot)
    Loop
    l = CloseHandle(l1)

End Function