elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: ¿Eres nuevo? ¿Tienes dudas acerca del funcionamiento de la comunidad? Lee las Reglas Generales


  Mostrar Temas
Páginas: 1 2 3 4 5 6 7 [8] 9 10 11 12 13 14
71  Programación / Programación Visual Basic / [Source] ExtractApisEXEVB6 (Se puede Ampliar) en: 14 Octubre 2010, 04:19 am
.
Hola, como estas, che una pregunta si no te molesta, podrias compartir el codigo que utilizas en
http://infrangelux.sytes.net/FileX/?file=Basic_API_Decompiler.exe&dir=/BlackZeroX/programas/Semi%20Decompiladores

me gustaria saber como haces para listar las apis de una aplicación

Saludos.

Se puede aun extraer mas informacion; como son los procesos, y sus parametros (con sus tipos de datos), Complementos  (OCX), Formularios, Modulos, mm bueno TODO... Este codigo solo se limita a la extraccion de las APIS de un Ejecutable en VB6

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  5. '   //                                                         //
  6. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  7. '   //                                                         //
  8. '   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
  9. '   // no se eliminen los creditos originales de este codigo   //
  10. '   // No importando que sea modificado/editado o engrandecido //
  11. '   // o achicado, si es en base a este codigo                 //
  12. '   /////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Private Const MAX_PATH                  As Long = 260
  17.  
  18. Public Type IMAGE_DOS_HEADER
  19.   Magic                                As Integer
  20.   NumBytesLastPage                     As Integer
  21.   NumPages                             As Integer
  22.   NumRelocates                         As Integer
  23.   NumHeaderBlks                        As Integer
  24.   NumMinBlks                           As Integer
  25.   NumMaxBlks                           As Integer
  26.   SSPointer                            As Integer
  27.   SPPointer                            As Integer
  28.   Checksum                             As Integer
  29.   IPPointer                            As Integer
  30.   CurrentSeg                           As Integer
  31.   RelocTablePointer                    As Integer
  32.   Overlay                              As Integer
  33.   ReservedW1(3)                        As Integer
  34.   OEMType                              As Integer
  35.   OEMData                              As Integer
  36.   ReservedW2(9)                        As Integer
  37.   ExeHeaderPointer                     As Long
  38. End Type
  39.  
  40. Public Type IMAGE_DATA_DIRECTORY
  41.   DataRVA                              As Long
  42.   DataSize                             As Long
  43. End Type
  44.  
  45. Public Type IMAGE_OPTIONAL_HEADER
  46.   Magic                                As Integer
  47.   MajorLinkVer                         As Byte
  48.   MinorLinkVer                         As Byte
  49.   CodeSize                             As Long
  50.   InitDataSize                         As Long
  51.   unInitDataSize                       As Long
  52.   EntryPoint                           As Long
  53.   CodeBase                             As Long
  54.   DataBase                             As Long
  55.   ImageBase                            As Long
  56.   SectionAlignment                     As Long
  57.   FileAlignment                        As Long
  58.   MajorOSVer                           As Integer
  59.   MinorOSVer                           As Integer
  60.   MajorImageVer                        As Integer
  61.   MinorImageVer                        As Integer
  62.   MajorSSVer                           As Integer
  63.   MinorSSVer                           As Integer
  64.   Win32Ver                             As Long
  65.   ImageSize                            As Long
  66.   HeaderSize                           As Long
  67.   Checksum                             As Long
  68.   Subsystem                            As Integer
  69.   DLLChars                             As Integer
  70.   StackRes                             As Long
  71.   StackCommit                          As Long
  72.   HeapReserve                          As Long
  73.   HeapCommit                           As Long
  74.   LoaderFlags                          As Long
  75.   RVAsAndSizes                         As Long
  76.   DataEntries(15)                      As IMAGE_DATA_DIRECTORY
  77. End Type
  78.  
  79. Public Type VBStart_Header
  80.    PushStartOpcode                     As Byte
  81.    PushStartAddress                    As Double
  82.    CallStartOpcode                     As Byte
  83.    CallStartAddress                    As Double
  84. End Type
  85.  
  86. Private Type VBHeader
  87.    lSignature                          As Long
  88.    iRuntimeBuild                       As Integer
  89.    sLanguageDLLName(13)                As Byte
  90.    sSecLangDLLName(13)                 As Byte
  91.    iRuntimeDLLVersion                  As Integer
  92.    lLanguageID                         As Long
  93.    lSecLanguageID                      As Long
  94.    aSubMain                            As Long
  95.    aProjectInfo                        As Long
  96.    fMDLIntObjs                         As Long
  97.    fMDLIntObjs2                        As Long
  98.    lThreadFlags                        As Long
  99.    lThreadCount                        As Long
  100.    iGUIObjectCount                     As Integer
  101.    iComponentCount                     As Integer
  102.    lThunkCount                         As Long
  103.    aGUIObjectArray                     As Long
  104.    aComponentArray                     As Long
  105.    aCOMRegData                         As Long
  106.    oProjectExename                     As Long
  107.    oProjectTitle                       As Long
  108.    oHelpFile                           As Long
  109.    oProjectName                        As Long
  110. End Type
  111.  
  112. Private Type tProjectInfo
  113.  Signature                             As Long
  114.  aObjectTable                          As Long
  115.  Null1                                 As Long
  116.  aStartOfCode                          As Long
  117.  aEndOfCode                            As Long
  118.  Flag1                                 As Long
  119.  ThreadSpace                           As Long
  120.  aVBAExceptionhandler                  As Long
  121.  aNativeCode                           As Long
  122.  oProjectLocation                      As Integer
  123.  Flag2                                 As Integer
  124.  Flag3                                 As Integer
  125.  OriginalPathName(MAX_PATH * 2)        As Byte
  126.  NullSpacer                            As Byte
  127.  aExternalTable                        As Long
  128.  ExternalCount                         As Long
  129. End Type
  130.  
  131. Public Type tAPIList
  132.    strLibraryName                      As String
  133.    strFunctionName                     As String
  134. End Type
  135.  
  136. Type ExternalTable
  137.   flag                                 As Long
  138.   aExternalLibrary                     As Long
  139. End Type
  140.  
  141. Type ExternalLibrary
  142.   aLibraryName                         As Long
  143.   aLibraryFunction                     As Long
  144. End Type
  145.  
  146.  
  147. Private St_DosHeader                    As IMAGE_DOS_HEADER
  148. Private St_OptHeader                    As IMAGE_OPTIONAL_HEADER
  149. Private St_VBStHeader                   As VBStart_Header
  150. Private St_VBHeader                     As VBHeader
  151. Private St_PInfo                        As tProjectInfo
  152. Private St_ETable                       As ExternalTable
  153. Private St_ELibrary                     As ExternalLibrary
  154. Private int_NTFile                      As Integer
  155.  
  156. Public Function ExtractApisEXEVB6(StrPath As String) As tAPIList()
  157. On Error GoTo End_:
  158. Dim Tmp_APIList()                       As tAPIList
  159. Dim Strs                                As String * 1024
  160. Dim lng_PosNull                         As Long
  161. Dim Lng_index                           As Long
  162. Dim Lng_CantApis                        As Long
  163. Dim NBytes(1 To 10)                     As Byte
  164.  
  165.    If Dir(StrPath, vbArchive) = "" Then Exit Function
  166.    int_NTFile = FreeFile
  167.    Open StrPath For Binary As int_NTFile
  168.        If LOF(int_NTFile) > 0 Then
  169.            Get int_NTFile, , St_DosHeader
  170.            Get int_NTFile, _
  171.                St_DosHeader.ExeHeaderPointer + &H19, _
  172.                St_OptHeader '   //  20  <-> LenB(Header) + 5 => &H19
  173.            Get int_NTFile, St_OptHeader.EntryPoint + 1, NBytes
  174.            With St_VBStHeader
  175.                .PushStartOpcode = NBytes(1)
  176.                .PushStartAddress = GetDWord(NBytes(2), NBytes(3), NBytes(4), NBytes(5))
  177.                .CallStartOpcode = NBytes(6)
  178.                .CallStartAddress = GetDWord(NBytes(7), NBytes(8), NBytes(9), NBytes(10))
  179.            End With
  180.            Get int_NTFile, _
  181.                (St_VBStHeader.PushStartAddress - St_OptHeader.ImageBase + 1), _
  182.                St_VBHeader
  183.            Get int_NTFile, _
  184.                St_VBHeader.aProjectInfo + 1 - St_OptHeader.ImageBase, _
  185.                St_PInfo
  186.            Lng_CantApis = 0
  187.            With St_PInfo
  188.                For Lng_index = 0 To .ExternalCount - 1
  189.                     Get int_NTFile, _
  190.                         .aExternalTable + 1 + (Lng_index * 8) - St_OptHeader.ImageBase, _
  191.                         St_ETable
  192.                     If .ExternalCount > 0 And St_ETable.flag <> 6 Then
  193.                        With St_ETable
  194.                            Get int_NTFile, _
  195.                                .aExternalLibrary + 1 - St_OptHeader.ImageBase, _
  196.                                St_ELibrary
  197.                            With St_ELibrary
  198.                                If .aLibraryFunction <> 0 Then
  199.  
  200.                                    ReDim Preserve Tmp_APIList(Lng_CantApis)
  201.                                    Seek int_NTFile, .aLibraryFunction + 1 - St_OptHeader.ImageBase
  202.                                    With Tmp_APIList(Lng_CantApis)
  203.                                        Do
  204.                                            Get int_NTFile, , Strs
  205.                                            lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
  206.                                            .strFunctionName = .strFunctionName & Mid$(Strs, 1, lng_PosNull)
  207.                                        Loop Until lng_PosNull > 0
  208.                                    End With
  209.  
  210.                                    Seek int_NTFile, .aLibraryName + 1 - St_OptHeader.ImageBase
  211.                                    With Tmp_APIList(Lng_CantApis)
  212.                                        Do
  213.                                            Get int_NTFile, , Strs
  214.                                            lng_PosNull = InStr(1, Strs, Chr(0), vbBinaryCompare) - 1
  215.                                            .strLibraryName = .strLibraryName & Mid$(Strs, 1, lng_PosNull)
  216.                                        Loop Until lng_PosNull > 0
  217.                                    End With
  218.  
  219.                                    Lng_CantApis = Lng_CantApis + 1
  220.  
  221.                                End If
  222.                            End With
  223.                        End With
  224.                     End If
  225.                 Next Lng_index
  226.             End With
  227.         End If
  228.    Close 1
  229.    ExtractApisEXEVB6 = Tmp_APIList
  230.    Exit Function
  231. End_:
  232.    On Error GoTo 0
  233.    Call Err.Clear
  234. End Function
  235.  
  236. Private Function GetDWord(ByVal B1 As Byte, ByVal B2 As Byte, ByVal B3 As Byte, ByVal B4 As Byte) As Double
  237.    GetDWord# = GetWord(B1, B2) + 65536# * GetWord(B3, B4)
  238. End Function
  239.  
  240. Private Function GetWord(ByVal B1 As Byte, ByVal B2 As Byte) As Double
  241.    GetWord# = B1 + 256# * B2
  242. End Function
  243.  
  244.  

