Don't Question the authority

Despedida de Fravia, traducida por google y un poquito por mi. (Un poco trade pero en fin...). - Adios a un grande

Bueno, por lo que todas las curas que tuve que sufrir durante casi dos años: dos añoscompletos y los ciclos de quimioterapia muy debilitantes, 4 operaciones, muchas biopsias, incontables exploraciones de PET y MRIS, meses pasados dentro de una clínica de ... no funcionó.
La metástasis se escapó de la garganta: mi profesor neerlandés lograron detener todo pero no el tumor del hígado, y mi hígado está implosionando. Por lo tanto,es una cuestión de semanas, no meses.
Mis opciones restantes son para morir en una clínica, a morir en casa, o solicitar la eutanasia (el último, por supuesto, voy a hacer si surgen necesidades ... afortunadamente este es un país civilizado y no posee pensamientos religiosos secos -al menos por ahora- suficientes para anular mis derechos sólo para apaciguar y aplacar los supuestos deseos dudosos de "Godzilla").

Voy a ir para casa: al parecer (de nuevo: esta "parece" ubicua ) voy a morir durante el sueño. Voy "sólo" a tenerlos más débiles (amarillentos, caramba: nada como un tumor terminal para ser realmente feo) hasta que un día no voy a despertar más. Si es así, bastante justo: usted va con un suave soplo en su último viaje, una experiencia que suele ser, por cierto, como único e irrepetible :-)

De todos modos, si el universo y el tiempo son realmente infinito (me queda alguna duda), entonces la combinación casi "idéntica metempsicoticamente" de las neuronas se volverá a aparecer de nuevo en alguna parte, por ejemplo, en otra galaxia y otro planeta ... esperemos que con menos imbéciles.

Más realista, lamento no tener el tiempo para acompañar a mis hijos cuando entran a la universidad pronto. Una parte de mí que vivo a través de ellos, sin embargo, y creo que no consiguen darles algun potente arma y paracaídas (véase más abajo) para preparar el feo momento que cualquier persona con un cerebro por encima de la berenjena puede ahora ver fácilmente en contra del horizonte: Las facultades que de nuestra sociedad "tan buena" han logrado provocar la pirámide más grande en la historia económica (FMI, 21/04/2009: pérdidas bancarias en EE.UU. casi 3 billones; total mundial de 4 billones las pérdidas bancarias .. . cacahuetes que no pequeña!) con todo el dinero que -ça va sans dire- pobres y esclavos se han de reparar y devolver!
Como una ventaja adicional en la media de tiempo que también logró destruir irremediablemente-probablemente-la totalidad del ecosistema del planeta :-|

Ahora, con el coral ensordecedor de sus corruptos políticos y medios de comunicación estática coribantes, la única solución que proponen todos los felices (perdiendo aún más por su propio bien cientos de miles de millones que en realidad le pertenece a usted), es poner en marcha nuevamente el mismo ciclo de moronic forzoso de crédito | forzado consum ... en lugar de cuestionar un modelo de desarrollo totalmente fracasado y que ya está ahora (y con razón) mordiendo todos en el culo.
Pero por desgracia esto no es nada: me temo que las masacres, las guerras y los campos de concentración de las próximas décadas tendrá a nosotros recordar los horrores de la primera mitad del siglo XX con leve nostalgia. Nuestra "tan bonita y tan democrática" sociedad (donde hoy en día sólo soubrettes, el cuerpo de constructores, propietarios de medios de comunicación y "los más ricos en el estanque Bozo" tienden a ser elegidos por una población de esclavos felices y zombificados para correr como conejillos dentro de ruedas) están dirigidos a toda velocidad sobre una empinada pendiente resbaladiza hacia el abismo, donde se llevará a cabo-como de costumbre-a final como un salto mortal de tres y media vueltas invertido, entre los vivas! y viva! de sus medios de comunicación pagados, lacayos ... en voz alta ante las salpicaduras sobre el pavimento debajo de la realidad concreta.


