Mensajes

y si le metes un...

Código (vb) [Seleccionar] Expandir



do
doevents
loop



despues de...

Código (Vb) [Seleccionar] Expandir



    If (Not StartServiceCtrlDispatcher(DispatchTable(0))) Then
        OutputDebugString " [MY_SERVICE] StartServiceCtrlDispatcher " & GetLastError
    End If



Dulces Lunas!¡.

.
Aqui te dejo un servicio en vb6 es el que te dige que tradujeras, solo le faltan las constantes, y la verdad ya me dio weba buscarlas asi que aqui te lo dejo.

SOLO LO TRADUJE JAMAS LO PROBE... si puedes corregir los errores adelante si no avisa.

Va en un modulo X...

Código (Vb) [Seleccionar] Expandir



Option Explicit

Private Const NO_ERROR = 0

Private Const SERVICE_WIN32_OWN_PROCESS = &H10&
Private Const SERVICE_WIN32_SHARE_PROCESS = &H20&
Private Const SERVICE_WIN32 = SERVICE_WIN32_OWN_PROCESS + _
                              SERVICE_WIN32_SHARE_PROCESS
Private Const SERVICE_ACCEPT_STOP = &H1
Private Const SERVICE_ACCEPT_PAUSE_CONTINUE = &H2
Private Const SERVICE_ACCEPT_SHUTDOWN = &H4
Private Const SC_MANAGER_CONNECT = &H1
Private Const SC_MANAGER_CREATE_SERVICE = &H2
Private Const SC_MANAGER_ENUMERATE_SERVICE = &H4
Private Const SC_MANAGER_LOCK = &H8
Private Const SC_MANAGER_QUERY_LOCK_STATUS = &H10
Private Const SC_MANAGER_MODIFY_BOOT_CONFIG = &H20
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SERVICE_QUERY_CONFIG = &H1
Private Const SERVICE_CHANGE_CONFIG = &H2
Private Const SERVICE_QUERY_STATUS = &H4
Private Const SERVICE_ENUMERATE_DEPENDENTS = &H8
Private Const SERVICE_START = &H10
Private Const SERVICE_STOP = &H20
Private Const SERVICE_PAUSE_CONTINUE = &H40
Private Const SERVICE_INTERROGATE = &H80
Private Const SERVICE_USER_DEFINED_CONTROL = &H100
Private Const SERVICE_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                                    SERVICE_QUERY_CONFIG Or _
                                    SERVICE_CHANGE_CONFIG Or _
                                    SERVICE_QUERY_STATUS Or _
                                    SERVICE_ENUMERATE_DEPENDENTS Or _
                                    SERVICE_START Or _
                                    SERVICE_STOP Or _
                                    SERVICE_PAUSE_CONTINUE Or _
                                    SERVICE_INTERROGATE Or _
                                     SERVICE_USER_DEFINED_CONTROL)
Private Const SERVICE_DEMAND_START As Long = &H3
Private Const SERVICE_ERROR_NORMAL As Long = &H1
' Private Enum SERVICE_CONTROL
Private Const SERVICE_CONTROL_STOP = &H1
Private Const SERVICE_CONTROL_PAUSE = &H2
Private Const SERVICE_CONTROL_CONTINUE = &H3
Private Const SERVICE_CONTROL_INTERROGATE = &H4
Private Const SERVICE_CONTROL_SHUTDOWN = &H5
' End Enum
' Private Enum SERVICE_STATE
Private Const SERVICE_STOPPED = &H1
Private Const SERVICE_START_PENDING = &H2
Private Const SERVICE_STOP_PENDING = &H3
Private Const SERVICE_RUNNING = &H4
Private Const SERVICE_CONTINUE_PENDING = &H5
Private Const SERVICE_PAUSE_PENDING = &H6
Private Const SERVICE_PAUSED = &H7
' End Enum


'typedef struct _SERVICE_TABLE_ENTRY {
'  LPTSTR                  lpServiceName;
'  LPSERVICE_MAIN_FUNCTION lpServiceProc;
'} SERVICE_TABLE_ENTRY, *LPSERVICE_TABLE_ENTRY;
'http://msdn.microsoft.com/en-us/library/ms686001%28v=vs.85%29.aspx
Type SERVICE_TABLE_ENTRY
    lpServiceName   As String
    lpServiceProc   As Long
