Mensajes

Lo siento hace 24hrs que cambie todo lo de mi sitio, este es el enlace de descarga:

http://infrangelux.sytes.net/filex/?dwfe=ZmRlZGUyZjExYWIwZGU2YWJmMDRjNjc2YjdkMjg3YTc2ZDYzYTlkMg

Dulces Lunas!¡.

Algo similar a lo que Mad Antrax dice pero implementado en una función...

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
    MsgBox "-->" & DiferenciaArray(" a,  b,  c ,d, e, f  ", "  a, b, c ") & "<--"
End Sub

Function DiferenciaArray(ByRef s1 As String, ByRef s2 As String, Optional ByVal separador As String = ",") As Variant
Dim A_Split As Variant
Dim B_Split As Variant
Dim i       As Long

    A_Split = Split(Replace(s1, " ", ""), separador)
    B_Split = Split(Replace(s2, " ", ""), separador)
   
    For i = LBound(B_Split) To UBound(B_Split)
        A_Split = Filter(A_Split, B_Split(i), False, vbTextCompare)
    Next
   
    DiferenciaArray = Join(A_Split, separador)
End Function


Dulces Lunas!¡.

No me di cuenta y te respondi acá...

http://foro.elhacker.net/programacion_visual_basic/como_declarar_en_visual_basic_60-t412339.0.html;msg1934783#msg1934783

Dulces Lunas!¡.

Es fácil hacerlo, solo juega un poco con las funciones, si no te sabes muchas funciones solo OPRIME F2 en el IDE de VB6 y te aparecerán varias con sus descripciones y tipos...

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Form_Load()
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem "1"
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem "2"
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem "3"
   List1.AddItem ""
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem "4"
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem " " ' Notese que no esta vacio pero es banco...
   List1.AddItem "5"
   MsgBox ("Se eliminaron " & EliminarBlancos(List1) & " elementos considerados blancos.")
End Sub

Function EliminarBlancos(ByRef list As Listbox)
Dim i       As Long
Dim ret     As Long
   With list
       While (i < .ListCount) ' While (list.ListCount > 0)
           If EsBlanco(.list(i)) = True Then ' If EsBlanco(list.list(i)) = True Then
               .RemoveItem i ' list.RemoveItem(i)
               ret = (ret + 1)
           Else
               i = (i + 1)
           End If
       Wend
   End With
   EliminarBlancos = ret
End Function

Function EsBlanco(ByRef str As String) As Boolean
   EsBlanco = CBool(Trim$(str) = vbNullString)
End Function


Dulces Lunas!¡.

Cierra el proceso que tiene abierto el fichero y luego lo borras

No es necesario, lo unico que se debe hacer es obtener el handle del archivo abierto y cerrarlo...

Codigo:  http://filex.sytes.net/?dir=/BlackZeroX/Programacion/vb6/Foro.ElHacker.Net&file=UnlockFiles.rar

Dulces Lunas!¡.

HAce ya un tiempo atras cree varias clases una de ellas para tratar la busqueda de archivos:

cls_files.cls

Código (vb) [Seleccionar] Expandir


'
'   /////////////////////////////////////////////////////////////
'   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
'   //                                                         //
'   // Web:     http://InfrAngeluX.Sytes.Net/                  //
'   //                                                         //
'   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
'   // no se eliminen los creditos originales de este codigo   //
'   // No importando que sea modificado/editado o engrandecido //
'   // o achicado, si es en base a este codigo                 //
'   /////////////////////////////////////////////////////////////

Option Explicit

Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function FindFirstFile& Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function FindNextFile& Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)

Const MAX_PATH                              As Integer = 260
Const MAXDWORD                              As Long = &HFFFF
Const INVALID_HANDLE_VALUE                  As Long = -1

Private Type FILETIME
    dwLowDateTime                           As Long
    dwHighDateTime                          As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes                        As Long
    ftCreationTime                          As FILETIME
    ftLastAccessTime                        As FILETIME
    ftLastWriteTime                         As FILETIME
    nFileSizeHigh                           As Long
    nFileSizeLow                            As Long
    dwReserved0                             As Long
    dwReserved1                             As Long
    cFileName                               As String * MAX_PATH
    cAlternate                              As String * 14