Dulce ~ ~

Suficiente mensaje de castigo: para estar enojado, porque su muerte sólo sería infantil. Y, de hecho, ni siquiera estoy enfadado, simplemente analizo y canalizo en voz alta.
De todos modos (aunque débiles) las armas para defenderse a sí mismo, están a la vista de los que, esparcidos en la web profunda, son nuestra insondable cornucopia de conocimientos.
Lo más poderoso, en mi humilde opinión, es un buen conocimiento de la retórica (Nota 2)
Especialmente eufemismos, que en la actualidad puede traicionar hasta una sarcastica historieta ... y la exégesis, y quizás también algunos escucharon (si es áspero y de fabricación casera) el "Reality Cracking".
La poesía-y, más generalmente, una buena cultura general, son también muy útiles armaduras.
Aprenda a encontrar buenos libros (ver más abajo para algunas sugerencias), usted necesita-al igual que en el medievo, los monjes hicieron una vez un tiempo-mientras que los bárbaros queman todo y todos a la vista fuera de los muros.
Más en general, todas las ciencias nunca subestiman "en decadencia", que a menudo son muy poderosos re, consumir consumir y consumir ... perdiendo toda tu vida con el fin de poder comprar un coche un poco antes, de un color diferente.

Otros dos son posibles paracaídas, saber utilizar técnicas de ingeniería inversa de software (cuyo papel en nuestras sociedades, y de sus pequeños, está obligado a aumentar de manera espectacular los intentos de censuras), y un sonido de más, de aprendizaje "de sólo una" lengua extranjera. Estos "paracaídas" podría permitir a muchos lectores (quizás) estar en los pies.
Buena suerte de todos modos. Yo deseo todo lo mejor a cualquier persona con un cerebro.

Sin embargo, mis más queridos asesoramiento a todos los amigos es la siguiente: aprender a disfrutar de su contingente actual, no se obsesione por el futuro. Carpe diem, disfrutar de lo actual y las emociones: un cielo estrellado, un nuevo viento, los depósitos a la orilla del mar, su amor a su lado en la noche, una larga charla en la noche de penumbra con un amigo, la sonrisa de sus hijos. * * Que sustituir con un TV o una pantalla de computadora-es una muy mala negociación ... que es una de las pocas cosas que ahora estoy bastante seguro .

Adiós a todos mis lectores, un fuerte abrazo a los muchos amigos que hice en todo el mundo. Una gran experiencia para mí! Voy a continuar como lo que yo manejo, voy a intentar incluso celebrar una última charla en Colonia a finales de mayo, pero dudo que voy a manejar, de todos modos y pronto mis sitios no se actualizará más, a menos que mis amigos cuidará y elaboraran algún tipo de wiki / blog (y la vigilancia y las instalaciones correccionales) para permitir esto. Vamos a ver.
Pero no se preocupe en lo más mínimo: si no aprenden a búsqueda encontrará otros buenos recursos de todos modos. Hay abundancia de todo, después de todo.
Sí! Hay buena información en la web, aunque oculto y enterrado detrás o debajo de viscosa morasses de adornos inútiles, se desplazan las dunas de basura comercial y una increíble cantidad de contenido vacío y totalmente inútil "cebo" sitios de publicidad.
Sin embargo, la estructura misma web se hizo para compartir, no para la acumulación y seguramente no para "vender", que nunca olvidará! Por lo tanto, los usuarios pueden tomar ventaja de este ... Un buen conocimiento de los principales protocolos de la Web, un buen navegador y nuestra confianza Wireshark y nadie va a detener de un poderoso buscador para encontrar lo que fantaseas :-)