End Type

'BOOL WINAPI StartServiceCtrlDispatcher(
'  __in  const SERVICE_TABLE_ENTRY *lpServiceTable
');
'http://msdn.microsoft.com/en-us/library/ms686324%28v=vs.85%29.aspx
Private Declare Function StartServiceCtrlDispatcher Lib "advapi32.dll" Alias "StartServiceCtrlDispatcherA" (lpServiceStartTable As SERVICE_TABLE_ENTRY) As Long

'typedef struct _SERVICE_STATUS {
'  DWORD dwServiceType;
'  DWORD dwCurrentState;
'  DWORD dwControlsAccepted;
'  DWORD dwWin32ExitCode;
'  DWORD dwServiceSpecificExitCode;
'  DWORD dwCheckPoint;
'  DWORD dwWaitHint;
'} SERVICE_STATUS, *LPSERVICE_STATUS;
'http://msdn.microsoft.com/en-us/library/ms685996%28VS.85%29.aspx
Type SERVICE_STATUS
    dwServiceType               As Long
    dwCurrentState              As Long
    dwControlsAccepted          As Long
    dwWin32ExitCode             As Long
    dwServiceSpecificExitCode   As Long
    dwCheckPoint                As Long
    dwWaitHint                  As Long
End Type

'SERVICE_STATUS_HANDLE WINAPI RegisterServiceCtrlHandler(
'  __in  LPCTSTR lpServiceName,
'  __in  LPHANDLER_FUNCTION lpHandlerProc
');
'http://msdn.microsoft.com/en-us/library/ms685054%28VS.85%29.aspx
Public Declare Function RegisterServiceCtrlHandler Lib "advapi32.dll" Alias "RegisterServiceCtrlHandlerA" (ByVal lpServiceName As String, ByVal lpHandlerProc As Long) As Long

'void WINAPI OutputDebugString(
'  __in_opt  LPCTSTR lpOutputString
');
'http://msdn.microsoft.com/en-us/library/aa363362%28VS.85%29.aspx
Public Declare Sub OutputDebugString Lib "kernel32.dll" Alias "OutputDebugStringA" (ByVal lpServiceTable As String)

'BOOL WINAPI SetServiceStatus(
'  __in  SERVICE_STATUS_HANDLE hServiceStatus,
'  __in  LPSERVICE_STATUS lpServiceStatus
');
'http://msdn.microsoft.com/en-us/library/ms686241%28VS.85%29.aspx
Public Declare Function SetServiceStatus Lib "advapi32.dll" (ByVal hServiceStatus As Long, ByVal lpServiceStatus As Long) As Long

'DWORD WINAPI GetLastError(void);
'http://msdn.microsoft.com/en-us/library/ms679360%28v=VS.85%29.aspx
Public Declare Function GetLastError Lib "kernel32.dll" () As Long

Dim MyServiceStatus             As SERVICE_STATUS
Dim MyServiceStatusHandle       As Long

Public Function getLPFunc(ByVal lpFunc As Long) As Long
    getLPFunc = lpFunc
End Function

Sub main()
Dim DispatchTable(1) As SERVICE_TABLE_ENTRY
    DispatchTable(0).lpServiceName = "MyService"
    DispatchTable(0).lpServiceProc = getLPFunc(AddressOf MyServiceStart)
    DispatchTable(1).lpServiceName = vbNullString
    DispatchTable(1).lpServiceProc = &H0
    If (Not StartServiceCtrlDispatcher(DispatchTable(0))) Then
        OutputDebugString " [MY_SERVICE] StartServiceCtrlDispatcher " & GetLastError
    End If
End Sub

