Keskustelu: Ohjelmointikysymykset: VB.NET: Resurssin lisääminen ohjelmallisesti?

Rox [15.10.2013 23:45:19]

Eli, oon yrittänyt tässä jo jonkun aikaa lisätä uuden resurssin ohjelmallisesti, käyttäen Visual Basic.NETiä. Eli; oon nyt saanut aikaan sen että pakkaan/kompressoin kuvan(bmp), ja nyt yritän lisätä sitä PE-tiedoston resursseihin, ja jäin jumiin virheeseen:

lainaus:

Value of type 'System.Drawing.Bitmap' cannot be converted to '1-dimensional array of System.Drawing.Bitmap'

Ja tässä pseudokoodi:

Module1:

Imports System.Runtime.InteropServices
Module ResourceWriter
    Private Function ToPtr(ByVal data As Object) As IntPtr
        Dim h As GCHandle = GCHandle.Alloc(data, GCHandleType.Pinned)
        Dim ptr As IntPtr
        Try
            ptr = h.AddrOfPinnedObject()
        Finally
            h.Free()
        End Try
        Return ptr

    End Function

    <DllImport("kernel32.dll", SetLastError:=True)> _
    Private Function UpdateResource(ByVal hUpdate As IntPtr, ByVal lpType As String, ByVal lpName As String, ByVal wLanguage As UShort, ByVal lpData As IntPtr, ByVal cbData As UInteger) As Boolean
    End Function
    <DllImport("kernel32.dll", SetLastError:=True)> _
    Private Function BeginUpdateResource(ByVal pFileName As String, <MarshalAs(UnmanagedType.Bool)> ByVal bDeleteExistingResources As Boolean) As IntPtr
    End Function
    <DllImport("kernel32.dll", SetLastError:=True)> _
    Private Function EndUpdateResource(ByVal hUpdate As IntPtr, ByVal fDiscard As Boolean) As Boolean
    End Function

    Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap()) As Boolean

        Try
            Dim handle As IntPtr = BeginUpdateResource(filename, False)
            Dim file1 As Bitmap() = bmp
            Dim fileptr As IntPtr = ToPtr(file1)
            Dim res As Boolean = UpdateResource(handle, "BitMaps", "0", 0, fileptr, Convert.ToUInt32(file1.Length))
            EndUpdateResource(handle, False)
        Catch ex As Exception
            Return False
        End Try
        Return True

    End Function
End Module

Formi, buttonin alla:

'...
Dim bmp1 As Bitmap = Compressed
WriteResource("C:\Users\Admin\Desktop\file.exe", bmp1)

Eikä luonnistu. Tajusin jo siis sen etten voi sitä noin sinne resursseihin laittaa, enkä saanut sitä käännettyä byte arrayksi taikka memorystreamiksi niin että se jopa toimisi. Tässä vielä yksi koodinpätkä mitä yritin, saamatta mitään kuitenkaan aikaan:

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        '... Moduuli vaihdetty tähän sopivaksi, eli "As Bitmap()" -> As Byte()
        Dim bmp1 As Bitmap = Compressed
        Dim Converted = ConvertToByteArray(bmp1)
        WriteResource("C:\Users\Admin\Desktop\file.exe", Converted)
    End Sub
    Public Shared Function ConvertToByteArray(ByVal value As Bitmap) As Byte()
        Dim bitmapBytes As Byte()
        Using stream As New System.IO.MemoryStream
            value.Save(stream, value.RawFormat)
            bitmapBytes = stream.ToArray
        End Using
        Return bitmapBytes
    End Function

...Ja alkaa ideat loppua. Miten saan laitettua kuvan toisen ohjelman resursseihin, ilman sen pakatun kuvan tallentamista kovalevylle? En halua käyttää 'hallittuja' resursseja(managed resource).

Ideoita, vinkkejä, koodia... jotain ?

jalski [16.10.2013 08:01:40]

Rox kirjoitti:

Eikä luonnistu. Tajusin jo siis sen etten voi sitä noin sinne resursseihin laittaa, enkä saanut sitä käännettyä byte arrayksi taikka memorystreamiksi niin että se jopa toimisi. Tässä vielä yksi koodinpätkä mitä yritin, saamatta mitään kuitenkaan aikaan:

Tallenna kuva streamiksi, konvertoi byte arrayksi ja kirjoittele sieltä?

Alla esimerkkinä vanha Component Pascalilla kirjoiteltu koodin pätkä, jota käytin joskus kuvatiedostoista koostettujen animoitujen GIF-tiedostojen kirjoitteluun Fortran ohjelmasta.

MODULE AnimGif;


IMPORT
  Sys := "[mscorlib]System",
  IO := "[mscorlib]System.IO",
  Cpm := "[system]System.ComponentModel",
  Wfm := "[system.windows.forms]System.Windows.Forms",
  Drw := "[system.drawing]System.Drawing",
  Im  := "[system.drawing]System.Drawing.Imaging",
  RTS;