Concedido hay de hecho un montón de cosas sobre searchlores obsoletos, y-como ya se ha dicho-la-bizantino laberíntica estructura del sitio que se han racionalizado desde hace mucho tiempo.
Sin embargo, aunque en parte obsoleto (pero rara vez es verdadero conocimiento obsoleto, ¿no?) He decidido dejar en línea todos los que se reunieron y ofrecieron a lo largo de muchos años como es, y en la medida en que permanecerá en la web, porque creo que aún hay una gran riqueza de conocimiento libre de la búsqueda aquí, a la espera de esos entre mis visitantes que estén interesados en aprender y dominar el difícil arte de dos búsquedas en la web y la inversión de todo lo que encuentran.

Si-como dicen algunos-la gente de todo nuestro planeta hizo uso de aprender lo que ofrece, mi vida no se desperdicia: =)

http://penelope.uchicago.edu/Thayer/E/Roman/Texts/Rhetorica_ad_Herennium/home.html

De nuevo aqui con el brute

Hola gente aqui dejo el brute force que habia posteado hace un tiempo, si bien no lo he mejorado mucho, algo le he cambiado... debido a mi falta de tiempo y un poco de vagancia ja... le he mejorado un poco al brute en si y le he agregado un port scanner.
Bueno el port scanner esta mas o menos comentado, creo que ya sabran que es un escaneador de puertos... en fin andar anda ja, eh hecho las siguientes pruebas y me han dado resultados. Probe con mi router la velocidad de respuesta, aunque parezca ilogico fue mas lenta que la velocidad de respuesta del server de mi isp :S... eso no lo entiendo todavia... Probe con el server de mi isp.. o sea para probar con 1 salto (o sea mi router), y luego con un server de cti para probar con mas de un salto. En todos logre respuesta en algunos puertos dandome los siguientes resultados:

Victima: Mi router
Puertos abiertos: 23,21,80
Respuesta:
21 : login

23 : Welcom to Vulcan ....

80: sin respuesta (esta bloqueado por configuración)
--------------------------------------------------------------
Victima: ns1.riotel.com.ar

Puertos abiertos:

22 Respuesta: SSH-2.0-OpenSSH_3.6.1p2

25 Respuesta: 220 smtp.riotel.com.ar ESMTP Postfix (Debian/GNU)

53 Sin Respuesta

80 no revise bien pero me dio sin respuesta a simple vista

110 Respuesta: +OK Hello there.

------------------------------------------------------------
Victima: claro.com.ar

Puertos abiertos:
21 y 80
Respuesta:

21: sin respuesta

80: pagina web

------------------------------------------------------------

En fin aca les dejo la descarga:

Algunos articulos y manuales de algoritmica, programacion, compiladores y programación orientada a objetos

Bueno aqui dejo algunos artículos y tutoriales que vi en un espacio:

















Bueno esto son la introducción para aprender a programar, luego ire posteando lenguajes y un poco mas avanzados.

Mi colección de E-Zines

Bueno aca dejo mi colección de e-zines que he ido recolectando con el paso de los años:

aqui dejo los links:

Parte 1

Parte 2


Bueno aqui posteo la lista de e-zines que contiene mi colección:

0ri0n Team Venezuela ---> 1 a 4
7a69 ---> 1 a 15
ACID KLAN ---> 1 a 4
CDLR - Proyecto R ---> 1 a 11
CDT - Cultura Digital Team ---> 0 a 3
CIA ---> 1 a 7
DisidentS! Hack Journal ---> 1 a 8
EKO - EZKRACHO SECURITY TEAM ---> 1 a 4
Electron security team ---> 1 a 4
FIH - FOROS INFORMATICOS HISPANOS ---> 1 a 3
Gedzac ---> 1 a 3
HACKERSS ---> 1 a 3
HACKMEX ---> 1
HH - Hack Hispano ---> 1 a 3
Hispabyte ---> 1 a 4
HVEN - Hackers Venezuela ---> 1 a 3
IH - INSANE HACKERS ---> 1 a 3
MHM - MEXICAN HACKERS MAFIA ---> 1 a 7
NetSearch ---> 1 a 8
Phrack ---> 65 en español
RAREGAZZ ---> 1 a 19
Raza Mexicana ---> 1 a 20
RTM - Essentials ---> 1 a 5
SAQUEADORES ---> 1 a 35 + bonus
Sinmoney ---> 1
SWP - Security Wari Project ---> 1 a 6
WEET_DEVILS HACK TEAM ---> 1

