|
Esta sección te permite ver todos los posts escritos por este usuario. Ten en cuenta que sólo puedes ver los posts escritos en zonas a las que tienes acceso en este momento.
Temas - L3andro
Páginas: [1]
1
« en: Lunes 17 de Diciembre de 2007, 18:00 »
Hola a todos, bueno quisiera consultarles lo siguiente, estoy intentando trabajar con una DLL programada en ASM, tengo algunas cuantas dudas sobre el tema, las cuales seguramente no sean muy complicadas de contestar. Bueno el codigo Fuente completo hasta ahora de la DLL es el siguiente: ;EasyCodeName=Module1,1 .386 .Model flat, StdCall Option CaseMap:none Include \masm32\include\windows.inc Include \masm32\include\user32.inc Include \masm32\include\kernel32.inc Include \masm32\include\masm32.inc IncludeLib \masm32\lib\user32.lib IncludeLib \masm32\lib\kernel32.lib IncludeLib \masm32\lib\masm32.lib Include \masm32\macros\MACROS.ASM .Const MEMSIZE Equ 175535 LittleBuffer Equ 10H GSAuthKey1 Equ 00BE2329H GSAuthKey2 Equ 0AED66CE1H GSAuthKey3 Equ 0F1499052H GSAuthKey4 Equ 0EBE9BBF1H GSAuthKey5 Equ 0A6B3H GSAuthKey6 Equ 0DBH .Data ItemKor DB "..\data\lang\Kor\item(Kor).txt", 0 ItemVTM DB "..\data\lang\vtm\item(Vtm).txt", 0 SkillKor DB "..\data\lang\Kor\skill(Kor).txt", 0 SkillVTM DB "..\data\lang\vtm\skill(Vtm).txt", 0 QuestKor DB "..\data\lang\Kor\Quest(Kor).txt", 0 QuestVTM DB "..\data\lang\Vtm\Quest(Vtm).txt", 0 CheckSum DB "..\data\lang\Kor\CheckSum.dat", 0 Monster DB "..\data\Monster.txt", 0 Gate DB "..\data\gate.txt", 0 MonsterBase DB "..\data\MonsterSetBase.txt", 0 Shop0 DB "..\data\Shop0.txt", 0 Shop1 DB "..\data\Shop1.txt", 0 Shop2 DB "..\data\Shop2.txt", 0 Shop3 DB "..\data\Shop3.txt", 0 Shop4 DB "..\data\Shop4.txt", 0 Shop5 DB "..\data\Shop5.txt", 0 Shop6 DB "..\data\Shop6.txt", 0 Shop7 DB "..\data\Shop7.txt", 0 Shop8 DB "..\data\Shop8.txt", 0 Shop9 DB "..\data\Shop9.txt", 0 Shop10 DB "..\data\Shop10.txt", 0 Shop11 DB "..\data\Shop11.txt", 0 Shop12 DB "..\data\Shop12.txt", 0 MoveReqKor DB "..\data\lang\Kor\movereq(kor).txt", 0 MoveReqVTM DB "..\data\lang\Vtm\movereq(Vtm).txt", 0 ItemSetOption DB "..\data\lang\Kor\itemsetoption(Kor).txt", 0 ItemSetType DB "..\data\lang\Kor\itemsettype(Kor).txt", 0 CommonLoc DB "..\data\lang\Kor\CommonLoc.cfg", 0 GameServerInfo DB "GameServerInfo", 0 ClientVersion DB "ClientExeVersion", 0 ClientSerial DB "ClientExeSerial", 0 ServerName DD LittleBuffer Dup(0) VersionServer DD LittleBuffer Dup(0) ClientVersionReturn DD LittleBuffer Dup(0) ClientSerialReturn DD LittleBuffer Dup(0) AGGSOffset DD ? AGSOffset2 DD ? FirstTime DD ? .Data? hFile HANDLE ? hMemory HANDLE ? pMemory DWord ? SizeReadWrite DWord ? .Code DllEntry Proc hInstDLL:HINSTANCE, reason:DWord, reserved1:DWord Mov Eax, TRUE Ret DllEntry EndP AGSetInfo Proc Mov Eax, DWord Ptr Ss:[Ebp + 18H] Mov Ecx, DWord Ptr Ss:[Ebp + 14H] Mov Edx, DWord Ptr Ss:[Ebp + 0CH] Mov Ebx, DWord Ptr Ss:[Ebp + 20H] Mov ServerName, Eax Mov VersionServer, Ecx Mov AGGSOffset, Edx Mov AGSOffset2, Ebx Xor Eax, Eax Ret AGSetInfo EndP AGGetKey Proc Mov Edx, GSAuthKey1 Mov Eax, DWord Ptr Ss:[Ebp + 8] Mov DWord Ptr Ds:[Eax], Edx Mov Edx, GSAuthKey2 Mov DWord Ptr Ds:[Eax + 4], Edx Mov Edx, GSAuthKey3 Mov DWord Ptr Ds:[Eax + 8], Edx Mov Edx, GSAuthKey4 Mov DWord Ptr Ds:[Eax + 0CH], Edx Mov Cx, GSAuthKey5 Mov Word Ptr Ds:[Eax + 10H], Cx Mov Dl, GSAuthKey6 Mov Byte Ptr Ds:[Eax + 12H], Dl Xor Eax, Eax Ret AGGetKey EndP AGRequestData Proc Local Number:DWord Cmp FirstTime, 0 Jnz DeleteBuffer Mov FirstTime, 1 Jmp SwitchNumbers DeleteBuffer: Invoke CloseHandle, hFile Invoke GlobalUnlock, pMemory Invoke GlobalFree, hMemory SwitchNumbers: Mov Ecx, DWord Ptr Ss:[Ebp + 0CH] Mov Number, Ecx Switch Number Case 0 Mov Eax, Offset ItemKor Case 1 Mov Eax, Offset ItemVTM Case 2 Mov Eax, Offset SkillKor Case 3 Mov Eax, Offset SkillVTM Case 4 Mov Eax, Offset QuestKor Case 5 Mov Eax, Offset QuestVTM Case 6 Mov Eax, Offset CheckSum Case 7 Mov Eax, Offset Monster Case 8 Mov Eax, Offset Gate Case 9 Mov Eax, Offset MonsterBase Case 0BH Mov Eax, Offset Shop0 Case 0CH Mov Eax, Offset Shop1 Case 0DH Mov Eax, Offset Shop2 Case 0EH Mov Eax, Offset Shop3 Case 0FH Mov Eax, Offset Shop4 Case 10H Mov Eax, Offset Shop5 Case 11H Mov Eax, Offset Shop6 Case 12H Mov Eax, Offset Shop7 Case 13H Mov Eax, Offset Shop8 Case 14H Mov Eax, Offset Shop9 Case 15H Mov Eax, Offset Shop10 Case 16H Mov Eax, Offset Shop11 Case 17H Mov Eax, Offset Shop12 Case 18H Mov Eax, Offset MoveReqKor Case 1AH Mov Eax, Offset ItemSetOption Case 1CH Mov Eax, Offset ItemSetType EndSw LoadFile: Invoke CreateFile, Eax, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, NULL Mov hFile, Eax Invoke GlobalAlloc, GMEM_MOVEABLE Or GMEM_ZEROINIT, MEMSIZE Mov hMemory, Eax Invoke GlobalLock, hMemory Mov pMemory, Eax Invoke ReadFile, hFile, pMemory, MEMSIZE - 1, Addr SizeReadWrite, NULL Xor Eax, Eax Ret AGRequestData EndP AGGetDataBufferSize Proc Mov Eax, SizeReadWrite Ret AGGetDataBufferSize EndP AGGetDataBuffer Proc Mov Eax, pMemory Ret AGGetDataBuffer EndP AGGetClientVersion Proc Invoke GetPrivateProfileString, Addr GameServerInfo, Addr ClientVersion, NULL, Addr ClientVersionReturn, 14H, Addr CommonLoc Invoke GetPrivateProfileString, Addr GameServerInfo, Addr ClientSerial, NULL, Addr ClientSerialReturn, 14H, Addr CommonLoc Mov Eax, DWord Ptr Ds:[ClientVersionReturn] Mov Ecx, DWord Ptr Ds:[ClientVersionReturn + 4] Mov Edx, DWord Ptr Ss:[Ebp + 8] Mov DWord Ptr Ds:[Edx], Eax Mov DWord Ptr Ds:[Edx + 4], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn] Mov Ecx, DWord Ptr Ds:[ClientSerialReturn + 4] Mov Edx, DWord Ptr Ss:[Ebp + 0CH] Mov DWord Ptr Ds:[Edx], Eax Mov DWord Ptr Ds:[Edx + 4], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn + 8] Mov Ecx, DWord Ptr Ds:[ClientSerialReturn + 0CH] Mov DWord Ptr Ds:[Edx + 8], Eax Mov DWord Ptr Ds:[Edx + 0CH], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn + 10H] Mov DWord Ptr Ds:[Edx + 10H], Eax Xor Eax, Eax Ret AGGetClientVersion EndP End DllEntry
Asi como esta, funciona bien... Ahora mi consulta es la siguiente, me decidi a agregarle algunas funciones mas de configuracion, añadiendo un .ini - y quisiera ver si esto esta bien y si de estarlo hay alguna forma de optimizar el codigo si pueden asesorarme, o corregirme de estar mal. Lo que agrego seria lo siguiente. Dentro de .Data añado esto: .Data IsGlobalChatBuff DB 1 Dup(0) GChatLevelBuff DB 4 Dup(0) GChatMoneyBuff DB 4 Dup(0) Sections DB "Config", 0 IniFileName DB "./Config.ini" , 0
Y posteriormente creo un nuevo Proc de la siguiente manera: LoadConfig Proc Invoke GetPrivateProfileInt, Addr Sections, Addr IsGlobalChat, 0, Addr IniFileName Mov DWord Ptr Ds:[IsGlobalChatBuff], Eax Invoke GetPrivateProfileInt, Addr Sections, Addr GChatLevel, 50, Addr IniFileName Mov DWord Ptr Ds:[GChatLevelBuff], Eax Invoke GetPrivateProfileInt, Addr Sections, Addr GChatMoney, 10000, Addr IniFileName Mov DWord Ptr Ds:[GChatMoneyBuff], Eax Retn LoadConfig EndP
Las opciones son muchisimas mas, pero en resumen la idea es esa, y esto quedaria de la siguiente manera: .386 .Model flat, StdCall Option CaseMap:none Include \masm32\include\windows.inc Include \masm32\include\user32.inc Include \masm32\include\kernel32.inc Include \masm32\include\masm32.inc IncludeLib \masm32\lib\user32.lib IncludeLib \masm32\lib\kernel32.lib IncludeLib \masm32\lib\masm32.lib Include \masm32\macros\MACROS.ASM .Const MEMSIZE Equ 175535 LittleBuffer Equ 10H GSAuthKey1 Equ 00BE2329H GSAuthKey2 Equ 0AED66CE1H GSAuthKey3 Equ 0F1499052H GSAuthKey4 Equ 0EBE9BBF1H GSAuthKey5 Equ 0A6B3H GSAuthKey6 Equ 0DBH .Data IsGlobalChatBuff DB 1 Dup(0) GChatLevelBuff DB 4 Dup(0) GChatMoneyBuff DB 4 Dup(0) Sections DB "Config", 0 IniFileName DB "./Config.ini" , 0 ItemKor DB "..\data\lang\Kor\item(Kor).txt", 0 ItemVTM DB "..\data\lang\vtm\item(Vtm).txt", 0 SkillKor DB "..\data\lang\Kor\skill(Kor).txt", 0 SkillVTM DB "..\data\lang\vtm\skill(Vtm).txt", 0 QuestKor DB "..\data\lang\Kor\Quest(Kor).txt", 0 QuestVTM DB "..\data\lang\Vtm\Quest(Vtm).txt", 0 CheckSum DB "..\data\lang\Kor\CheckSum.dat", 0 Monster DB "..\data\Monster.txt", 0 Gate DB "..\data\gate.txt", 0 MonsterBase DB "..\data\MonsterSetBase.txt", 0 Shop0 DB "..\data\Shop0.txt", 0 Shop1 DB "..\data\Shop1.txt", 0 Shop2 DB "..\data\Shop2.txt", 0 Shop3 DB "..\data\Shop3.txt", 0 Shop4 DB "..\data\Shop4.txt", 0 Shop5 DB "..\data\Shop5.txt", 0 Shop6 DB "..\data\Shop6.txt", 0 Shop7 DB "..\data\Shop7.txt", 0 Shop8 DB "..\data\Shop8.txt", 0 Shop9 DB "..\data\Shop9.txt", 0 Shop10 DB "..\data\Shop10.txt", 0 Shop11 DB "..\data\Shop11.txt", 0 Shop12 DB "..\data\Shop12.txt", 0 MoveReqKor DB "..\data\lang\Kor\movereq(kor).txt", 0 MoveReqVTM DB "..\data\lang\Vtm\movereq(Vtm).txt", 0 ItemSetOption DB "..\data\lang\Kor\itemsetoption(Kor).txt", 0 ItemSetType DB "..\data\lang\Kor\itemsettype(Kor).txt", 0 CommonLoc DB "..\data\lang\Kor\CommonLoc.cfg", 0 GameServerInfo DB "GameServerInfo", 0 ClientVersion DB "ClientExeVersion", 0 ClientSerial DB "ClientExeSerial", 0 ServerName DD LittleBuffer Dup(0) VersionServer DD LittleBuffer Dup(0) ClientVersionReturn DD LittleBuffer Dup(0) ClientSerialReturn DD LittleBuffer Dup(0) AGGSOffset DD ? AGSOffset2 DD ? FirstTime DD ? .Data? hFile HANDLE ? hMemory HANDLE ? pMemory DWord ? SizeReadWrite DWord ? .Code DllEntry Proc hInstDLL:HINSTANCE, reason:DWord, reserved1:DWord Mov Eax, TRUE Ret DllEntry EndP LoadConfig Proc Invoke GetPrivateProfileInt, Addr Sections, Addr IsGlobalChat, 0, Addr IniFileName Mov DWord Ptr Ds:[IsGlobalChatBuff], Eax Invoke GetPrivateProfileInt, Addr Sections, Addr GChatLevel, 50, Addr IniFileName Mov DWord Ptr Ds:[GChatLevelBuff], Eax Invoke GetPrivateProfileInt, Addr Sections, Addr GChatMoney, 10000, Addr IniFileName Mov DWord Ptr Ds:[GChatMoneyBuff], Eax Retn LoadConfig EndP AGSetInfo Proc Mov Eax, DWord Ptr Ss:[Ebp + 18H] Mov Ecx, DWord Ptr Ss:[Ebp + 14H] Mov Edx, DWord Ptr Ss:[Ebp + 0CH] Mov Ebx, DWord Ptr Ss:[Ebp + 20H] Mov ServerName, Eax Mov VersionServer, Ecx Mov AGGSOffset, Edx Mov AGSOffset2, Ebx Xor Eax, Eax Ret AGSetInfo AGGetKey Proc Mov Edx, GSAuthKey1 Mov Eax, DWord Ptr Ss:[Ebp + 8] Mov DWord Ptr Ds:[Eax], Edx Mov Edx, GSAuthKey2 Mov DWord Ptr Ds:[Eax + 4], Edx Mov Edx, GSAuthKey3 Mov DWord Ptr Ds:[Eax + 8], Edx Mov Edx, GSAuthKey4 Mov DWord Ptr Ds:[Eax + 0CH], Edx Mov Cx, GSAuthKey5 Mov Word Ptr Ds:[Eax + 10H], Cx Mov Dl, GSAuthKey6 Mov Byte Ptr Ds:[Eax + 12H], Dl Xor Eax, Eax Ret AGGetKey EndP AGRequestData Proc Local Number:DWord Cmp FirstTime, 0 Jnz DeleteBuffer Mov FirstTime, 1 Jmp SwitchNumbers DeleteBuffer: Invoke CloseHandle, hFile Invoke GlobalUnlock, pMemory Invoke GlobalFree, hMemory SwitchNumbers: Mov Ecx, DWord Ptr Ss:[Ebp + 0CH] Mov Number, Ecx Switch Number Case 0 Mov Eax, Offset ItemKor Case 1 Mov Eax, Offset ItemVTM Case 2 Mov Eax, Offset SkillKor Case 3 Mov Eax, Offset SkillVTM Case 4 Mov Eax, Offset QuestKor Case 5 Mov Eax, Offset QuestVTM Case 6 Mov Eax, Offset CheckSum Case 7 Mov Eax, Offset Monster Case 8 Mov Eax, Offset Gate Case 9 Mov Eax, Offset MonsterBase Case 0BH Mov Eax, Offset Shop0 Case 0CH Mov Eax, Offset Shop1 Case 0DH Mov Eax, Offset Shop2 Case 0EH Mov Eax, Offset Shop3 Case 0FH Mov Eax, Offset Shop4 Case 10H Mov Eax, Offset Shop5 Case 11H Mov Eax, Offset Shop6 Case 12H Mov Eax, Offset Shop7 Case 13H Mov Eax, Offset Shop8 Case 14H Mov Eax, Offset Shop9 Case 15H Mov Eax, Offset Shop10 Case 16H Mov Eax, Offset Shop11 Case 17H Mov Eax, Offset Shop12 Case 18H Mov Eax, Offset MoveReqKor Case 1AH Mov Eax, Offset ItemSetOption Case 1CH Mov Eax, Offset ItemSetType EndSw LoadFile: Invoke CreateFile, Eax, GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_ATTRIBUTE_ARCHIVE, NULL Mov hFile, Eax Invoke GlobalAlloc, GMEM_MOVEABLE Or GMEM_ZEROINIT, MEMSIZE Mov hMemory, Eax Invoke GlobalLock, hMemory Mov pMemory, Eax Invoke ReadFile, hFile, pMemory, MEMSIZE - 1, Addr SizeReadWrite, NULL Xor Eax, Eax Ret AGRequestData EndP AGGetDataBufferSize Proc Mov Eax, SizeReadWrite Ret AGGetDataBufferSize EndP AGGetDataBuffer Proc Mov Eax, pMemory Ret AGGetDataBuffer EndP AGGetClientVersion Proc Invoke GetPrivateProfileString, Addr GameServerInfo, Addr ClientVersion, NULL, Addr ClientVersionReturn, 14H, Addr CommonLoc Invoke GetPrivateProfileString, Addr GameServerInfo, Addr ClientSerial, NULL, Addr ClientSerialReturn, 14H, Addr CommonLoc Mov Eax, DWord Ptr Ds:[ClientVersionReturn] Mov Ecx, DWord Ptr Ds:[ClientVersionReturn + 4] Mov Edx, DWord Ptr Ss:[Ebp + 8] Mov DWord Ptr Ds:[Edx], Eax Mov DWord Ptr Ds:[Edx + 4], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn] Mov Ecx, DWord Ptr Ds:[ClientSerialReturn + 4] Mov Edx, DWord Ptr Ss:[Ebp + 0CH] Mov DWord Ptr Ds:[Edx], Eax Mov DWord Ptr Ds:[Edx + 4], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn + 8] Mov Ecx, DWord Ptr Ds:[ClientSerialReturn + 0CH] Mov DWord Ptr Ds:[Edx + 8], Eax Mov DWord Ptr Ds:[Edx + 0CH], Ecx Mov Eax, DWord Ptr Ds:[ClientSerialReturn + 10H] Mov DWord Ptr Ds:[Edx + 10H], Eax Xor Eax, Eax Ret AGGetClientVersion EndP End DllEntry
Bueno mi consulta es la nombrada, quisiera saber si los ultimos agregados como el del .ini para configuracion estan bien aplicados, y si hay alguna manera de optimizar el codigo. Saludos y desde ya gracias.
2
« en: Lunes 17 de Diciembre de 2007, 15:50 »
Buenos dias a todos, bueno mi consulta es la siguiente: Quisiera saber como utilizar en una DLL la Funcion Virtual Protect en lugar de OpenProcces, por ejemplo. // Start Procedure (Loader) procedure InitDLL;stdcall;export;inline; begin ProcessId:=OpenProcess(PROCESS_ALL_ACCESS, False,GetCurrentProcessId); if(ProcessId<>0)then begin TCReward; PotBug; NoIDUser; end; end; {EXPORTS SECTION} exports InitDLL; begin end.
Como podría hacer para utilizar el VirtualProtect en lugar de OpenProcess ? Desde y amuchas gracias, por cualquier ayuda que puedan brindarme.
3
« en: Domingo 2 de Septiembre de 2007, 06:07 »
Bueno tengo un problema con una aplicacion, el cual la verdad no estoy muy seguro como solucionar, y consta en que al ejecutarla esta se cierra automaticamente, al cargarla con un Debuguer como el Olly o WinDBG, y Ejecutarla desde el mismo, puedo ver que el problema se produce en las siguiente linea: MOV DWORD PTR DS:[68ED96],EAX ; Mueve la Carga de la DLL al Offset 68ED96
como referencia pongo tambien el codigo completo sobre lo afectado: PUSH appz3.0068EF76 ; /FileName = "DbDatos.dll" CALL DWORD PTR DS:[<&KERNEL32.LoadLibraryA>] ; \LoadLibraryA MOV DWORD PTR DS:[68ED96],EAX ; Mueve la Carga de la DLL al Offset 68ED96 PUSH appz3.0068EF86 ; /ProcNameOrOrdinal = "msgbox" PUSH EAX ; |hModule CALL DWORD PTR DS:[<&KERNEL32.GetProcAddress>] ; \GetProcAddress MOV DWORD PTR DS:[68ED9A],EAX ; Mueve la Caraga del Proc al Offset 68ED9A CALL EAX JMP appz3.005828E5 ; Con este JMP Regresamos al EP!
Bueno ahi carga una dll en primer instancia, y luego con el "MOV EAX, DWORD PTR DS:[68ED9A]" la mueve a otra direccion para ser usada o almenos eso me parece a mi, y es justo alli donde se produce el error, El Offset a donde quiere moverla no tiene permiso de escritura por lo cual se produce una falla por que el offset 68ED9A no tiene permiso de escritura, y seguramente al reparar ese tambien deba hacerlo con el offset a donde se mueve para ser usado el msgbox (El Proc); mi pregunta seria, como puedo hacer que esos offset sean tengan permiso de escritura, supongo que deberia usar algun editor PE para conseguirlo, pero podrian explicarme cual es el camino y forma indicada de lograrlo? desde ya estoy muy agradecido. chauchas
4
« en: Sábado 21 de Julio de 2007, 09:43 »
Buenas noches, me gustaria saber si alguien puede indicarme como hago para ver el PID y TID de un Proceso en mi ordenador, el PID puedo verlo desde el TaskManager o desde el Process Viewer el cual me muestra el PID de cada proceso en ejecucion en mi PC, pero como puedo hacer para llegar a saber cual es el Thread ID del Proceso?
Desde ya muchas gracias muchachos. Saludos.
5
« en: Miércoles 18 de Julio de 2007, 17:21 »
Hola muchach@s, bueno este es mi primer post aqui en Solo Codigo, llegue hasta aqui por recomendacion de unos amigos que al ver que quiero introducirme un poco mas en ASM e ir aprendiendo me recomendaron este sitio. Para que mi primer post no sean preguntas quiero colaborar con esto quizas a alguien le sea de utilidad. A continuación veremos como podemos armar un formulario "invisible", esto podria tener varias utilidades pero eso ya dependera de la que ustedes quieran darle, por ejemplo podriamos dejar un text o un command volando, asi que bueno comenzemos. Option Explicit 'Declaraciones de los diferentes tipos de regiones a crear Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long 'POINTAPI tipo requerido para CreatePolygonRgn Private Type POINTAPI X As Long Y As Long End Type 'Fija la region Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 'Combina la region Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long 'Tipo de combinacion Const RGN_XOR = 3 '---------------------------------------------------------------------------------------------------- Public Sub MakeTransparent(TransForm As Form) Dim ErrorTest As Double 'en caso de que haya un error, se ignora On Error Resume Next Dim Regn As Long Dim TmpRegn As Long Dim TmpControl As Control Dim LinePoints(4) As POINTAPI 'Puesto que las API trabajan en pixels, cambiamos el modo de escala a pixels TransForm.ScaleMode = 3 'Debe ejecutarse sobre un formulario son bordes. If TransForm.BorderStyle <> 0 Then MsgBox "Cambia el borderstyle a 0!", vbCritical, "ACK!": End 'Hace todo invisible Regn = CreateRectRgn(0, 0, 0, 0) 'Un bucle para controlar cada control en el formulario For Each TmpControl In TransForm 'Si el control es una linea... If TypeOf TmpControl Is Line Then 'Comprueba la inclinacion If Abs((TmpControl.Y1 - TmpControl.Y2) / (TmpControl.X1 - TmpControl.X2)) > 1 Then 'Si es mas vertical que horizontal entonces.. 'Fija los puntos LinePoints(0).X = TmpControl.X1 - 1 LinePoints(0).Y = TmpControl.Y1 LinePoints(1).X = TmpControl.X2 - 1 LinePoints(1).Y = TmpControl.Y2 LinePoints(2).X = TmpControl.X2 + 1 LinePoints(2).Y = TmpControl.Y2 LinePoints(3).X = TmpControl.X1 + 1 LinePoints(3).Y = TmpControl.Y1 Else 'Si es mas horizontal que vertical, entonces... 'Fija los puntos LinePoints(0).X = TmpControl.X1 LinePoints(0).Y = TmpControl.Y1 - 1 LinePoints(1).X = TmpControl.X2 LinePoints(1).Y = TmpControl.Y2 - 1 LinePoints(2).X = TmpControl.X2 LinePoints(2).Y = TmpControl.Y2 + 1 LinePoints(3).X = TmpControl.X1 LinePoints(3).Y = TmpControl.Y1 + 1 End If 'Crea el nuevo poligono con los puntos TmpRegn = CreatePolygonRgn(LinePoints(0), 4, 1) 'Si el control es una figura... ElseIf TypeOf TmpControl Is Shape Then 'si es asi, comprobamos el tipo If TmpControl.Shape = 0 Then 'Es un rectangulo TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height) ElseIf TmpControl.Shape = 1 Then 'Es un cuadrado If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width) Else TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height) End If ElseIf TmpControl.Shape = 2 Then 'Es un ovalo TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + TmpControl.Height + 0.5) ElseIf TmpControl.Shape = 3 Then 'Es un circulo If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateEllipticRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 0.5) Else TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 0.5, TmpControl.Top + TmpControl.Height + 0.5) End If ElseIf TmpControl.Shape = 4 Then 'Es un rectangulo redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Width / 4, TmpControl.Width / 4) End If ElseIf TmpControl.Shape = 5 Then 'Es un cuadrado redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2, TmpControl.Top, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height + 1, TmpControl.Top + TmpControl.Height + 1, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2, TmpControl.Left + TmpControl.Width + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width + 1, TmpControl.Width / 4, TmpControl.Width / 4) End If End If 'Si el control es una figura con fondo transparente If TmpControl.BackStyle = 0 Then 'Combinamos la region en memoria y creamos una nueva CombineRgn Regn, Regn, TmpRegn, RGN_XOR If TmpControl.Shape = 0 Then 'Rectangulo TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + TmpControl.Height - 1) ElseIf TmpControl.Shape = 1 Then 'Cuadrado If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 1) Else TmpRegn = CreateRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 1, TmpControl.Top + TmpControl.Height - 1) End If ElseIf TmpControl.Shape = 2 Then 'Ovalo TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + TmpControl.Height - 0.5) ElseIf TmpControl.Shape = 3 Then 'Circulo If TmpControl.Width < TmpControl.Height Then TmpRegn = CreateEllipticRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width - 0.5, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width - 0.5) Else TmpRegn = CreateEllipticRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height - 0.5, TmpControl.Top + TmpControl.Height - 0.5) End If ElseIf TmpControl.Shape = 4 Then 'Rectangulo redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height, TmpControl.Width / 4, TmpControl.Width / 4) End If ElseIf TmpControl.Shape = 5 Then 'Cuadrado redondeado If TmpControl.Width > TmpControl.Height Then TmpRegn = CreateRoundRectRgn(TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + 1, TmpControl.Top + 1, TmpControl.Left + (TmpControl.Width - TmpControl.Height) / 2 + TmpControl.Height, TmpControl.Top + TmpControl.Height, TmpControl.Height / 4, TmpControl.Height / 4) Else TmpRegn = CreateRoundRectRgn(TmpControl.Left + 1, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + 1, TmpControl.Left + TmpControl.Width, TmpControl.Top + (TmpControl.Height - TmpControl.Width) / 2 + TmpControl.Width, TmpControl.Width / 4, TmpControl.Width / 4) End If End If End If Else 'Crea una region rectangular con estos parametros TmpRegn = CreateRectRgn(TmpControl.Left, TmpControl.Top, TmpControl.Left + TmpControl.Width, TmpControl.Top + TmpControl.Height) End If 'Comprueba que el control tiene ancho o conseguiremos extraños resultados ErrorTest = 0 ErrorTest = TmpControl.Width If ErrorTest <> 0 Or TypeOf TmpControl Is Line Then 'Combina las regiones CombineRgn Regn, Regn, TmpRegn, RGN_XOR End If Next TmpControl 'Crea las regiones SetWindowRgn TransForm.hwnd, Regn, True End Sub
Bueno todo corresponde a las declaraciones del form, y deben tener en cuenta que el "Option Explicit" va primero si lo queremos incluir en otras declaraciones. Ahora, para hacer el formulario transparente, basta que en el form_load coloquemos: --> MakeTransparent Me Bueno con eso basta tendremos un buen efecto en nuestros formularios de suspencion de los objetos y textos. Saludos y espero que a alguien le sea de utilidad L3andro.
Páginas: [1]
|
|
|