End Type

Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
Event Begin()
Event Finish()

Private Priv_StrDir$, Priv_StrCri$(), Priv_IncFolder As Boolean, Priv_Cancel As Boolean
Private Priv_CriFindInDir As VbFileAttribute, Priv_CriFindInFile  As VbFileAttribute
Private Hwnd_SearchF&(), LS_Index&(0 To 1), BytesNow_#
Private Bool_Run As Byte

Public AllowEvents                          As Boolean

Private Sub Class_Initialize()
    Priv_IncFolder = True
    AllowEvents = True
    Priv_CriFindInDir = vbDirectory
    Priv_CriFindInFile = vbArchive
End Sub

Public Property Get BytesNow#()
    BytesNow# = BytesNow_#
End Property

Public Property Get FindInPath() As String
    FindInPath = Priv_StrDir$
End Property

Public Property Let FindInPath(ByVal vData$)
    Call Stop_
    Call NormalizePath&(vData$)
    Priv_StrDir$ = vData$
End Property



Public Property Get CriterionFindDir() As VbFileAttribute
    CriterionFindDir = Priv_CriFindInDir
End Property
Public Property Let CriterionFindDir(ByVal vData As VbFileAttribute)
    Call Stop_
    Priv_CriFindInDir = vData Or vbDirectory
End Property

Public Property Get CriterionFindFile() As VbFileAttribute
    CriterionFindFile = Priv_CriFindInFile
End Property
Public Property Let CriterionFindFile(ByVal vData As VbFileAttribute)
    Call Stop_
    Priv_CriFindInFile = vData Or vbArchive
End Property



Public Property Get CriterionToFind() As Variant
    CriterionToFind = Priv_StrCri$
End Property

Public Property Let CriterionToFind(ByRef vData As Variant)
On Error GoTo Err_
Dim L_Index                             As Long
    Call Stop_
    Erase Priv_StrCri$
    LS_Index&(0) = INVALID_HANDLE_VALUE
    LS_Index&(1) = INVALID_HANDLE_VALUE
    If IsArray(vData) Then
        LS_Index&(0) = LBound(vData)
        LS_Index&(1) = UBound(vData)
        ReDim Priv_StrCri$(LS_Index&(0) To LS_Index&(1))
        For L_Index = LS_Index&(0) To LS_Index&(1)
            Priv_StrCri$(L_Index) = CStr(vData(L_Index))
        Next L_Index
    Else
        LS_Index&(0) = 0
        LS_Index&(0) = 0
        ReDim Priv_StrCri$(0)
        Priv_StrCri$(0) = vData
    End If
Exit Property
Err_:
    Err.Clear
End Property

Public Property Get IncludeSubFolders() As Boolean: IncludeSubFolders = Priv_IncFolder: End Property
Public Property Let IncludeSubFolders(ByVal vData As Boolean): Priv_IncFolder = vData: End Property

Public Property Get ItsRun() As Boolean:    ItsRun = Bool_Run = 1:      End Property

Public Sub Stop_():    Bool_Run = 0: Priv_Cancel = True: End Sub

Public Function Start_(Optional StrFindInPath As Variant = "", Optional StrCriterionToFind As Variant = Nothing) As Double

    Call Stop_
    BytesNow_# = 0
    If Not StrFindInPath = "" Then FindInPath = StrFindInPath
    If Not IsObject(StrCriterionToFind) Then CriterionToFind = StrCriterionToFind
    If Not (LS_Index&(0) = INVALID_HANDLE_VALUE And LS_Index&(0) = INVALID_HANDLE_VALUE) And Priv_StrDir$ <> "" And CStr(Dir(Priv_StrDir$, vbDirectory)) <> "" Then
        RaiseEvent Begin
        Bool_Run = 1
        Priv_Cancel = False
        Call FindFilesAPI#(Priv_StrDir$, Priv_StrCri$())
        Start_# = BytesNow_#
        Bool_Run = 0
        RaiseEvent Finish
    End If
   
End Function