Bueno esta es mi coleccion que esta creciando desde 1999, si bien no estan todas las que existen y existieron desde esa epoca pues de a poquito seguire buscando y agregando. Si alguien quiere aportar Bienvenido sea ;)
Saludos

Códigos anti debug para VB6

Pues eso aca dejo algunos codigos antidebugging que se usar para mis aplicaciones:

Para VB6:

Debug.Print 1 / 0

Esta sentencia genera una exepción de división por cero cuando la aplicación es debugueda.

____________________________________________________________________________


Public Declare Function IsDebuggerPresent Lib "kernel32" () As Long
Private Sub Form_Load()
If IsDebuggerPresent Then
........
End Sub

Ejemplo de como detectar un debugger con la rutina de kernel32, IssDebuggerPresent

____________________________________________________________________________

Public Declare Function OutputDebugStringA Lib "kernel32" (ByVal lpString As String) As Long

Private Sub Form_Load()
Dim AA As String
Dim i As Integer

For i = 1 To 200
AA = AA & "%s"
Next i

MsgBox OutputDebugStringA(AA)
End Sub

Este code genera una exepción de desbordamiento de pila en algunos debuggers, mas específicamente el olly 1.10.Lo hace entrar en Deadlock
____________________________________________________________________________


'---------------------------------------------------------------------------------------
' Module : mGetProcAddress
' DateTime : 06/10/2008 20:06
' Author : Cobein
' Mail : cobein27@hotmail.com
' WebPage : http://www.advancevb.com.ar
' Member of : http://hackhound.org/
' Purpose : GetProcAddress alternative function
' Usage : At your own risk
' Requirements: None
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
'
' Reference : Based on ExtremeCoder sample [http://www.rohitab.com/discuss/lofiversion/index.php/t30773.html]
'
' History : 06/10/2008 First Cut....................................................
' 06/10/2008 Minor change in buffer size to increase speed................
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, RetVal As Long)
Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal pOlechar As Long) As String

Public Function GetProcAddressAlt(ByVal sLib As String, ByVal sMod As String) As Long
Dim lLib As Long
Dim i As Long

lLib = LoadLibraryA(sLib)

If Not lLib = 0 Then
Dim dwNumberOfNames As Long
Dim dwNamesOffset As Long
Dim dwNameRVAs As Long
Dim dwFuncOffset As Long
Dim dwFuncRVAs As Long

GetMem4 (lLib + &H3C), i
GetMem4 (lLib + i + &H78), i

GetMem4 (lLib + i + &H18), dwNumberOfNames
GetMem4 (lLib + i + &H20), dwNamesOffset
GetMem4 (lLib + i + &H1C), dwFuncOffset

Dim sBuff As String * 128
Dim sName As String

For i = 0 To dwNumberOfNames - 1
GetMem4 (lLib + dwNamesOffset + i * &H4), dwNameRVAs
GetMem4 (lLib + dwFuncOffset + i * &H4), dwFuncRVAs

sBuff = SysAllocString(lLib + dwNameRVAs)
sName = Left$(sBuff, lstrlen(sBuff))

If sName = sMod Then
GetProcAddressAlt = lLib + dwFuncRVAs
Exit Function
End If
Next
End If

End Function