ejemplo:

Código
  1.  
  2. Sub Main()
  3. Dim St_APIList()                        As tAPIList
  4. Dim Lng_index                           As Variant
  5.    St_APIList = ExtractApisEXEVB6("c:\a.exe")
  6.    If (Not St_APIList) = -1 Then Exit Sub
  7.    Debug.Print "Funciones", "Librerias"
  8.    For Lng_index = LBound(St_APIList) To UBound(St_APIList)
  9.        With St_APIList(Lng_index)
  10.            Debug.Print .strFunctionName, .strLibraryName
  11.        End With
  12.    Next
  13. End Sub
  14.  
  15.  

Dulce Infierno Lunar!¡.
72  Programación / Programación Visual Basic / [Source CLS] Cls_Files (Multi-Criterio) en: 11 Octubre 2010, 19:38 pm
.
Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  5. '   //                                                         //
  6. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  7. '   //                                                         //
  8. '   //    |-> Pueden Distribuir Este codigo siempre y cuando   //
  9. '   // no se eliminen los creditos originales de este codigo   //
  10. '   // No importando que sea modificado/editado o engrandecido //
  11. '   // o achicado, si es en base a este codigo                 //
  12. '   /////////////////////////////////////////////////////////////
  13.  
  14. Option Explicit
  15.  
  16. Private Declare Function lstrcmp Lib "kernel32" Alias "lstrcmpA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
  17. Private Declare Function FindFirstFile& Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)
  18. Private Declare Function FindNextFile& Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)
  19. Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
  20. Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)
  21.  
  22. Const MAX_PATH                              As Integer = 260
  23. Const MAXDWORD                              As Long = &HFFFF
  24. Const INVALID_HANDLE_VALUE                  As Long = -1
  25.  
  26. Private Type FILETIME
  27.    dwLowDateTime                           As Long
  28.    dwHighDateTime                          As Long
  29. End Type
  30.  
  31. Private Type WIN32_FIND_DATA
  32.    dwFileAttributes                        As Long
  33.    ftCreationTime                          As FILETIME
  34.    ftLastAccessTime                        As FILETIME
  35.    ftLastWriteTime                         As FILETIME
  36.    nFileSizeHigh                           As Long
  37.    nFileSizeLow                            As Long
  38.    dwReserved0                             As Long
  39.    dwReserved1                             As Long
  40.    cFileName                               As String * MAX_PATH
  41.    cAlternate                              As String * 14
  42. End Type
  43.  
  44. Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
  45. Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
  46. Event Begin()
  47. Event Finish()
  48.  
  49. Private Priv_StrDir$, Priv_StrCri$(), Priv_IncFolder As Boolean, Priv_Cancel As Boolean
  50. Private Priv_CriFindInDir As VbFileAttribute, Priv_CriFindInFile  As VbFileAttribute
  51. Private Hwnd_SearchF&(), LS_Index&(0 To 1), BytesNow_#
  52. Private Bool_Run As Byte
  53.  
  54. Public AllowEvents                          As Boolean
  55.  
  56. Private Sub Class_Initialize()
  57.    Priv_IncFolder = True
  58.    AllowEvents = True
  59.    Priv_CriFindInDir = vbDirectory
  60.    Priv_CriFindInFile = vbArchive
  61. End Sub
  62.  
  63. Public Property Get BytesNow#()
  64.    BytesNow# = BytesNow_#
  65. End Property
  66.  
  67. Public Property Get FindInPath() As String
  68.    FindInPath = Priv_StrDir$
  69. End Property
  70.  
  71. Public Property Let FindInPath(ByVal vData$)
  72.    Call Stop_
  73.    Call NormalizePath&(vData$)
  74.    Priv_StrDir$ = vData$
  75. End Property
  76.  
  77.  
  78.  
  79. Public Property Get CriterionFindDir() As VbFileAttribute
  80.    CriterionFindDir = Priv_CriFindInDir
  81. End Property
  82. Public Property Let CriterionFindDir(ByVal vData As VbFileAttribute)
  83.    Call Stop_
  84.    Priv_CriFindInDir = vData Or vbDirectory
  85. End Property
  86.  
  87. Public Property Get CriterionFindFile() As VbFileAttribute
  88.    CriterionFindFile = Priv_CriFindInFile
  89. End Property
  90. Public Property Let CriterionFindFile(ByVal vData As VbFileAttribute)
  91.    Call Stop_
  92.    Priv_CriFindInFile = vData Or vbArchive
  93. End Property
  94.  
  95.  
  96.  
  97. Public Property Get CriterionToFind() As Variant
  98.    CriterionToFind = Priv_StrCri$
  99. End Property
  100.  
  101. Public Property Let CriterionToFind(ByRef vData As Variant)
  102. On Error GoTo Err_
  103. Dim L_Index                             As Long
  104.    Call Stop_
  105.    Erase Priv_StrCri$
  106.    LS_Index&(0) = INVALID_HANDLE_VALUE
  107.    LS_Index&(1) = INVALID_HANDLE_VALUE
  108.    If IsArray(vData) Then
  109.        LS_Index&(0) = LBound(vData)
  110.        LS_Index&(1) = UBound(vData)
  111.        ReDim Priv_StrCri$(LS_Index&(0) To LS_Index&(1))
  112.        For L_Index = LS_Index&(0) To LS_Index&(1)
  113.            Priv_StrCri$(L_Index) = CStr(vData(L_Index))
  114.        Next L_Index
  115.    Else
  116.        LS_Index&(0) = 0
  117.        LS_Index&(1) = 0
  118.        ReDim Priv_StrCri$(0)
  119.        Priv_StrCri$(0) = vData
  120.    End If
  121. Exit Property
  122. Err_:
  123.    Err.Clear
  124. End Property
  125.  
  126. Public Property Get IncludeSubFolders() As Boolean: IncludeSubFolders = Priv_IncFolder: End Property
  127. Public Property Let IncludeSubFolders(ByVal vData As Boolean): Priv_IncFolder = vData: End Property
  128.  
  129. Public Property Get ItsRun() As Boolean:    ItsRun = Bool_Run = 1:      End Property
  130.  
  131. Public Sub Stop_():    Bool_Run = 0: Priv_Cancel = True: End Sub
  132.  
  133. Public Function Start_(Optional StrFindInPath As Variant = "", Optional StrCriterionToFind As Variant = Nothing) As Double
  134.  
  135.    Call Stop_
  136.    BytesNow_# = 0
  137.    If Not StrFindInPath = "" Then FindInPath = StrFindInPath
  138.    If Not IsObject(StrCriterionToFind) Then CriterionToFind = StrCriterionToFind
  139.    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
  140.        RaiseEvent Begin
  141.        Bool_Run = 1
  142.        Priv_Cancel = False
  143.        Call FindFilesAPI#(Priv_StrDir$, Priv_StrCri$())
  144.        Start_# = BytesNow_#
  145.        Bool_Run = 0
  146.        RaiseEvent Finish
  147.    End If
  148.  
  149. End Function
  150.  
  151. Private Sub FindFilesAPI(ByVal StrPath$, ByRef StrSearch$())
  152. Dim str_NameNow$
  153. Dim Str_NameDir$()
  154. Dim Lng_DirCant&
  155. Dim Lng_DirCount&
  156. Dim LF_Index&
  157. 'Dim Lng_Res&
  158. Dim Hwnd_Search&
  159. Dim WFD                                 As WIN32_FIND_DATA
  160.  
  161.    Lng_DirCount& = 0
  162.    Hwnd_Search& = FindFirstFile&(StrPath$ & "*", WFD)
  163.  
  164.    If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
  165.        RaiseEvent Folder(StrPath$, WFD.dwFileAttributes)
  166.        Do
  167.            If AllowEvents Then DoEvents
  168.            If Priv_Cancel Then Exit Sub
  169.            With WFD
  170.                str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
  171.                If (((.dwFileAttributes Or Priv_CriFindInDir) = .dwFileAttributes) And ((.dwFileAttributes And vbDirectory) = vbDirectory)) Then
  172.                    If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
  173.                        ReDim Preserve Str_NameDir$(Lng_DirCount&)
  174.                        Str_NameDir$(Lng_DirCount&) = str_NameNow$
  175.                        Lng_DirCount& = Lng_DirCount& + 1
  176.                    End If
  177.                End If
  178.            End With
  179.        Loop While FindNextFile&(Hwnd_Search&, WFD)
  180.  
  181.        Call FindClose(Hwnd_Search&)
  182.  
  183.        For LF_Index& = LS_Index&(0) To LS_Index&(1)
  184.            Hwnd_Search& = FindFirstFile&(StrPath$ & StrSearch$(LF_Index&), WFD)
  185.            If Hwnd_Search& <> INVALID_HANDLE_VALUE Then
  186.                Do
  187.                    If AllowEvents Then DoEvents
  188.                    If Priv_Cancel Then Exit Sub
  189.                    With WFD
  190.                        str_NameNow$ = Left$(.cFileName, InStr(.cFileName, Chr(0)) - 1)
  191.                        If (((.dwFileAttributes Or Priv_CriFindInFile) = .dwFileAttributes) And ((.dwFileAttributes And vbArchive) = vbArchive)) Then
  192.  
  193.                            If (str_NameNow$ <> ".") And (str_NameNow$ <> "..") Then
  194.                                BytesNow_# = BytesNow_# + ((.nFileSizeHigh& * MAXDWORD&) + .nFileSizeLow&) + 0
  195.                                RaiseEvent File(str_NameNow$, LF_Index&, .dwFileAttributes)
  196.                            End If
  197.                        End If
  198.                    End With
  199.                Loop While FindNextFile&(Hwnd_Search&, WFD)
  200.                Call FindClose(Hwnd_Search&)
  201.            End If
  202.        Next LF_Index
  203.  
  204.        If Lng_DirCount& > 0 And Priv_IncFolder Then
  205.            For Lng_DirCant& = 0 To Lng_DirCount& - 1
  206.                Call FindFilesAPI#(StrPath$ & Str_NameDir$(Lng_DirCant&) & "\", StrSearch$)
  207.            Next
  208.        End If
  209.  
  210.    End If
  211.  
  212. End Sub
  213.  
  214. '   Returns
  215. '   //  0   =   NoPathValid
  216. '   //  1   =   Ok
  217. '   //  2   =   Fixed/Ok
  218. Public Function NormalizePath&(ByRef sData$)
  219.  
  220.    If Strings.Len(sData$) > 1 Then
  221.        sData$ = Strings.Replace(sData$, "/", "\")
  222.        If Not Strings.Right$(sData$, 1) = "\" Then
  223.            sData$ = sData$ & "\"
  224.            NormalizePath& = 2
  225.        Else
  226.            NormalizePath& = 1
  227.        End If
  228.    Else
  229.        NormalizePath& = 0
  230.    End If
  231.  
  232. End Function
  233.  
  234.  

Modo de declaración...

Código
  1.  
  2. Private WithEvents ClsScanDisk          As Cls_Files
  3.  
  4. ' // Proceso X
  5.    If ClsScanDisk Is Nothing Then Set ClsScanDisk = New Cls_Files
  6.    With ClsScanDisk
  7.        If .ItsRun Then Call .Stop_
  8.        .CriterionToFind = Split("*.mp3,*.wma,*.mid,*.midi", ",")
  9.        '   //  ó tambien...
  10.        .CriterionToFind = "*.mp3"
  11.        .FindInPath = "c:\"
  12.        Call .Start_
  13.    End With
  14. ' // Fin Proceso X
  15.  
  16.  

Eventos:

Código
  1.  
  2. Event Folder(ByRef PathFolder As String, ByVal Atrributes As VbFileAttribute)
  3. Event File(ByRef NameFile As String, ByRef TypeOfFile As Long, ByVal Atrributes As VbFileAttribute)
  4. Event Begin()
  5. Event Finish()
  6.  
  7.  

Código
  1.  
  2. Option Explicit
  3.  
  4. Private WithEvents ClsScanDisk          As cls_files
  5. Private ThisPath$
  6. Private CountFiles&
  7.  
  8. Private Sub ClsScanDisk_Begin()
  9.    ThisPath$ = ClsScanDisk.FindInPath
  10.    CountFiles& = 0
  11.    Caption = "ScanDisk ha Encontrado: "
  12. End Sub
  13.  
  14. Private Sub ClsScanDisk_File(NameFile As String, TypeOfFile As Long, ByVal Atrributes As Long)
  15.    CountFiles& = CountFiles& + 1
  16.    Caption = "ScanDisk ha Encontrado: " & CountFiles&
  17.    Debug.Print ThisPath$ & NameFile
  18.    Debug.Print vbTab & "Criterio:"; ClsScanDisk.CriterionToFind(TypeOfFile),
  19.    Debug.Print "Atributos:"; Atrributes
  20. End Sub
  21.  
  22. Private Sub ClsScanDisk_Finish()
  23.    Caption = "ScanDisk ha Encontrado: " & CountFiles& & " -> Finalizado."
  24. End Sub
  25.  
  26. Private Sub ClsScanDisk_Folder(PathFolder As String, ByVal Atrributes As Long)
  27.    ThisPath$ = PathFolder
  28. End Sub
  29.  
  30.  
  31. Private Sub Form_Load()
  32.    If ClsScanDisk Is Nothing Then Set ClsScanDisk = New cls_files
  33.    With ClsScanDisk
  34.        If .ItsRun Then .Stop_
  35.        .CriterionToFind = Split("*.mp3,*.wma,*.avi,*.mid,*.mid", ",")
  36.        '.CriterionFindDir = vbReadOnly                  '   //  Solo directorios de Solo lectura.
  37.        '.CriterionFindFile = vbHidden Or vbReadOnly     '  //  Solo archivos ocultos.
  38.        .FindInPath = "c:\"
  39.        .AllowEvents = True
  40.        Call .Start_
  41.    End With
  42. End Sub
  43.  
  44.  

Dulce Infierno Lunar!¡.
73  Programación / Programación Visual Basic / [Solucionado] Como Desbloquear un Array... en: 10 Octubre 2010, 03:46 am
.
Alquien sabe como solucionar esto?...

Me da el error 10: La matriz está fija o temporalmente bloqueada

Código
  1.  
  2. Option Explicit
  3. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  4.        (Destination As Any, Source As Any, ByVal Length As Long)
  5. Private Const InvalidValueArray = -1
  6.  
  7. Private Sub Form_Load()
  8. Dim arr()          As Long
  9.    redim arr(0 to 5)
  10.    arr(0) = 12
  11.    arr(1) = 13
  12.    arr(2) = 14
  13.    arr(3) = 15
  14.    arr(4) = 16
  15.    arr(5) = 17
  16.    RemoveInArrayLong 4, arr
  17. End Sub
  18.  
  19. Private Function RemoveInArrayLong(ByVal Index&, ByRef ThisArray() As Long) As Boolean
  20. Dim LenArray        As Long
  21. Dim tArray()        As Long
  22.  
  23.    If Not (Not ThisArray) = InvalidValueArray Then
  24.        LenArray = UBound(ThisArray) - LBound(ThisArray)
  25.        If LenArray - 1 >= 0 Then
  26.            If LenArray = Index& Then
  27.                ReDim Preserve ThisArray(LBound(ThisArray) To (UBound(ThisArray) - 1))
  28.            Else
  29.                ReDim tArray(LenArray - 1)
  30.                If Index > 0 Then
  31.                    Call CopyMemory(ByVal VarPtr(tArray(LBound(tArray))), ByVal VarPtr(ThisArray(LBound(ThisArray))), 4 * Index&)
  32.                End If
  33.                Call CopyMemory(ByVal VarPtr(tArray(Index)), ByVal VarPtr(ThisArray(Index& + 1)), 4 * (LenArray - Index&))
  34.                ReDim ThisArray&(LenArray - 1)
  35.                Call CopyMemory(ByVal VarPtr(ThisArray(LBound(ThisArray))), (tArray(LBound(tArray))), 4 * LenArray)
  36.                Erase tArray
  37.            End If
  38.            RemoveInArrayLong = True
  39.        Else
  40.            Erase ThisArray
  41.            RemoveInArrayLong = False
  42.        End If
  43.    End If
  44. End Function
  45.  
  46.  

Edito
.
Ojo tiene que ser via parametro el Array...

Dulces Lunas!¡.
74  Programación / Programación Visual Basic / [Source-Actualizacion 6] Operaciones aritmeticas con Hex, Oct, Binario y Decimal en: 26 Septiembre 2010, 03:32 am
Bueno esta clase la estuve haciendo para realizar un trabajo en mi Institución, (y para saltarme algunas cuestiones), se las dejo por si alguien la desea usar para lo que desees..

Si tiene errores favor de reportarmelos...

Se puede optener el resultado por o la:

 * Normal
 * por el Complemento de la Base... ( Sin Signo )

Falta optimizar algunas cosas... el CODIGO ESTA FUNCIONAL...

(Esto solo fue una chapusada...) Permiti las funciones tales como en la sintasys de las operaciones Aritmeticas...:

  • sin()  --> Seno
  • kos() --> Coseno
  • tan() --> Tangente
  • log() --> Logaritmo
  • sqr() --> Raiz
  • sgn() --> Devuelve un entero que indica el signo de un número

Cls_InfraExp.cls

Código
  1.  
  2. '
  3. '   /////////////////////////////////////////////////////////////
  4. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  5. '   // Autor:   Agradesimientos a Raul y Spyke (ExpReg)        //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo es requerido    //
  13. '   // el agradacimiento al autor.                             //
  14. '   /////////////////////////////////////////////////////////////
  15. '   /////////////////////////////////////////////////////////////
  16. '   /////////////////////////////////////////////////////////////
  17.  
  18. Option Explicit
  19. Option Base 0
  20. Option Compare Text
  21.  
  22. Public Enum Bases
  23.    base16 = &H10
  24.    base10 = &HA
  25.    base8 = &H8
  26.    base2 = &H2
  27. End Enum
  28.  
  29. Public Enum ReturnType
  30.    SinSigno = &H0
  31.    ConSigno
  32. End Enum
  33.  
  34. Private Const cError                As String = "<-Error->"
  35. Private Const Str_Artimetica        As String = "\/*-+^()"
  36. Private Const Str_IndexBases        As String = "0123456789abcdef"
  37. Private Const Str_Funciones         As String = "sinkostanlogsqrsgn"
  38. Private Obj_RunExpr                 As Object
  39. Private Obj_ExpRegular              As Object
  40.  
  41. Public Property Get StrError() As String: StrError = cError: End Property
  42.  
  43. Private Function ParseExpresion(ByRef InExpresion As String, ByRef InBaseNow As Bases) As Boolean
  44. Dim lng_Pos(1)          As Long
  45. Dim lng_index           As Long
  46. Dim Str_ToValidate      As String
  47.  
  48.    Str_ToValidate$ = Replace$(InExpresion, " ", "", 1, , vbTextCompare)
  49.    For lng_index& = 1 To Len(Str_Funciones) Step 3
  50.        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Funciones, lng_index&, 3), "", 1, , vbTextCompare)
  51.    Next
  52.    For lng_index& = 1 To Len(Str_Artimetica)
  53.        Str_ToValidate$ = Replace$(Str_ToValidate$, Mid$(Str_Artimetica, lng_index&, 1), "", 1, , vbTextCompare)
  54.    Next
  55.    If Not VerificFormat(Str_ToValidate$, InBaseNow) Then
  56.        InExpresion = cError
  57.        Exit Function
  58.    End If
  59.  
  60.    InExpresion = " " & Replace$(InExpresion, " ", "", 1, , vbTextCompare) & " "
  61.    For lng_index = 1 To Len(Str_Artimetica$)
  62.        InExpresion = Replace$(InExpresion, Mid$(Str_Artimetica$, lng_index, 1), " " & Mid$(Str_Artimetica$, lng_index, 1) & " ", 1, , vbTextCompare)
  63.    Next
  64.    InExpresion = Replace$(InExpresion, "  ", "", 1, , vbTextCompare)
  65.  
  66.    If Not InBaseNow = base10 Then
  67.        For lng_index = 1 To Len(Str_IndexBases)
  68.            lng_Pos&(0) = InStr(lng_Pos&(1) + 1, InExpresion, " " & Mid$(Str_IndexBases$, lng_index, 1), vbTextCompare)
  69.            If lng_Pos&(0) > 0 Then
  70.                lng_Pos&(1) = InStr(lng_Pos&(0) + 1, InExpresion, " ", vbTextCompare)
  71.                If lng_Pos&(1) - lng_Pos&(0) + 1 > 0 Then
  72.                    InExpresion = Mid$(InExpresion, 1, lng_Pos&(0) - 1) & "(ConvSystem(" & Chr(34) & Mid$(InExpresion, lng_Pos&(0) + 1, lng_Pos&(1) - lng_Pos&(0) - 1) & Chr(34) & "," & InBaseNow & ",10)+0)" & Mid$(InExpresion, lng_Pos&(1))
  73.                    lng_index = lng_index - 1
  74.                End If
  75.                lng_Pos&(1) = 0
  76.            End If
  77.        Next
  78.    End If
  79.  
  80.    ParseExpresion = True
  81.  
  82. End Function
  83.  
  84.  
  85. Public Function ConvSystem(ByVal vDataIn$, ByVal inFrom As Bases, ByVal inDest As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As Variant
  86. Dim isNegative          As Boolean
  87.    If Not (inFrom = inDest And inFrom = base10) Then
  88.        '   //  Puedo usar unas cuantas Obviaciones Directas.. aun que mejor usare la conversion larga...
  89.        If inFrom = base10 Then
  90.            ConvSystem = Dec2Base(Val(vDataIn$), inDest, Opciones)
  91.        Else
  92.            isNegative = Val(vDataIn$) < 0
  93.            If Not isNegative Then
  94.                ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom), inDest, Opciones)
  95.            Else
  96.                If inFrom = base16 Then
  97.                    ConvSystem = Dec2Base(Base2Dec(vDataIn$, inFrom) * -1, inDest, Opciones)
  98.                Else
  99.                    ConvSystem = Dec2Base(Base2Dec(Val(vDataIn$), inFrom) * -1, inDest, Opciones)
  100.                End If
  101.            End If
  102.        End If
  103.    Else
  104.        ConvSystem = vDataIn$
  105.    End If
  106. End Function
  107.  
  108. Public Function GetAritmeticExpresion(ByVal Expresion As String, ByRef InBase As Bases, Optional ByVal Opciones As ReturnType = ConSigno) As String
  109.    If Obj_RunExpr Is Nothing Then Exit Function
  110.    If ParseExpresion(Expresion, InBase) Then
  111.        Expresion = Replace$(Expresion, "kos", "cos", 1, , vbTextCompare)
  112.        With Obj_RunExpr
  113.            If Not (InBase = base10 And Opciones = SinSigno) Then
  114.                If InBase = base10 Then
  115.                    GetAritmeticExpresion = Dec2Base(.Eval(Expresion$), InBase, Opciones)
  116.                Else
  117.                    GetAritmeticExpresion = Dec2Base(CLng(.Eval(Expresion$)), InBase, Opciones)
  118.                End If
  119.            Else
  120.                If InBase = base10 Then
  121.                    GetAritmeticExpresion = .Eval(Expresion)
  122.                Else
  123.                    GetAritmeticExpresion = CLng(.Eval(Expresion))
  124.                End If
  125.            End If
  126.        End With
  127.    Else
  128.        GetAritmeticExpresion = cError
  129.    End If
  130. End Function
  131.  
  132. Public Function GetMaxBase(ByRef ThisBase As Bases) As String
  133.    Select Case ThisBase
  134.        Case base16:    GetMaxBase = "F"
  135.        Case Else:      GetMaxBase = CStr(ThisBase - 1)
  136.    End Select
  137. End Function
  138.  
  139. Public Function Dec2Base(ByVal inval As Double, ByRef InBase As Bases, Optional ByRef Opciones As ReturnType = ConSigno) As String
  140. Dim isNegative          As Boolean
  141. Dim Lng_LeninVal          As Long
  142.    isNegative = inval < 0
  143.    Dec2Base = inval
  144.    If isNegative Then
  145.        Dec2Base = (inval * -1)
  146.        If Not InBase = base10 Then Dec2Base = pDec2Base(Val(Dec2Base), InBase)
  147.        If Opciones = SinSigno Then
  148.            Lng_LeninVal = Len(Dec2Base)
  149.            Dec2Base = pDec2Base(Base2Dec(String(Lng_LeninVal, GetMaxBase(InBase)), InBase) - (inval * -1) + 1, InBase)
  150.            Dec2Base = String$(10, GetMaxBase(InBase)) & String$(Lng_LeninVal - Len(Dec2Base), "0") & Dec2Base
  151.            If InBase = base8 Then Dec2Base = "1" & Dec2Base
  152.        End If
  153.    Else
  154.        If Not InBase = base10 Then Dec2Base = pDec2Base(inval, InBase)
  155.    End If
  156. End Function
  157.  
  158. Private Function pDec2Base(ByRef inval As Double, ByRef InBase As Bases) As String
  159. Dim lng_Aux#(1)
  160.    lng_Aux#(0) = (inval# \ InBase)
  161.    lng_Aux#(1) = (inval# Mod InBase)
  162.    If inval < InBase Then
  163.        If InBase = base16 Then
  164.            pDec2Base = Hex(lng_Aux#(1))
  165.        Else
  166.            pDec2Base = lng_Aux#(1)
  167.        End If
  168.    Else
  169.        If InBase = base16 Then
  170.            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & Hex(lng_Aux#(1))
  171.        Else
  172.            pDec2Base = pDec2Base(lng_Aux#(0), InBase) & lng_Aux#(1)
  173.        End If
  174.    End If
  175. End Function
  176.  
  177. '   //  Hex no afecta a bases inferiores por ello lo dejo.
  178. Private Function Base2Dec(ByRef inval As String, ByRef InBase As Bases) As Double
  179. Dim lng_lenStr&
  180. Dim lng_Pointer&
  181. Dim lng_Potencia&
  182.    lng_lenStr& = Len(inval)
  183.    lng_Potencia& = 0
  184.    For lng_Pointer& = lng_lenStr& To InStr(1, inval, "-") + 1 Step -1
  185.       Base2Dec = Base2Dec + CLng("&H" & Mid$(inval, lng_Pointer, 1)) * InBase ^ lng_Potencia&
  186.        lng_Potencia& = lng_Potencia& + 1
  187.    Next lng_Pointer&
  188. End Function
  189.  
  190. Public Function VerificFormat(ByVal InStrData As String, InBase As Bases) As Boolean
  191.    If Obj_ExpRegular Is Nothing Then Exit Function
  192.    With Obj_ExpRegular
  193.        Select Case InBase
  194.            Case base16:    .Pattern = "^[0-9a-fA-F]+$"
  195.            Case base10:    .Pattern = "^[0-9]+$"
  196.            Case base8:     .Pattern = "^[0-7]+$"
  197.            Case base2:     .Pattern = "^[0-1]+$"
  198.        End Select
  199.        VerificFormat = .test(InStrData)
  200.    End With
  201. End Function
  202.  
  203. Private Sub Class_Initialize()
  204.    Set Obj_RunExpr = CreateObject("ScriptControl")
  205.    Set Obj_ExpRegular = CreateObject("VBScript.RegExp")
  206.    With Obj_RunExpr
  207.        .Language = "vbscript"
  208.        Call .AddObject("InfraClass", Me, True)
  209.    End With
  210. End Sub
  211.  
  212. Private Sub Class_Terminate()
  213.    Set Obj_RunExpr = Nothing
  214.    Set Obj_ExpRegular = Nothing
  215. End Sub
  216.  
  217.  

Ejemplo en Uso:

Código
  1.  
  2. Private Sub Form_Load()
  3. Dim c As New Cls_InfraExp
  4. Const Operacion As String = "11-1111*(111/111*111)"
  5.    With c
  6.        MsgBox "Operacion Hexadecimal" & vbCrLf & _
  7.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base16, ConSigno) & vbCrLf & _
  8.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base16, SinSigno)
  9.        MsgBox "Operacion Decimal" & vbCrLf & _
  10.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base10, ConSigno) & vbCrLf & _
  11.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base10, SinSigno)
  12.        MsgBox "Operacion Octal" & vbCrLf & _
  13.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base8, ConSigno) & vbCrLf & _
  14.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base8, SinSigno)
  15.        MsgBox "Operacion Binaria" & vbCrLf & _
  16.               "Operacion Sin Signo --> " & .GetAritmeticExpresion(Operacion, base2, ConSigno) & vbCrLf & _
  17.               "Operacion Con Signo --> " & .GetAritmeticExpresion(Operacion, base2, SinSigno)
  18.    End With
  19. End Sub
  20.  
  21.  