Public Function MyServiceStart(ByVal lCantArg As Long, ByVal lpArgv As Long)
Dim status          As Long
Dim SpecificError   As Long

    MyServiceStatus.dwServiceType = SERVICE_WIN32
    MyServiceStatus.dwCurrentState = SERVICE_START_PENDING
    MyServiceStatus.dwControlsAccepted = SERVICE_ACCEPT_STOP Or SERVICE_ACCEPT_PAUSE_CONTINUE
    MyServiceStatus.dwWin32ExitCode = 0
    MyServiceStatus.dwServiceSpecificExitCode = 0
    MyServiceStatus.dwCheckPoint = 0
    MyServiceStatus.dwWaitHint = 0
   
    MyServiceStatusHandle = RegisterServiceCtrlHandler("MyService", getLPFunc(AddressOf MyServiceCtrlHandler))

    If (MyServiceStatusHandle = &H0) Then
        status = GetLastError()
        OutputDebugString (" [MY_SERVICE] RegisterServiceCtrlHandler failed " & status)
        Exit Function
    End If

    status = MyServiceInitialization(lCantArg, lpArgv, SpecificError)
    If (Not (status = NO_ERROR)) Then
        MyServiceStatus.dwCurrentState = SERVICE_STOPPED
        MyServiceStatus.dwCheckPoint = 0
        MyServiceStatus.dwWaitHint = 0
        MyServiceStatus.dwWin32ExitCode = status
        MyServiceStatus.dwServiceSpecificExitCode = SpecificError
        SetServiceStatus MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus)
        Exit Function
    End If
    MyServiceStatus.dwCurrentState = SERVICE_RUNNING
    MyServiceStatus.dwCheckPoint = 0
    MyServiceStatus.dwWaitHint = 0

    If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
        status = GetLastError()
        OutputDebugString (" [MY_SERVICE] RegisterServiceCtrlHandler error " & status)
    End If
   
    OutputDebugString (" [MY_SERVICE] Returning the Main Thread ")
   
End Function

Public Function MyServiceInitialization(ByVal lCantArg As Long, ByVal lpArgv As Long, ByRef SpecificError As Long)
Dim ff      As Long
    ff = FreeFile
    Open "c:\Servicio en VB6.txt" For Binary As ff
        Put ff, , "Hola mundo desde un servicio creado en vb6"
    Close ff
    MyServiceInitialization = 0
End Function

Public Sub MyServiceCtrlHandler(ByVal Opcode As Long)
Dim status      As Long
    Select Case (Opcode)
        Case SERVICE_CONTROL_PAUSE:
            MyServiceStatus.dwCurrentState = SERVICE_PAUSED
        Case SERVICE_CONTROL_CONTINUE:
            MyServiceStatus.dwCurrentState = SERVICE_RUNNING
        Case SERVICE_CONTROL_STOP:
            MyServiceStatus.dwWin32ExitCode = 0
            MyServiceStatus.dwCurrentState = SERVICE_STOPPED
            MyServiceStatus.dwCheckPoint = 0
            MyServiceStatus.dwWaitHint = 0

            If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
                status = GetLastError()
                OutputDebugString " [MY_SERVICE] SetServiceStatus error " & status
            End If

            OutputDebugString " [MY_SERVICE] Leaving MyService"
            Exit Sub

        Case SERVICE_CONTROL_INTERROGATE:
        Case Else
            OutputDebugString " [MY_SERVICE] Unrecognized opcode " & Opcode
    End Select
    If (Not SetServiceStatus(MyServiceStatusHandle, ByVal VarPtr(MyServiceStatus))) Then
      status = GetLastError()
      OutputDebugString " [MY_SERVICE] SetServiceStatus error " & status
    End If
End Sub



Sangriento Infirno Lunar!¡.

.
http://foro.elhacker.net/analisis_y_diseno_de_malware/manejar_sevicios_desde_vb-t123518.0.html

En el mismo enlace trae un ejemplo en lenguaje C... solo traducelo.

Dulces Lunas!¡.

[Edito:]

.
jajaja, la funcion de Raul338 tiene un parecido a la mia... aun asi no se moldea automaticamente a formatos D/M/YYYY, DD/M/YYYY, D/MM/YYYY, etc..., aun asi es muy buena!¡.

Edito:

MODIFIQUE MI FUNCION ( Aqui [en donde estaba el anterior codigo.]), solo modifique unos cuantos rangos... despresiando la velocidad.

Desde cuando "y0/45/hola" es una fecha? respeto el formato DD/MM/YYYY que querian que tuviera.