Este modulo sirve para buscar nombre de procesos tales como: ollydbg, snd, etc.
Con el pueden saber si se ha cargado X programa, se puede mejorar el modulo para que detecte si la cadena ingresada se encuentra en una porción del modulo con el cual esta siendo comprobada, en ese caso detectaria algunas variantes de olly, ya que la mayoria agregan por ejemplo: Yoda's - olldbg. Entonces si comparamos con olly nos daría que son distintas pero si lo hacemos como si fuera un Like, o sea q sea igual o este contenida nos devolvería ese proceso sospechoso tbn.


____________________________________________________________________________
Private Declare Function OutputDebugStringA Lib "kernel32" (ByVal lpString As String) As Long

Private Sub Form_Load()
If IsDebuggerActive Then
MsgBox "Debugger Present"
End If
End Sub

Private Function IsDebuggerActive() As Boolean
IsDebuggerActive = Not (OutputDebugStringA("=)") = 1)
End Function

Otro ejemplo con OutputDebugStringA pero en este caso genera una exepción.

____________________________________________________________________________

Option Explicit

Private Declare Function CheckRemoteDebuggerPresent Lib "kernel32.dll" (ByVal hProcess As Long, fResult 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 GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF


Private Sub Form_Load()

Dim fResult As Long
Dim hProcess As Long

hProcess = OpenProcess(ByVal PROCESS_ALL_ACCESS, ByVal 0&, ByVal GetCurrentProcessId)
Call CheckRemoteDebuggerPresent(hProcess, fResult)
CloseHandle hProcess
.........

End Sub


En este caso testeamos remotamente q nuestro programa no sea debuggeado, si es debuggeado fResult nos dara 1 como valor.
____________________________________________________________________________

'IsDbgCrss
Private Declare Function CsrGetProcessId Lib "ntdll.dll" () As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

'---------------------------------------------------------------------------------------
' Procedure : IsDbgCsrss
' Author : Karcrack
' Date : 30/12/2008
' Purpose : Check if our app is being debugged
' Usage : If IsDbgCrss = True Then MsgBox "I'm Debugged"
' Tested On : OllyDbg v2.0 ß
' Reference : http://www.piotrbania.com/all/articles/antid.txt
'---------------------------------------------------------------------------------------
'
Public Function IsDbgCsrss() As Boolean
IsDbgCsrss = CBool(OpenProcess(&H1F0FFF, 0, CsrGetProcessId)) '&H1F0FFF = PROCESS_ALL_ACCESS
End Function

Este codigo detecta si se esta debugueando nuestra aplicación.
____________________________________________________________________________


Option Explicit

Private Const ANYSIZE_ARRAY = 1
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Private Const SE_PRIVILEGE_ENABLED = &H2

Private Type LUID
LowPart As Long
HighPart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type


Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long



Public Const SE_DEBUG_NAME As String = "SeDebugPrivilege"


Public Declare Function RtlSetProcessIsCritical Lib "ntdll.dll" (ByVal NewValue As Boolean, ByVal OldValue As Boolean, ByVal WinLogon As Boolean)

Public Function ObtenerPrivilegios(ByVal privilegio As String) As Long

Dim lpLUID As LUID
Dim lpToken As TOKEN_PRIVILEGES
Dim lpAntToken As TOKEN_PRIVILEGES
Dim hToken As Long
Dim hProcess As Long
Dim res As Long

hProcess = GetCurrentProcess()
res = OpenProcessToken(hProcess, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
If res = 0 Then
Exit Function
End If
res = LookupPrivilegeValue(vbNullString, privilegio, lpLUID)
If res = 0 Then
Exit Function
End If
With lpToken
.PrivilegeCount = 1
.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
.Privileges(0).pLuid = lpLUID
End With

res = AdjustTokenPrivileges(hToken, False, lpToken, Len(lpToken), lpAntToken, Len(lpAntToken))
If res = 0 Then
Exit Function
End If
ObtenerPrivilegios = res
End Function






'*************************************************************************
'*************************************************************************
' Uso de RtlSetProcessIsCritical para setear nuestro proceso, como proceso
' critico del sistema: del mismo modo que csrss.exe o winlogon
' XcryptOR - Made In Colombia
'**************************************************************************
'*************************************************************************
Private Sub Form_Load()
On Error Resume Next
ObtenerPrivilegios SE_DEBUG_NAME ' obtiene privilegios de Debugeo
Call RtlSetProcessIsCritical(0, 0, 1) ' setea nuestro proceso como Proceso Critico
End Sub




Bueno como dice el comentario para setear a nuestra aplicación privilegios.

____________________________________________________________________________



Y por ultimo algunos trucos para dificultar un poco mas:



App.TaskVisible = False

App.Title = ""



Saludos

Modulos utiles a la hora de programar en vb6

Hola aca dejo algunos módulos que son bastantes útiles a la hora de programar, modificar registro de windows, detectar version de windows, capturas de pantalla y escalar privilegios en win XP, NT, etc:


====================================================================================
Detectar versión, devolver revisión y compilación:

====================================================================================
Option Explicit
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
wSPMajor As Integer
End Type

Public Enum EnumWinVer
Win95 = 0
Win95OSR2 = 1
Win98 = 2
Win98SE = 3
WinME = 4
WinNT3_0 = 5
WinNT3_1 = 6
WinNT3_5 = 7
WinNT4 = 8
WinNT5 = 9
Win2k = 10
WinXP = 11
WinVista = 12
End Enum


Public Function Winversion(param As Integer) As EnumWinVer
Dim myVer As OSVERSIONINFO
Dim dl&
myVer.dwOSVersionInfoSize = 148
dl& = GetVersionEx&(myVer)
If param = 1 Then 'param=1 devuelve la versiòn de Windows (95, 98,ME, 2000, XP, Vista)
If myVer.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
If myVer.dwMajorVersion = 4 And myVer.dwMinorVersion = 0 Then
If myVer.dwBuildNumber = 950 Then
GetVersion = Win95
Else
GetVersion = Win95OSR2
End If
ElseIf myVer.dwMajorVersion = 4 And myVer.dwMinorVersion = 10 Then
If myVer.dwBuildNumber = 1998 Then
GetVersion = Win98
Else
GetVersion = Win98SE
End If
ElseIf myVer.dwMajorVersion >= 4 And myVer.dwMinorVersion > 10 Then
GetVersion = WinME
End If
ElseIf myVer.dwPlatformId = VER_PLATFORM_WIN32_NT Then
If myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 0 Then
GetVersion = WinNT3_0
ElseIf myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 1 Then
GetVersion = WinNT3_1
ElseIf myVer.dwMajorVersion = 3 And myVer.dwMinorVersion = 5 Then
GetVersion = WinNT3_5
ElseIf myVer.dwMajorVersion = 4 Then
GetVersion = WinNT4
ElseIf myVer.dwMajorVersion = 5 And myVer.dwMinorVersion = 0 Then
GetVersion = Win2k
ElseIf myVer.dwMajorVersion = 5 And myVer.dwMinorVersion = 1 Then
GetVersion = WinXP
ElseIf myVer.dwMajorVersion = 6 And myVer.dwMinorVersion = 1 Then
GetVersion = WinVista
End If
End If
Else
If param = 2 Then 'param=2 devuelve la Compilación
Winversion = osvi.dwBuildNumber
Else
If param = 3 Then 'Param=3 devuelve la revisión
Winversion = osvi.szCSDVersion
Else
If param = 4 Then
Winversion = Str(osvi.dwMajorVersion) + "." + Trim(Str(osvi.dwMinorVersion))
Else
Winversion = MsgBox("El identificador seleccionado no es válido.", vbCritical, "Error #1Ver")
End If
End If
End If
End If
End Function

====================================================================================


Funciones para el Registro de Windows:
====================================================================================
Option Explicit

Global Const REG_SZ As Long = 1
Global Const REG_DWORD As Long = 4
Global Const REG_BINARY As Long = 3

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003

Global Const ERROR_NONE = 0
Global Const ERROR_BADDB = 1
Global Const ERROR_BADKEY = 2
Global Const ERROR_CANTOPEN = 3
Global Const ERROR_CANTREAD = 4
Global Const ERROR_CANTWRITE = 5
Global Const ERROR_OUTOFMEMORY = 6
Global Const ERROR_INVALID_PARAMETER = 7
Global Const ERROR_ACCESS_DENIED = 8
Global Const ERROR_INVALID_PARAMETERS = 87
Global Const ERROR_NO_MORE_ITEMS = 259

Global Const KEY_ALL_ACCESS = &H3F

Global Const REG_OPTION_NON_VOLATILE = 0

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" 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, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
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
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExBinary Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey& Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String)
Private Declare Function RegDeleteValue& Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)

Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)



