|
211
|
Programación / Programación Visual Basic / Re: Proporcion entre picturebox y screen ¿?
|
en: 28 Diciembre 2006, 23:23 pm
|
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
|
|
|
214
|
Programación / Programación Visual Basic / Re: Grupos de Usuarios en VB6
|
en: 28 Diciembre 2006, 20:07 pm
|
a ver si esto te sirve: en el form: 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 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...
|
|
|
216
|
Programación / Programación Visual Basic / Re: Como mandar un picturebox con winsock
|
en: 28 Diciembre 2006, 02:47 am
|
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.zippara usarla se hace de la siguiente manera: 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
|
|
|
218
|
Programación / Programación Visual Basic / Re: Como mandar un picturebox con winsock
|
en: 27 Diciembre 2006, 23:47 pm
|
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...
|
|
|
219
|
Programación / Programación Visual Basic / Re: Como mandar un picturebox con winsock
|
en: 27 Diciembre 2006, 22:48 pm
|
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 '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 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
|
|
|
220
|
Programación / Programación Visual Basic / Re: Como mandar un picturebox con winsock
|
en: 27 Diciembre 2006, 21:48 pm
|
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
|
|
|
|
|
|
|