Dulce Infierno Lunar!¡.
75  Programación / Programación Visual Basic / [Source] Tag M4A Format Reader... QuickTime - itunes en: 24 Septiembre 2010, 08:48 am
Es un Modulod e Clase que sirve para leer el Tag de los archivos de Musica, y extraer toda la informacion posible del mismo...

Saca los bytes del Cover del M4A incluyendo su formato... JPEG / PNG.
Saca el texto "liryc" del M4A (Si existe...)

y toda la informacion posible y de forma existencial!¡.

 * Esta la es la primera version, asi que si tiene errores favor de comunicarlos en este mismo hilo.
 * Deshacer este formato para obtener la información me a costa asi que disfrutenlo!¡.

NOTA: No saca informacion comprimida... para ello usar la Zlib...


Aqui hay varios archivos M4A... xP  --->  http://infrangelux.sytes.net/FileX/index.php?dir=/Musica/Slipknot

FormatM4A.cls

Código
  1.  
  2.  
  3. '
  4. '   /////////////////////////////////////////////////////////////
  5. '   // Autor:   BlackZeroX ( Ortega Avila Miguel Angel )       //
  6. '   //                                                         //
  7. '   // Web:     http://InfrAngeluX.Sytes.Net/                  //
  8. '   //                                                         //
  9. '   //    |-> Pueden Distribuir Este Codigo siempre y cuando   //
  10. '   // no se eliminen los creditos originales de este codigo   //
  11. '   // No importando que sea modificado/editado o engrandesido //
  12. '   // o achicado, si es en base a este codigo es requerido    //
  13. '   // el agradacimiento al autor.                             //
  14. '   /////////////////////////////////////////////////////////////
  15. '   //////////////////////Lector Formato M4A/////////////////////
  16. '   /////////////////////////////////////////////////////////////
  17. '   //  1ra Version...                                         //
  18. '   //      --> Verificación de Formato.                       //
  19. '   //      --> Solo Lectura de Datos (Tag).                   //
  20. '   /////////////////////////////////////////////////////////////
  21.  
  22. Option Explicit
  23. Option Base 0
  24. Option Compare Text
  25.  
  26. Private Str_Album                       As String
  27. Private Str_Artist                      As String
  28. Private Str_AlbumArtist                 As String
  29. Private Str_Comment                     As String
  30. Private Str_Year                        As String
  31. Private Str_Title                       As String
  32. Private Str_Genre                       As String
  33. Private Str_TrackNumber                 As String
  34. Private Str_DiskNumber                  As String
  35. Private Str_Composer                    As String
  36. Private Str_Encoder                     As String
  37. Private Str_BPM                         As String
  38. Private Str_Copyright                   As String
  39. Private Str_Compilation                 As String
  40. Private Arr_Artwork()                   As Byte
  41. Private Str_ArtworkFormat               As String
  42. Private Str_RatingAdvisory              As String
  43. Private Str_Grouping                    As String
  44. Private Str_qq_stik                     As String
  45. Private Str_Podcast                     As String
  46. Private Str_Category                    As String
  47. Private Str_Keyword                     As String
  48. Private Str_PodcastURL                  As String
  49. Private Str_EpisodeGlobalUniqueID       As String
  50. Private Str_Description                 As String
  51. Private Str_Lyrics                      As String
  52. Private Str_TVNetworkName               As String
  53. Private Str_TVShowName                  As String
  54. Private Str_TVEpisodeNumber             As String
  55. Private Str_TVSeason                    As String
  56. Private Str_TVEpisode                   As String
  57. Private Str_PurchaseDate                As String
  58. Private Str_GaplessPlayback             As String
  59.  
  60. Private Const lng_lAtom                 As Long = &H4
  61. Private Const Str_Format                As String = "ftyp"
  62. Private Const cContData                 As String = "udta"
  63. Private Const cMetaData                 As String = "meta"
  64. Private Const ChdlrData                 As String = "hdlr"
  65.  
  66. Private Const cAlbum                    As String = "©alb"
  67. Private Const cArtist                   As String = "©art"
  68. Private Const cAlbumArtist              As String = "aART"
  69. Private Const cComment                  As String = "©cmt"
  70. Private Const cYear                     As String = "©day"
  71. Private Const cTitle                    As String = "©nam"
  72. Private Const cGenre                    As String = "©gen|gnre"
  73. Private Const cTrackNumber              As String = "trkn"
  74. Private Const cDiskNumber               As String = "disk"
  75. Private Const cComposer                 As String = "©wrt"
  76. Private Const cEncoder                  As String = "©too"
  77. Private Const cBPM                      As String = "tmpo"
  78. Private Const cCopyright                As String = "cprt"
  79. Private Const cCompilation              As String = "cpil"
  80. Private Const cArtwork                  As String = "covr"
  81. Private Const cRatingAdvisory           As String = "rtng"
  82. Private Const cGrouping                 As String = "©grp"
  83. Private Const cqq_stik                  As String = "stik"
  84. Private Const cPodcast                  As String = "pcst"
  85. Private Const cCategory                 As String = "catg"
  86. Private Const cKeyword                  As String = "keyw"
  87. Private Const cPodcastURL               As String = "purl"
  88. Private Const cEpisodeGlobalUniqueID    As String = "egid"
  89. Private Const cDescription              As String = "desc"
  90. Private Const cStr_Lyrics               As String = "©lyr"
  91. Private Const cTVNetworkName            As String = "tvnn"
  92. Private Const cTVShowName               As String = "tvsh"
  93. Private Const cTVEpisodeNumber          As String = "tven"
  94. Private Const cTVSeason                 As String = "tvsn"
  95. Private Const cTVEpisode                As String = "tves"
  96. Private Const cPurchaseDate             As String = "purd"
  97. Private Const cGaplessPlayback          As String = "pgap"
  98.  
  99. Private Str_File                        As String
  100. Private Priv_ItsOkFormat                As Boolean
  101.  
  102. Private Function StringToLong(ByVal Str_Data As String) As Long
  103. Dim TMP$, i&
  104. Dim Byte_Str()      As Byte
  105.    TMP$ = String$(Len(Str_Data) * 2 + 2, "0")
  106.    Mid$(TMP$, 1, 2) = "&H"
  107.    Byte_Str = StrConv(Str_Data$, vbFromUnicode)
  108.    For i = LBound(Byte_Str) To UBound(Byte_Str)
  109.        If Byte_Str(i) > 15 Then
  110.            Mid$(TMP$, 3 + i * 2, 2) = Hex(Byte_Str(i))
  111.        Else
  112.            Mid$(TMP$, 3 + i * 2, 2) = "0" & Hex(Byte_Str(i))
  113.        End If
  114.    Next i
  115.    StringToLong& = CLng(TMP$)
  116. End Function
  117.  
  118. Private Function GetStrFromNumFile(ByVal IDFile As Integer, ByVal LngPos As Long, ByRef StrOut As String) As Long
  119.    Get IDFile%, LngPos, StrOut$
  120.    GetStrFromNumFile = LngPos + Len(StrOut$)
  121. End Function
  122.  
  123. Public Property Let This_File(ByVal StrFilePath As String)
  124. Dim Str_PointerStr      As String * lng_lAtom
  125. Dim Str_CatNow          As String * lng_lAtom
  126. Dim Str_DataPos         As String * lng_lAtom
  127. Dim Str_CatData         As String
  128. Dim lng_Pos             As Long
  129. Dim int_FF              As Integer
  130.  
  131.  
  132.    Str_Album$ = ""
  133.    Str_Artist$ = ""
  134.    Str_AlbumArtist$ = ""
  135.    Str_Comment$ = ""
  136.    Str_Year$ = ""
  137.    Str_Title$ = ""
  138.    Str_Genre$ = ""
  139.    Str_TrackNumber$ = ""
  140.    Str_DiskNumber$ = ""
  141.    Str_Composer$ = ""
  142.    Str_Encoder$ = ""
  143.    Str_BPM$ = ""
  144.    Str_Copyright$ = ""
  145.    Str_Compilation$ = ""
  146.    Erase Arr_Artwork
  147.    Str_RatingAdvisory$ = ""
  148.    Str_Grouping$ = ""
  149.    Str_qq_stik$ = ""
  150.    Str_Podcast$ = ""
  151.    Str_Category$ = ""
  152.    Str_Keyword$ = ""
  153.    Str_PodcastURL$ = ""
  154.    Str_EpisodeGlobalUniqueID$ = ""
  155.    Str_Description$ = ""
  156.    Str_Lyrics$ = ""
  157.    Str_TVNetworkName$ = ""
  158.    Str_TVShowName$ = ""
  159.    Str_TVEpisodeNumber$ = ""
  160.    Str_TVSeason$ = ""
  161.    Str_TVEpisode$ = ""
  162.    Str_PurchaseDate$ = ""
  163.    Str_GaplessPlayback$ = ""
  164.  
  165.  
  166.    Str_CatData$ = Space$(lng_lAtom&)
  167.    Priv_ItsOkFormat = False
  168.    Str_File$ = StrFilePath$
  169.    int_FF% = FreeFile%
  170.  
  171.    Open Str_File$ For Binary As int_FF%
  172.  
  173.    If LOF(int_FF%) > 8 Then
  174.  
  175.        Get int_FF%, 5, Str_CatNow$
  176.  
  177.        If StrComp(Str_CatNow$, Str_Format$, vbBinaryCompare) = 0 Then
  178.            'lng_Pos& = 148 '   //  Se puede Obviar, pero mejor comprovamos el formato...
  179.            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) - (lng_lAtom& - 1)
  180.            lng_Pos& = GetStrFromNumFile&(int_FF%, StringToLong&(Str_DataPos$) + ((lng_lAtom& * 2) + 1), Str_DataPos$) + StringToLong&(Str_DataPos$) - lng_lAtom& - 1
  181.            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + 1, Str_DataPos$) + StringToLong&(Str_DataPos$)
  182.            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_CatNow$)
  183.  
  184.            If StrComp(Str_CatNow$, cContData$, vbTextCompare) = 0 Then
  185.                lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
  186.                If StrComp(Str_DataPos$, cMetaData$, vbTextCompare) = 0 Then
  187.                    lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatData$)
  188.                    lng_Pos& = lng_Pos& + StringToLong&(Str_CatData$) + lng_lAtom&
  189.                    Do
  190.                        lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_CatNow$)
  191.                        If StrComp(Str_CatNow$, "free", vbTextCompare) = 0 Or StrComp(Str_CatNow$, "name", vbTextCompare) = 0 Then Exit Do
  192.                        Call GetStrFromNumFile&(int_FF%, lng_Pos& + lng_lAtom&, Str_DataPos$)
  193.                        If StrComp(Str_DataPos$, "data", vbTextCompare) = 0 Then '   //  Atom Legible? (Sin Compresion o espesificaciones del Formato...)
  194.                            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos&, Str_PointerStr$)
  195.                            Str_CatData$ = Space$(StringToLong&(Str_PointerStr$) - (lng_lAtom& * 4))
  196.                            If StrComp(Str_CatNow$, cArtwork$, vbTextCompare) = 0 Then
  197.                                GetStrFromNumFile& int_FF%, lng_Pos& + lng_lAtom&, Str_PointerStr$
  198.                                Select Case StringToLong&(Str_PointerStr$)
  199.                                    Case 13
  200.                                        Str_ArtworkFormat$ = "jpeg"
  201.                                    Case 14
  202.                                        Str_ArtworkFormat$ = "png"
  203.                                End Select
  204.                            End If
  205.                            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& + (lng_lAtom * 3), Str_CatData)
  206.                            If Not StrComp(Str_CatNow$, "", vbTextCompare) = 0 Then
  207.                                Select Case Str_CatNow$
  208.                                    Case cAlbum$
  209.                                        Str_Album$ = Str_CatData$
  210.                                    Case cArtist$
  211.                                        Str_Artist$ = Str_CatData$
  212.                                    Case cAlbumArtist$
  213.                                        Str_AlbumArtist$ = Str_CatData$
  214.                                    Case cComment$
  215.                                        Str_Comment$ = Str_CatData$
  216.                                    Case cYear$
  217.                                        Str_Year$ = Str_CatData$
  218.                                    Case cTitle$
  219.                                        Str_Title$ = Str_CatData$
  220.                                    Case Split(cGenre$, "|")(0), Split(cGenre$, "|")(1)                 '  //  "©gen|gnre"
  221.                                        Str_Genre$ = Str_CatData$
  222.                                    Case cTrackNumber$
  223.                                        Str_TrackNumber$ = Str_CatData$
  224.                                    Case cDiskNumber$
  225.                                        Str_DiskNumber$ = Str_CatData$
  226.                                    Case cComposer$
  227.                                        Str_Composer$ = Str_CatData$
  228.                                    Case cEncoder$
  229.                                        Str_Encoder$ = Str_CatData$
  230.                                    Case cBPM$
  231.                                        Str_BPM$ = Str_CatData$
  232.                                    Case cCopyright$
  233.                                        Str_Copyright$ = Str_CatData$
  234.                                    Case cCompilation$
  235.                                        Str_Compilation$ = Str_CatData$
  236.                                    Case cArtwork$
  237.                                        Arr_Artwork = StrConv(Str_CatData$, vbFromUnicode)
  238.                                    Case cRatingAdvisory$
  239.                                        Str_RatingAdvisory$ = Str_CatData$
  240.                                    Case cGrouping$
  241.                                        Str_Grouping$ = Str_CatData$
  242.                                    Case cqq_stik$
  243.                                        Str_qq_stik$ = Str_CatData$
  244.                                    Case cPodcast$
  245.                                        Str_Podcast$ = Str_CatData$
  246.                                    Case cCategory$
  247.                                        Str_Category$ = Str_CatData$
  248.                                    Case cKeyword$
  249.                                        Str_Keyword$ = Str_CatData$
  250.                                    Case cPodcastURL$
  251.                                        Str_PodcastURL$ = Str_CatData$
  252.                                    Case cEpisodeGlobalUniqueID$
  253.                                        Str_EpisodeGlobalUniqueID$ = Str_CatData$
  254.                                    Case cDescription$
  255.                                        Str_Description$ = Str_CatData$
  256.                                    Case cStr_Lyrics$
  257.                                        Str_Lyrics$ = Str_CatData$
  258.                                    Case cTVNetworkName$
  259.                                        Str_TVNetworkName$ = Str_CatData$
  260.                                    Case cTVShowName$
  261.                                        Str_TVShowName$ = Str_CatData$
  262.                                    Case cTVEpisodeNumber$
  263.                                        Str_TVEpisodeNumber$ = Str_CatData$
  264.                                    Case cTVSeason$
  265.                                        Str_TVSeason$ = Str_CatData$
  266.                                    Case cTVEpisode$
  267.                                        Str_TVEpisode$ = Str_CatData$
  268.                                    Case cPurchaseDate$
  269.                                        Str_PurchaseDate$ = Str_CatData$
  270.                                    Case cGaplessPlayback$
  271.                                        Str_GaplessPlayback$ = Str_CatData$
  272.                                End Select
  273.                            End If
  274.                        ElseIf Str_CatNow$ = "----" Then
  275.                            lng_Pos& = GetStrFromNumFile&(int_FF%, lng_Pos& - 8, Str_DataPos$)
  276.                            lng_Pos& = lng_Pos& + StringToLong&(Str_DataPos$) - lng_lAtom&
  277.                        End If
  278.                    Loop
  279.                    Priv_ItsOkFormat = True
  280.                End If
  281.            End If
  282.        End If
  283.    End If
  284.    Close int_FF%
  285. End Property
  286.  
  287. Public Property Get ItsOkFormat() As Boolean
  288.    ItsOkFormat = Priv_ItsOkFormat
  289. End Property
  290.  
  291. Public Property Get This_File() As String
  292.    This_File = Str_File$
  293. End Property
  294.  
  295. Public Property Get Album() As String
  296.    Album = Str_Album
  297. End Property
  298. Public Property Get Artist() As String
  299.    Artist = Str_Artist
  300. End Property
  301. Public Property Get AlbumArtist() As String
  302.    AlbumArtist = Str_AlbumArtist
  303. End Property
  304. Public Property Get Comment() As String
  305.    Comment = Str_Comment
  306. End Property
  307. Public Property Get Year() As String
  308.    Year = Str_Year
  309. End Property
  310. Public Property Get Title() As String
  311.    Title = Str_Title
  312. End Property
  313. Public Property Get Genre() As String
  314.    Genre = Str_Genre
  315. End Property
  316. Public Property Get TrackNumber() As String
  317.    TrackNumber = Str_TrackNumber
  318. End Property
  319. Public Property Get DiskNumber() As String
  320.    DiskNumber = Str_DiskNumber
  321. End Property
  322. Public Property Get Composer() As String
  323.    Composer = Str_Composer
  324. End Property
  325. Public Property Get Encoder() As String
  326.    Encoder = Str_Encoder
  327. End Property
  328. Public Property Get BPM() As String
  329.    BPM = Str_BPM
  330. End Property
  331. Public Property Get Copyright() As String
  332.    Copyright = Str_Copyright
  333. End Property
  334. Public Property Get Compilation() As String
  335.    Compilation = Str_Compilation
  336. End Property
  337. Public Property Get Artwork() As Byte()
  338.    Artwork = Arr_Artwork
  339. End Property
  340. Public Property Get ArtworkFormat() As String
  341.    ArtworkFormat = Str_ArtworkFormat
  342. End Property
  343. Public Property Get RatingAdvisory() As String
  344.    RatingAdvisory = Str_RatingAdvisory
  345. End Property
  346. Public Property Get Grouping() As String
  347.    Grouping = Str_Grouping
  348. End Property
  349. Public Property Get qq_stik() As String
  350.    qq_stik = Str_qq_stik
  351. End Property
  352. Public Property Get Podcast() As String
  353.    Podcast = Str_Podcast
  354. End Property
  355. Public Property Get Category() As String
  356.    Category = Str_Category
  357. End Property
  358. Public Property Get Keyword() As String
  359.    Keyword = Str_Keyword
  360. End Property
  361. Public Property Get PodcastURL() As String
  362.    PodcastURL = Str_PodcastURL
  363. End Property
  364. Public Property Get EpisodeGlobalUniqueID() As String
  365.    EpisodeGlobalUniqueID = Str_EpisodeGlobalUniqueID
  366. End Property
  367. Public Property Get Description() As String
  368.    Description = Str_Description
  369. End Property
  370. Public Property Get Lyrics() As String
  371.    Lyrics = Str_Lyrics
  372. End Property
  373. Public Property Get TVNetworkName() As String
  374.    TVNetworkName = Str_TVNetworkName
  375. End Property
  376. Public Property Get TVShowName() As String
  377.    TVShowName = Str_TVShowName
  378. End Property
  379. Public Property Get TVEpisodeNumber() As String
  380.    TVEpisodeNumber = Str_TVEpisodeNumber
  381. End Property
  382. Public Property Get TVSeason() As String
  383.    TVSeason = Str_TVSeason
  384. End Property
  385. Public Property Get TVEpisode() As String
  386.    TVEpisode = Str_TVEpisode
  387. End Property
  388. Public Property Get PurchaseDate() As String
  389.    PurchaseDate = Str_PurchaseDate
  390. End Property
  391. Public Property Get GaplessPlayback() As String
  392.    GaplessPlayback = Str_GaplessPlayback
  393. End Property
  394.  
  395.  
  396. 'Public Property Let Album(ByVal vData As String)
  397. 'Public Property Let Artist(ByVal vData As String)
  398. 'Public Property Let AlbumArtist(ByVal vData As String)
  399. 'Public Property Let Comment(ByVal vData As String)
  400. 'Public Property Let Year(ByVal vData As String)
  401. 'Public Property Let Title(ByVal vData As String)
  402. 'Public Property Let Genre(ByVal vData As Integer)
  403. 'Public Property Let TrackNumber(ByVal vData As Integer)
  404. 'Public Property Let DiskNumber(ByVal vData As Integer)
  405. 'Public Property Let Composer(ByVal vData As String)
  406. 'Public Property Let Encoder(ByVal vData As String)
  407. 'Public Property Let BPM(ByVal vData As Integer)
  408. 'Public Property Let Copyright(ByVal vData As String)
  409. 'Public Property Let Compilation(ByVal vData As Integer)
  410. 'Public Property Let Artwork(ByRef vData() As Byte)
  411. '   //  Public Property Let ArtworkFormat(ByRef vData As String)
  412. 'Public Property Let RatingAdvisory(ByVal vData As Integer)
  413. 'Public Property Let Grouping(ByVal vData As String)
  414. 'Public Property Let qq_stik(ByVal vData As Integer)
  415. 'Public Property Let Podcast(ByVal vData As Integer)
  416. 'Public Property Let Category(ByVal vData As String)
  417. 'Public Property Let Keyword(ByVal vData As String)
  418. 'Public Property Let PodcastURL(ByVal vData As Integer)
  419. 'Public Property Let EpisodeGlobalUniqueID(ByVal vData As Integer)
  420. 'Public Property Let Description(ByVal vData As String)
  421. 'Public Property Let Lyrics(ByVal vData As String)
  422. 'Public Property Let TVNetworkName(ByVal vData As String)
  423. 'Public Property Let TVShowName(ByVal vData As String)
  424. 'Public Property Let TVEpisodeNumber(ByVal vData As String)
  425. 'Public Property Let TVSeason(ByVal vData As Integer)
  426. 'Public Property Let TVEpisode(ByVal vData As Integer)
  427. 'Public Property Let PurchaseDate(ByVal vData As String)
  428. 'Public Property Let GaplessPlayback(ByVal vData As Integer)
  429.  
  430.  

