Error visual basic Programa

Iniciado por skapunky, 12 Enero 2007, 13:11 PM

0 Miembros y 1 Visitante están viendo este tema.

skapunky

Buenas...estoy haciendo un escaner de troyanos en visual basic 6...y ante mi sorpresa hay gente que al analizar con este al final le marca un error de archivo o noseke..

A mi me funciona perfectamente y me fijado que la gente que tiene el visual basic instalado le va bien...a la gente que no tiene visual basic le marca un error al final del analisis.

Lo pongo en descarga aqui (no esta acabado) para ver si alguien sabe a que se debe este error... sipueden probarlo en un ordenador con visual basi y otro sin mejor para asi comparar...

NOTA: No uso librerias, esta todo con api's..menos la del progressbar pero el mismo programa sin este componente da el mismo error, asi que por esta libreria no sera.

http://www.megaupload.com/es/?d=TV8BTVLG

Haber si alguien sabe a que se debe...Gracias por el tiempo dedicado.

Saludos.
Killtrojan Syslog v1.44: ENTRAR

BenRu


skapunky

Bueno...no se si abras visto el mensaje de error lo que pone..

CitarRun-time error '52' Bad file name or number

Le e sacado una funcion y ese error parece que a otros usuarios les a desaparecido sin esa función... la funcion en concreto es una que recorre el disco duro para ver si existe un archivo. En concreto es esta, la encontre por internet:

Function PathTo(strFile As String) As String
    Dim x As Integer
    Dim strDirs As String
    Dim strDir As String
    Dim strEntry As String
   
    strDirs = "c:\" & vbNullChar
    Do While Len(strDirs)
        x = InStr(strDirs, vbNullChar)
        strDir = Left$(strDirs, x - 1)
        strDirs = Mid$(strDirs, x + 1)
       
        If Len(Dir$(strDir & strFile)) Then
            PathTo = strDir & Dir$(strDir & strFile)
            Exit Function
        End If
       
        strEntry = Dir$(strDir & "*.*", vbDirectory)
        Do While Len(strEntry)
           
            On Local Error Resume Next
            If (GetAttr(strDir & strEntry) And vbDirectory) Then
                If strEntry <> "." And strEntry <> ".." Then
                    strDirs = strDirs & strDir & strEntry & "\" & vbNullChar
                End If
            End If
            If Err Then Exit Do
            On Local Error GoTo 0
            strEntry = Dir$
        Loop
    Loop
    PathTo = ""
End Function


y la uso asi:

CitarSub heuristic()
Dim r As String
r = PathTo("server.exe")
If FileExist(r) Then
List1.AddItem "New Trojan " & r
End If
End Sub

A mi me funciona y lo e probado con otro ordenador y funciona...también hay gente que le funciona, pero a otras les da el errror anteriormente mencionado...

Haber si alguien sabe de donde puede ser el error...

Saludos.
Killtrojan Syslog v1.44: ENTRAR

CeLaYa

#3
jeje Reconozco ese código yo le puse lo del control de errores


On Local Error Resume Next<-----
            If (GetAttr(strDir & strEntry) And vbDirectory) Then
                If strEntry <> "." And strEntry <> ".." Then
                    strDirs = strDirs & strDir & strEntry & "\" & vbNullChar
                End If
            End If
            If Err Then Exit Do <---
            On Local Error GoTo 0 <----
            strEntry = Dir$


si checas el post de donde esta este código, veras que explicaba que generalmente en las carpetas de archivos temporales hay algunos nombres de archivos que tienen caracteres invalidos y es por eso que falla el programa, ahora se supone que con el control de errores no debería de interrumpirse la ejecución.

creo que se podrian hacer 2 cosas:
1-. Prueba borrando los archivos temporales de la pc donde falla y si asi vuelve a fallar habrá que ver en que linea esta el problema.

2.- El control de errores lo puse cuando se verifican nombres de archivos pero no los de las carpetas. lo que se me ocurre es esto:


Function PathTo(strFile As String) As String
    Dim x As Integer
    Dim strDirs As String
    Dim strDir As String
    Dim strEntry As String
   
    strDirs = "c:\" & vbNullChar
    Do While Len(strDirs)
        x = InStr(strDirs, vbNullChar)
        On local error resume next
        strDir = Left$(strDirs, x - 1)
        strDirs = Mid$(strDirs, x + 1)
       
        If Len(Dir$(strDir & strFile)) Then
            PathTo = strDir & Dir$(strDir & strFile)
            Exit Function
        End If

        'Obtiene el nombre de la carpeta
        strEntry = Dir$(strDir & "*.*", vbDirectory)
       
        'Si no es valido se genera un error, avisa del error y se sigue con el siguiente directorio
        If Err Then
            Msgbox "Nombre de carpeta no valido"
            strEntry = Dir$
         end if

        Do While Len(strEntry)
                  If (GetAttr(strDir & strEntry) And vbDirectory) Then
                If strEntry <> "." And strEntry <> ".." Then
                    strDirs = strDirs & strDir & strEntry & "\" & vbNullChar
                End If
            End If

            'Si el nombre del archivo no es valido se genera error
            If Err Then msgbox "Nombre de archivo no valido"
            On Local Error GoTo 0
            strEntry = Dir$
        Loop
    Loop
    PathTo = ""
End Function


no tengo VB en esta pc pero creo que con eso detectaría los nombres no validos y seguiria con tu escaneo... espero te sirva de algo
"La soledad es el elemento de los grandes talentos".
Cristina de Suecia (1626-1689) Reina de Suecia.

skapunky

Gracias y felicidades por el codigo...sigue sin funcionar con eso que as añadido.

Saludos.
Killtrojan Syslog v1.44: ENTRAR

CeLaYa

y no has revisado en que linea se genera el error?
"La soledad es el elemento de los grandes talentos".
Cristina de Suecia (1626-1689) Reina de Suecia.

NYlOn

¿Podrias postear la funcion FileExist?

Otra cosa, podrias poner un IF antes de usar dicha funcion. Algo asi:

Sub heuristic()
Dim r As String
r = PathTo("server.exe")
If r <> "" then
If FileExist(r) Then
List1.AddItem "New Trojan " & r
End If
end if
End Sub


Por ahi estas en la funcion FileExist estas tratando de abrir un archivo inexistente y por eso te da error.

Saludos.-