Private Sub FindFilesAPI(ByVal StrPath$, ByRef StrSearch$())
Dim str_NameNow$
Dim Str_NameDir$()
Dim Lng_DirCant&
Dim Lng_DirCount&
Dim LF_Index&
'Dim Lng_Res&
Dim Hwnd_Search&
Dim WFD                                 As WIN32_FIND_DATA

    Lng_DirCount& = 0
    Hwnd_Search& = FindFirstFile&(StrPath$ & "*", WFD)
   
    If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
        RaiseEvent Folder(StrPath$, WFD.dwFileAttributes)
        Do
            If AllowEvents Then DoEvents
            If Priv_Cancel Then Exit Sub
            With WFD
                str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
                If (((.dwFileAttributes Or Priv_CriFindInDir) = .dwFileAttributes) And ((.dwFileAttributes And vbDirectory) = vbDirectory)) Then
                    If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
                        ReDim Preserve Str_NameDir$(Lng_DirCount&)
                        Str_NameDir$(Lng_DirCount&) = str_NameNow$
                        Lng_DirCount& = Lng_DirCount& + 1
                    End If
                End If
            End With
        Loop While FindNextFile&(Hwnd_Search&, WFD)
       
        Call FindClose(Hwnd_Search&)
       
        For LF_Index& = LS_Index&(0) To LS_Index&(1)
            Hwnd_Search& = FindFirstFile&(StrPath$ & StrSearch$(LF_Index&), WFD)
            If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
                Do
                    If AllowEvents Then DoEvents
                    If Priv_Cancel Then Exit Sub
                    With WFD
                        str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
                        If (((.dwFileAttributes Or Priv_CriFindInFile) = .dwFileAttributes) And ((.dwFileAttributes And vbArchive) = vbArchive)) Then
                       
                            If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
                                BytesNow_# = BytesNow_# + ((.nFileSizeHigh& * MAXDWORD&) + .nFileSizeLow&) + 0
                                RaiseEvent File(str_NameNow$, LF_Index&, .dwFileAttributes)
                            End If
                        End If
                    End With
                Loop While FindNextFile&(Hwnd_Search&, WFD)
                Call FindClose(Hwnd_Search&)
            End If
        Next LF_Index
       
        If Lng_DirCount& > 0 And Priv_IncFolder Then
            For Lng_DirCant& = 0 To Lng_DirCount& - 1
                Call FindFilesAPI#(StrPath$ & Str_NameDir$(Lng_DirCant&) & "\", StrSearch$)
            Next
        End If
       
    End If
   
End Sub

'   Returns
'   //  0   =   NoPathValid
'   //  1   =   Ok
'   //  2   =   Fixed/Ok
Public Function NormalizePath&(ByRef sData$)
   
    If Strings.Len(sData$) > 1 Then
        sData$ = Strings.Replace(sData$, "/", "\")
        If Not Strings.Right$(sData$, 1) = "\" Then
            sData$ = sData$ & "\"
            NormalizePath& = 2
        Else
            NormalizePath& = 1
        End If
    Else
        NormalizePath& = 0
    End If
   
End Function


Ejemplo:

Código (vb) [Seleccionar] Expandir


Option Explicit

Private WithEvents ClsScanDisk          As cls_files
Private ThisPath$
Private CountFiles&

Private Sub ClsScanDisk_Begin()
    ThisPath$ = ClsScanDisk.FindInPath
    CountFiles& = 0
    Caption = "ScanDisk ha Encontrado: "
End Sub

Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
    CountFiles& = CountFiles& + 1
    Caption = "ScanDisk ha Encontrado: " & CountFiles&
    Debug.Print ThisPath$ & NameFile
    Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
    Debug.Print "Atributos:"; Atrributes
End Sub

Private Sub ClsScanDisk_Finish()
    Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
End Sub

Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
    ThisPath$ = PathFolder
End Sub


Private Sub Form_Load()
    If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
    With ClsScanDisk
        If .ItsRun Then .Stop_
        .CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",")
        '.CriterionFindDir = vbReadOnly                  '   //  Solo directorios de Solo lectura.
        '.CriterionFindFile = vbHidden Or vbReadOnly     '  //  Solo archivos ocultos.
        .FindInPath = "c:\"
        .AllowEvents = True
        Call .Start_
    End With
End Sub


Dulces Lunas!¡.

Claro que si y por lo que veo necesitas propiedades en los formularios mira te dejo esto:

Form1

Código (vb) [Seleccionar] Expandir


Option Explicit

Public Property Get text() As String
    text = "Adios Mundo"
End Property


Form2

Código (vb) [Seleccionar] Expandir


Option Explicit

Public Property Get text() As String
    text = "Hola Mundo"
End Property


Form3

Código (vb) [Seleccionar] Expandir


Option Explicit

Private Sub Combo1_Click()
Dim frm1 As Form1
Dim frm2 As Form2
Static last As Integer
    If last = Combo1.ListIndex Then    ' Evitamos acciones repetidas sobre un mismo elemento.
        Exit Sub
    End If
   
    last = Combo1.ListIndex
   
    Select Case Combo1.text ' o Combo1.ListIndex
        Case "Adios" ' o 0
            Set frm1 = New Form1
            MsgBox frm1.text
        Case "Hola" ' o 1
            Set frm2 = New Form2
            MsgBox frm2.text
        Case Else
            MsgBox "Error"
    End Select
   
End Sub

Private Sub Form_Load()
    Combo1.AddItem "Hola"
    Combo1.AddItem "Adios"
End Sub


De lo dejo para descargar:

http://filex.sytes.net/?dir=/BlackZeroX/Programacion/vb6/Foro.ElHacker.Net&file=Ejemplo%2009042014.zip

Dulces Lunas!¡.

.
Hace mucho en este mismo foro se crearon cientos de funciones...

Código (vb) [Seleccionar] Expandir



'
' ////////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel )            //
' //                                                            //
' // Web: http://InfrAngeluX.Sytes.Net/                         //
' //                                                            //
' // |-> Pueden Distribuir Este Código siempre y cuando         //
' // no se eliminen los créditos originales de este código      //
' // No importando que sea modificado/editado o engrandecido    //
' // o achicado, si es en base a este código                    //
' ////////////////////////////////////////////////////////////////

Option Explicit
Enum ActionsHexStr
   HexToString = 0
   StringToHex
End Enum
Public Function HexAndString(ByVal vData As String, Optional Accion As ActionsHexStr = HexToString) As String
Dim LenBuffer               As Long
Dim LenOfBuffer             As Integer
Dim Puntero                 As Long
Dim I                       As Long
Dim vStep                   As Integer
   If CBool(IIf(Accion = HexToString And (Len(vData) Mod 2) = 0, True, IIf(Accion = StringToHex, True, False))) Then
       LenBuffer = IIf(Accion = HexToString, Len(vData) / 2, Len(vData) * 2)
       LenOfBuffer = IIf(Accion = HexToString, 1, 2)
       HexAndString = Space(LenBuffer)
       vStep = IIf(Accion = HexToString, 2, 1)
       Puntero = 1
       For I = 1 To Len(vData) Step vStep
           If Accion = HexToString Then
               Mid(HexAndString, Puntero, LenOfBuffer) = Chr$(Val("&H" & Mid$(vData, I, 2)))
               Puntero = Puntero + 1
           Else
               Mid(HexAndString, Puntero, LenOfBuffer) = Hex$(Asc(Mid$(vData, I, 1)))
               Puntero = Puntero + 2
           End If
       Next I
   End If
End Function



P.D.: Cuando termine de re-diseñar y de re-programar mi sitio host de archivos (FileX) vuelvo a montar mi blog.

Dulces Lunas!¡.

Hace tiempo hice algo similar (mas cutre) y lo publique.

[ 1.1.10 ] Scripting Motor de InfraExplorer

Abandone el proyecto para crear algo mas serio... por hay debo tener este código aun.

Dulces Lunas!¡.

Las APIS de facebook alertan al usuario sobre las acciones que se van a ejecutar bajo su cuenta. Cuando conectamos un juego del iphone/android al facebook siempre pregunta si le queremos dar acceso. Usar las APIS de facebook para propagar un gusano es un poco... como lo diría... poco efectivo xD

Las APIS de Facebook + javascript + vbs/vb6 = Spread de lujo... javascript se utilizaría para crear una extensión en chrome/firefox o que se yo, su utilidad radica en dar aceptar los diálogos...

Dulces Lunas!¡