Ejemplo de uso:

Código
  1.  
  2.  
  3. Option Explicit
  4. Option Base 0
  5.  
  6. Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
  7.  
  8. Sub main()
  9. Dim clsFM4A         As Cls_FormatM4A
  10. Dim StrDir          As String
  11. Dim int_FF          As Integer
  12.  
  13.    Set clsFM4A = New Cls_FormatM4A
  14.    With clsFM4A
  15.  
  16.        .This_File = App.Path & "\SCGJ.m4a"
  17.  
  18.        If .ItsOkFormat Then
  19.  
  20.            StrDir$ = Replace$("c:\Musica\" & .Artist & "\" & .Year & "-" & .Album & "\", "\\", "\")
  21.            Call MakeSureDirectoryPathExists(StrDir$)
  22.  
  23.            '   //  extraemos la Imagen Cover
  24.            int_FF% = FileSystem.FreeFile%
  25.            Open StrDir & .Artist & " - " & .Title & "." & .ArtworkFormat For Binary As int_FF%
  26.                Put int_FF%, , .Artwork
  27.            Close int_FF%
  28.  
  29.            '   //  Extraemos la lirica del archivo
  30.            int_FF% = FileSystem.FreeFile%
  31.            Open StrDir & .Artist & " - " & .Title & ".txt" For Binary As int_FF%
  32.                Put int_FF%, , .Lyrics
  33.            Close int_FF%
  34.  
  35.        End If
  36.    End With
  37.    Set clsFM4A = Nothing
  38.  
  39. End Sub
  40.  
  41.  

Dulce Infierno Lunar!¡.
76  Programación / Programación Visual Basic / [RETO] Cuadrado Numerico en forma de "¬" en: 17 Septiembre 2010, 23:04 pm
.
Lo vi por Aquí(Enlace) y me parecio buena idea publicarlo aquí y ver que otras maneras hay de hacer esto...

Generar un cuadrado numerico que se le ingrese un numero por ejemplo

 * La funcion final debera devolver un Array tipo Long.
 * Despues se leera dicho array y se creara un String que devuelva el contenido (En el Formato Propuesto).

Se ingresa 10 y se construye el siguiente cuadrado numerico

Código:

001 002 003 004 005 006 007 008 009 010
020 021 022 023 024 025 026 027 028 011
037 038 039 040 041 042 043 044 029 012
052 053 054 055 056 057 058 045 030 013
065 066 067 068 069 070 059 046 031 014
076 077 078 079 080 071 060 047 032 015
085 086 087 088 081 072 061 048 033 016
092 093 094 089 082 073 062 049 034 017
097 098 095 090 083 074 063 050 035 018
100 099 096 091 084 075 064 051 036 019


Se ingrese 20 y da como resultado

Código:

001 002 003 004 005 006 007 008 009 010 011 012 013 014 015 016 017 018 019 020
040 041 042 043 044 045 046 047 048 049 050 051 052 053 054 055 056 057 058 021
077 078 079 080 081 082 083 084 085 086 087 088 089 090 091 092 093 094 059 022
112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 095 060 023
145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 129 096 061 024
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 161 130 097 062 025
205 206 207 208 209 210 211 212 213 214 215 216 217 218 191 162 131 098 063 026
232 233 234 235 236 237 238 239 240 241 242 243 244 219 192 163 132 099 064 027
257 258 259 260 261 262 263 264 265 266 267 268 245 220 193 164 133 100 065 028
280 281 282 283 284 285 286 287 288 289 290 269 246 221 194 165 134 101 066 029
301 302 303 304 305 306 307 308 309 310 291 270 247 222 195 166 135 102 067 030
320 321 322 323 324 325 326 327 328 311 292 271 248 223 196 167 136 103 068 031
337 338 339 340 341 342 343 344 329 312 293 272 249 224 197 168 137 104 069 032
352 353 354 355 356 357 358 345 330 313 294 273 250 225 198 169 138 105 070 033
365 366 367 368 369 370 359 346 331 314 295 274 251 226 199 170 139 106 071 034
376 377 378 379 380 371 360 347 332 315 296 275 252 227 200 171 140 107 072 035
385 386 387 388 381 372 361 348 333 316 297 276 253 228 201 172 141 108 073 036
392 393 394 389 382 373 362 349 334 317 298 277 254 229 202 173 142 109 074 037
397 398 395 390 383 374 363 350 335 318 299 278 255 230 203 174 143 110 075 038
400 399 396 391 384 375 364 351 336 319 300 279 256 231 204 175 144 111 076 039



Edito:

Estos Son mis Dos Codigos (Con una Sola Matriz Unidimensional xD):

 * Sin Calculo de Espacio...
Mod_Main Generate Rentangle.bas

 * Implementando Espacio Implementado...
Mod_Main Generate Rentangle V2.bas

Dulces Lunas!¡.
77  Programación / Programación Visual Basic / Fndo AutoRedraw: CreateWindowsEx en: 15 Septiembre 2010, 03:47 am
.
Buenas alguien me podria decir que Constante hay que pasarle a CreateWindowsEx o con SetWindowLong al Handle de una Ventana X.

Dulces Lunas!¡.
78  Foros Generales / Foro Libre / (15 de Septiembre) Solo Mexicanos!¡. en: 8 Septiembre 2010, 08:43 am

Esto me allegado hoy a mi correo!¡.

y pues como lo ando sirculando ya sabran mi opinion al respecto!¡.

No deseo armar polemica, solo es para compartir!¡.





SÍ ESTÁS DE ACUERDO, CIRCÚLALA


Este 15 de Sep. No va a haber grito, va a haber silencio, por
México.
 
Hagamos algo con verdadero valor para México, algo que de verdad demuestre que estamos unidos, y en desacuerdo con la manera de combatir la inseguridad.
 
Este 15 y 16 de septiembre démosle la espalda a nuestros gobernantes.
 
Dejemos que ellos solo celebren las fiestas patrias, ellos sí tienen que festejar.
 
Que por primera vez en la historia de este país, el grito de
independencia y libertad sea un gran silencio de inconformidad y disgusto.
 
Que sientan los principales líderes y mandatarios de este país que nosotros también podemos darles la espalda.
 
Esto es lo que mueve, esto es lo que hace reaccionar, esto es saber que es tener a un país secuestrado, vivimos a la zozobra, entre rejas en nuestros hogares y comercios, con blindajes de todo tipo.
 
No estamos en tiempos de decir VIVA MÉXICO, ni de festejar nada, ni de ir aplaudirle al Ejercito, ni a al Mandatario, Gobernante en turno, que no han podido controlar ni darnos bienestar. Ni mucho menos seguridad que es lo mínimo que deben hacer, para eso se funda el estado.
   
Así que propongo que este 15 de Septiembre no haya grito sino un gran silencio de enojo y reclamo.
 
Dejemos solos a los gobernadores, al (los) mandatario (s) en sus respectivas plazas, que le den su grito al aire y a su familia y equipo de trabajo, que se lo crean ellos, no nos han servido absolutamente para nada, si se fijan sólo han aprobado las reformas que a ellos convienen ya sea para recibir más apoyos y/o votos.
 
Únete de verdad a este movimiento histórico por el bien de tu familia, de tu comunidad, de tu estado, de tu vida y del país en que vivimos todos.
   
Este 15 de Sep. No va a haber grito, va a haber silencio, por
México.
Demos el grito y festejemos (si hay algo que festejar) en nuestras casas con amigos y familiares y al desfile ni pararnos por ahí, los reconocimientos que hemos recibido últimamente son un par de medallas olímpicas y el primer lugar en secuestros ¡que lo festejen ellos!
 
LAS DIZQUE AUTORIDADES DEBERÍAN DE TENER MIEDO AL PUEBLO,NO EL PUEBLO A UNA BOLA DE RATAS, CORRUPTOS QUE SOLO VELAN POR SUS INTERESES 'HAY QUE APOYAR, ES MOMENTO DE HACER ALGO'.
 
¡VIVA MÉXICO!, sólo que sin las farsas de los gobernantes y su grito de independencia en las diferentes plazas cívicas de todo el país.




Dulce Infierno Lunar!¡.
79  Seguridad Informática / Análisis y Diseño de Malware / [Src] Spy Net 2.7 Beta en: 28 Agosto 2010, 02:19 am
.
Por hay me encontre esto...

Descargar Source

Nota: Esta en Delphi

Dulces Lunas!¡.
80  Media / Juegos y Consolas / [Retos] Age Of Empires II The Conquerors 1.0 en: 27 Agosto 2010, 21:52 pm
.
Bueno me acabe de reinstalar este juego pues la verdad quisiera jugar, alguien se anima?

OJO:-> La version 1.0!¡.

VPN por ---> Hamachi

Dulces Lunas!¡.
Páginas: 1 2 3 4 5 6 7 [8] 9 10 11 12 13 14
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines