Mensajes

creo que con la api "GetCursorPos" podrias sacar en donde esta el cursor, y la proporción conrespecto al form podría ser una regla de 3:

si el ancho del picture es 1095 y el del form 4800, pues se podria sacar la equivalencia asi


1 twip del picture =( form.width / picture.with ) twips del form

el archivo trae ejemplos de Hack, por ejemplo el Keylogger, por eso los firewall y antivirus bloquean la descarga, jejeje, solo vacunenlo y que elimine todos los .exe de los archivos .zip

  disculpa mi ignorancia, ¿que es lo que hace exactamente? 

a ver si esto te sirve:

en el form:

Código [Seleccionar] Expandir


Option Explicit
Private Sub Form_Load()
    If IsAdmin Then
        MsgBox "Eres un Administrator", vbInformation, Caption
    Else
        MsgBox "jaja, sigue soñando", vbInformation, Caption
    End If
End Sub


en un módulo

Código [Seleccionar] Expandir


Option Explicit
Option Base 0     ' Important assumption for this code

Private Const ANYSIZE_ARRAY = 20 'Fixed at this size for comfort. Could be bigger or made dynamic.

' Security APIs
Private Const TokenUser = 1
Private Const TokenGroups = 2
Private Const TokenPrivileges = 3
Private Const TokenOwner = 4
Private Const TokenPrimaryGroup = 5
Private Const TokenDefaultDacl = 6
Private Const TokenSource = 7
Private Const TokenType = 8
Private Const TokenImpersonationLevel = 9
Private Const TokenStatistics = 10

' Token Specific Access Rights
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = &H2
Private Const TOKEN_IMPERSONATE = &H4
Private Const TOKEN_QUERY = &H8
Private Const TOKEN_QUERY_SOURCE = &H10
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_ADJUST_GROUPS = &H40
Private Const TOKEN_ADJUST_DEFAULT = &H80

' NT well-known SIDs
Private Const SECURITY_DIALUP_RID = &H1
Private Const SECURITY_NETWORK_RID = &H2
Private Const SECURITY_BATCH_RID = &H3
Private Const SECURITY_INTERACTIVE_RID = &H4
Private Const SECURITY_SERVICE_RID = &H6
Private Const SECURITY_ANONYMOUS_LOGON_RID = &H7
Private Const SECURITY_LOGON_IDS_RID = &H5
Private Const SECURITY_LOCAL_SYSTEM_RID = &H12
Private Const SECURITY_NT_NON_UNIQUE = &H15
Private Const SECURITY_BUILTIN_DOMAIN_RID = &H20

' Well-known domain relative sub-authority values (RIDs)
Private Const DOMAIN_ALIAS_RID_ADMINS = &H220
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Private Const DOMAIN_ALIAS_RID_GUESTS = &H222
Private Const DOMAIN_ALIAS_RID_POWER_USERS = &H223
Private Const DOMAIN_ALIAS_RID_ACCOUNT_OPS = &H224
Private Const DOMAIN_ALIAS_RID_SYSTEM_OPS = &H225
Private Const DOMAIN_ALIAS_RID_PRINT_OPS = &H226
Private Const DOMAIN_ALIAS_RID_BACKUP_OPS = &H227
Private Const DOMAIN_ALIAS_RID_REPLICATOR = &H228

Private Const SECURITY_NT_AUTHORITY = &H5

Type SID_AND_ATTRIBUTES
    Sid As Long
    Attributes As Long
End Type

Type TOKEN_GROUPS
    GroupCount As Long
    Groups(ANYSIZE_ARRAY) As SID_AND_ATTRIBUTES
End Type

Type SID_IDENTIFIER_AUTHORITY
    Value(0 To 5) As Byte
End Type

Declare Function GetCurrentProcess Lib "Kernel32" () As Long

Declare Function GetCurrentThread Lib "Kernel32" () As Long

Declare Function OpenProcessToken Lib "Advapi32" ( _
    ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, _
    TokenHandle As Long) As Long

Declare Function OpenThreadToken Lib "Advapi32" ( _
    ByVal ThreadHandle As Long, ByVal DesiredAccess As Long, _
    ByVal OpenAsSelf As Long, TokenHandle As Long) As Long

Declare Function GetTokenInformation Lib "Advapi32" ( _
    ByVal TokenHandle As Long, TokenInformationClass As Integer, _
    TokenInformation As Any, ByVal TokenInformationLength As Long, _
    ReturnLength As Long) As Long

Declare Function AllocateAndInitializeSid Lib "Advapi32" ( _
    pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, _
    ByVal nSubAuthorityCount As Byte, ByVal nSubAuthority0 As Long, _
    ByVal nSubAuthority1 As Long, ByVal nSubAuthority2 As Long, _
    ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As Long, _
    ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, _
    ByVal nSubAuthority7 As Long, lpPSid As Long) As Long

Declare Function RtlMoveMemory Lib "Kernel32" ( _
    Dest As Any, Source As Any, ByVal lSize As Long) As Long

Declare Function IsValidSid Lib "Advapi32" (ByVal pSid As Long) As Long

Declare Function EqualSid Lib "Advapi32" (pSid1 As Any, pSid2 As Any) As Long

Declare Sub FreeSid Lib "Advapi32" (pSid As Any)

Declare Function CloseHandle Lib "Kernel32" (ByVal hObject As Long) As Long