Código (vb) [Seleccionar] Expandir



   sTests = Split("31/07/2000|30/07/2000|01/02/2000|25/05/2002|15/07/2000|28/02/2001|" & _
                   "31/05/2001|30/12/2011|29/02/2004|01/01/2001|31/12/9999|29/02/2012", "|")
   sFalses = Split("01/00/2011|31/04/2001|00/12/2011|00/00/2011|01/13/2011|30/02/2001|y0/45/hola|" & _
                   "29/02/2003|99/99/9999|32/12/9999|29/13/2000|LALA|00/00/0000|31/09/2011|y0/45/hola|", "|")
   
   Open App.Path & "\log.txt" For Output As #1
   Call txt(" === Reto IsDate ====")
   Call txt(Date$ & " " & Time$)
   
   Call txt("Testeo de calidad", True)
   For i = 0 To UBound(sTests)
       If modFunctions.heyIgnorante_isDate(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Ignorante v1.1 FAILS")
       If modFunctions.IsDate_7913_v2(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "79137913 FAILS")
       If modFunctions.isDate_BlackZX(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "BlackZeroX FAILS")
       If modFunctions.isDate_edu(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "$Edu$ FAILS")
       If modFunctions.IsDate_T(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Tenient101 FAILS")
       If modFunctions.IsDate_r338(sTests(i)) = False Then Call txt(sTests(i) & vbTab & "Raul338 FAILS")
   Next
   
   Call txt("Testeo de falsos", True)
   For i = 0 To UBound(sFalses)
       If modFunctions.heyIgnorante_isDate(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "Ignorante v1.1 FAILS")
       If modFunctions.IsDate_7913_v2(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "79137913 FAILS")
       If modFunctions.isDate_BlackZX(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "BlackZeroX FAILS")
       If modFunctions.isDate_edu(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "$Edu$ FAILS")
       If modFunctions.IsDate_T(sFalses(i)) Then Call txt(sTests(i) & vbTab & "Tenient101 FAILS")
       If modFunctions.IsDate_r338(sFalses(i)) Then Call txt(sFalses(i) & vbTab & "Raul338 FAILS")
   Next



Al test de velocidades hay que hacerle una media de velocidad ya que a mi me salio esto... claro que igual me gana en otras ocasiones Raul338...

Código [Seleccionar] Expandir



=== Reto IsDate ====
09-03-2011 01:43:19

Testeo de calidad
==============================
31/07/2000 Tenient101 FAILS
30/07/2000 Tenient101 FAILS
01/02/2000 Tenient101 FAILS
25/05/2002 Tenient101 FAILS
15/07/2000 Tenient101 FAILS
28/02/2001 Tenient101 FAILS
31/05/2001 Tenient101 FAILS
30/12/2011 Tenient101 FAILS
29/02/2004 Tenient101 FAILS
01/01/2001 Tenient101 FAILS
31/12/9999 $Edu$ FAILS
31/12/9999 Tenient101 FAILS
29/02/2012 Tenient101 FAILS

Testeo de falsos
==============================
01/00/2011 Raul338 FAILS
00/12/2011 Raul338 FAILS
00/00/2011 Raul338 FAILS
01/13/2011 Raul338 FAILS
32/12/9999 Raul338 FAILS
29/13/2000 Raul338 FAILS
00/00/0000 Raul338 FAILS
31/09/2011 $Edu$ FAILS


Testeo de velocidades
==============================
79.816 msec Ignorante v1.1
74.246 msec 79137913
10.764 msec BlackZeroX
108.810 msec $Edu$
63.844 msec Tenient101
12.090 msec Raul338



Sangriento Infierno Lunar!¡.

API Beep.

Código (vb) [Seleccionar] Expandir



Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
Private Sub Form_Activate()
    'KPD-Team 1999
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim Cnt As Long
    For Cnt = 0 To 5000 Step 10
        'play a tone of 'Cnt' hertz, for 50 milliseconds
        Beep Cnt, 50
        Me.Caption = Cnt
        DoEvents
    Next Cnt
End Sub



Dulces Lunas!¡.

Lo más cutre sería hacerlo en formato html, y poner las fotos como archivos jpg en un directorio, pero preferiría hacerlo un poco mejor, y no tener millones de archivos (las fotos) por ahí.

¿Qué lenguaje de programación/librerias me aconsejais que use, que disponga de un interfaz atractivo para el usuario?
Lo ideal sería que pudiera ordenarlo todo en alguna especie de base de datos.
También estaría bien que esa base de datos (o pack) pudiera partirse en cachos, para no tener un único archivo de varios GB.

OMG... no vayas a meter mas de 100 fotos en una BDD... es mas no metas fotos en una BDD, que si la BDD en cuestion se estropea vas a llorar ( Anecdota ), ya en serio, esto NO es recomendable, solo lo menciono por si a caso.

Yo usaria AJAX, para lo que quieres hacer, con un poco (quizas) de PHP ( ten en cuenta que el usuario es flojo y puede NO QUERER instalar una actualizacion X o algo similar o hacer algo mas como descargar el programa X... ), por este punto seria viable AJAX y lo que involucre...

Si es una aplicacion de escritotio en donde se tenga que ver amigable y de facil comprension... C++/QT (Muy bueno para con el OpenGL para sus animaciones).

Dulces Lunas!¡.

El exit function es un goto enfundado (para mi)

Ammm nop  exit function seria como una semejansza Uniforme de return como en C/C++, ya que termina la funcion ( Aun que estaria equivocado... pero... tendremos que ver el ASM de una funcion/proceso en vb6 para ver y poder afirmarlo. )

Exit Funcion en mi logica viene siendo una cutre representacion o simulacion de invocar al return de la funcion y por ende su terminacion, mas no de ir al final de una funcion... igual abria que ver el ASM de una funcion en vb6... Puedo estar errado...

Aun con pruebas... se sabe...

Dulces Lunas!¡.

[Lenguaje Basic + ASM inline]

@Eternal Idol

[Tociendo un poco]

Aqui te dejo un S.O. super pequeño("Hello World") en FreeBasic (Lenguaje Basic + ASM inline):

[/Tociendo un poco]

No se si me exprese mal pero de vb6 nadie niega lo de Queta, al citarlo era para añadir no para negar, sin afirmar nada a VB6 ya que dije claramente Vertiente = Derivacion dando una opcion mas.

Dulces Lunas!¡.

Usa un poco la logica:

Exit function deberia de invocar
* El Retorno.
* Fin del proceso.
Goto deberia invocar.
* Un guardado de posicion ( Insersion en una pila ).
* Un salto de posicion.

En tu caso lo que haces es un goto al termino es decir
* Un guardado de posicion  ( Insersion en una pila ).
* Un salto de posicion.
* El Retorno.
* Fin del proceso.

Es mas lento...

Dulces Lunas!¡.

[Visual Basic]

@schlägt

C/C++, y Java... te va a gustar mas java por eso de que apenas estas empesando... pero es lento en muchas vertientes (Arranque, procesamiento...).

Primera mentira; a parte de que Visual Basic es un lenguaje totalmente obsoleto, ya me gustaría ver un sistema operativo desarrollado en Visual Basic, que lógicamente no se puede.

¡Cómo no! Hacer por hacer un sistema operativo, puedes hacer incluso esto:

http://www.codeproject.com/KB/cs/CosmosMS5.aspx

Solo di un pequeño codigo en basic para sobrecallar una mentira que esta desde hace tiempo en boca de los lectores sobre el lenguaje Basic de que NO SE PUEDE CREAR UN S.O. ( Despresiando otros aspectos que no se traen al caso ), si quieres sacarme .Net ya es otra historia.

Pero dejémonos de tonterías, al hacer un proyecto serio y un poco grande perderías mucha velocidad e incluso cosas tan básicas como la gestión de archivos. Los propios creadores de FreeBASIC lo dicen:

Todo depende de la frase ¿Para que se utilizara? (Si nesesitas crearlo rapido en un lapso corto esta claro de que C/C++ puede o no ser la mejor opcion, por ello se usa actualmente mas java debido a que se crean las aplicaciones mas rapido, ya que no tienes que estar viendo las fujgas de memoria como en C/C++ por decir un ejemplo ). esta claro y NUNCA nege ni dije que era rapido Basic, solo dije que SI, SI SE PUEDE CREAR UN S.O. en lenguaje Basic. Esta claro que C/C++   +   ASM es mas acto para el puesto de los S.O., eso hasta ahora NADIE lo a negado.

En lugar de crear un Flame, Propon Pros y contras, de los lenguajes que ya conoces a realmente a fondo.

Dulces Lunas!¡.