Dim lRetVal As Long
Dim hKey As Long


lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)

End Function

Public Function DeleteValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)


Dim lRetVal As Long
Dim hKey As Long


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteValue(hKey, sValueName)
RegCloseKey (hKey)
End Function

Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Dim bValue As String

Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
Case REG_BINARY
bValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, bValue, Len(bValue))
End Select

End Function





Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
Dim bValue As String

On Error GoTo QueryValueExError



lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5

Select Case lType
' Cadenas
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If

' Binario
Case REG_BINARY:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, bValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(bValue, cch)
Else
vValue = Empty
End If

' DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'Otros tipos
lrc = -1
End Select

QueryValueExExit:

QueryValueEx = lrc
Exit Function

QueryValueExError:

Resume QueryValueExExit

End Function
Public Function CreateNewKey(lPredefinedKey As Long, sNewKeyName As String)



Dim hNewKey As Long
Dim lRetVal As Long

lRetVal = RegCreateKeyEx(lPredefinedKey, sNewKeyName, 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hNewKey, lRetVal)
RegCloseKey (hNewKey)
End Function


Sub Main()
'Ejemplos para llamar a cada función:
'CreateNewKey HKEY_CURRENT_USER, "Prueba\Rama1\Rama2"
'SetKeyValue HKEY_CURRENT_USER, "Prueba\Rama1", "Prueba", "Probando, Probando", REG_SZ
'MsgBox QueryValue(HKEY_CURRENT_USER, "Prueba\Rama1", "Prueba")
'DeleteKey HKEY_CURRENT_USER, "Prueba\Rama1|Rama2"
'DeleteValue HKEY_CURRENT_USER, "Prueba\Rama1", "Prueba"
End Sub