TYPE
  AnimatedGif* = POINTER TO RECORD
    files*: POINTER TO ARRAY OF Sys.String;
    delay*: INTEGER (* delay in 1/100 s *)
  END;


PROCEDURE ValidateImagefile*(IN filepath: Sys.String): BOOLEAN;
VAR
  NativeType: RTS.NativeType;
  NativeTypeName: Sys.String;
  image: Drw.Image;

BEGIN
  image := Drw.Bitmap.FromFile(filepath);
  RETURN TRUE;

  RESCUE (exc)
    NativeType := TYPEOF(exc);
    NativeTypeName := MKSTR(RTS.TypeName(NativeType)^);
    IF NativeTypeName = "System.OutOfMemoryException" THEN
      RETURN FALSE
    ELSE
      THROW (exc)
    END
END ValidateImagefile;


PROCEDURE (gif: AnimatedGif) ScanImages*(IN dirpath: Sys.String; IN filter: Sys.String), NEW;

VAR
  NativeType: RTS.NativeType;
  NativeTypeName: Sys.String;
  rslt: Wfm.DialogResult;

  PROCEDURE sort(VAR a: ARRAY OF Sys.String);
  VAR
    i, j: INTEGER;
    s: Sys.String;

  BEGIN
    FOR i := 1 TO LEN(a)-1 DO
      s := a[i];
      j := i;
      WHILE (j > 0) & (a[j-1] > s) DO
        a[j] := a[j-1];
        DEC(j)
      END;
      a[j] := s
    END
  END sort;


BEGIN
  gif.files := IO.Directory.GetFiles(dirpath, filter);
  IF LEN(gif.files) > 0 THEN sort(gif.files) END;

  RESCUE (exc)
    NativeType := TYPEOF(exc);
    NativeTypeName := MKSTR(RTS.TypeName(NativeType)^);
    IF NativeTypeName = "System.IO.IOException" THEN
      rslt := Wfm.MessageBox.Show("Path: " + dirpath + " is a filename.",
                "Error", Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Error)
    ELSIF NativeTypeName = "System.IO.DirectoryNotFoundException" THEN
      rslt := Wfm.MessageBox.Show("Path: " + dirpath + " not found.",
                "Error", Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Error)
    ELSE
      THROW (exc)
    END
END ScanImages;


PROCEDURE (gif: AnimatedGif) Output*(IN target: Sys.String), NEW;
VAR
  NativeType: RTS.NativeType;
  NativeTypeName: Sys.String;
  rslt: Wfm.DialogResult;

  i: INTEGER;
  memStream: IO.MemoryStream;
  binWriter: IO.BinaryWriter;
  image: Drw.Image;
  wstream: IO.FileStream;
  buf1: POINTER TO ARRAY OF UBYTE;
  buf2: POINTER TO ARRAY OF UBYTE;
  buf3: POINTER TO ARRAY OF UBYTE;