Public Function IsAdmin() As Boolean
    Dim hProcessToken       As Long
    Dim BufferSize          As Long
    Dim psidAdmin           As Long
    Dim lResult             As Long
    Dim X                   As Integer
    Dim tpTokens            As TOKEN_GROUPS
    Dim tpSidAuth           As SID_IDENTIFIER_AUTHORITY

    IsAdmin = False
    tpSidAuth.Value(5) = SECURITY_NT_AUTHORITY
   
    ' Obtain current process token
    If Not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hProcessToken) Then
        Call OpenProcessToken(GetCurrentProcess(), TOKEN_QUERY, hProcessToken)
    End If
    If hProcessToken Then

        ' Deternine the buffer size required
        Call GetTokenInformation(hProcessToken, ByVal TokenGroups, 0, 0, BufferSize) ' Determine required buffer size
        If BufferSize Then
            ReDim InfoBuffer((BufferSize \ 4) - 1) As Long
           
            ' Retrieve your token information
            lResult = GetTokenInformation(hProcessToken, ByVal TokenGroups, InfoBuffer(0), BufferSize, BufferSize)
            If lResult <> 1 Then Exit Function
           
            ' Move it from memory into the token structure
            Call RtlMoveMemory(tpTokens, InfoBuffer(0), Len(tpTokens))
           
            ' Retreive the admins sid pointer
            lResult = AllocateAndInitializeSid(tpSidAuth, 2, SECURITY_BUILTIN_DOMAIN_RID, _
                    DOMAIN_ALIAS_RID_ADMINS, 0, 0, 0, 0, 0, 0, psidAdmin)
            If lResult <> 1 Then Exit Function
            If IsValidSid(psidAdmin) Then
                For X = 0 To tpTokens.GroupCount
               
                    ' Run through your token sid pointers
                    If IsValidSid(tpTokens.Groups(X).Sid) Then
                   
                        ' Test for a match between the admin sid equalling your sid's
                        If EqualSid(ByVal tpTokens.Groups(X).Sid, ByVal psidAdmin) Then
                            IsAdmin = True
                            Exit For
                        End If
                    End If
                Next
            End If
            If psidAdmin Then Call FreeSid(psidAdmin)
        End If
        Call CloseHandle(hProcessToken)
    End If
End Function


esto lo saque de la Api-Guide...

tal vez esto te ayude

http://www.elguille.info/vb/ejemplos/crear_links.htm

ya he encontrado el problema. El problema esque cuando uso la instrucción SavePicture me guarda el archivo como mapa de bits (bmp) y lo que hice es cambiar la imagen de BMP a JPG con una dll que me encontre. la Dll se llama GBITMAP.DLL

y se las dejo para quien la quiera:

http://www.geocities.com/cero780814/GBITMAP.zip

para usarla se hace de la siguiente manera:

Código [Seleccionar] Expandir



    bitmap.LoadFileBmp ("c:\x.bmp") 'Cargar el archivo bmp
    If bitmap.SaveFileJpg("c:\x.jpg") = 0 Then 0 ' y lo convierte a jpg
        MsgBox "Imposible grabar JPG: " & Name, vbCritical
    End If



bajalo de Torrentz

http://www.torrentz.com/search?q=visual+basic+6.0

Gracias, referente a lo del tamaño de la imagen creo que no me di a entender, lo que pasa esque la imagen que cargo al picture es de 3.5Kb y cuando le pongo SavePicture me crea un archivo de 23kb, creo que es porque lo manda como bmp, y lo tendría que pasar a jpg, pero bueno de eso ya se ha hablado mucho aqui, igual y me pongo a búscarle...

BRoWLi gracias por tu comentario, modifique un poco el código que puse y quedo así, aver que opinan, porque es la 1a vez que le meto mano al winsock:

Para enviar

Código [Seleccionar] Expandir



'Aqui le envio el tamaño de la imagen
Private Sub Command1_Click()
    Dim x As String, f As Long
   
    SavePicture Picture1.Picture, "c:\x.jpg"
   
    Tamaño = FileLen("c:\x.jpg")
   
    tcpServer.SendData Str(Tamaño)
   
End Sub

'Espero a que el cliente me conteste que recibio el tamaño de la imagen y ahora si le envio el archivo
Private Sub tcpServer_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String, f As Long, x As String
    tcpServer.GetData strData
    txtOutput.Text = strData
   
    If strData = "RECIBIDO" Then
        f = FreeFile
        Open "C:\x.jpg" For Binary Access Read As #f
        x = Space(LOF(f))
        Get #f, , x
        Close #f
        tcpServer.SendData x
       
        Kill "C:\x.jpg"
    End If
End Sub


Para recibir

Código [Seleccionar] Expandir


Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
    Dim strData As String, f As Long
   
    tcpClient.GetData strData
    'si el max de progress bar es 1 le pongo el tamaño del archivo
    If ProgressBar1.Max = 1 Then
        ProgressBar1.Max = Val(strData)
        ProgressBar1.Value = 0
        tcpClient.SendData "RECIBIDO"
        t = 0
        Exit Sub
    End If
    'aqui voy recibiendo e incrementando el Progressbar
    txtOutput.Text = txtOutput.Text & strData
    ProgressBar1.Value = bytesTotal
    t = t + bytesTotal

    'Cuando ya lo tengo todo creo un archivo y lo cargo al picture
    If ProgressBar1.Max = t Then
       
        f = FreeFile
        Open "C:\x2.jpg" For Binary Access Write As #f
        Put #f, , txtOutput.Text
        Close #f
        Picture1.Picture = LoadPicture("c:\x2.jpg")
        ProgressBar1.Max = 1
        txtOutput.Text = ""
        Kill "C:\x2.jpg"
    End If
   
End Sub


he estado probando el código y me surgierón 2 dudas:

1.- ¿Cómo se sabe cuando se ha terminado de enviar todos los datos?, (porque lo que hice fue que se fueran guardando en un archivo los datos como iban llegando)

2.- ¿Porque el nuevo archivo no es del mismo tamaño que el original?, casi siempre es mayor y no siempre es del mismo tamaño.

alguién sabe