Public Function SetKeyValue(lPredefinedKey As Long, sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)

Dim lRetVal As Long
Dim hKey As Long



lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)

End Function

Public Function QueryValue(lPredefinedKey As Long, sKeyName As String, sValueName As String)
Dim lRetVal As Long
Dim hKey As Long
Dim vValue As Variant


lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function

====================================================================================


Funciones para hacer una captura de pantalla y guardarla:
====================================================================================



Option Explicit


Public Enum GpStatus
Ok = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
End Enum

Public Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long

SuppressExternalCodecs As Long

End Type

Public Type CLSID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Public Enum ImageCodecFlags
ImageCodecFlagsEncoder = &H1
ImageCodecFlagsDecoder = &H2
ImageCodecFlagsSupportBitmap = &H4
ImageCodecFlagsSupportVector = &H8
ImageCodecFlagsSeekableEncode = &H10
ImageCodecFlagsBlockingDecode = &H20

ImageCodecFlagsBuiltin = &H10000
ImageCodecFlagsSystem = &H20000
ImageCodecFlagsUser = &H40000
End Enum

Public Type ImageCodecInfo
ClassID As CLSID
FormatID As CLSID
CodecName As Long
DllName As Long
FormatDescription As Long
FilenameExtension As Long
MimeType As Long
flags As ImageCodecFlags
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long
SigMask As Long
End Type