BEGIN
  IF LEN(gif.files) = 0 THEN
    RETURN
  ELSE
    FOR i := 0 TO LEN(gif.files)-1 DO
      IF ~IO.File.Exists(gif.files[i]) THEN
        rslt := Wfm.MessageBox.Show("File: " + gif.files[i] + " not found.", "Error",
                  Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Error);
        RETURN
      END;
      IF ~ValidateImagefile(gif.files[i]) THEN
        rslt := Wfm.MessageBox.Show("File: " + gif.files[i] + " is not a valid image.", "Error",
                  Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Error);
        RETURN
      END
    END;
    IF IO.File.Exists(target) THEN
      rslt := Wfm.MessageBox.Show("File: " + target + " already exists, overwrite?",
                "File already exists", Wfm.MessageBoxButtons.YesNo,
                Wfm.MessageBoxIcon.Question);
      IF rslt = Wfm.DialogResult.No THEN
        RETURN
      ELSE
        IO.File.Delete(target)
      END
    END
  END;

  NEW(memStream);
  NEW(buf2,19);
  NEW(buf3,8);

  buf2[0] := 33;  (*extension introducer*)
  buf2[1] := 255; (*application extension*)
  buf2[2] := 11;  (*size of block*)
  buf2[3] := 78;  (*N*)
  buf2[4] := 69;  (*E*)
  buf2[5] := 84;  (*T*)
  buf2[6] := 83;  (*S*)
  buf2[7] := 67;  (*C*)
  buf2[8] := 65;  (*A*)
  buf2[9] := 80;  (*P*)
  buf2[10] := 69; (*E*)
  buf2[11] := 50; (*2*)
  buf2[12] := 46; (*.*)
  buf2[13] := 48; (*0*)
  buf2[14] := 3;  (*size of block*)
  buf2[15] := 1;  (**)
  buf2[16] := 0;  (**)
  buf2[17] := 0;  (**)
  buf2[18] := 0;  (*Block terminator*)

  buf3[0] := 33;  (*extension introducer*)
  buf3[1] := 249; (*Graphic control extension*)
  buf3[2] := 4;   (*size of block*)
  buf3[3] := 8;   (*no transparency*)
  buf3[4] := USHORT(ORD(BITS(gif.delay)*BITS(0FFH))); (*Delay time low byte*)
  buf3[5] := USHORT(ASH(ORD(BITS(gif.delay)*BITS(0FF00H)),-16)); (*Delay time high byte*)
  buf3[6] := 0; (*no transparency*)
  buf3[7] := 0; (*Block terminator*)

  wstream := IO.FileStream.init(target, IO.FileMode.Create);
  binWriter := IO.BinaryWriter.init(wstream);

  FOR i:=0 TO (LEN(gif.files)-1) BY 1 DO
    image := Drw.Bitmap.FromFile(gif.files[i]);
    image.Save(memStream, Im.ImageFormat.get_Gif());
    buf1 := memStream.ToArray();

    IF i = 0 THEN
      binWriter.Write(buf1,0,781);   (*Header & global color table*)
      binWriter.Write(buf2, 0, 19)   (*Application extension*)
    END;

    binWriter.Write(buf3, 0, 8);                    (*Graphic extension*)
    binWriter.Write(buf1, 789, LEN(buf1) - 790);    (*Image data*)

    IF i = (LEN(gif.files)-1) THEN
      binWriter.Write(";")   (*Image terminator*)
    END;

    memStream.SetLength(0);

  END;

    binWriter.Close();

    rslt := Wfm.MessageBox.Show("Wrote " + Sys.Convert.ToString(LEN(gif.files)) + " images into animated GIF file: "
            + target, "Success", Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Information);

  RESCUE (exc)
    NativeType := TYPEOF(exc);
    NativeTypeName := MKSTR(RTS.TypeName(NativeType)^);
    IF NativeTypeName = "System.IO.DirectoryNotFoundException" THEN
      rslt := Wfm.MessageBox.Show("Output directory in path: " + target + " not found.",
                "Error", Wfm.MessageBoxButtons.OK, Wfm.MessageBoxIcon.Error)
    ELSE
      THROW (exc)
    END

END Output;


PROCEDURE WriteAnimatedGif*(IN sourcedir: Sys.String; IN filter:Sys.String; delay: INTEGER; IN odir: Sys.String; IN ofile: Sys.String);
VAR
  agif: AnimatedGif;

BEGIN
  NEW(agif);
  agif.delay := delay;
  agif.ScanImages(sourcedir, filter);
  agif.Output(odir + "\" + ofile)
END WriteAnimatedGif;


END AnimGif.

Käyttö FTN95 Fortranilla tapahtui siis:

module UseAnimGif
  implicit none

  ! Methods for Object "AnimGif.AnimatedGif"
  ASSEMBLY_EXTERNAL(name="AnimGif.AnimatedGif.ScanImages") ScanImages
  ASSEMBLY_EXTERNAL(name="AnimGif.AnimatedGif.Output") OutAnimGIF

end module UseAnimGif


winapp
  use UseAnimGif
  implicit none

  object("AnimGif.AnimatedGif") :: agif
  object("System.String[]") source

  source = new@("System.String[]",5)
  source(0) = "in\e.jpg"
  source(1) = "in\d.jpg"
  source(2) = "in\c.jpg"
  source(3) = "in\b.jpg"
  source(4) = "in\a.jpg"

  !AnimGif.AnimatedGif object can be used like a user defined type
  agif = new@("AnimGif.AnimatedGif")  ! Allocate new AnimatedGif object
  agif%delay = 100  ! Set animation delay in 1/100 s
  agif%files = source  ! Set source image files
  call OutAnimGIF(agif, 'out\testi1.gif')   ! Output animated GIF

  ! Scan directory for image files, sort them alphabetically and output animated gif
  call ScanImages(agif, 'in', '*.jpg')
  call OutAnimGIF(agif, 'out\testi2.gif')
end

Hennkka [16.10.2013 10:29:20]

Rox kirjoitti:

lainaus:

Value of type 'System.Drawing.Bitmap' cannot be converted to '1-dimensional array of System.Drawing.Bitmap'
Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap()) As Boolean
    ' --
End Function
Dim bmp1 As Bitmap = Compressed
WriteResource("C:\Users\Admin\Desktop\file.exe", bmp1)

No ainakin virheesi johtuu siitä, että funktiosi WriteResource tahtoo sisällensä Bitmap-taulukon, mutta tarjoat sille pelkkää Bitmapia.
Näin saat muutettua yksittäisen Bitmapin taulukoksi:

WriteResource("C:\Users\Admin\Desktop\file.exe", New Bitmap() {bmp1})

Toinen vaihtoehto voi tietenkin olla, että funktiosi määrittely on väärin, jolloin siellä on ylimääräiset sulut ja funktio menisi tähän tapaan:

Imports System.Runtime.InteropServices
Module ResourceWriter
    ' --
    Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap) As Boolean
        ' --
        Dim file1 As Bitmap = bmp
        ' --
    End Function
End Module

Rox [16.10.2013 12:23:17]

jalski kirjoitti:

Rox kirjoitti:

Eikä luonnistu. Tajusin jo siis sen etten voi sitä noin sinne resursseihin laittaa, enkä saanut sitä käännettyä byte arrayksi taikka memorystreamiksi niin että se jopa toimisi. Tässä vielä yksi koodinpätkä mitä yritin, saamatta mitään kuitenkaan aikaan:

Tallenna kuva streamiksi, konvertoi byte arrayksi ja kirjoittele sieltä?

Taitaa olla just tämä kohta missä tökkii, vaikkei kovin vaikea pitäis olla. Eli jos joku viittis pienen esimerkin näyttää miten tämä tapahtuu niin se olis ihan jees..

Hennkka kirjoitti:

Rox kirjoitti:
lainaus:

Value of type 'System.Drawing.Bitmap' cannot be converted to '1-dimensional array of System.Drawing.Bitmap'
Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap()) As Boolean
    ' --
End Function
Dim bmp1 As Bitmap = Compressed
WriteResource("C:\Users\Admin\Desktop\file.exe", bmp1)
No ainakin virheesi johtuu siitä, että funktiosi WriteResource tahtoo sisällensä Bitmap-taulukon, mutta tarjoat sille pelkkää Bitmapia.
Näin saat muutettua yksittäisen Bitmapin taulukoksi:
WriteResource("C:\Users\Admin\Desktop\file.exe", New Bitmap() {bmp1})
Toinen vaihtoehto voi tietenkin olla, että funktiosi määrittely on väärin, jolloin siellä on ylimääräiset sulut ja funktio menisi tähän tapaan:
Imports System.Runtime.InteropServices
Module ResourceWriter
    ' --
    Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap) As Boolean
        ' --
        Dim file1 As Bitmap = bmp
        ' --
    End Function
End Module

Koitin tuota jo ennenkuin postasin, ei toimi ei.

Edit: Tässä vielä mitä äsken koitin, kuitenkaan toimimatta..

Kuva 1
Kuva 2

Hennkka [16.10.2013 21:26:44]

Kannattaa miettiä, mitkä parametrit ovat järjellisiä tuolle funktiolle. Jos sillä kirjoitetaan aina tasan yksi kuva tiedostoon, niin tietenkin parametrin kuuluu olla kuva eikä taulukollinen kuvia tai tavuja! Tässä koodi, jolla sain lisättyä kuvia exe-tiedostoon (tosin ResEdit ei tunnistanut niitä kuvista, liekö sitten väärä sijainti ja/tai muoto). Saat itse pähkäillä oikean tallennusmuodon ja paikan. Vihjeenä voinen sanoa, että kannattaa tutustua MAKEINTRESOURCE makroon sekä joihinkin sen vakioihin.

Public Function WriteResource(ByVal filename As String, ByVal bmp As Bitmap) As Boolean
    Try
        Dim handle As IntPtr = BeginUpdateResource(filename, False)

        ' Tiedostona otsikoineen
        Dim ms As New MemoryStream
        bmp.Save(ms, ImageFormat.Bmp)
        ms.Position = 0
        Dim msDataPtr As IntPtr = Marshal.AllocHGlobal(CInt(ms.Length))
        Marshal.Copy(ms.ToArray(), 0, msDataPtr, ms.Length)
        Dim res1 As Boolean = UpdateResource(handle, "BitMaps1", "0", 0, msDataPtr, Convert.ToUInt32(ms.Length))
        Marshal.FreeHGlobal(msDataPtr)

        ' Vain pikselidata
        Dim bmpData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), Imaging.ImageLockMode.ReadOnly, bmp.PixelFormat)
        Dim bmpDataPtr As IntPtr = bmpData.Scan0
        Dim res2 As Boolean = UpdateResource(handle, "BitMaps2", "0", 0, bmpDataPtr, Convert.ToUInt32(bmpData.Height * bmpData.Stride))

        EndUpdateResource(handle, False)
    Catch ex As Exception
        Return False
    End Try
    Return True
End Function

Rox [16.10.2013 22:16:49]

Hennkka kirjoitti:

...

Kiitosta! Toimii täydellisesti. Joo, C++:ssa on tullut tutustuttua MAKEINTRESOURCE makroon, mutta jostain syystä ei VB:llä luonnistunut. Kiitos! :)

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät