|
Mostrar Temas
|
Páginas: [1]
|
1
|
Programación / Programación Visual Basic / PEdit: Clase para editar archivos ejecutables de Windows
|
en: 26 Diciembre 2005, 21:10 pm
|
Cree una clase para editar archivos ejecutables portables. Les dejo todo el proyecto, el que no entienda y le interese me dice en este mismo post y explico función por función, pero primero quiero saber si a alguien le interesa así no escribo al pedo xD.
También cree una GUI para demostrar el funcionamiento de la clase, dejo unos screenshots. El proyecto de la GUI lo ya casi lo termino y lo posteo, me falta la parte de edición pero la clase está terminada.
A la clase me falta agregarle cosas, pero lo voy a hacer en la semana. Por ejemplo extraer y editar recursos, administrar símbolos y varias cosas más. Los archivos ejecutables tienen muchas cosas que analizar.
Postee esto acá porque había amigos que no podían verlo en el laboratorio.
Saludos.
EDITADO: Posteo el proyecto actualizado, y con la GUI casi terminada. No la voy a terminar porque me aburrí xD, pero voy a actualizar la clase para ver recursos & stuff.
|
|
|
2
|
Programación / Programación Visual Basic / Saluden a Ap0
|
en: 26 Septiembre 2005, 01:08 am
|
Bueno este post es para saludar a Ap0calipse y desearle suerte ya que está por empezar la universidad.
Ap0 va a ser mi ingeniera informática favorita y ya es mi virukera favorita ^_^, asì que se merece toda la suerte del mundo.
Que te vaya bien Ap0 y quedate ahi abajo que con lo que me diste ya puedo ir fácil y así nadie nos jode xD.
NOTA: Ya borraré este post mañana así que por favor Mods dejenlo.
|
|
|
3
|
Programación / Programación Visual Basic / Declaraciones de WinInet
|
en: 3 Septiembre 2005, 04:16 am
|
Ya que estamos con los módulos pongo las declaraciones de la API de WinInet, ya que son muy útiles para el manejo de cookies, historial, opciones de internet, bajar archivos, etc, etc, etc. Option Explicit
'Funciones de WININET.DLL ' Declare Function CommitUrlCacheEntry Lib "wininet" Alias "CommitUrlCacheEntryA" (ByVal lpszUrlName As String, ByVal lpszLocalFileName As String, ExpireTime As FILETIME, LastModifiedTime As FILETIME, ByVal CacheEntryType As Long, ByVal lpHeaderInfo As Byte, ByVal dwHeaderSize As Long, ByVal lpszFileExtension As String, ByVal dwReserved As Long) As Long Declare Function CreateUrlCacheEntry Lib "wininet" Alias "CreateUrlCacheEntryA" (ByVal lpszUrlName As String, ByVal dwExpectedFileSize As Long, ByVal lpszFileExtension As String, ByVal lpszFileName As String, ByVal dwReserved As Long) As Long Declare Function CreateUrlCacheGroup Lib "wininet" (ByVal dwFlags As Long, lpReserved As Any) As Long Declare Function DeleteUrlCacheEntry Lib "wininet" Alias "DeleteUrlCacheEntryA" (ByVal lpszUrlName As String) As Long Declare Function DeleteUrlCacheGroup Lib "wininet" (ByVal GroupID As Long, ByVal dwFlags As Long, lpReserved As Any) As Long Declare Function FindCloseUrlCache Lib "wininet" (ByVal hEnumHandle As Long) As Long Declare Function FindFirstUrlCacheEntry Lib "wininet" Alias "FindFirstUrlCacheEntryA" (ByVal lpszUrlSearchPattern As String, lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwFirstCacheEntryInfoBufferSize As Long) As Long Declare Function FindFirstUrlCacheEntryEx Lib "wininet" Alias "FindFirstUrlCacheEntryExA" (ByVal lpszUrlSearchPattern As String, ByVal dwFlags As Long, ByVal dwFilter As Long, ByVal GroupID As Long, lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwFirstCacheEntryInfoBufferSize As Long, lpGroupAttributes As Any, ByVal pcbGroupAttributes As Long, lpReserved As Any) As Long Declare Function FindNextUrlCacheEntry Lib "wininet" Alias "FindNextUrlCacheEntryA" (ByVal hEnumHandle As Long, lpNextCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwNextCacheEntryInfoBufferSize As Long) As Long Declare Function FindNextUrlCacheEntryEx Lib "wininet" Alias "FindNextUrlCacheEntryExA" (ByVal hEnumHandle As Long, lpFirstCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwFirstCacheEntryInfoBufferSize As Long, lpGroupAttributes As Any, pcbGroupAttributes As Long, lpReserved As Any) As Long
Declare Function FtpCommand Lib "wininet" Alias "FtpCommandA" (ByVal hFtpConnect As Long, ByVal fExpectResponse As Long, ByVal dwFlag As Long, ByVal lpszCommand As String, ByVal dwContext As Long) As Long Declare Function FtpCreateDirectory Lib "wininet" Alias "FtpCreateDirectoryA" (ByVal hFTPSession As Long, ByVal lpszDirectory As String) As Long Declare Function FtpDeleteFile Lib "wininet" Alias "FtpDeleteFileA" (ByVal hFTPSession As Long, ByVal lpszFileName As String) As Long Declare Function FtpFindFirstFile Lib "wininet" Alias "FtpFindFirstFileA" (ByVal hFTPSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function FtpGetCurrentDirectory Lib "wininet" Alias "FtpGetCurrentDirectoryA" (ByVal hFTPSession As Long, ByVal lpszCurrentDirectory As String, ByVal lpdwCurrentDirectory As Long) As Long Declare Function FtpGetFile Lib "wininet" Alias "FtpGetFileA" (ByVal hFTPSession As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwLocalFlagsAndAttributes As Long, ByVal dwInternetFlags As Long, ByVal dwContext As Long) As Long Declare Function FtpOpenFile Lib "wininet" Alias "FtpOpenFileA" (ByVal hFTPSession As Long, ByVal lpszFileName As String, ByVal fdwAccess As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function FtpPutFile Lib "wininwt" Alias "FtpPutFileA" (ByVal hFTPSession As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function FtpRemoveDirectory Lib "wininet" Alias "FtpRemoveDirectoryA" (ByVal hFTPSession As Long, ByVal lpszDirectory As String) As Long Declare Function FtpRenameFile Lib "wininet" Alias "FtpRenameFileA" (ByVal hFTPSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Long Declare Function FtpSetCurrentDirectory Lib "wininet" Alias "FtpSetCurrentDirectoryA" (ByVal hFTPSession As Long, ByVal lpszDirectory As String) As Long
Declare Function GetUrlCacheEntryInfo Lib "wininet" Alias "GetUrlCacheEntryInfoA" (ByVal lpszUrlName As String, lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwCacheEntryInfoBufferSize As Long) As Long Declare Function GetUrlCacheEntryInfoEx Lib "wininet" Alias "GetUrlCacheEntryInfoExA" (ByVal lpszUrlName As String, lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwCacheEntryInfoBufferSize As Long, ByVal lpszReserved As String, ByVal lpdwReserved As Long, lpReserved As Any, ByVal dwFlags As Long) As Long
Declare Function GopherCreateLocator Lib "wininet" Alias "GopherCreateLocatorA" (ByVal lpszHost As String, ByVal nServerPort As Integer, ByVal lpszDisplayString As String, ByVal lpszSelectorString As String, ByVal dwGopherType As Long, ByVal lpszLocator As String, ByVal lpdwBufferLength As Long) As Long Declare Function GopherFindFirstFile Lib "wininet" Alias "GopherFindFirstFileA" (ByVal hGopherSession As Long, ByVal lpszLocator As String, ByVal lpszSearchString As String, lpFindData As GOPHER_FIND_DATA, ByVal dwFlags As Long, ByVal dwContext As Long) Declare Function GopherGetAttribute Lib "wininet" Alias "GopherGetAttributeA" (ByVal hGopherSession As Long, ByVal lpszLocator As String, ByVal lpszAttributeName As String, ByVal lpBuffer As Byte, ByVal dwBufferLength As Long, ByVal lpdwCharactersReturned As Long, ByVal lpfnEnumerator As Long, ByVal dwContext As Long) As Long Declare Function GopherGetLocatorType Lib "wininet" Alias "GopherGetLocatorTypeA" (ByVal lpszLocator As String, ByVal lpdwGopherType As Long) As Long Declare Function GopherOpenFile Lib "wininet" Alias "GopherOpenFileA" (ByVal hGopherSession As Long, ByVal lpszLocator As String, ByVal lpszView As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Declare Function HttpAddRequestHeaders Lib "wininet" Alias "HttpAddRequestHeadersA" (ByVal hHttpRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwModifiers As Long) As Long Declare Function HttpEndRequest Lib "wininet" Alias "HttpEndRequestA" (ByVal hRequest As Long, lpBuffersOut As INTERNET_BUFFERS, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function HttpOpenRequest Lib "wininet" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal lpszVerb As String, ByVal lpszObjectName As String, ByVal lpszVersion As String, ByVal lpszReferer As String, lpszAcceptTypes() As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function HttpQueryInfo Lib "wininet" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal dwInfoLevel As Long, lpvBuffer As Any, ByVal lpdwBufferLength As Long, ByVal lpdwIndex As Long) As Long Declare Function HttpSendRequest Lib "wininet" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, lpOptional As Any, ByVal dwOptionalLength As Long) As Long Declare Function HttpSendRequestEx Lib "wininet" Alias "HttpSendRequestExA" (ByVal hRequest As Long, lpBuffersIn As INTERNET_BUFFERS, lpBuffersOut As INTERNET_BUFFERS, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Declare Function InternetAttemptConnect Lib "wininet" Alias "" (ByVal dwReserved As Long) As Long Declare Function InternetAutodial Lib "wininet" Alias "" (ByVal dwFlags As Long, ByVal dwReserved As Long) As Long Declare Function InternetAutodialHangup Lib "wininet" Alias "" (ByVal dwReserved As Long) As Long Declare Function InternetCanonicalizeUrl Lib "wininet" Alias "InternetCanonicalizeUrlA" (ByVal lpszUrl As String, ByVal lpszBuffer As String, ByVal lpdwBufferLength As Long, ByVal dwFlags As Long) As Long Declare Function InternetCheckConnection Lib "wininet" Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, ByVal dwFlags As Long, ByVal dwReserved As Long) Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Long Declare Function InternetCombineUrl Lib "wininet" Alias "InternetCombineUrlA" (ByVal lpszBaseUrl As String, ByVal lpszRelativeUrl As String, ByVal lpszBuffer As String, lpdwBufferLength As Long, ByVal dwFlags As Long) As Long Declare Function InternetConfirmZoneCrossing Lib "wininet" Alias "InternetConfirmZoneCrossingA" (ByVal hWnd As Long, ByVal szUrlPrev As String, ByVal szUrlNew As Long, ByVal bPost As Boolean) As Long Declare Function InternetConnect Lib "wininet" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal lpszServerName As String, ByVal nServerPort As Long, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) Declare Function InternetCrackUrl Lib "wininet" Alias "InternetCrackUrlA" (ByVal lpszUrl As String, ByVal dwUrlLength As Long, ByVal dwFlags As Long, lpUrlComponents As URL_COMPONENTS) Declare Function InternetCreateUrl Lib "wininet" Alias "InternetCreateUrlA" (lpUrlComponents As URL_COMPONENTS, ByVal dwFlags As Long, ByVal lpszUrl As String, ByVal lpdwUrlLength As Long) As Long Declare Function InternetDial Lib "wininet" Alias "InternetDialA" (ByVal hwndParent As Long, ByVal lpszConnectoid As String, ByVal dwFlags As Long, ByVal lpdwConnection As Long, ByVal dwReserved As Long) As Long Declare Function InternetErrorDlg Lib "wininet" (ByVal hWnd As Long, ByVal hInternet As Long, ByVal dwError As Long, ByVal dwFlags As Long, lppvData As Any) As Long Declare Function InternetFindNextFile Lib "wininet" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As Any) As Long Declare Function InternetGetConnectedState Lib "wininet" (ByVal lpdwFlags As Long, ByVal dwReserved As Long) As Long Declare Function InternetGetCookie Lib "wininet" Alias "InternetGetCookieA" (ByVal lpszUrlName As String, ByVal lpszCookieName As String, ByVal lpszCookieData As String, ByVal lpdwSize As Long) As Long Declare Function InternetGetLastResponseInfo Lib "wininet" Alias "InternetGetLastResponseInfoA" (ByVal lpdwError As Long, ByVal lpszBuffer As String, ByVal lpdwBufferLength As Long) As Long Declare Function InternetGoOnline Lib "wininet" Alias "InternetGoOnlineA" (ByVal lpszUrl As String, ByVal hwndParent As Long, ByVal dwReserved As Long) As Long Declare Function InternetHangUp Lib "wininet" (ByVal dwConnection As Long, ByVal dwReserved As Long) As Long Declare Function InternetLockRequestFile Lib "wininet" (ByVal hInternet As Long, lphLockReqHandle As Long) Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function InternetQueryDataAvailable Lib "wininet" (ByVal hFile As Long, lpdwNumberOfBytesAvailable As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function InternetQueryOption Lib "wininet" Alias "InternetQueryOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByVal lpBuffer As String, ByVal lpdwBufferLength As Long) As Long Declare Function InternetReadFile Lib "wininet" Alias "InternetReadFileA" (ByVal hFile As Long, lpBuffer As Any, ByVal dwNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long) As Long Declare Function InternetReadFileEx Lib "wininet" Alias "InternetReadFileExA" (ByVal hFile As Long, lpBuffersOut As INTERNET_BUFFERS, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function InternetSetCookie Lib "wininet" Alias "InternetSetCookieA" (ByVal lpszUrlName As String, ByVal lpszCookieName As String, ByVal lpszCookieData As Long) As Long Declare Function InternetSetDialState Lib "wininet" Alias "InternetSetDialStateA" (ByVal lpszConnectoid As String, ByVal dwState As Long, ByVal dwReserved As Long) As Long Declare Function InternetSetFilePointer Lib "wininet" (ByVal hFile As Long, ByVal lDistanceToMove As Long, pReserved As Any, ByVal dwMoveMethod As Long, ByVal dwContext As Long) As Long Declare Function InternetSetOption Lib "wininet" Alias "InternetSetOptionA" (ByVal hInternet As Long, ByVal dwOption As Long, ByVal lpBuffer As Long, ByVal dwBufferLength As Long) As Long Declare Function InternetSetStatusCallback Lib "wininet" Alias "InternetSetStatusCallbackA" (ByVal hInternet As Long, ByVal lpfnInternetCallback As Long) As Long Declare Function InternetTimeFromSystemTime Lib "wininet" Alias "InternetTimeFromSystemTimeA" (pst As SystemTime, ByVal dwRFC As Long, ByVal lpszTime As String, ByVal cbTime As Long) As Long Declare Function InternetUnlockRequestFile Lib "wininet" Alias "" (ByVal hLockHandle As Long) As Long Declare Function InternetWriteFile Lib "wininet" (ByVal hFile As Long, lpBuffer As Any, ByVal dwNumberOfBytesToWrite As Long, ByVal lpdwNumberOfBytesWritten As Long) As Long
Declare Function ReadUrlCacheEntryStream Lib "wininet" (ByVal hUrlCacheStream As Long, ByVal dwLocation As Long, lpBuffer As Any, lpdwLen As Long, ByVal dwReserved As Long) As Long Declare Function RetrieveUrlCacheEntryFile Lib "wininet" Alias "RetrieveUrlCacheEntryFileA" (ByVal lpszUrlName As String, lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwCacheEntryInfoBufferSize As Long, ByVal dwReserved As Long) As Long Declare Function RetrieveUrlCacheEntryStream Lib "wininet" Alias "RetrieveUrlCacheEntryStreamA" (ByVal lpszUrlName As String, lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal lpdwCacheEntryInfoBufferSize As Long, ByVal fRandomRead As Boolean, ByVal dwReserved As Long) As Long Declare Function SetUrlCacheEntryGroup Lib "wininet" Alias "SetUrlCacheEntryGroupA" (ByVal lpszUrlName As String, ByVal dwFlags As Long, ByVal GroupID As Long, ByVal pbGroupAttributes As Byte, ByVal cbGroupAttributes As Long, lpReserved As Any) As Long Declare Function SetUrlCacheEntryInfo Lib "wininet" Alias "SetUrlCacheEntryInfoA" (ByVal lpszUrlName As String, lpCacheEntryInfo As INTERNET_CACHE_ENTRY_INFO, ByVal dwFieldControl As Long) As Long Declare Function UnlockUrlCacheEntryFile Lib "wininet" Alias "UnlockUrlCacheEntryFileA" (ByVal lpszUrlName As String, ByVal dwReserved As Long) As Long Declare Function UnlockUrlCacheEntryStream Lib "wininet" (ByVal hUrlCacheStream As Long, ByVal dwReserved As Long) As Long
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0 'indicates to use config info from registry Public Const INTERNET_OPEN_TYPE_DIRECT = 1 'direct to net Public Const INTERNET_OPEN_TYPE_PROXY = 3 'via named proxy
Public Const INTERNET_FLAG_EXISITING_CONNECT = &H20000000 Public Const INTERNET_FLAG_RELOAD = &H80000000 ' read from wire even if locally cached
'Opciones adicionales Public Const INTERNET_FLAG_SECURE = &H800000 'use PCT/SSL if applicable (HTTP) Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000 'use keep-alive semantics Public Const INTERNET_FLAG_NO_AUTO_REDIRECT = &H200000 'don't handle redirections automatically Public Const INTERNET_FLAG_READ_PREFETCH = &H100000 'do background read prefetch Public Const INTERNET_FLAG_NO_COOKIES = &H80000 'no automatic cookie handling Public Const INTERNET_FLAG_NO_AUTH = &H40000 'no automatic authentication handling
'Opciones del cache Public Const INTERNET_FLAG_MUST_CACHE_REQUEST = &H10 'fails if unable to cache request Public Const INTERNET_FLAG_RESYNCHRONIZE = &H800 'asking wininet to update an item if it is newer
'Opciones de seguridad Public Const INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTP = &H8000 'ex: https:// to http:// Public Const INTERNET_FLAG_IGNORE_REDIRECT_TO_HTTPS = &H4000 'ex: http:// to https:// Public Const INTERNET_FLAG_IGNORE_CERT_DATE_INVALID = &H2000 'expired X509 Cert. Public Const INTERNET_FLAG_IGNORE_CERT_CN_INVALID = &H1000 'bad common name in X509 Cert.
Public Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 'don't write this item to the cache Public Const INTERNET_FLAG_DONT_CACHE = INTERNET_FLAG_NO_CACHE_WRITE Public Const INTERNET_FLAG_MAKE_PERSISTENT = &H2000000 'make this item persistent in cache
'Longitud máxima de campos Public Const INTERNET_MAX_HOST_NAME_LENGTH = 256 Public Const INTERNET_MAX_USER_NAME_LENGTH = 128 Public Const INTERNET_MAX_PASSWORD_LENGTH = 128 Public Const INTERNET_MAX_PORT_NUMBER_LENGTH = 5 'INTERNET_PORT is unsigned short Public Const INTERNET_MAX_PORT_NUMBER_VALUE = 65535 'maximum unsigned short value Public Const INTERNET_MAX_PATH_LENGTH = 2048 Public Const INTERNET_MAX_PROTOCOL_NAME = "gopher" 'longest protocol name Public Const INTERNET_MAX_URL_LENGTH = (6 - 1 + 3 + INTERNET_MAX_PATH_LENGTH) '6=Len(INTERNET_MAX_PROTOCOL_NAME); 3=Len("://")
'Para FTP Public Const FTP_TRANSFER_TYPE_UNKNOWN = &H0 Public Const FTP_TRANSFER_TYPE_ASCII = &H1 Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Public Const INTERNET_FLAG_TRANSFER_ASCII = FTP_TRANSFER_TYPE_ASCII Public Const INTERNET_FLAG_TRANSFER_BINARY = FTP_TRANSFER_TYPE_BINARY
Public Const FTP_TRANSFER_TYPE_MASK = (FTP_TRANSFER_TYPE_ASCII Or FTP_TRANSFER_TYPE_BINARY)
'Para Gopher 'Tipo de datos Public Const GOPHER_TYPE_TEXT_FILE = &H1 'Archivo de texto Public Const GOPHER_TYPE_DIRECTORY = &H2 'Directorio Public Const GOPHER_TYPE_CSO = &H4 'Servidor de libreta de direcciones CSO Public Const GOPHER_TYPE_ERROR = &H8 'Indicador de error Public Const GOPHER_TYPE_MAC_BINHEX = &H10 'Archivo Macintosh en formato BINHEX Public Const GOPHER_TYPE_DOS_ARCHIVE = &H20 'Archivo de MS-DOS Public Const GOPHER_TYPE_UNIX_UUENCODED = &H40 'Archivo UUENCODED Public Const GOPHER_TYPE_INDEX_SERVER = &H80 'Servidor de indices Public Const GOPHER_TYPE_TELNET = &H100 'Servidor Telnet Public Const GOPHER_TYPE_BINARY = &H200 'Archivo binario Public Const GOPHER_TYPE_REDUNDANT = &H400 'Indica que es un duplicado del servidor Public Const GOPHER_TYPE_TN3270 = &H800 'Servidor TN3270 Public Const GOPHER_TYPE_GIF = &H1000 'Archivo de imagen GIF Public Const GOPHER_TYPE_IMAGE = &H2000 'Archivo de imagen Public Const GOPHER_TYPE_BITMAP = &H4000 'Archivo de mapa de bits Public Const GOPHER_TYPE_MOVIE = &H8000 'Archivo de película Public Const GOPHER_TYPE_SOUND = &H10000 'Archivo de sonido Public Const GOPHER_TYPE_HTML = &H20000 'Documento HTML Public Const GOPHER_TYPE_PDF = &H40000 'Archivo PDF Public Const GOPHER_TYPE_CALENDAR = &H80000 'Archivo de calendario Public Const GOPHER_TYPE_INLINE = &H100000 'Archivo Inline Public Const GOPHER_TYPE_UNKNOWN = &H20000000 'Elemento desconocido Public Const GOPHER_TYPE_ASK = &H40000000 'Ask+ Item Public Const GOPHER_TYPE_GOPHER_PLUS = &H80000000 'Gopher+ Item
Public Const MAX_GOPHER_DISPLAY_TEXT = 128 Public Const MAX_GOPHER_SELECTOR_TEXT = 256 Public Const MAX_GOPHER_HOST_NAME = INTERNET_MAX_HOST_NAME_LENGTH Public Const MAX_GOPHER_LOCATOR_LENGTH = (1 + MAX_GOPHER_DISPLAY_TEXT + 1 + MAX_GOPHER_SELECTOR_TEXT + 1 + MAX_GOPHER_HOST_NAME + 1 + INTERNET_MAX_PORT_NUMBER_LENGTH + 1 + 1 + 2)
'Para HTTP Public Const HTTP_QUERY_MIME_VERSION = 0 Public Const HTTP_QUERY_CONTENT_TYPE = 1 Public Const HTTP_QUERY_CONTENT_TRANSFER_ENCODING = 2 Public Const HTTP_QUERY_CONTENT_ID = 3 Public Const HTTP_QUERY_CONTENT_DESCRIPTION = 4 Public Const HTTP_QUERY_CONTENT_LENGTH = 5 Public Const HTTP_QUERY_CONTENT_LANGUAGE = 6 Public Const HTTP_QUERY_ALLOW = 7 Public Const HTTP_QUERY_PUBLIC = 8 Public Const HTTP_QUERY_DATE = 9 Public Const HTTP_QUERY_EXPIRES = 10 Public Const HTTP_QUERY_LAST_MODIFIED = 11 Public Const HTTP_QUERY_MESSAGE_ID = 12 Public Const HTTP_QUERY_URI = 13 Public Const HTTP_QUERY_DERIVED_FROM = 14 Public Const HTTP_QUERY_COST = 15 Public Const HTTP_QUERY_LINK = 16 Public Const HTTP_QUERY_PRAGMA = 17 Public Const HTTP_QUERY_VERSION = 18 'special: part of status line Public Const HTTP_QUERY_STATUS_CODE = 19 'special: part of status line Public Const HTTP_QUERY_STATUS_TEXT = 20 'special: part of status line Public Const HTTP_QUERY_RAW_HEADERS = 21 'special: all headers as ASCIIZ Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22 'special: all headers Public Const HTTP_QUERY_CONNECTION = 23 Public Const HTTP_QUERY_ACCEPT = 24 Public Const HTTP_QUERY_ACCEPT_CHARSET = 25 Public Const HTTP_QUERY_ACCEPT_ENCODING = 26 Public Const HTTP_QUERY_ACCEPT_LANGUAGE = 27 Public Const HTTP_QUERY_AUTHORIZATION = 28 Public Const HTTP_QUERY_CONTENT_ENCODING = 29 Public Const HTTP_QUERY_FORWARDED = 30 Public Const HTTP_QUERY_FROM = 31 Public Const HTTP_QUERY_IF_MODIFIED_SINCE = 32 Public Const HTTP_QUERY_LOCATION = 33 Public Const HTTP_QUERY_ORIG_URI = 34 Public Const HTTP_QUERY_REFERER = 35 Public Const HTTP_QUERY_RETRY_AFTER = 36 Public Const HTTP_QUERY_SERVER = 37 Public Const HTTP_QUERY_TITLE = 38 Public Const HTTP_QUERY_USER_AGENT = 39 Public Const HTTP_QUERY_WWW_AUTHENTICATE = 40 Public Const HTTP_QUERY_PROXY_AUTHENTICATE = 41 Public Const HTTP_QUERY_ACCEPT_RANGES = 42 Public Const HTTP_QUERY_SET_COOKIE = 43 Public Const HTTP_QUERY_COOKIE = 44 Public Const HTTP_QUERY_REQUEST_METHOD = 45 'special: GET/POST etc. Public Const HTTP_QUERY_MAX = 45 Public Const HTTP_QUERY_CUSTOM = 65535 Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000 Public Const HTTP_QUERY_FLAG_SYSTEMTIME = &H40000000 Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000 Public Const HTTP_QUERY_FLAG_COALESCE = &H10000000
'Servidores de Internet Public Const INTERNET_SERVICE_FTP = 1 Public Const INTERNET_SERVICE_GOPHER = 2 Public Const INTERNET_SERVICE_HTTP = 3
'Indicadores para InternetQueryOption e InternetSetOption Public Const INTERNET_OPTION_CALLBACK = 1 Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2 Public Const INTERNET_OPTION_CONNECT_RETRIES = 3 Public Const INTERNET_OPTION_CONNECT_BACKOFF = 4 Public Const INTERNET_OPTION_SEND_TIMEOUT = 5 Public Const INTERNET_OPTION_CONTROL_SEND_TIMEOUT = INTERNET_OPTION_SEND_TIMEOUT Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6 Public Const INTERNET_OPTION_CONTROL_RECEIVE_TIMEOUT = INTERNET_OPTION_RECEIVE_TIMEOUT Public Const INTERNET_OPTION_DATA_SEND_TIMEOUT = 7 Public Const INTERNET_OPTION_DATA_RECEIVE_TIMEOUT = 8 Public Const INTERNET_OPTION_HANDLE_TYPE = 9 Public Const INTERNET_OPTION_CONTEXT_VALUE = 10
Public Const INTERNET_OPTION_READ_BUFFER_SIZE = 12 Public Const INTERNET_OPTION_WRITE_BUFFER_SIZE = 13
Public Const INTERNET_OPTION_ASYNC_ID = 15 Public Const INTERNET_OPTION_ASYNC_PRIORITY = 16
Public Const INTERNET_OPTION_PARENT_HANDLE = 21 Public Const INTERNET_OPTION_KEEP_CONNECTION = 22 Public Const INTERNET_OPTION_REQUEST_FLAGS = 23 Public Const INTERNET_OPTION_EXTENDED_ERROR = 24
Public Const INTERNET_OPTION_OFFLINE_MODE = 26 Public Const INTERNET_OPTION_CACHE_STREAM_HANDLE = 27 Public Const INTERNET_OPTION_USERNAME = 28 Public Const INTERNET_OPTION_PASSWORD = 29 Public Const INTERNET_OPTION_ASYNC = 30 Public Const INTERNET_OPTION_SECURITY_FLAGS = 31 Public Const INTERNET_OPTION_SECURITY_CERTIFICATE_STRUCT = 32 Public Const INTERNET_OPTION_DATAFILE_NAME = 33 Public Const INTERNET_OPTION_URL = 34 Public Const INTERNET_OPTION_SECURITY_CERTIFICATE = 35 Public Const INTERNET_OPTION_SECURITY_KEY_BITNESS = 36 Public Const INTERNET_OPTION_REFRESH = 37 Public Const INTERNET_OPTION_PROXY = 38 Public Const INTERNET_OPTION_SETTINGS_CHANGED = 39 Public Const INTERNET_OPTION_VERSION = 40
'Estados de la conexión Public Const INTERNET_STATUS_RESOLVING_NAME = 10 Public Const INTERNET_STATUS_NAME_RESOLVED = 11 Public Const INTERNET_STATUS_CONNECTING_TO_SERVER = 20 Public Const INTERNET_STATUS_CONNECTED_TO_SERVER = 21 Public Const INTERNET_STATUS_SENDING_REQUEST = 30 Public Const INTERNET_STATUS_REQUEST_SENT = 31 Public Const INTERNET_STATUS_RECEIVING_RESPONSE = 40 Public Const INTERNET_STATUS_RESPONSE_RECEIVED = 41 Public Const INTERNET_STATUS_CTL_RESPONSE_RECEIVED = 42 Public Const INTERNET_STATUS_PREFETCH = 43 Public Const INTERNET_STATUS_CLOSING_CONNECTION = 50 Public Const INTERNET_STATUS_CONNECTION_CLOSED = 51 Public Const INTERNET_STATUS_HANDLE_CREATED = 60 Public Const INTERNET_STATUS_HANDLE_CLOSING = 70 Public Const INTERNET_STATUS_REQUEST_COMPLETE = 100 Public Const INTERNET_STATUS_REDIRECT = 110
'Puertos estandard Public Const INTERNET_DEFAULT_FTP_PORT = 21 'default for FTP servers Public Const INTERNET_DEFAULT_GOPHER_PORT = 70 ' " " gopher " Public Const INTERNET_DEFAULT_HTTP_PORT = 80 ' " " HTTP " Public Const INTERNET_DEFAULT_HTTPS_PORT = 443 ' " " HTTPS " Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080 'default for SOCKS firewall servers.
'Modos de acceso a los archivos Public Const GENERIC_READ = &H80000000 Public Const GENERIC_WRITE = &H40000000
'Posiciones en el archivo Public Const FILE_BEGIN = 0 Public Const FILE_CURRENT = 1 Public Const FILE_END = 2
Public Const MAX_PATH = 260
Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type
Public 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
Public Type INTERNET_CACHE_ENTRY_INFO_UNION dwReserved As Long dwExemptDelta As Long End Type
Public Type INTERNET_CACHE_ENTRY_INFO dwStructSize As Long 'Tamaño, en bytes de la estructura lpszSourceUrlName As String 'Dirección URL lpszLocalFileName As String 'Nombre del archivo local CacheEntryType As Long dwUseCount As Long 'Cuenta del usuario actual de la entrada del cache dwHitRate As Long 'Numero de veces que la entrada del cache fue recuperada dwSizeLow As Long dwSizeHigh As Long LastModifiedTime As FILETIME ExpireTime As FILETIME LastAccessTime As FILETIME LastSyncTime As FILETIME lpHeaderInfo As Byte 'Dirección del búfer que contiene la información del encabezado dwHeaderInfoSize As Long 'Tamaño del búfer de lpHeaderInfo lpszFileExtension As String Union As INTERNET_CACHE_ENTRY_INFO_UNION End Type
Public Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type
Public Type GOPHER_FIND_DATA DisplayString(MAX_GOPHER_DISPLAY_TEXT + 1) As Byte GopherType As Long SizeLow As Long SizeHigh As Long LastModificationTime As FILETIME Locator(MAX_GOPHER_LOCATOR_LENGTH + 1) As Byte End Type
Public Type GOPHER_ADMIN_ATTRIBUTE_TYPE Comment As String EmailAddress As String End Type
Public Type GOPHER_SCORE_ATTRIBUTE_TYPE Score As Integer End Type
Public Type GOPHER_SCORE_RANGE_ATTRIBUTE_TYPE LowerBound As Integer UpperBound As Integer End Type
Public Type GOPHER_SITE_ATTRIBUTE_TYPE Site As String End Type
Public Type GOPHER_ORGANIZATION_ATTRIBUTE_TYPE Organization As String End Type
Public Type GOPHER_LOCATION_ATTRIBUTE_TYPE Location As String End Type
Public Type GOPHER_GEOGRAPHICAL_LOCATION_ATTRIBUTE_TYPE DegreesNorth As Integer MinutesNorth As Integer SecondsNorth As Integer DegreesEast As Integer MinutesEast As Integer SecondsEast As Integer End Type
Public Type GOPHER_TIMEZONE_ATTRIBUTE_TYPE Zone As Integer End Type
Public Type GOPHER_PROVIDER_ATTRIBUTE_TYPE Provider As String End Type
Public Type GOPHER_VERSION_ATTRIBUTE_TYPE Version As String End Type
Public Type GOPHER_ABSTRACT_ATTRIBUTE_TYPE ShortAbstract As String AbstractFile As String End Type
Public Type GOPHER_VIEW_ATTRIBUTE_TYPE ContentType As String Language As String Size As Long End Type
Public Type GOPHER_VERONICA_ATTRIBUTE_TYPE TreeWalk As Long End Type
Public Type GOPHER_ASK_ATTRIBUTE_TYPE QuestionType As String QuestionText As String End Type
Public Type GOPHER_UNKNOWN_ATTRIBUTE_TYPE Text As String End Type
Public Type GOPHER_ATTRIBUTE_TYPE_UNION Admin As GOPHER_ADMIN_ATTRIBUTE_TYPE ModDate As FILETIME Score As GOPHER_SCORE_ATTRIBUTE_TYPE ScoreRange As GOPHER_SCORE_RANGE_ATTRIBUTE_TYPE Site As GOPHER_SITE_ATTRIBUTE_TYPE Organization As GOPHER_ORGANIZATION_ATTRIBUTE_TYPE Location As GOPHER_LOCATION_ATTRIBUTE_TYPE GeographicalLocation As GOPHER_GEOGRAPHICAL_LOCATION_ATTRIBUTE_TYPE TimeZone As GOPHER_TIMEZONE_ATTRIBUTE_TYPE Provider As GOPHER_PROVIDER_ATTRIBUTE_TYPE Version As GOPHER_VERSION_ATTRIBUTE_TYPE Abstract As GOPHER_ABSTRACT_ATTRIBUTE_TYPE View As GOPHER_VIEW_ATTRIBUTE_TYPE Veronica As GOPHER_VERONICA_ATTRIBUTE_TYPE Ask As GOPHER_ASK_ATTRIBUTE_TYPE Unknown As GOPHER_UNKNOWN_ATTRIBUTE_TYPE End Type
Public Type GOPHER_ATTRIBUTE_TYPE CategoryId As Long AttributeId As Long AttributeType As GOPHER_ATTRIBUTE_TYPE_UNION End Type
Public Type INTERNET_BUFFERS dwStructSize As Long Next As Long 'Dirección del siguiente INTERNET_BUFFERS lpcszHeader As String 'Cadena que contiene los encabezados dwHeadersLength As Long 'Tamaño de los encabezados si lpcszHeader no es Nulo dwHeadersTotal As Long 'Tamaño total de los encabezados si no hay suficiente memoria en lpcszHeader lpvBuffer As Variant 'Búfer de datos dwBufferLength As Long 'Tamaño de lpvBuffer si lpvBuffer no es Nulo dwBufferTotal As Long dwOffsetLow As Long 'Usado para leer rangos dwOffsetHigh As Long 'Usado para leer rangos End Type
Public Type URL_COMPONENTS dwStructSize As Long lpszScheme As String dwSchemeLength As Long nScheme As Integer lpszHostName As String dwHostNameLength As Long nPort As Integer lpszUsername As String dwUserNameLength As Long lpszPassword As String dwPasswordLength As Long lpszUrlPath As String dwUrlPathLength As Long lpszExtraInfo As String dwExtraInfoLength As Long End Type
Function InternetStatusCallback(ByVal hInternet As Long, ByVal dwContext As Long, ByVal dwInternetStatus As Long, lpvStatusInformation As Variant, ByVal dwStatusInformationLength As Long)
End Function
Saludos.
|
|
|
4
|
Programación / Programación Visual Basic / Buscar huecos en ejecutables.
|
en: 20 Agosto 2005, 08:39 am
|
Para los que le interese la programación de virus este código sirve para buscar espacios libres en la sección de código del ejecutable para luego poder insertar nuestro código ahi. Lo bueno de este método es que la sección de código (.text) siempre tiene permiso de ejecución por lo que no nos dará errores de protección. Necesita agregar como referencia al proyecto win.tlb' 'Coded by Slasher ' Option Explicit Option Base 1
Public Const IMAGE_SIZEOF_SHORT_NAME = 8 Public Const IMAGE_NUMBEROF_DIRECTORY_ENTRIES = 16
Public Const IMAGE_DOS_SIGNATURE = &H5A4D ' MZ Public Const IMAGE_OS2_SIGNATURE = &H454E ' NE Public Const IMAGE_OS2_SIGNATURE_LE = &H454C ' LE Public Const IMAGE_NT_SIGNATURE = &H4550 ' PE Public Const IMAGE_FILE_UNKNOWN = &H0 ' Desconocido
Type IMAGE_DOS_HEADER e_magic As Integer e_cblp As Integer e_cp As Integer e_crlc As Integer e_cparhdr As Integer e_minalloc As Integer e_maxalloc As Integer e_ss As Integer e_sp As Integer e_csum As Integer e_ip As Integer e_cs As Integer e_lfarlc As Integer e_ovno As Integer e_res(3) As Integer e_oemid As Integer e_oeminfo As Integer e_res2(9) As Integer e_lfanew As Long End Type
Type IMAGE_FILE_HEADER Magic As Long Machine As Integer NumberOfSections As Integer TimeDateStamp As Long PointerToSymbolTable As Long NumberOfSymbols As Long SizeOfOptionalHeader As Integer Characteristics As Integer End Type
Type IMAGE_DATA_DIRECTORY VirtualAddress As Long Size As Long End Type
Type IMAGE_OPTIONAL_HEADER 'Campos estándar ' Magic As Integer MajorLinkerVersion As Byte MinorLinkerVersion As Byte SizeOfCode As Long SizeOfInitializedData As Long SizeOfUninitializedData As Long AddressOfEntryPoint As Long BaseOfCode As Long BaseOfData As Long 'Campos adicionales de NT ' ImageBase As Long SectionAlignment As Long FileAlignment As Long MajorOperatingSystemVersion As Integer MinorOperatingSystemVersion As Integer MajorImageVersion As Integer MinorImageVersion As Integer MajorSubsystemVersion As Integer MinorSubsystemVersion As Integer Reserved1 As Long SizeOfImage As Long SizeOfHeaders As Long CheckSum As Long Subsystem As Integer DllCharacteristics As Integer SizeOfStackReserve As Long SizeOfStackCommit As Long SizeOfHeapReserve As Long SizeOfHeapCommit As Long LoaderFlags As Long NumberOfRvaAndSizes As Long DataDirectory(IMAGE_NUMBEROF_DIRECTORY_ENTRIES - 1) As IMAGE_DATA_DIRECTORY End Type
Type HoleInfo Offset As Long Size As Long End Type
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Sub Main() Dim lpHoles() As HoleInfo Dim hMap&, lBase&, lSize& Dim lHoles&, i&
hMap = MapExe("C:\WINDOWS\SYSTEM32\NOTEPAD.EXE") lBase = GetCodeOffset(hMap, lSize) 'Busca huecos de 128 bytes como mínimo. ' lHoles = FindHoles(hMap, lBase, lSize, lpHoles, 128) For i = 1 To lHoles Debug.Print "Hueco Nº " & i, "Offset: 0x" & Hex$(lpHoles(i).Offset), _ "Tamaño: 0x" & Hex$(lpHoles(i).Size) Next Call VirtualFree(hMap, 0&, MEM_RELEASE)
End Sub
Function MapExe(Filename As String) As Long Dim hMem&, hFile& Dim r&
hFile = CreateFile(Filename, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0&, OPEN_EXISTING, 0&, 0&) If hFile = INVALID_HANDLE_VALUE Then Exit Function 'Asigna memoria. ' hMem = VirtualAlloc(0&, GetFileSize(hFile, 0), MEM_COMMIT, PAGE_READWRITE) 'Lee el archivo a memoria. ' r = ReadFile(hFile, ByVal hMem, GetFileSize(hFile, 0), 0&, ByVal 0&) MapExe = hMem End Function
Function GetCodeOffset(hMap As Long, Optional outSize As Long) As Long Dim lpDosHdr As IMAGE_DOS_HEADER Dim lpFileHdr As IMAGE_FILE_HEADER Dim lpOptHdr As IMAGE_OPTIONAL_HEADER Dim r&
r = ReadProcessMemory(GetCurrentProcess(), hMap, lpDosHdr, Len(lpDosHdr)) If lpDosHdr.e_magic <> IMAGE_DOS_SIGNATURE Then Exit Function r = ReadProcessMemory(GetCurrentProcess(), hMap + lpDosHdr.e_lfanew + Len(lpFileHdr), lpOptHdr, Len(lpOptHdr)) outSize = lpOptHdr.SizeOfCode GetCodeOffset = lpOptHdr.BaseOfCode End Function
Function FindHoles(hMap As Long, BaseOfCode As Long, SizeOfCode As Long, outHoles() As HoleInfo, Optional MinSize As Integer) As Long Dim btData() As Byte Dim lHoleSize&, lCnt& Dim r&, i&
ReDim btData(SizeOfCode) As Byte r = ReadProcessMemory(GetCurrentProcess(), hMap + BaseOfCode, btData(1), SizeOfCode) If MinSize <= 0 Then MinSize = 128 Erase outHoles For i = 1 To SizeOfCode If btData(i) <> 0 And lHoleSize > MinSize Then lCnt = lCnt + 1 ReDim Preserve outHoles(lCnt) As HoleInfo outHoles(lCnt).Offset = BaseOfCode + i outHoles(lCnt).Size = lHoleSize lHoleSize = 0 ElseIf btData(i) = 0 Then lHoleSize = lHoleSize + 1 End If Next FindHoles = lCnt End Function
Saludos.
|
|
|
5
|
Programación / Programación Visual Basic / Apagar monitor desde VB
|
en: 19 Agosto 2005, 01:39 am
|
Option Explicit
Const TOKEN_ADJUST_PRIVILEGES = &H20 Const TOKEN_QUERY = &H8 Const SE_PRIVILEGE_ENABLED = &H2
Const ANYSIZE_ARRAY = 1
Type LUID LowPart As Long HighPart As Long End Type
Type LUID_AND_ATTRIBUTES pLuid As LUID Attributes As Long End Type
Type TOKEN_PRIVILEGES PrivilegeCount As Long Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES End Type
Declare Function GetCurrentProcess Lib "kernel32" () As Long Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLUID As LUID) As Long 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
Declare Function SetSystemPowerState Lib "kernel32" (ByVal fSuspend As Long, ByVal fForce As Long) As Long
Private Sub SetShutdownPrivilege() Dim lpLUID As LUID Dim lpToken As TOKEN_PRIVILEGES Dim lpPrevToken As TOKEN_PRIVILEGES Dim hToken&, r&
r = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES + TOKEN_QUERY, hToken) r = LookupPrivilegeValue(vbNullString, "SeShutdownPrivilege", lpLUID) With lpToken .PrivilegeCount = 1 .Privileges(0).Attributes = SE_PRIVILEGE_ENABLED .Privileges(0).pLuid = lpLUID End With r = AdjustTokenPrivileges(hToken, False, lpToken, 4 + (12 * lpToken.PrivilegeCount), lpPrevToken, 4 + (12 * lpPrevToken.PrivilegeCount)) End Sub
Sub SuspendSystem() Call SetShutdownPrivilege Call SetSystemPowerState(True, False) End Sub
|
|
|
6
|
Media / Juegos y Consolas / Counter Strike Mod AMX - Ranking
|
en: 10 Agosto 2005, 03:01 am
|
Buenas. Tengo montado un server de CS en LAN y quería crear una tabla de ranking.
Estuve buscando por el foro y por internet y no encontré ningún plugin o método para crear un ranking para el cs (o será que no soy tan vicioso y no sé buscar xD).
Cualquiera que sepa algo al respecto se lo voy a agradecer.
Saludos.
|
|
|
7
|
Programación / Programación Visual Basic / Listar procesos, threads, módulos y ventanas.
|
en: 9 Junio 2005, 09:13 am
|
Bueno lo siguiente es un código que escribi hace mucho y que lista todos los procesos del sistema, cos sus threads, módulos atados y las ventanas de cada thread. Se puede utilizar para hacer un árbol de recursos o algo similar. También tiene un sistema que loguea los procesos creando una tabla en memoria con los datos de todos los procesos y luego se puede guardar en un archivo. El código es algo complejo pero no tengo ganas de ponerle los comentarios xDDD. Con sólo llamar a EnumProcesses la variable global SysProcess va a tener almacenados todos los procesos y sus datos. '***************************************************************** ' 'Autor: Slasher Keeper 'Descripción: ' * Lista procesos del sistema y sus recursos. ' * Loguea los procesos. '***************************************************************** ' Option Explicit Option Base 1
Public Const MAX_PATH = 260
Const TH32CS_SNAPHEAPLIST = &H1 Const TH32CS_SNAPPROCESS = &H2 Const TH32CS_SNAPTHREAD = &H4 Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Type WindowInfo ProcessId As Long ThreadID As Long NumThdWindows As Long ThreadWindows() As Long hwndParent As Long hwnd As Long hModule As Long hIcon As Long Identifier As Long WindowProc As Long hInstance As Long Style As Long UserData As Long ChildWindows() As Long NumOfChild As Integer Index As Integer ClassName As String Text As String * MAX_PATH ModuleName As String * MAX_PATH End Type
Type ThreadInfo ThreadID As Long BasePriority As Long UsageCount As Long AttachCount As Long End Type
Type ModuleInfo BaseAddress As Long hModule As Long ModuleSize As Long ProcessId As Long ModuleId As Long GlobalUsage As Long ProcessUsage As Long Filename As String * MAX_PATH ModuleName As String * MAX_PATH End Type
Type ProcessInfo hProcess As Long ProcessId As Long ParentProcessID As Long PriorityClass As Long MinWorkingSetSize As Long MaxWorkingSetSize As Long ExitCode As Long AffinityMask As Long SysAffinityMask As Long HandleCount As Long NumOfThreads As Long NumOfModules As Long CurrentMemPage As Long Threads() As ThreadInfo Modules() As ModuleInfo ExeFilename As String * MAX_PATH Index As Integer End Type
Type FileVersionInfo CompanyName As String FileDescription As String FileVersion As String InternalName As String LegalCopyright As String OriginalFileName As String ProductName As String ProductVersion As String Comments As String FileOS As String End Type
Type HEAPENTRY32 dwSize As Long hHandle As Long dwAddress As Long dwBlockSize As Long dwFlags As Long dwLockCount As Long dwResvd As Long th32ProcessID As Long th32HeapID As Long End Type
Type Var wLength As Integer wValueLength As Integer wType As Integer szKey As Long Padding As Long Value() As Long End Type
Type MODULEENTRY32 dwSize As Long th32ModuleID As Long th32ProcessID As Long GlblcntUsage As Long ProccntUsage As Long modBaseAddr As Long modBaseSize As Long hModule As Long szModule As String * 256 szExePath As String * 256 End Type
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 * MAX_PATH End Type
Type THREADENTRY32 dwSize As Long cntUsage As Long th32ThreadID As Long th32OwnerProcessID As Long tpBasePri As Long tpDeltaPri As Long dwFlags As Long End Type
Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long Declare Function Heap32First Lib "kernel32" (lpHE As HEAPENTRY32, ByVal th32ProcessID As Long, ByVal th32HeapID As Long) As Boolean Declare Function Heap32ListFirst Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPENTRY32) As Boolean Declare Function Heap32ListNext Lib "kernel32" (ByVal hSnapshot As Long, lphl As HEAPENTRY32) As Boolean Declare Function Heap32Next Lib "kernel32" (lpHE As HEAPENTRY32) As Boolean Declare Function Module32First Lib "kernel32" (ByVal hSnapshot As Long, lpME As MODULEENTRY32) As Boolean Declare Function Module32Next Lib "kernel32" (ByVal hSnapshot As Long, lpME As MODULEENTRY32) As Boolean Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32) As Boolean Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32) As Boolean Declare Function Thread32First Lib "kernel32" (ByVal hSnapshot As Long, lpte As THREADENTRY32) As Boolean Declare Function Thread32Next Lib "kernel32" (ByVal hSnapshot As Long, lpte As THREADENTRY32) As Boolean Declare Function Toolhelp32ReadProcessMemory Lib "kernel32" (ByVal th32ProcessID As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal cbRead As Long, lpNumberOfBytesRead As Long) As Boolean
Declare Function GetCurrentThread Lib "kernel32" () As Long 'Devuelve una pseudo-referencia al subproceso actual. Declare Function GetCurrentThreadId Lib "kernel32" () As Long 'Devuelve el identificador de subproceso del subproceso que llama a la función. Declare Function GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long 'Devuelve el estado de terminación del subproceso actual. Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long 'Devuelve la clase de prioridad para el proceso especificado. Declare Function GetProcessAffinityMask Lib "kernel32" (ByVal hProcess As Long, lpProcessAffinityMask As Long, SystemAffinityMask As Long) As Long 'Devuelve la máscara de afinidad (valor que indica sobre qué procesador se puede ejecutar) para el proceso especificado. Declare Function GetProcessShutdownParameters Lib "kernel32" (lpdwLevel As Long, lpdwFlags As Long) As Long 'Devuelve los parámetros de cierre para el proceso que llama a la función. Declare Function GetProcessWorkingSetSize Lib "kernel32" (ByVal hProcess As Long, lpMinimumWorkingSetSize As Long, lpMaximumWorkingSetSize As Long) As Long 'Obtiene el mínimo y el máximo del tamaño del espacio de trabajo (working set) de un proceso especificado. Declare Function GetThreadPriority Lib "kernel32" (ByVal hThread As Long) As Long 'Devuelve el nivel de prioridad para el subproceso especificado. Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long 'Establece la clase de prioridad para el proceso especificado.
Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Declare Function GetWindowModuleFileName Lib "user32" Alias "GetWindowModuleFileNameA" (ByVal hwnd As Long, ByVal lpszFileName As String, ByVal cchFileNameMax As Long) As Long Declare Function EnumThreadWindows Lib "user32" (ByVal dwThreadId As Long, ByVal lpfn As Long, lParam As WindowInfo) As Long Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public SysProcess() As ProcessInfo Public SysModule() As ModuleInfo Public Windows() As WindowInfo
Public lSysProcCnt As Long Public lSysModCnt As Long Public lWinCnt As Long
Private CancelProcessLog As Boolean Private bIsLogging As Boolean Private bProcLogStarted As Boolean
Private hProcTable As Long
Property Get ActiveProcessId() As Long Dim r& r = GetWindowThreadProcessId(GetForegroundWindow, ActiveProcessId) End Property
Property Get ActiveProcess() As ProcessInfo ActiveProcess = GetProcessInfoById(ActiveProcessId) End Property
Property Get ActiveThreadId() As Long ActiveThreadId = GetWindowThreadProcessId(GetForegroundWindow, 0) End Property
Property Get IsProcessLogEnabled() As Boolean IsProcessLogEnabled = bIsLogging End Property
Sub EnumProcesses(Optional OpenHandles As Boolean = False) Dim hSnap& Dim pe32 As PROCESSENTRY32
Erase SysProcess lSysProcCnt = 0 'Crea el objeto Snapshot. hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) pe32.dwSize = LenB(pe32) 'Obtiene el primer proceso. If Process32First(hSnap, pe32) Then lSysProcCnt = 1 ReDim SysProcess(lSysProcCnt) As ProcessInfo SysProcess(lSysProcCnt) = GetProcessInfo(pe32, OpenHandles) SysProcess(lSysProcCnt).Index = lSysProcCnt Do While Process32Next(hSnap, pe32) lSysProcCnt = lSysProcCnt + 1 ReDim Preserve SysProcess(lSysProcCnt) As ProcessInfo SysProcess(lSysProcCnt) = GetProcessInfo(pe32, OpenHandles) SysProcess(lSysProcCnt).Index = lSysProcCnt Loop End If Call CloseHandle(hSnap) End Sub
Function GetWindowInfo(ByVal hwnd As Long, Optional EnumThdWins As Boolean = True) As WindowInfo On Error Resume Next Dim r& With GetWindowInfo .hwnd = hwnd .hwndParent = GetParent(hwnd) .ThreadID = GetWindowThreadProcessId(hwnd, .ProcessId) .hIcon = GetClassLong(.hwndParent, GCL_HICON) .hInstance = GetWindowLong(.hwndParent, GWL_HINSTANCE) .Identifier = GetWindowLong(.hwndParent, GWL_ID) .Style = GetWindowLong(.hwndParent, GWL_STYLE) .WindowProc = GetWindowLong(.hwndParent, GWL_WNDPROC) .UserData = GetWindowLong(.hwndParent, GWL_USERDATA) r = EnumChildWindows(hwnd, AddressOf EnumChildProc, GetWindowInfo) .ClassName = String$(256, 0) r = GetClassName(hwnd, .ClassName, MAX_PATH) .ClassName = Left$(.ClassName, r) .Text = GetWindowText(hwnd) r = GetWindowModuleFileName(hwnd, .ModuleName, MAX_PATH) .ModuleName = Left$(.ModuleName, r) .hModule = GetModuleHandle(Trim(.ModuleName)) If EnumThdWins Then _ r = EnumThreadWindows(.ThreadID, AddressOf EnumThreadWndProc, GetWindowInfo) End With End Function
Function GetProcessInfo(pProcess As PROCESSENTRY32, Optional OpenHandle As Boolean = False) As ProcessInfo 'Obtiene información acerca de un proceso. ' With GetProcessInfo .hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pProcess.th32ProcessID) .ProcessId = pProcess.th32ProcessID .ParentProcessID = pProcess.th32ParentProcessID .PriorityClass = GetPriorityClass(.hProcess) .NumOfThreads = pProcess.cntThreads .Threads = EnumThreads(.ProcessId) .Modules = EnumModules(.ProcessId, .NumOfModules) .ExeFilename = RTrim$(pProcess.szExeFile) .HandleCount = pProcess.cntUsage Call GetProcessWorkingSetSize(.hProcess, .MinWorkingSetSize, .MaxWorkingSetSize) Call GetExitCodeProcess(.hProcess, .ExitCode) Call GetProcessAffinityMask(.hProcess, .AffinityMask, .SysAffinityMask) If Not OpenHandle Then 'Se cierra el controlador del proceso. ' Call CloseHandle(.hProcess) .hProcess = 0 End If End With End Function
Function EnumThreads(ByVal ProcessId As Long) As ThreadInfo()
Dim te32 As THREADENTRY32 Dim thds() As ThreadInfo Dim iCount% Dim hSnap& 'Crea el objeto snapshot. hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&) te32.dwSize = LenB(te32) If Thread32First(hSnap, te32) Then 'Si se obtiene el primer subproceso. If te32.th32OwnerProcessID = ProcessId Then GoSub GetThreadInfo Do While Thread32Next(hSnap, te32) 'Obtiene los siguientes subprocesos y verifica 'que pertenezcan al proceso especificado. If te32.th32OwnerProcessID = ProcessId Then GoSub GetThreadInfo End If Loop End If CloseHandle hSnap EnumThreads = thds Exit Function GetThreadInfo: iCount = iCount + 1 ReDim Preserve thds(iCount) As ThreadInfo With thds(iCount) .ThreadID = te32.th32ThreadID .BasePriority = te32.tpBasePri .UsageCount = te32.cntUsage End With Return End Function
Function EnumModules(Optional ByVal ProcessId As Long, Optional NumOfModules As Long) As ModuleInfo() Dim me32 As MODULEENTRY32 Dim pModule() As ModuleInfo Dim iCount% Dim hSnap& If ProcessId = 0 Then ProcessId = GetCurrentProcessId 'Crea el objeto snapshot. hSnap& = CreateToolhelp32Snapshot(TH32CS_SNAPALL, ProcessId) me32.dwSize = LenB(me32) If Module32First(hSnap, me32) Then 'Si se obtiene el primer módulo. GoSub GetModuleInfo Do While Module32Next(hSnap, me32) 'Obtiene los siguientes módulos. If me32.th32ProcessID = ProcessId Then GoSub GetModuleInfo End If Loop End If CloseHandle hSnap NumOfModules = iCount EnumModules = pModule Exit Function GetModuleInfo: iCount = iCount + 1 ReDim Preserve pModule(iCount) As ModuleInfo With pModule(iCount) .hModule = me32.hModule .ModuleId = me32.th32ModuleID .BaseAddress = me32.modBaseAddr .ModuleSize = me32.modBaseSize .GlobalUsage = me32.GlblcntUsage .ProcessUsage = me32.ProccntUsage .ProcessId = ProcessId .ModuleName = Left$(me32.szModule, InStr(1, me32.szModule, vbNullChar) - 1) .Filename = Left$(me32.szExePath, InStr(1, me32.szExePath, vbNullChar) - 1) End With Return End Function
Function EnumSysModules() As Long On Error Resume Next Dim i&, ind& Call EnumProcesses Erase SysModule lSysModCnt = 0 For i = 1 To lSysProcCnt For ind = 1 To SysProcess(i).NumOfModules If Not ModuleExist(SysProcess(i).Modules(ind)) Then lSysModCnt = lSysModCnt + 1 ReDim Preserve SysModule(lSysModCnt) As ModuleInfo SysModule(lSysModCnt) = SysProcess(i).Modules(ind) End If Next Next EnumSysModules = lSysModCnt End Function
Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Boolean Dim pWin As WindowInfo
pWin = GetWindowInfo(hwnd, False) lWinCnt = lWinCnt + 1 ReDim Preserve Windows(lWinCnt) As WindowInfo pWin.Index = lWinCnt Windows(lWinCnt) = pWin EnumWindowsProc = True End Function
Function EnumChildProc(ByVal hwnd As Long, lParam As WindowInfo) As Boolean With lParam .NumOfChild = .NumOfChild + 1 ReDim Preserve .ChildWindows(.NumOfChild) .ChildWindows(.NumOfChild) = hwnd End With EnumChildProc = True End Function
Function EnumThreadWndProc(ByVal hwnd As Long, lParam As WindowInfo) As Boolean With lParam .NumThdWindows = .NumThdWindows + 1 ReDim Preserve .ThreadWindows(.NumThdWindows) As Long .ThreadWindows(.NumThdWindows) = hwnd EnumThreadWndProc = True End With End Function
Function KillProcessByName(AppExeFilename As String, Optional Wait As Boolean = False, Optional WaitTime As Long, Optional KillAll As Boolean = False) As Boolean Dim sAppName$ Dim i% Call EnumProcesses For i = 1 To lSysProcCnt sAppName = RTrim$(Replace(GetFileTitle(SysProcess(i).ExeFilename), vbNullChar, vbNullString)) If InStr(1, sAppName, AppExeFilename, vbTextCompare) Then If SysProcess(i).ProcessId = GetCurrentProcessId Then Exit Function KillProcessByName = KillProcessById(SysProcess(i).ProcessId, Wait, WaitTime) If Not KillAll Then Exit For End If End If Next End Function
Function KillProcessById(ProcessId As Long, Optional Wait As Boolean = False, Optional WaitTime As Long) As Boolean Dim hProcess&, r&
If ProcessId = GetCurrentProcessId Then Exit Function hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, ProcessId) If hProcess Then KillProcessById = (TerminateProcess(hProcess, 0)) If Wait Then If WaitTime = 0 Then WaitTime = 3000 r = WaitForSingleObject(hProcess, WaitTime) If r <> WAIT_OBJECT_0 Then KillProcessById = False End If End If r = CloseHandle(hProcess) End If End Function
Function GetProcessInfoById(ProcessId As Long) As ProcessInfo Dim pProcess As ProcessInfo Dim i&
Call EnumProcesses For i = 1 To lSysProcCnt If SysProcess(i).ProcessId = ProcessId Then GetProcessInfoById = SysProcess(i) Exit For End If Next End Function
Private Function ModuleExist(pModuleInfo As ModuleInfo) As Boolean On Error Resume Next Dim i&
For i = 1 To lSysModCnt If (pModuleInfo.Filename Like SysModule(i).Filename) And _ pModuleInfo.ModuleId = SysModule(i).ModuleId Then ModuleExist = True Exit For End If Next End Function
Sub ProcLogTmrProc(ByVal hwnd As Long, ByVal uMsg As Integer, ByVal idEvent As Integer, ByVal dwTime As Long) Dim r&
r = KillTimer(0&, idEvent) bProcLogStarted = True Call StartProcessLog End Sub
Function StartProcessLog() As Long
'Devuelve un puntero a memoria en donde se encuentran 'almacenados una serie de estructuras ProcessInfo 'que identifican a los procesos. 'Estas estructuras comienzan 4 (cuatro) bytes más 'adelante que dicho puntero. Esto cuatro bytes 'es un valor de tipo Long que indica la cantidad 'de estructuras que existen en la tabla. On Error Resume Next Dim pProcessInfo As ProcessInfo Dim pProcess() As ProcessInfo Dim lProcCnt& Dim snTime! Dim i&, r&
If Not bProcLogStarted Then r = SetTimer(0&, 0&, 0&, AddressOf ProcLogTmrProc) Exit Function End If Call EnumProcesses Call ProcTableInitialize snTime = Timer Do While Not CancelProcessLog If (Timer - snTime) > 2 Then Call EnumProcesses snTime = Timer End If If lSysProcCnt <> lProcCnt Then 'Terminó o se creó un proceso. ' If lProcCnt < lSysProcCnt Then 'Fue creado un nuevo proceso. '
For i = lProcCnt + 1 To lSysProcCnt Call ProcTableAddEntry(SysProcess(i)) If i Mod 4 = 0 Then DoEvents Next pProcess = SysProcess lProcCnt = lSysProcCnt Else 'Si terminó un proceso 'busca el proceso que terminó. ' End If pProcess = SysProcess lProcCnt = lSysProcCnt End If DoEvents Loop StartProcessLog = hProcTable CancelProcessLog = False bProcLogStarted = False Call ProcTableRelease End Function
Sub EndProcessLog() CancelProcessLog = True End Sub
Function ProcTableAddEntry(pInfo As ProcessInfo) As Boolean Dim lOffset&, r&, i& Dim dtNow As Date
If ProcTableGetEntryCount >= 32767 Then Exit Function 'Actualiza la tabla de módulos. ' Call ProcTableRefreshModuleTable '16 bytes: 8 bytes to start time, 8 bytes to end time lOffset = ProcTableCalculateOffset(ProcTableGetEntryCount + 1) r = WriteProcessMemory(GetCurrentProcess(), lOffset, GetProcessInfoSize(pInfo), 4) lOffset = lOffset + 4 r = WriteProcessMemory(GetCurrentProcess(), lOffset, pInfo, 52) lOffset = lOffset + 52 For i = 1 To pInfo.NumOfThreads r = WriteProcessMemory(GetCurrentProcess(), lOffset, pInfo.Threads(i), Len(pInfo.Threads(i))) lOffset = lOffset + Len(pInfo.Threads(i)) Next r = WriteProcessMemory(GetCurrentProcess(), lOffset, ProcTableGetIndexes(pInfo)(1), 4 * pInfo.NumOfModules) lOffset = lOffset + (4 * pInfo.NumOfModules) r = WriteProcessMemory(GetCurrentProcess(), lOffset, CInt(Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString)))), 2&) lOffset = lOffset + 2 r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal pInfo.ExeFilename, Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString)))) lOffset = lOffset + Len(RTrim$(Replace$(pInfo.ExeFilename, vbNullChar, vbNullString))) dtNow = Now r = WriteProcessMemory(GetCurrentProcess(), lOffset, dtNow, 8) r = WriteProcessMemory(GetCurrentProcess(), lOffset + 8, dtNow, 8) If r Then r = WriteProcessMemory(GetCurrentProcess(), hProcTable, ProcTableGetEntryCount() + 1, 2) End If ProcTableAddEntry = (r <> 0) End Function
Function ProcTableGetEntry(Index As Integer) As ProcessInfo Dim lOffset&, r&, i& Dim pEntry As ProcessInfo Dim iSize%, iModSize% If (Index < 0 Or Index > ProcTableGetEntryCount()) Or hProcTable = 0 Then Exit Function lOffset = ProcTableCalculateOffset(Index) r = ReadProcessMemory(GetCurrentProcess(), lOffset + 4, pEntry, 52) lOffset = lOffset + 4 + 52 ReDim pEntry.Threads(1 To pEntry.NumOfThreads) As ThreadInfo r = ReadProcessMemory(GetCurrentProcess(), lOffset, pEntry.Threads(1), Len(pEntry.Threads(1)) * pEntry.NumOfThreads) lOffset = lOffset + (Len(pEntry.Threads(1)) * pEntry.NumOfThreads) ReDim pEntry.Modules(1 To pEntry.NumOfModules) As ModuleInfo For i = 1 To pEntry.NumOfModules r = ReadProcessMemory(GetCurrentProcess(), lOffset, pEntry.Modules(i), 28) lOffset = lOffset + 28 r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2&) lOffset = lOffset + 2 r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.Modules(i).Filename, iSize) lOffset = lOffset + iSize r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2&) lOffset = lOffset + 2 r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.Modules(i).ModuleName, iSize) lOffset = lOffset + iSize Next r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2) lOffset = lOffset + 2 r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pEntry.ExeFilename, iSize) ProcTableGetEntry = pEntry End Function
Function ProcTableGetEntryCount() As Integer Dim iCnt% If hProcTable Then Call ReadProcessMemory(GetCurrentProcess(), hProcTable, iCnt, 2) ProcTableGetEntryCount = iCnt End If End Function
Function ProcTableFindEntry(ProcessId As Long, Optional outIndex As Integer) As ProcessInfo Dim pProcess As ProcessInfo Dim i%
For i = 1 To ProcTableGetEntryCount() pProcess = ProcTableGetEntry(i) If pProcess.ProcessId = ProcessId Then ProcTableFindEntry = pProcess outIndex = i Exit For End If Next End Function
Function ProcTableNotifyEnd(ProcessId As Long) As Boolean Dim dtEndTime As Date Dim pProcess As ProcessInfo Dim iIndex%, lOffset& Dim r& pProcess = ProcTableFindEntry(ProcessId, iIndex) lOffset = ProcTableGetOffset(pProcess) + ProcTableGetEntrySize(iIndex) - 8 dtEndTime = Now r = WriteProcessMemory(GetCurrentProcess(), lOffset, dtEndTime, 8)
End Function
Function ProcTableCalculateOffset(Index As Integer) As Long Dim lOffset& Dim pProcInfo As ProcessInfo Dim pThdInfo As ThreadInfo Dim pModInfo As ModuleInfo Dim i%, r& Dim lSize&
lOffset = GetProcTableOffset For i = 1 To ProcTableGetEntryCount() lOffset = lOffset + lSize r = ReadProcessMemory(GetCurrentProcess(), hProcTable + lOffset, lSize, 4) If i = Index Then Exit For Next lOffset = hProcTable + lOffset ProcTableCalculateOffset = lOffset End Function
Function ProcTableGetOffset(ProcessInfo As ProcessInfo) As Long Dim pProcInfo As ProcessInfo, i%
For i = 1 To ProcTableGetEntryCount() pProcInfo = ProcTableGetEntry(i) If pProcInfo.ProcessId = ProcessInfo.ProcessId Then 'Se encontró el proceso en la tabla. ' ProcTableGetOffset = ProcTableCalculateOffset(i) Exit For End If Next End Function
Function ProcTableGetEntrySize(Index As Integer) As Long Dim lOffset&, lSize& Dim r& lOffset = ProcTableCalculateOffset(Index) r = ReadProcessMemory(GetCurrentProcess(), lOffset, lSize, 4)
ProcTableGetEntrySize = lSize End Function
Function GetProcessInfoSize(ProcInfo As ProcessInfo) As Long Dim pThdInfo As ThreadInfo Dim pModInfo As ModuleInfo Dim lSize&, i&
lSize = 52 + (Len(pThdInfo) * ProcInfo.NumOfThreads) + 16 + 4 lSize = lSize + ProcInfo.NumOfModules * 4 'Tabla de indices de modulos. lSize = lSize + Len(RTrim$(Replace$(ProcInfo.ExeFilename, vbNullChar, vbNullString))) lSize = lSize + 2 GetProcessInfoSize = lSize End Function
Function ProcTableSaveToFile(Filename As String, Optional AppendData As Boolean = True) As Boolean Dim hFile&, sMagic$ Dim lOffset&, lTableSize& Dim sData$, lDataSize& Dim r&
hFile = CreateFile(Filename, GENERIC_READ Or GENERIC_WRITE, 1&, 0&, OPEN_ALWAYS, 0&, 0&) If hFile = INVALID_HANDLE_VALUE Then Exit Function sMagic = String$(3, 0) r = ReadFileStr(hFile, ByVal sMagic, 3&, 0&, ByVal 0&) If AppendData And StrComp(sMagic, "DAT") = False Then lOffset = GetFileSize(hFile, 0) + 1 ElseIf Not AppendData Or StrComp(sMagic, "DAT") Then r = CloseHandle(hFile) r = DeleteFile(Filename)
hFile = CreateFile(Filename, GENERIC_READ Or GENERIC_WRITE, 1&, 0&, CREATE_ALWAYS, 0&, 0&) r = WriteFileStr(hFile, ByVal "DAT", 3&, 0&, ByVal 0&) lOffset = 21 End If lTableSize = ProcTableGetTableSize() lDataSize = GetModuleTableSize + lTableSize + 1 r = SetFilePointer(hFile, 3, 0, FILE_BEGIN) r = WriteFile(hFile, ByVal hProcTable, 10, 0&, ByVal 0&) r = WriteFile(hFile, 1, 1, 0&, ByVal 0&) 'Formato del archivo. r = WriteFile(hFile, 1, 1, 0&, ByVal 0&) 'cifrado. r = WriteFile(hFile, lDataSize, 4, 0&, ByVal 0&) 'Longitud de los datos no cifrados. r = SetFilePointer(hFile, lOffset, 0, FILE_BEGIN) sData = String$(lDataSize, 0) r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 10, ByVal sData, Len(sData)) r = WriteFile(hFile, Len(sData), 4, 0&, ByVal 0&) 'Longitud de los datos cifrados. r = WriteFileStr(hFile, ByVal sData, Len(sData), 0&, ByVal 0&) 'Datos cifrados.
r = CloseHandle(hFile) End Function
Function ProcTableGetTableSize() As Long Dim lSize&, i%
For i = 1 To ProcTableGetEntryCount() lSize = lSize + ProcTableGetEntrySize(i) Next ProcTableGetTableSize = lSize End Function
Function GetModInfoSize(pInfo As ModuleInfo) As Long Dim lSize& With pInfo lSize = 28 lSize = lSize + Len(RTrim$(Replace$(.Filename, vbNullChar, vbNullString))) lSize = lSize + Len(RTrim$(Replace$(.ModuleName, vbNullChar, vbNullString))) GetModInfoSize = lSize End With End Function
Function GetProcTableOffset() As Long Dim lSize& Dim r&
r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 6, lSize, 4) GetProcTableOffset = lSize + 10 End Function
Function GetProcTableOffsetRVA() As Long Dim lSize&
lSize = hProcTable + GetProcTableOffset GetProcTableOffsetRVA = lSize End Function
Function ProcTableGetModuleCount() As Long Dim lCnt&, r& r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 2, lCnt, 4) ProcTableGetModuleCount = lCnt End Function
Function ProcTableGetModuleOffset(Index As Long) As Long Dim lOffset&, i&, r& Dim lSize&
lOffset = 10 For i = 1 To ProcTableGetModuleCount lOffset = lOffset + lSize r = ReadProcessMemory(GetCurrentProcess(), hProcTable + lOffset, lSize, 4&) If Index = i Then ProcTableGetModuleOffset = hProcTable + lOffset Exit For End If Next End Function
Function ProcTableGetModuleInfo(Index As Long) As ModuleInfo Dim pModule As ModuleInfo Dim lOffset&, i&, r& Dim iSize%
lOffset = ProcTableGetModuleOffset(Index) + 4 r = ReadProcessMemory(GetCurrentProcess(), lOffset, pModule, 28) lOffset = lOffset + 28 r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2) lOffset = lOffset + 2 If iSize > MAX_PATH Then iSize = MAX_PATH r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pModule.Filename, iSize) lOffset = lOffset + iSize r = ReadProcessMemory(GetCurrentProcess(), lOffset, iSize, 2) If iSize > MAX_PATH Then iSize = MAX_PATH lOffset = lOffset + 2 r = ReadProcessMemory(GetCurrentProcess(), lOffset, ByVal pModule.ModuleName, iSize)
ProcTableGetModuleInfo = pModule End Function
Function ProcTableGetModuleIndex(ModuleId As Long) As Long Dim pModule As ModuleInfo Dim i&
For i = 1 To ProcTableGetModuleCount pModule = ProcTableGetModuleInfo(i) If pModule.ModuleId = ModuleId Then ProcTableGetModuleIndex = i Exit For End If Next End Function
Function ProcTableGetIndexes(ProcInfo As ProcessInfo) As Long() Dim pModule As ModuleInfo Dim lIndex&(), lCnt& Dim i&, ind%
For i = 1 To ProcTableGetModuleCount pModule = ProcTableGetModuleInfo(i) For ind = 1 To ProcInfo.NumOfModules If pModule.ModuleId = ProcInfo.Modules(ind).ModuleId Then lCnt = lCnt + 1 ReDim Preserve lIndex&(lCnt) lIndex&(lCnt) = i Exit For End If Next Next ProcTableGetIndexes = lIndex End Function
Function GetModuleTableSize() As Long Dim lSize&, r&
r = ReadProcessMemory(GetCurrentProcess(), hProcTable + 6, lSize, 4) GetModuleTableSize = lSize End Function
Sub ProcTableInitialize() If hProcTable = 0 Then 'Asigna memoria para 32767 entradas en la tabla, aprox.. ' hProcTable = VirtualAlloc(0&, 10551296 + 2&, MEM_COMMIT, PAGE_READWRITE) Call ProcTableInitModuleTable End If End Sub
Sub ProcTableRelease(Optional Force As Boolean = False) Dim r& If hProcTable Then r = VirtualFree(hProcTable, 0&, MEM_RELEASE) If r Or Force Then hProcTable = 0 End If End If End Sub
Sub ProcTableInitModuleTable() Dim lOffset&, i& Dim lTableSize& Dim r&
Call EnumSysModules lOffset = hProcTable + 10 For i = 1 To lSysModCnt r = WriteProcessMemory(GetCurrentProcess(), lOffset, GetModInfoSize(SysModule(i)) + 4 + 4, 4) lOffset = lOffset + 4 r = WriteProcessMemory(GetCurrentProcess(), lOffset, SysModule(i), 28) lOffset = lOffset + 28 r = WriteProcessMemory(GetCurrentProcess(), lOffset, Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString))), 2) lOffset = lOffset + 2 r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal SysModule(i).Filename, Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString)))) lOffset = lOffset + Len(RTrim$(Replace$(SysModule(i).Filename, vbNullChar, vbNullString))) r = WriteProcessMemory(GetCurrentProcess(), lOffset, Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString))), 2) lOffset = lOffset + 2 r = WriteProcessMemory(GetCurrentProcess(), lOffset, ByVal SysModule(i).ModuleName, Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString)))) lOffset = lOffset + Len(RTrim$(Replace$(SysModule(i).ModuleName, vbNullChar, vbNullString))) lTableSize = lTableSize + GetModInfoSize(SysModule(i)) + 4 + 2 + 2 Next r = WriteProcessMemory(GetCurrentProcess(), hProcTable + 2, lSysModCnt, 4) r = WriteProcessMemory(GetCurrentProcess(), hProcTable + 6, lTableSize, 4)
End Sub
Sub ProcTableRefreshModuleTable() Dim hTmp&, lSize&, r& lSize = ProcTableGetTableSize hTmp = VirtualAlloc(0&, lSize, MEM_COMMIT, PAGE_READWRITE) If hTmp Then r = ReadProcessMemory(GetCurrentProcess(), GetProcTableOffsetRVA, _ ByVal hTmp, lSize) If r Then Call ProcTableInitModuleTable r = ReadProcessMemory(GetCurrentProcess(), hTmp, _ ByVal GetProcTableOffsetRVA, lSize)
End If r = VirtualFree(hTmp, 0, MEM_RELEASE) End If End Sub
Function GetVersionInfo(Filename As String) As FileVersionInfo Dim pFixedInfo As VS_FIXEDFILEINFO Dim pFileInfo As FileVersionInfo Dim sCharset$, btCharset(4) As Byte Dim lCharset&, hCharBlck& Dim lInfoSize&, hVersion& Dim sVerData$, sVerBlck$, lLen& Dim sVerInfo$(9), sData$, i%, r& Dim lBinType& lInfoSize = GetFileVersionInfoSize(Filename, 0&) sVerData$ = String$(lInfoSize, 0) r = GetFileVersionInfo(Filename, 0&, lInfoSize, sVerData) If r = 0 Then Exit Function r = VerQueryValue(sVerData, "\VarFileInfo\Translation", hCharBlck, lLen) If r = 0 Then Exit Function r = ReadProcessMemory(GetCurrentProcess(), hCharBlck, btCharset(1), lLen) lCharset = btCharset(3) + btCharset(4) * &H100 + _ btCharset(1) * &H10000 + btCharset(2) * &H1000000 sCharset$ = Hex$(lCharset) sCharset$ = String(8 - Len(sCharset$), "0") & sCharset$ sVerInfo(1) = "CompanyName" sVerInfo(2) = "FileDescription" sVerInfo(3) = "FileVersion" sVerInfo(4) = "InternalName" sVerInfo(5) = "LegalCopyright" sVerInfo(6) = "OriginalFileName" sVerInfo(7) = "ProductName" sVerInfo(8) = "ProductVersion" sVerInfo(9) = "Comments"
For i = 1 To 9 sVerBlck$ = "\StringFileInfo\" & sCharset & "\" & sVerInfo(i) r = VerQueryValue(sVerData, sVerBlck, hVersion, lInfoSize) If r Then sData = String$(lInfoSize, 0) r = ReadProcessMemory(GetCurrentProcess(), hVersion, ByVal sData, lInfoSize) sData = Left$(sData, lInfoSize - 1) With GetVersionInfo Select Case i Case 1: .CompanyName = sData Case 2: .FileDescription = sData Case 3: .FileVersion = sData Case 4: .InternalName = sData Case 5: .LegalCopyright = sData Case 6: .OriginalFileName = sData Case 7: .ProductName = sData Case 8: .ProductVersion = sData Case 9: .Comments = sData End Select If GetBinaryType(Filename, lBinType) Then Select Case lBinType Case SCS_32BIT_BINARY: .FileOS = "Ejecutable Para Windows De 32 Bits" Case SCS_DOS_BINARY: .FileOS = "Ejecutable Para MS-DOS" Case SCS_OS216_BINARY: .FileOS = "Ejecutable Para OS/2 De 16 Bits" Case SCS_PIF_BINARY: .FileOS = "Acceso Directo A Programa De MS-DOS" Case SCS_POSIX_BINARY: .FileOS = "Archivo Ejecutable Para POSIX" Case SCS_WOW_BINARY: .FileOS = "Ejecutable Para Windows De 16 Bits" Case Else: .FileOS = "Sistema Desconocido" End Select End If
End With End If Next End Function
Function GetPriorityClassName(PriorityClass As Long) As String Dim sName$ Select Case PriorityClass Case HIGH_PRIORITY_CLASS: sName$ = "Alta" Case IDLE_PRIORITY_CLASS: sName$ = "Inactivo" Case NORMAL_PRIORITY_CLASS: sName$ = "Normal" Case REALTIME_PRIORITY_CLASS: sName$ = "Tiempo Real" Case Else: sName$ = "Desconocida" End Select
GetPriorityClassName = sName$ End Function
Function GetWindowText(hwnd As Long) As String Dim sTitle$, r& sTitle = String$(255, 0): r = Win.GetWindowText(hwnd, sTitle, 255) sTitle = Left$(sTitle, r) GetWindowText = sTitle End Function
Function GetFileTitle(Filename As String) As String GetFileTitle = Trim(Replace(Mid$(Filename, InStrRev(Filename, "\") + 1), vbNullChar, vbNullString)) End Function
Enjoy!! Saludos.
|
|
|
8
|
Programación / Programación Visual Basic / Funciones para manipular el registro utilizando la API
|
en: 25 Mayo 2005, 12:41 pm
|
Revisando mis codes encontré un módulo que tiene todos los procedimientos para manipular el registro del sistema usando las funciones de la API. Es un código muy viejo así que disculpen pero mi gramática de código no era muy buena . Option Explicit
Private Declare Function OSRegOpenKeyEx 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 OSRegCreateKeyEx 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, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long Private Declare Function OSRegConnectRegistry Lib "advapi32.dll" Alias "RegConnectRegistryA" (ByVal lpMachineName As String, ByVal hKey As Long, phkResult As Long) As Long Private Declare Function OSRegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function OSRegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (ByVal hKey As Long) As Long
Private Declare Function OSRegEnumKeyEx 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 OSRegFlushKey Lib "advapi32.dll" Alias "RegFlushKey" (ByVal hKey As Long) As Long Private Declare Function OSRegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As FILETIME) As Long
Private Declare Function OSRegReplaceKey Lib "advapi32.dll" Alias "RegReplaceKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpNewFile As String, ByVal lpOldFile As String) As Long Private Declare Function OSRegRestoreKey Lib "advapi32.dll" Alias "RegRestoreKeyA" (ByVal hKey As Long, ByVal lpFile As String, ByVal dwFlags As Long) As Long Private Declare Function OSRegSaveKey Lib "advapi32.dll" Alias "RegSaveKeyA" (ByVal hKey As Long, ByVal lpFile As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Declare Function OSRegEnumValue 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 OSRegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function OSRegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Private Declare Function OSRegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
'Tipos de datos del registro ' Const REG_NONE = 0 'No definido Const REG_SZ = 1 'Cadena de texto Const REG_EXPAND_SZ = 2 'Cadena que contiene una referencia a una variable de entorno (por ej. %windir%) Const REG_BINARY = 3 'Datos binarios en cualquier formato Const REG_DWORD = 4 'Número de 32 bits Const REG_DWORD_LITTLE_ENDIAN = 4 'Igual a REG_DWORD Const REG_DWORD_BIG_ENDIAN = 5 Const REG_LINK = 6 'Un vínculo Unicode símbolico Const REG_MULTI_SZ = 7 'Una matriz de cadenas terminadas en dos caracteres nulos Const REG_RESOURCE_LIST = 8 'Lista de recursos de un controlador de dispositivo
Const READ_CONTROL = &H20000 'El derecho para leer la información en el descriptor de seguridad del objeto, no incluyendo la información en SACL. Const SYNCHRONIZE = &H100000
'Derechos normales de acceso ' Const STANDARD_RIGHTS_ALL = &H1F0000 'Lectura y escritura Const STANDARD_RIGHTS_READ = (READ_CONTROL) 'Lectura Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) 'Escritura
'Argumentos para RegOpenKey ' Const KEY_QUERY_VALUE = &H1 'Permiso para consultar los datos de una subclave Const KEY_SET_VALUE = &H2 'Permiso para establecer los datos de una subclave Const KEY_CREATE_SUB_KEY = &H4 'Permiso para crear subclaves Const KEY_ENUMERATE_SUB_KEYS = &H8 'Permiso para enumerar subclaves Const KEY_NOTIFY = &H10 'Permiso para cambiar notificación Const KEY_CREATE_LINK = &H20 'Permiso para crear un vínculo simbólico Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE)) Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE)) Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
'Valores devueltos por lpdwDisposition de RegCreateKey ' Const REG_CREATED_NEW_KEY = &H1 'Se creó una nueva clave Const REG_OPENED_EXISTING_KEY = &H2 'Se abrió una clave existente
'Valores para dwNotifyFilter de RegNotifyChangeKeyValue ' Const REG_NOTIFY_CHANGE_NAME = &H1 'Si se agrega o elimina una clave Const REG_NOTIFY_CHANGE_ATTRIBUTES = &H2 'Cambiar atributos de la clave Const REG_NOTIFY_CHANGE_LAST_SET = &H4 'Modificar, agregar o eliminar un valor de la clave Const REG_NOTIFY_CHANGE_SECURITY = &H8 'Cambiar el descriptor de seguridad de la clave (SECURITY_DESCRIPTOR)
'Argumentos para dwOptions de RegCreateKey ' Const REG_OPTION_NON_VOLATILE = 0 '(Predeterminado) Crea una clave normalmente Const REG_OPTION_VOLATILE = 1 'Borra la clave al reiniciar el sistema Const REG_OPTION_CREATE_LINK = 2 'Crea un vínculo virtual Const REG_OPTION_BACKUP_RESTORE = 4 'Para Windows NT
Const REG_OPTION_RESERVED = 0 'Reservado
Const REG_LEGAL_CHANGE_FILTER = (REG_NOTIFY_CHANGE_NAME Or REG_NOTIFY_CHANGE_ATTRIBUTES Or REG_NOTIFY_CHANGE_LAST_SET Or REG_NOTIFY_CHANGE_SECURITY) Const REG_LEGAL_OPTION = (REG_OPTION_RESERVED Or REG_OPTION_NON_VOLATILE Or REG_OPTION_VOLATILE Or REG_OPTION_CREATE_LINK Or REG_OPTION_BACKUP_RESTORE)
'Para el argumento dwFlags de RegRestoreKey ' Const REG_WHOLE_HIVE_VOLATILE = &H1 'Borra la clave al reiniciar el sistema
'Claves del registro ' Const HKEY_CLASSES_ROOT = &H80000000 Const HKEY_CURRENT_CONFIG = &H80000005 Const HKEY_CURRENT_USER = &H80000001 Const HKEY_DYN_DATA = &H80000006 Const HKEY_LOCAL_MACHINE = &H80000002 Const HKEY_PERFORMANCE_DATA = &H80000004 'Sólo para NT Const HKEY_USERS = &H80000003
Const ERROR_SUCCESS = 0& Const ERROR_NO_MORE_ITEMS = 259& 'No hay más elementos
Const MODULE_DESC$ = "Registry Module"
Enum RegKeyConstants RegClassesRoot = HKEY_CLASSES_ROOT RegCurrentConfig = HKEY_CURRENT_CONFIG RegCurrentUser = HKEY_CURRENT_USER RegDynData = HKEY_DYN_DATA RegLocalMachine = HKEY_LOCAL_MACHINE RegPerformanceData = HKEY_PERFORMANCE_DATA RegUsers = HKEY_USERS End Enum
Enum RegAccessType regqueryvalue = KEY_QUERY_VALUE RegSetValue = KEY_SET_VALUE RegCreateSubKey = KEY_CREATE_SUB_KEY RegEnumerateSubKeys = KEY_ENUMERATE_SUB_KEYS RegNotify = KEY_NOTIFY RegCreateLink = KEY_CREATE_LINK RegAllAccess = KEY_ALL_ACCESS RegRead = KEY_READ RegWrite = KEY_WRITE RegExecute = KEY_EXECUTE End Enum
Enum RegValueTypeConstants RegString = REG_SZ RegExpandString = REG_EXPAND_SZ RegMultiString = REG_MULTI_SZ RegBinary = REG_BINARY RegDWORD = REG_DWORD RegDWORDLittleEndian = REG_DWORD_LITTLE_ENDIAN RegDWORDBigEndian = REG_DWORD_BIG_ENDIAN RegLink = REG_LINK RegUnknown = REG_NONE RegResourceList = REG_RESOURCE_LIST End Enum
Enum RegCreateOptionsConstants RegVolatile = REG_OPTION_VOLATILE RegNonVolatile = REG_OPTION_NON_VOLATILE RegOptionBackupRestore = REG_OPTION_BACKUP_RESTORE End Enum
Private Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Long End Type
Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type
Type RegValue sName As String cType As RegValueTypeConstants vData As Variant lData As Long End Type
Type RegKey lLongKey As RegKeyConstants sStringKey As String sPath As String sName As String lNameLen As Long lHandle As Long lSubKeys As Long lValues As Long tValues() As RegValue sClass As String End Type
Function RegOpenKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional DesiredAccess As RegAccessType = RegAllAccess) As RegKey Dim iPos%, r& With RegOpenKey r = OSRegOpenKeyEx(CLng(Key), SubKey, 0&, CLng(DesiredAccess), .lHandle) If r = ERROR_SUCCESS Then If Right(SubKey, 1) = "\" Then SubKey = Left(SubKey, Len(SubKey) - 1) iPos = InStrRev("\", SubKey) .sName = Mid(SubKey, iPos + 1) .lNameLen = LenB(.sName) .lLongKey = Key .sStringKey = GetKeyString(.lLongKey) .sPath = Left(SubKey, iPos) End If End With End Function
Function RegCreateKey(Key As RegKeyConstants, SubKey As String, Optional Options As RegCreateOptionsConstants = RegNonVolatile, Optional DesiredAccess As RegAccessType = RegAllAccess, Optional Class As String) As RegKey Dim sa As SECURITY_ATTRIBUTES, r& Dim iPos%
With RegCreateKey r = OSRegCreateKeyEx(CLng(Key), SubKey, 0&, Class, CLng(Options), _ CLng(DesiredAccess), sa, .lHandle, 0&) If r = ERROR_SUCCESS Then If Not Right(SubKey, 1) Like "\" Then SubKey = SubKey & "\" iPos = InStrRev("\", SubKey) .sName = Mid(SubKey, iPos + 1) .lNameLen = LenB(.sName) .lLongKey = Key .sStringKey = GetKeyString(.lLongKey) .sPath = Left(SubKey, iPos) End If End With End Function
Function RegConnectRegistry(MachineName As String, Optional Key As RegKeyConstants = RegLocalMachine) As RegKey Dim r& With RegConnectRegistry r = OSRegConnectRegistry(MachineName, CLng(Key), .lHandle) If r = ERROR_SUCCESS Then .sName = GetKeyString(Key) .lNameLen = LenB(.sName) .lLongKey = Key .sStringKey = GetKeyString(.lLongKey) End If End With End Function
Function RegCloseKey(hKey As Long) As Boolean RegCloseKey = (OSRegCloseKey(hKey) = ERROR_SUCCESS) End Function
Function RegDeleteKey(Key As RegKeyConstants, SubKey As String) As Boolean RegDeleteKey = (OSRegDeleteKey(CLng(Key), SubKey) = ERROR_SUCCESS) End Function
Function RegEnumKeyNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional MaxKeysToEnum As Long = -1) As Long On Error GoTo CloseKey Dim iCount%, iArrayType% Dim hKey&, ft As FILETIME Dim r&, sName$, lName&
hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle If hKey <> ERROR_SUCCESS Then Erase TargetArray Do lName = 256: sName = String(lName, 0) r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, ByVal "", 0&, ft) If r <> ERROR_NO_MORE_ITEMS Then ReDim Preserve TargetArray(iCount) As String TargetArray(iCount) = Left(sName, lName) Else GoTo CloseKey End If Step: iCount = iCount + 1 If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey Loop CloseKey: Call RegCloseKey(hKey) RegEnumKeyNames = iCount End If End Function
Function RegEnumKeys(TargetArray() As RegKey, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional bEnumValues As Boolean = False, Optional MaxKeysToEnum As Long = -1) As Long On Error GoTo CloseKey Dim iCount%, iArrayType% Dim hKey&, ft As FILETIME Dim r&, sName$, lName& Dim sClass$, lClass& hKey = RegOpenKey(Key, SubKey, RegEnumerateSubKeys).lHandle If hKey <> ERROR_SUCCESS Then Erase TargetArray Do lName = 256: sName = String(lName, 0) lClass = 256: sClass = String(lName, 0) r = OSRegEnumKeyEx(hKey, iCount, sName, lName, 0&, sClass, lClass, ft) If bEnumValues Then 'Enumerar valores End If If r <> ERROR_NO_MORE_ITEMS Then ReDim Preserve TargetArray(iCount) As RegKey With TargetArray(iCount) .sName = Left(sName, lName) .lNameLen = LenB(.sName) .lLongKey = Key .sStringKey = GetKeyString(.lLongKey) .sPath = SubKey .lValues = RegEnumValues(.tValues, hKey) End With Else GoTo CloseKey End If Step: iCount = iCount + 1 If MaxKeysToEnum > -1 And iCount = MaxKeysToEnum Then GoTo CloseKey Loop CloseKey: Call RegCloseKey(hKey) RegEnumKeys = iCount - 1 End If End Function
Function RegQueryInfoKey(Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String, Optional QueryValues As Boolean = False, Optional OpenKey As Boolean = False) As RegKey Dim hKey&, ft As FILETIME Dim lClass&, r& Dim iPos% With RegQueryInfoKey hKey = RegOpenKey(Key, SubKey, RegRead).lHandle If hKey <> ERROR_SUCCESS Then lClass = 256: .sClass = String(lClass, 0) r = OSRegQueryInfoKey(hKey, .sClass, lClass, 0&, .lSubKeys, 0&, 0&, .lValues, 0&, 0&, 0&, ft) If r = ERROR_SUCCESS Then iPos = InStrRev(SubKey, "\") .sClass = Left(.sClass, lClass) .sName = Mid(SubKey, iPos + 1) .lNameLen = Len(.sName) .sPath = Left(SubKey, iPos) .lLongKey = Key .sStringKey = GetKeyString(.lLongKey) If Not OpenKey Then Call RegCloseKey(hKey) Else .lHandle = hKey If QueryValues Then r = RegEnumValues(.tValues, Key, SubKey) End If End If End If End With End Function
Function RegFlushKey(hKey As Long) As Boolean RegFlushKey = (OSRegFlushKey(hKey) = ERROR_SUCCESS) End Function
Function RegEnumValueNames(TargetArray() As String, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long On Error GoTo CloseKey Dim hKey&, r& Dim sName$, lName& Dim lCount& Dim btData As Byte, lData& Dim lType& hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle If hKey <> ERROR_SUCCESS Then Erase TargetArray
Do lName = 256: sName = String(lName, 0) lData = 2000 r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, 0&, ByVal btData, lData) If r = ERROR_SUCCESS Then ReDim Preserve TargetArray(lCount) As String TargetArray(lCount) = Left(sName, lName) Else: GoTo CloseKey End If lCount = lCount + 1 Loop CloseKey:
Call RegCloseKey(hKey) RegEnumValueNames = lCount - 1 End If End Function
Function RegEnumValues(TargetArray() As RegValue, Optional Key As RegKeyConstants = RegLocalMachine, Optional ByVal SubKey As String) As Long On Error GoTo CloseKey Dim hKey&, r& Dim sName$, lName& Dim lCount& Dim btData As Byte, lData& Dim lType& hKey = RegOpenKey(Key, SubKey, KEY_QUERY_VALUE).lHandle If hKey <> ERROR_SUCCESS Then Erase TargetArray Do lName = 256: sName = String(lName, 0) lData = 2000 r = OSRegEnumValue(hKey, lCount&, sName, lName, 0&, lType, ByVal btData, lData) If r = ERROR_SUCCESS Then ReDim Preserve TargetArray(lCount) As RegValue TargetArray(lCount) = RegGetValue(hKey, , Left(sName, lName)) Else: GoTo CloseKey End If lCount = lCount + 1 Loop CloseKey: Call RegCloseKey(hKey) RegEnumValues = lCount - 1 End If End Function
Function RegGetValueData(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Variant Dim hKey&, r& Dim sData$, lDataLen& Dim lData&, ValType As RegValueTypeConstants hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle ValType = RegString If hKey <> ERROR_SUCCESS Then Select Case ValType Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown sData = String(2000, 0) lDataLen = LenB(sData) r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _ ByVal sData, lDataLen) If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType RegGetValueData = Left(sData, lDataLen - 1) Case Else LongType: r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _ lData, lDataLen) RegGetValueData = lData End Select Call RegCloseKey(hKey) End If End Function
Function RegGetValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As RegValue Dim hKey&, r& Dim sData$, lDataLen& Dim lData&, ValType As RegValueTypeConstants
hKey = RegOpenKey(Key, SubKey, regqueryvalue).lHandle ValType = RegString
If hKey <> ERROR_SUCCESS Then With RegGetValue Select Case ValType Case RegLink, RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown sData = String(2000, 0) lDataLen = LenB(sData) r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _ ByVal sData, lDataLen) If ValType = RegDWORD Or ValType = RegDWORDBigEndian Or ValType = RegDWORDLittleEndian Then GoTo LongType If r = ERROR_SUCCESS Then .vData = Left(sData, lDataLen) .lData = lDataLen .cType = ValType .sName = ValueName End If Case Else LongType: r = OSRegQueryValueEx(hKey, ValueName, 0&, ValType, _ lData, lDataLen) If r = ERROR_SUCCESS Then .vData = lData .lData = lDataLen .cType = ValType .sName = ValueName End If End Select Call RegCloseKey(hKey) End With End If End Function
Function RegDeleteValue(Key As RegKeyConstants, Optional ByVal SubKey As String, Optional ValueName As String) As Boolean Dim hKey& hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle RegDeleteValue = (OSRegDeleteValue(hKey, ValueName) = ERROR_SUCCESS) Call RegCloseKey(hKey) End Function
Function RegSetValues(Key As RegKeyConstants, SubKey As String, ValueName As Variant, Data As Variant, Optional ValueType As RegValueTypeConstants = RegString) As Integer Dim hKey&, r& Dim i%, iScsCount% hKey = RegOpenKey(Key, SubKey, RegSetValue).lHandle If hKey <> ERROR_SUCCESS Then If IsArray(ValueName) And IsArray(Data) Then 'Si son dos matrices If (UBound(ValueName) - LBound(ValueName)) <> (UBound(Data) - LBound(Data)) Then 'Si no tienen las mismas dimensiones se produce un error Call Err.Raise(45, MODULE_DESC, "Las matrices no tienen la misma dimensión") Else For i = LBound(ValueName) To UBound(ValueName) 'Identifica el tipo de valor que se va a establecer Select Case ValueType Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown r = OSRegSetValueEx(hKey, ValueName(i), 0&, _ CLng(ValueType), ByVal CStr(Data(i)), LenB(Data(i))) Case Else r = OSRegSetValueEx(hKey, ValueName(i), 0&, _ CLng(ValueType), CLng(Data(i)), 4) End Select 'Si no hay ningún error aumenta el contador de valores 'que se pudieron establecer If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1 Next 'Devuelve el la cantidad de valores que se establecieron RegSetValues = iScsCount End If ElseIf IsArray(ValueName) Then 'Si los nombres de valores están en una matriz For i = LBound(ValueName) To UBound(ValueName) 'Establece todos los valores pero con los mismos datos Select Case ValueType Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown r = OSRegSetValueEx(hKey, ValueName(i), 0&, _ CLng(ValueType), ByVal CStr(Data), LenB(Data)) Case Else r = OSRegSetValueEx(hKey, ValueName(i), 0&, _ CLng(ValueType), CLng(Data), 4) End Select If r = ERROR_SUCCESS Then iScsCount = iScsCount + 1 Next RegSetValues = iScsCount Else Select Case ValueType Case RegString, RegMultiString, RegExpandString, RegBinary, RegUnknown, RegLink r = OSRegSetValueEx(hKey, ValueName, 0&, _ CLng(ValueType), ByVal CStr(Data), LenB(Data)) Case Else r = OSRegSetValueEx(hKey, ValueName, 0&, _ CLng(ValueType), CLng(Data), 4) End Select RegSetValues = True End If End If Call RegCloseKey(hKey) End Function
Function RegIsKey(Key As RegKeyConstants, Optional ByVal SubKey As String) As Boolean Dim hKey& hKey = RegOpenKey(Key, SubKey).lHandle RegIsKey = (hKey <> 0) Call RegCloseKey(hKey) End Function
Function GetKeyString(hKey As Variant) As String Select Case hKey Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyString = "HKEY_CLASSES_ROOT" Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG": GetKeyString = "HKEY_CURRENT_CONFIG" Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyString = "HKEY_CURRENT_USER" Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyString = "HKEY_DYN_DATA" Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyString = "HKEY_LOCAL_MACHINE" Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyString = "HKEY_PERFORMANCE_DATA" Case RegUsers, "HKU", "HKEY_USERS": GetKeyString = "HKEY_USERS" End Select End Function
Function GetKeyLong(hKey As Variant) As String Select Case hKey Case RegClassesRoot, "HKCR", "HKEY_CLASSES_ROOT": GetKeyLong = RegClassesRoot Case RegCurrentConfig, "HKCC", "HKEY_CURRENT_CONFIG": GetKeyLong = RegCurrentConfig Case RegCurrentUser, "HKCU", "HKEY_CURRENT_USER": GetKeyLong = RegCurrentUser Case RegDynData, "HKDD", "HKEY_DYN_DATA": GetKeyLong = RegDynData Case RegLocalMachine, "HKLM", "HKEY_LOCAL_MACHINE": GetKeyLong = RegLocalMachine Case RegPerformanceData, "HKPD", "HKEY_PERFORMANCE_DATA": GetKeyLong = RegPerformanceData Case RegUsers, "HKU", "HKEY_USERS": GetKeyLong = RegUsers End Select End Function
Cualquier cosa que no entiendan dirigirse a MSDN . Saludos.
|
|
|
9
|
Programación / Programación Visual Basic / API de WinSock para VB (Completa)
|
en: 21 Marzo 2005, 07:15 am
|
Muchas veces es difícil encontrar las funciones de WinSock para VB, así que recopilé todas las funciones, estructuras, constantes, etc. que se usan para manipular sockets en Windows. También puse algunas funciones básicas para ejemplificar el uso de las funciones. '************************************************************* '¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ ' Application Programming Inteface (API) for WinSock ' 'Este módulo contiene todas las declaraciones necesarias para 'utilizar los sockets de sistema. El funcionamiento y ejemplo 'de estas funciones se pueden encontrar en MSDN: ' 'http://msdn.microsoft.com ' 'Autor: Slasher Keeper :) 'Fuente: MSDN Library ' '¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬ '**************************************************************
Option Explicit
#Const WS_CURVERSION = 2
Public Const WS_VERSION_REQD = &H101 Public Const WS_VERSION_MAJOR = WS_VERSION_REQD \ &H100 And &HFF& Public Const WS_VERSION_MINOR = WS_VERSION_REQD And &HFF& Public Const MIN_SOCKETS_REQD = 1 Public Const SOCKET_ERROR = -1 Public Const WSADescription_Len = 256 Public Const WSASYS_Status_Len = 128 Public Const FD_SETSIZE = 64
'Network Events. ' Public Const FD_READ_BIT = 0 Public Const FD_READ = 1 Public Const FD_WRITE_BIT = 1 Public Const FD_WRITE = 2 Public Const FD_OOB_BIT = 2 Public Const FD_OOB = 4 Public Const FD_ACCEPT_BIT = 3 Public Const FD_ACCEPT = 8 Public Const FD_CONNECT_BIT = 4 Public Const FD_CONNECT = 16 Public Const FD_CLOSE_BIT = 5 Public Const FD_CLOSE = 32 Public Const FD_QOS_BIT = 6 Public Const FD_QOS = 64 Public Const FD_GROUP_QOS_BIT = 7 Public Const FD_GROUP_QOS = 128 Public Const FD_ROUTING_INTERFACE_CHANGE_BIT = 8 Public Const FD_ROUTING_INTERFACE_CHANGE = 256 Public Const FD_ADDRESS_LIST_CHANGE_BIT = 9 Public Const FD_ADDRESS_LIST_CHANGE = 512 Public Const FD_MAX_EVENTS = 10 Public Const FD_ALL_EVENTS = 1023
'Namespaces. ' Public Const NS_ALL = 0
Public Const NS_SAP = 1 Public Const NS_NDS = 2 Public Const NS_PEER_BROWSE = 3
Public Const NS_TCPIP_LOCAL = 10 Public Const NS_TCPIP_HOSTS = 11 Public Const NS_DNS = 12 Public Const NS_NETBT = 13 Public Const NS_WINS = 14
Public Const NS_NBP = 20
Public Const NS_MS = 30 Public Const NS_STDA = 31 Public Const NS_NTDS = 32
Public Const NS_X500 = 40 Public Const NS_NIS = 41 Public Const NS_NISPLUS = 42
Public Const NS_WRQ = 50
Public Const SERVICE_REGISTER = 1 Public Const SERVICE_DEREGISTER = 2 Public Const SERVICE_FLUSH = 3 Public Const SERVICE_FLAG_HARD = &H2
Enum SearchControlFlags LUP_DEEP = &H1 LUP_CONTAINERS = &H2 LUP_NOCONTAINERS = &H4 LUP_NEAREST = &H8 LUP_RETURN_NAME = &H10 LUP_RETURN_TYPE = &H20 LUP_RETURN_VERSION = &H40 LUP_RETURN_COMMENT = &H80 LUP_RETURN_ADDR = &H100 LUP_RETURN_BLOB = &H200 LUP_RETURN_ALIASES = &H400 LUP_RETURN_QUERY_STRING = &H800 LUP_RETURN_ALL = &HFF0 LUP_RES_SERVICE = &H8000 LUP_FLUSHCACHE = &H1000 LUP_FLUSHPREVIOUS = &H2000 End Type
'Protocolos ' Enum SockProtocols IPPROTO_IP = 0 'dummy for IP IPPROTO_ICMP = 1 'control message protocol IPPROTO_IPIP = 4 IPPROTO_GGP = 2 ' gateway^2 (deprecated) IPPROTO_TCP = 6 ' tcp IPPROTO_EGP = 8 IPPROTO_PUP = 12 ' pup IPPROTO_UDP = 17 ' user datagram protocol IPPROTO_IDP = 22 ' xns idp IPPROTO_ND = 77 ' UNOFFICIAL net disk proto NSPROTO_IPX = 1000 NSPROTO_SPX = 1256 NSPROTO_SPXII = 1257 End Enum
'Socket types. ' Enum SockTypes SOCK_STREAM = 1 'Envía datos como flujo de bytes. SOCK_DGRAM = 2 'Datagrama. Protocolo de conexión. SOCK_RAW = 3 '??? SOCK_RDM = 4 'Reliably-Delivered Message (Mensaje confiablemente-entregado) 'Es un protocolo que conserva los límites del mensaje en los 'datos SOCK_SEQPACKET = 5 'Flujo de paquetes secuenciados. Es esencialmente igual 'que SOCK_RDM. End Enum
Enum SockPorts ' 'Standard well-known ports ' IPPORT_ECHO = 7 IPPORT_DISCARD = 9 IPPORT_SYSTAT = 11 IPPORT_DAYTIME = 13 IPPORT_NETSTAT = 15 IPPORT_FTP = 21 IPPORT_TELNET = 23 IPPORT_SMTP = 25 IPPORT_TIMESERVER = 37 IPPORT_NAMESERVER = 42 IPPORT_WHOIS = 43 IPPORT_MTP = 57
IPPORT_TFTP = 69 IPPORT_RJE = 77 IPPORT_FINGER = 79 IPPORT_TTYLINK = 87 IPPORT_SUPDUP = 95
IPPORT_EXECSERVER = 512 IPPORT_LOGINSERVER = 513 IPPORT_CMDSERVER = 514 IPPORT_EFSSERVER = 520
'UDP ports. ' IPPORT_BIFFUDP = 512 IPPORT_WHOSERVER = 513 IPPORT_ROUTESERVER = 520
'Los puertos menores a este valor están reservados para 'procesos con provilegios. ' IPPORT_RESERVED = 1024
'Los puertos mayores a este valor están reservados para 'procesos sin privilegios. ' IPPORT_USERRESERVED = 5000
End Enum
Enum SockErrors ' 'Windows Sockets definitions of regular Berkeley error constants ' WSABASEERR = 10000 WSAEWOULDBLOCK = (WSABASEERR + 35) WSAEINPROGRESS = (WSABASEERR + 36) WSAEALREADY = (WSABASEERR + 37) WSAENOTSOCK = (WSABASEERR + 38) WSAEDESTADDRREQ = (WSABASEERR + 39) WSAEMSGSIZE = (WSABASEERR + 40) WSAEPROTOTYPE = (WSABASEERR + 41) WSAENOPROTOOPT = (WSABASEERR + 42) WSAEPROTONOSUPPORT = (WSABASEERR + 43) WSAESOCKTNOSUPPORT = (WSABASEERR + 44) WSAEOPNOTSUPP = (WSABASEERR + 45) WSAEPFNOSUPPORT = (WSABASEERR + 46) WSAEAFNOSUPPORT = (WSABASEERR + 47) WSAEADDRINUSE = (WSABASEERR + 48) WSAEADDRNOTAVAIL = (WSABASEERR + 49) WSAENETDOWN = (WSABASEERR + 50) WSAENETUNREACH = (WSABASEERR + 51) WSAENETRESET = (WSABASEERR + 52) WSAECONNABORTED = (WSABASEERR + 53) WSAECONNRESET = (WSABASEERR + 54) WSAENOBUFS = (WSABASEERR + 55) WSAEISCONN = (WSABASEERR + 56) WSAENOTCONN = (WSABASEERR + 57) WSAESHUTDOWN = (WSABASEERR + 58) WSAETOOMANYREFS = (WSABASEERR + 59) WSAETIMEDOUT = (WSABASEERR + 60) WSAECONNREFUSED = (WSABASEERR + 61) WSAELOOP = (WSABASEERR + 62) WSAENAMETOOLONG = (WSABASEERR + 63) WSAEHOSTDOWN = (WSABASEERR + 64) WSAEHOSTUNREACH = (WSABASEERR + 65) WSAENOTEMPTY = (WSABASEERR + 66) WSAEPROCLIM = (WSABASEERR + 67) WSAEUSERS = (WSABASEERR + 68) WSAEDQUOT = (WSABASEERR + 69) WSAESTALE = (WSABASEERR + 70) WSAEREMOTE = (WSABASEERR + 71) WSAEDISCON = (WSABASEERR + 101) End Enum
Enum SockAddressFamilies AF_UNSPEC = 0 'unspecified AF_UNIX = 1 'local to host (pipes, portals) AF_INET = 2 'internetwork: UDP, TCP, etc. AF_IMPLINK = 3 'arpanet imp addresses AF_PUP = 4 'pup protocols: e.g. BSP AF_CHAOS = 5 'mit CHAOS protocols AF_IPX = 6 'IPX and SPX AF_NS = 6 'XEROX NS protocols AF_ISO = 7 'ISO protocols AF_OSI = AF_ISO 'OSI is ISO AF_ECMA = 8 'european computer manufacturers AF_DATAKIT = 9 'datakit protocols AF_CCITT = 10 'CCITT protocols, X.25 etc AF_SNA = 11 'IBM SNA AF_DECnet = 12 'DECnet AF_DLI = 13 'Direct data link interface AF_LAT = 14 'LAT AF_HYLINK = 15 'NSC Hyperchannel AF_APPLETALK = 16 'AppleTalk AF_NETBIOS = 17 'NetBios-style addresses End Enum
Type SOCKADDR sa_family As Integer sa_data As String * 14 End Type
Type IN_ADDR s_b1 As Byte s_b2 As Byte s_b3 As Byte s_b4 As Byte s_w1 As Integer s_w2 As Integer End Type
Type SOCKADDR_IN sin_family As Integer sin_port As Integer sin_addr As IN_ADDR sin_zero As String * 8 End Type
Type OVERLAPPED Internal As Long InternalHigh As Long Offset As Long OffsetHigh As Long hEvent As Long End Type
Type CSADDR_INFO LocalAddr As Long RemoteAddr As Long iSocketType As Long iProtocol As SockProtocols End Type
Type HOSTENT h_name As Long 'official name of host h_aliases As Long 'alias list h_addrtype As Integer 'host address type h_length As Integer h_addr_list As Long 'list of addresses End Type
Type PROTOENT p_name As String p_aliases(15) As String p_proto As Integer End Type
Type SERVENT s_name As String s_aliases(15) As String s_port As Integer s_proto As String End Type
Type SERVICE_ADDRESS dwAddressType As Long dwAddressFlags As Long dwAddressLength As Long dwPrincipalLength As Long lpAddress As Byte lpPrincipal As Byte End Type
Type SERVICE_ADDRESSES dwAddressCount As Long Addresses(1) As SERVICE_ADDRESS End Type
Type BLOB cbSize As Long pBlobData As Byte End Type
Type SERVICE_INFO lpServiceType As Long lpServiceName As String lpComment As String lpLocale As String dwDisplayHint As Long dwVersion As Long dwTime As Long lpMachineName As String lpServiceAddress As SERVICE_ADDRESSES ServiceSpecificInfo As BLOB End Type
Type NS_SERVICE_INFO dwNameSpace As Long ServiceInfo As SERVICE_INFO End Type
Type WSADATA wversion As Integer wHighVersion As Integer szDescription(0 To WSADescription_Len) As Byte szSystemStatus(0 To WSASYS_Status_Len) As Byte iMaxSockets As Integer iMaxUdpDg As Integer lpszVendorInfo As Long End Type
Type LARGE_INTEGER lowpart As Long highpart As Long End Type
Type FD_SET fd_count As Long fd_array(FD_SETSIZE) As Long End Type
Type TIMEVAL tv_sec As Long tv_usec As Long End Type
Type TRANSMIT_FILE_BUFFERS Head As Long HeadLength As Long Tail As Long TailLength As Long End Type
Type FLOWSPEC TokenRate As Long 'In Bytes/sec TokenBucketSize As Long 'In Bytes PeakBandwidth As Long 'In Bytes/sec Latency As Long 'In microseconds DelayVariation As Long 'In microseconds ServiceType As Integer 'Guaranteed, Predictive, 'Best Effort, etc. MaxSduSize As Long 'In Bytes MinimumPolicedSize As Long 'In Bytes End Type
Type PROTOCOL_INFO dwServiceFlags As Long iAddressFamily As Long iMaxSockAddr As Long iMinSockAddr As Long iSocketType As Long iProtocol As Long dwMessageSize As Long lpProtocol As Long End Type
Declare Function accept Lib "ws2_32" (ByVal sck As Long, addr As SOCKADDR, AddrLen As Integer) As Long
Declare Function AcceptEx Lib "ws2_32" (ByVal sListenSocket As Long, ByVal sAcceptSocket As Long, lpOutputBuffer As Any, ByVal dwReceiveDataLength As Long, ByVal dwLocalAddressLength As Long, ByVal dwRemoteAddressLength As Long, lpdwBytesReceived As Long, lpOverlapped As OVERLAPPED) As Long
Declare Function bind Lib "ws2_32" (ByVal sck As Long, name As SOCKADDR, ByVal namelen As Long) As Long Declare Function closesocket Lib "ws2_32" (ByVal sck As Long) As Long
Declare Function Connect Lib "ws2_32" (ByVal sck As Long, ByVal SckName As String, ByVal namelen As Long) As Long Declare Function EnumProtocols Lib "ws2_32" Alias "EnumProtocolsA" (ByVal lpiProtocols As SockProtocols, ByVal lpProtocolBuffer As PROTOCOL_INFO, ByVal lpdwBufferLength As Long)
Declare Sub GetAcceptExSockaddrs Lib "ws2_32" (lpOutputBuffer As Any, ByVal dwReceiveDataLength As Long, ByVal dwLocalAddressLength As Long, ByVal dwRemoteAddressLength As Long, LocalSockaddr As Long, LocalSockaddrLength As Long, RemoteSockaddr As Long, RemoteSockaddrLength As Long)
Declare Function GetAddressByName Lib "ws2_32" Alias "GetAddressByNameA" (ByVal dwNameSpace As Long, ByVal lpServiceType As Long, ByVal lpServiceName As Long, ByVal lpiProtocols As SockProtocols, ByVal dwResolution As Long, ByVal lpServiceAsyncInfo As Long, lpCsaddrBuffer As CSADDR_INFO, ByVal lpdwBufferLength As Long, ByVal lpAliasBuffer As Long, ByVal lpdwAliasBufferLength As Long) As Long
Declare Function gethostbyaddr Lib "ws2_32" (ByVal addr As String, ByVal iaddrlen As Long, ByVal iaddrtype As Long) As HOSTENT
Declare Function gethostbyname Lib "ws2_32" (ByVal hostname As String) As Long
Declare Function gethostname Lib "ws2_32" (ByVal name As String, ByVal namelen As Long) As Long
Declare Function GetNameByType Lib "ws2_32" Alias "GetNameByTypeA" (ByVal lpServiceType As Long, ByVal lpServiceName As String, ByVal dwNameLength As Long) As Long
Declare Function getpeername Lib "ws2_32" (ByVal sck As Long, name As SOCKADDR, ByVal namelen As Long) As Long
Declare Function getprotobyname Lib "ws2_32" (ByVal name As String) As PROTOENT
Declare Function getprotobynumber Lib "ws2_32" (ByVal Number As Long) As PROTOENT
Declare Function getservbyname Lib "ws2_32" (ByVal name As String, ByVal proto As String) As SERVENT
Declare Function getservbyport Lib "ws2_32" (ByVal port As Integer, ByVal proto As String) As SERVENT
Declare Function GetService Lib "ws2_32" Alias "GetServiceA" (ByVal dwNameSpace As Long, ByVal lpGuid As Long, ByVal lpServiceName As String, ByVal dwProperties As Long, lpBuffer As NS_SERVICE_INFO, ByVal lpdwBufferSize As Long, ByVal lpServiceAsyncInfo As Long) As Long
Declare Function GetSockName Lib "ws2_32" Alias "GetSockNameA" (ByVal sck As Long, name As Long, ByVal namelen As Long) As Long
Declare Function getsockopt Lib "ws2_32" (ByVal sck As Long, ByVal level As Long, ByVal optname As Long, ByVal optval As Long, optlen As Long) As Long
Declare Function GetTypeByName Lib "ws2_32" Alias "GetTypeByNameA" ()
Declare Function htons Lib "ws2_32" (ByVal hostshort As Integer) As Integer
Declare Function htonl Lib "ws2_32" (ByVal hostlong As Long) As Long
Declare Function inet_addr Lib "ws2_32" (ByVal cp As String) As Long
Declare Function inet_ntoa Lib "ws2_32" (pin As IN_ADDR) As Long
Declare Function ioctlsocket Lib "ws2_32" (ByVal s As Long, ByVal cmd As Long, ByVal argp As Long) As Integer
Declare Function listen Lib "ws2_32" (ByVal s As Long, ByVal backlog As Integer) As Integer
Declare Function ntohl Lib "ws2_32" (ByVal netlong As Long) As Long
Declare Function ntohs Lib "ws2_32" (ByVal netshort As Integer) As Integer
Declare Function recv Lib "ws2_32" (ByVal s As Long, ByVal buf As String, ByVal BufLen As Integer, ByVal flags As Integer) As Integer
Declare Function recvfrom Lib "ws2_32" (ByVal s As Long, ByVal buf As String, ByVal BufLen As Integer, ByVal flags As Integer, from As SOCKADDR, fromlen As Integer) As Integer
Declare Function sockselect Lib "ws2_32" Alias "select" (ByVal nfds As Integer, readfds As FD_SET, writefds As FD_SET, exceptfds As FD_SET, timeout As TIMEVAL) As Integer
Declare Function send Lib "ws2_32" (ByVal s As Long, ByVal buf As Long, ByVal BufLen As Integer, ByVal flags As Integer) As Integer
Declare Function sendto Lib "ws2_32" (ByVal s As Long, ByVal buf As Long, ByVal BufLen As Integer, ByVal flags As Integer, sckto As SOCKADDR, ByVal tolen As Integer) As Integer
Declare Function SetService Lib "ws2_32" Alias "SetServiceA" (ByVal dwNameSpace As Long, ByVal dwOperation As Long, ByVal dwFlags As Long, lpServiceInfo As SERVICE_INFO, ByVal lpServiceAsyncInfo As Long, ByVal lpdwStatusFlags As Long) As Long
Declare Function setsockopt Lib "ws2_32" (ByVal s As Long, ByVal level As Integer, ByVal optname As Integer, ByVal optval As Long, ByVal optlen As Long) As Integer
Declare Function shutdown Lib "ws2_32" (ByVal s As Long, ByVal how As Integer) As Integer
Declare Function socket Lib "ws2_32" (ByVal iAddressFamily As Long, ByVal iType As Long, ByVal iProtocol As Long) As Long
Declare Function TransmitFile Lib "ws2_32" (ByVal hSocket As Long, ByVal hFile As Long, ByVal nNumberOfBytesToWrite As Long, ByVal nNumberOfBytesPerSend As Long, ByVal lpOverlapped As OVERLAPPED, ByVal lpTransmitBuffers As TRANSMIT_FILE_BUFFERS, ByVal dwFlags As Long) As Boolean
Const MAX_PROTOCOL_CHAIN = 7
Type WSAPROTOCOLCHAIN ChainLen As Integer 'the length of the chain, 'length = 0 means layered protocol, 'length = 1 means base protocol, 'length > 1 means protocol chain ChainEntries(MAX_PROTOCOL_CHAIN) As Long 'a list of dwCatalogEntryIds End Type
Const WSAPROTOCOL_LEN = 255
Type WSAPROTOCOL_INFO dwServiceFlags1 As Long dwServiceFlags2 As Long dwServiceFlags3 As Long dwServiceFlags4 As Long dwProviderFlags As Long ProviderId As CLSID dwCatalogEntryId As Long ProtocolChain As WSAPROTOCOLCHAIN iVersion As Integer iAddressFamily As Integer iMaxSockAddr As Integer iMinSockAddr As Integer iSocketType As Integer iProtocol As Integer iProtocolMaxOffset As Integer iNetworkByteOrder As Integer iSecurityScheme As Integer dwMessageSize As Integer dwProviderReserved As Integer szProtocol(WSAPROTOCOL_LEN + 1) As Byte End Type Declare Function WSAAccept Lib "ws2_32" (ByVal hSocket As Long, pSockAddr As SOCKADDR, ByVal AddrLen As Integer, ByVal lpfnCondition As Long, ByVal dwCallbackData As Long) As Long
Declare Function WSAAddressToString Lib "ws2_32" Alias "WSAAddressToStringA" (lpsaAddress As SOCKADDR, ByVal dwAddressLength As Long, lpProtocolInfo As PROTOCOL_INFO, ByVal lpszAddressString As String, ByVal lpdwAddressStringLength As Long) As Long
Declare Function WSAAsyncGetHostByAddr Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lpNetAddr As Long, ByVal AddrLen As Long, ByVal AddrType As Long, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncGetHostByName Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lpHostName As String, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncGetProtoByName Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lpHostName As String, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncGetProtoByNumber Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal iNumer As Integer, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncGetServByName Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lpServiceName As String, ByVal lpProtocolName As String, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncGetServByPort Lib "ws2_32" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal iPort As Integer, ByVal lpProtocolName As String, ByVal lpBuf As Long, ByVal BufLen As Long) As Long
Declare Function WSAAsyncSelect Lib "ws2_32" (ByVal hSocket As Long, ByVal hWnd As Long, ByVal wMsg As Integer, ByVal lEvent As Long) As Integer
Declare Function WSACancelAsyncRequest Lib "ws2_32" (ByVal hAsyncTaskHandle As Long) As Integer
Declare Function WSACleanup Lib "ws2_32" () As Integer
Declare Function WSACloseEvent Lib "ws2_32" (ByVal hEvent As Long) As Boolean Declare Function WSAConnect Lib "ws2_32" (ByVal hSocket As Long, lpSckName As SOCKADDR, ByVal iSckNameLen As Integer, ByVal lpCallerData As Long, lpCalleeData As Long, lpSQOS As FLOWSPEC, lpGQOS As FLOWSPEC) As Integer
Declare Function WSACreateEvent Lib "ws2_32" () As Long
Declare Function WSADuplicateSocket Lib "ws2_32" Alias "WSADuplicateSocketA" (ByVal hSocket As Long, ByVal dwProcessId As Long, lpProtocolInfo As WSAPROTOCOL_INFO)
Type WSANAMESPACE_INFO NSProviderId As CLSID dwNameSpace As Long fActive As Boolean dwVersion As Long lpszIdentifier As Long End Type
Declare Function WSAEnumNameSpaceProviders Lib "ws2_32" Alias "WSAEnumNameSpaceProvidersA" (lpdwBufferLength As Long, lpnspBuffer As Long) As Integer
Type WSANETWORKEVENTS lNetworkEvents As Long iErrorCode(FD_MAX_EVENTS) As Integer End Type
Declare Function WSAEnumNetworkEvents Lib "ws2_32" (ByVal hSocket As Long, ByVal hEventObject As Long, lpNetworkEvents As WSANETWORKEVENTS)
Declare Function WSAEnumProtocols Lib "ws2_32" Alias "WSAEnumProtocolsA" (ByVal lpiProtocols As Long, lpProtocolBuffer As Long, ByVal lpdwBufferLength As Long) As Integer
Declare Function WSAEventSelect Lib "ws2_32" (ByVal hSocket As Long, ByVal hEventObject As Long, ByVal lNetworkEvents As Long)
Declare Function WSAGetLastError Lib "ws2_32" () As Integer
Type WSAOVERLAPPED Internal As Long InternalHigh As Long Offset As Long OffsetHigh As Long hEvent As Long End Type
Declare Function WSAGetOverlappedResult Lib "ws2_32" (ByVal hSocket As Long, lpOverlapped As WSAOVERLAPPED, lpcbTransfer As Long, ByVal fWait As Boolean, ByVal lpdwFlags As Long) As Boolean
Type WSABUF dwBufferLen As Long lpBuffer As Long End Type
Type QUALITYOFSERVICE SendingFlowspec As FLOWSPEC ReceivingFlowspec As FLOWSPEC ProviderSpecific As WSABUF End Type
Declare Function WSAGetQOSByName Lib "ws2_32" (ByVal hSocket As Long, lpQOSName As Long, lpQOS As QUALITYOFSERVICE)
Declare Function WSAGetServiceClassInfo Lib "ws2_32" Alias "WSAGetServiceClassInfoA" (lpProviderId As CLSID, lpServiceClassId As CLSID, ByVal lpdwBufferLength As Long, ByVal lpServiceClassInfo As Long) As Integer
Declare Function WSAGetServiceClassNameByClassId Lib "ws2_32" Alias "WSAGetServiceClassNameByClassIdA" (lpServiceClassId As CLSID, ByVal lpszServiceClassName As String, ByVal lpdwBufferLength As Integer) As Integer
Declare Function WSAHtonl Lib "ws2_32" (ByVal hSocket As Long, ByVal dwHostLong As Long, dwNetLong As Long) As Integer
Declare Function WSAHtons Lib "ws2_32" (ByVal hSocket As Long, ByVal iHostShort As Integer, lpNetShort As Integer) As Integer
Type WSAServiceClassInfo lpServiceClassId As CLSID lpszServiceClassName As String dwCount As Long lpClassInfos As Long End Type
Declare Function WSAInstallServiceClass Lib "ws2_32" Alias "WSAInstallServiceClassA" (lpServiceClassInfo As WSAServiceClassInfo)
Declare Function WSAIoctl Lib "ws2_32" (ByVal hSocket As Long, ByVal dwIoControlCode As Long, ByVal lpvInBuffer As Long, ByVal cbInBuffer As Long, ByVal lpvOUTBuffer As Long, ByVal bOUTBuffer As Long, lpcbBytesReturned As Long, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long)
Declare Function WSAJoinLeaf Lib "ws2_32" (ByVal hSocket As Long, lpSckName As SOCKADDR, ByVal iSckNameLen As Integer, lpCallerData As WSABUF, lpCalleeData As WSABUF, lpSQOS As FLOWSPEC, lpGQOS As FLOWSPEC, ByVal dwFlags As Long) As Long
Enum WSAEcomparator COMP_EQUAL = 0 COMP_NOTLESS = 1 End Enum
Type WSAVersion dwVersion As Long ecHow As WSAEcomparator End Type
Type AFPROTOCOLS iAddressFamily As Integer iProtocol As Integer End Type
Type SOCKET_ADDRESS lpSockaddr As Long iSockaddrLength As Long End Type
Type WSAQuerySet dwSize As Long lpszServiceInstanceName As String lpServiceClassId As CLSID lpVersion As WSAVersion lpszComment As String dwNameSpace As Long lpNSProviderId As CLSID lpszContext As String dwNumberOfProtocols As Long lpafpProtocols As Long lpszQueryString As String dwNumberOfCsAddrs As Long lpcsaBuffer As CSADDR_INFO dwOutputFlags As Long lpBlob As BLOB End Type
Declare Function WSALookupServiceBegin Lib "ws2_32" Alias "WSALookupServiceBeginA" (ByVal lpqsRestrictions As WSAQuerySet, ByVal dwControlFlags As SearchControlFlags, lphLookup As Long) As Integer
Declare Function WSALookupServiceEnd Lib "ws2_32" (ByVal hLookup As Long) As Integer
Declare Function WSALookupServiceNext Lib "ws2_32" Alias "WSALookupServiceNextA" (ByVal hLookup As Long, ByVal dwControlFlags As SearchControlFlags, lpdwBufferLength As Long, lpqsResults As WSAQuerySet) As Integer
Declare Function WSANtohl Lib "ws2_32" (ByVal hSocket As Long, ByVal lpNetLong As Long, lpHostLong As Long) As Integer
Declare Function WSANtohs Lib "ws2_32" (ByVal hSocket As Long, ByVal lpNetShort As Integer, lpHostShort As Integer) As Integer
Declare Function WSAProviderConfigChange Lib "ws2_32" (ByVal lpNotificationHandle As Long, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long) As Integer
Declare Function WSARecvEx Lib "ws2_32" (ByVal hSocket As Long, ByVal lpBuffers As Long, ByVal dwBufferCount As Long, lpNumberOfBytesRecvd As Long, lpFlags As Long, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long) As Integer
Declare Function WSARecvDisconnect Lib "ws2_32" (ByVal hSocket As Long, lpInboundDisconnectData As WSABUF) As Integer
Declare Function WSARecvFrom Lib "ws2_32" (ByVal hSocket As Long, ByVal lpBuffers As Long, ByVal dwBufferCount As Long, lpNumberOfBytesRecvd As Long, lpFlags As Long, lpFrom As SOCKADDR, lpFromlen As Integer, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long) As Integer
Declare Function WSARemoveServiceClass Lib "ws2_32" (lpServiceClassId As CLSID) As Integer
Declare Function WSAResetEvent Lib "ws2_32" (ByVal hEvent As Long) As Boolean
Declare Function WSASend Lib "ws2_32" (ByVal hSocket As Long, ByVal lpBuffers As Long, ByVal dwBufferCount As Long, lpNumberOfBytesSent As Long, ByVal dwFlags As Long, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long) As Integer
Declare Function WSASendDisconnect Lib "ws2_32" (ByVal hSocket As Long, boundDisconnectData As WSABUF) As Integer
Declare Function WSASendTo Lib "ws2_32" (ByVal hSocket As Long, ByVal lpBuffers As Long, ByVal dwBufferCount As Long, lpNumberOfBytesSent As Long, ByVal dwFlags As Long, lpTo As SOCKADDR, ByVal iToLen As Integer, lpOverlapped As WSAOVERLAPPED, ByVal lpCompletionROUTINE As Long) As Integer
Declare Function WSASetEvent Lib "ws2_32" (ByVal hEvent As Long) As Boolean Declare Sub WSASetLastError Lib "ws2_32" (ByVal iError As Integer)
Enum WSAESETSERVICEOP RNRSERVICE_REGISTER = 0 RNRSERVICE_DEREGISTER = 1 RNRSERVICE_DELETE = 2 End Enum
Declare Function WSASetService Lib "ws2_32" Alias "WSASetServiceA" (lpqsRegInfo As WSAQuerySet, essOperation As WSAESETSERVICEOP, ByVal dwControlFlags As Long) As Integer
Declare Function WSASocket Lib "ws2_32" Alias "WSASocketA" (ByVal iAddressFamily As Integer, ByVal iType As Integer, ByVal iProtocol As Integer, lpProtocolInfo As WSAPROTOCOL_INFO, ByVal lpGroup As Long, ByVal dwFlags As Long) As Long
Declare Function WSAStartup Lib "ws2_32" (ByVal wVersionRequired As Long, lpWSAData As WSADATA) As Long
Declare Function WSAStringToAddress Lib "ws2_32" (ByVal AddressString As String, ByVal AddressFamily As Integer, lpProtocolInfo As WSAPROTOCOL_INFO, lpAddress As SOCKADDR, lpAddressLength As Integer) As Integer
Public SockLastError As Long
Function sckhibyte(ByVal wParam As Integer) sckhibyte = (wParam \ &H100) And &HFF& End Function
Function scklobyte(ByVal wParam As Integer) scklobyte = wParam And &HFF& End Function
Property Get LocalHostName() As String Dim sStr As String * 256, lStr& Dim r& r = gethostname(sStr, 256) SockLastError = WSAGetLastError() LocalHostName = Trim(Replace(sStr, vbNullChar, vbNullString)) End Property
Property Get LocalHostIP() As String
Dim sHostName$, pHostent& Dim pHost As HOSTENT Dim hIPAddress&, sIPAddress$ Dim abIPAddress() As Byte Dim i%
sHostName = LocalHostName pHostent = gethostbyname(sHostName) SockLastError = WSAGetLastError()
If pHostent = 0 Then Exit Property CopyMemory ByVal pHost, ByVal pHostent, ByVal LenB(pHost) CopyMemory hIPAddress, ByVal pHost.h_addr_list, ByVal 4&
ReDim abIPAddress(1 To pHost.h_length) CopyMemory abIPAddress(1), ByVal hIPAddress, ByVal pHost.h_length
For i = 1 To pHost.h_length sIPAddress = sIPAddress & abIPAddress(i) & "." Next LocalHostIP = Left$(sIPAddress, Len(sIPAddress) - 1) End Property
Sub SocketsInitialize() Dim WSAD As WSADATA Dim iReturn As Integer Dim sLowByte As String, sHighByte As String, sMsg As String
iReturn = WSAStartup(WS_VERSION_REQD, WSAD) SockLastError = WSAGetLastError()
If iReturn <> 0 Then Exit Sub End If
If LoByte(WSAD.wversion) < WS_VERSION_MAJOR Or _ (LoByte(WSAD.wversion) = WS_VERSION_MAJOR And _ HiByte(WSAD.wversion) < WS_VERSION_MINOR) Then Exit Sub End If
If WSAD.iMaxSockets < MIN_SOCKETS_REQD Then Exit Sub End If
End Sub
Function SocketsCleanup() As Long SocketsCleanup = WSACleanup() End Function
Function CreateSocket(ByVal SockType As SockTypes, Optional ByVal Protocol As SockProtocols = IPPROTO_TCP) As Long CreateSocket = socket(AF_NETBIOS, SockType, Protocol) SockLastError = WSAGetLastError End Function
Function DestroySocket(hSocket As Long) As Boolean DestroySocket = (closesocket(hSocket) = 0) SockLastError = WSAGetLastError End Function
Function GetSckName(hSocket As Long) As String Dim sName$ Dim pSckAdd As SOCKADDR, lpAdd& Dim r& r = GetSockNameA(hSocket, lpAdd, LenB(pSckAdd)) SockLastError = WSAGetLastError CopyMemory ByVal pSckAdd, ByVal lpAdd, ByVal LenB(pSckAdd) GetSckName = Trim(Replace(pSckAdd.sa_data, vbNullChar, vbNullString)) End Function
Saludos.
|
|
|
|
|
|
|