Public Enum EncoderParameterValueType
EncoderParameterValueTypeByte = 1
EncoderParameterValueTypeASCII = 2

EncoderParameterValueTypeShort = 3
EncoderParameterValueTypeLong = 4
EncoderParameterValueTypeRational = 5

EncoderParameterValueTypeLongRange = 6

EncoderParameterValueTypeUndefined = 7
EncoderParameterValueTypeRationalRange = 8

End Enum

Public Type EncoderParameter
GUID As CLSID
NumberOfValues As Long
type As EncoderParameterValueType
value As Long
End Type

Public Type EncoderParameters
count As Long
Parameter As EncoderParameter
End Type

Public Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Public Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As GpStatus
Public Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal filename As String, clsidEncoder As CLSID, encoderParams As Any) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As CLSID) As Long
Private token As Long

Public Function SaveAsJPEG(pb As PictureBox, ByVal filename As String, Optional ByVal Quality As Long = 80) As Long
Dim stat As GpStatus
Dim bm As Long
Dim encoderCLSID As CLSID
Dim encoderParams As EncoderParameters
Dim lQuality As Long

stat = GdipCreateBitmapFromHBITMAP(pb.Picture.Handle, pb.Picture.hpal, bm)

Call GetEncoderClsid("image/jpeg", encoderCLSID)

If (stat = Ok) Then
lQuality = Quality
encoderParams.count = 1
With encoderParams.Parameter
.NumberOfValues = 1
.type = EncoderParameterValueTypeLong

.GUID = DEFINE_GUID(EncoderQuality)
.value = VarPtr(lQuality)
End With

stat = GdipSaveImageToFile(bm, StrConv(filename, vbUnicode), encoderCLSID, encoderParams)

End If

SaveAsJPEG = stat

Call GdipDisposeImage(bm)
End Function

Public Function gdipLoad() As Boolean

Dim GpInput As GdiplusStartupInput

gdipLoad = False
GpInput.GdiplusVersion = 1
If GdiplusStartup(token, GpInput) = Ok Then
gdipLoad = True
End If

End Function

Public Sub gdipUnLoad()
Call GdiplusShutdown(token)
End Sub

Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSID)
Dim num As Long, size As Long, i As Long
Dim ICI() As ImageCodecInfo
Dim buffer() As Byte

GetEncoderClsid = -1

Call GdipGetImageEncodersSize(num, size)
If size = 0 Then Exit Function

ReDim ICI(1 To num) As ImageCodecInfo
ReDim buffer(1 To size) As Byte

Call GdipGetImageEncoders(num, size, buffer(1))

Call CopyMemory(ICI(1), buffer(1), (Len(ICI(1)) * num))

For i = 1 To num

If StrComp(PtrToStrW(ICI(i).MimeType), strMimeType, vbTextCompare) = 0 Then
ClassID = ICI(i).ClassID
GetEncoderClsid = i
Exit For
End If
Next

Erase ICI
Erase buffer
End Function

Public Function DEFINE_GUID(ByVal sGuid As String) As CLSID
Call CLSIDFromString(StrPtr(sGuid), DEFINE_GUID)
End Function

Public Function PtrToStrW(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long

lLen = lstrlenW(lpsz)

If (lLen > 0) Then
sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(sOut, vbFromUnicode)
End If
End Function


====================================================================================

Algo muy importante a la hora de hacer programas q requieran reiniciar windows, escribir un ejecutable cargado ya en memoria y otras cosas que necesiten que el programa escale privilegios:
====================================================================================

Option explicit


Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type

Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
TheLuid As LUID
Attributes As Long
End Type


Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long

Public Sub AdjustToken()
Const TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8
Const SE_PRIVILEGE_ENABLED = &H2
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long

hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle

LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid

tkp.PrivilegeCount = 1
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED



AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded

End Sub


====================================================================================
okas por ahora publico eso nomas.