VB 5/6-Tipp 0268: Datei binär öffnen in ein Byte-Array ablegen und abspeichern

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei PROJECT1.VBP -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Bildfeld-Steuerelement "Picture1"
' Steuerelement: Schaltfläche "Command3"
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Schaltfläche "Command1"

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias _
        "RtlMoveMemory" (lpTo As Any, lpFrom As Any, _
        ByVal lLen As Long)
       
Dim B() As Byte

Private Sub Command1_Click()
  Dim aa$, l&
    
    Command1.Enabled = False
    'Einlesen als String
    Open App.Path & "\Original.gif" For Binary As #1
      aa = Input(LOF(1), #1)
    Close 1
    
    'Umwandeln des Strings in ein ByteArray
    l = Len(aa) - 1
    ReDim B(0 To l)
    Call CopyMemory(B(0), ByVal aa, l + 1)
    Command2.Enabled = True
End Sub

Private Sub Command2_Click()
  Command2.Enabled = False
  'Das Array binär abspeichern
  Open App.Path & "\Kopie.gif" For Binary Access Write As #1
    Put #1, , B()
  Close #1
  Command3.Enabled = True
End Sub

Private Sub Command3_Click()
  Command3.Enabled = False
  Picture1.Picture = LoadPicture(App.Path & "\Kopie.gif")
  Command1.Enabled = True
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei PROJECT1.VBP --------------

Kommentar von Joseph Banholzer am 02.02.2010 um 08:02

Hallo zusammen
Als Infu, damit andere auch einen Nutzen davon haben:

Es funktioniert endlich mit:

Auszug aus dem Code:

Dim myArr() As Byte

  ' Filialinformationen

  Set adoFil = CreateObject("ADODB.Connection")
  adoFil.Provider = "ADSDSOObject"
  adoFil.Open

  Set RsFil = adoFil.Execute("<LDAP://DC=ch/DC=meineDomain/OU=Email Recipients/OU=Telefonbuch/OU=filialinfo>;(&(objectClass=contact)(physicalDeliveryOfficeName=" & Schnittstelle & "));ADsPath;SubTree")

  'Loop till all objects are imported. Darf eigentlich nur 1 User kommen, da Filter auf physicalDeliveryOfficeName
  RsFil.MoveFirst
  
  FilialAdsPath = RsFil.Fields.Item("ADsPath").Value
  
  Set objFil = GetObject(FilialAdsPath)
  
  RsFil.Close
  adoFil.Close
  
     
  On Error Resume Next
  myArr = objFil.thumbnailPhoto




'***************************************************************************************************
'Logo Laden
'***************************************************************************************************
  
  On Error Goto no_logo
  
  Dim MS As New memoryStream
  
  Open MS For Binary Access Write As #1
  Put #1, , myArr()
  Close #1
    
  
    
  If ActiveDocument.FormFields("logo").Enabled Then
 
    
  ' Logo erste Seite
  Selection.Goto What:=wdGoToBookmark, Name:="logo"
  Selection.InlineShapes.AddPicture FileName:=MS, _
  LinkToFile:=False, SaveWithDocument:=True
  ActiveDocument.FormFields("logo").Enabled = False

      
  ' Logo zweite Seite


  Selection.Goto What:=wdGoToBookmark, Name:="logo2"
  Selection.InlineShapes.AddPicture FileName:=MS, _
  LinkToFile:=False, SaveWithDocument:=True
  ActiveDocument.FormFields("logo2").Enabled = False
      
      
  'Logo dritte Seite

  Selection.Goto What:=wdGoToBookmark, Name:="logo3"
  Selection.InlineShapes.AddPicture FileName:=MS, _
  LinkToFile:=False, SaveWithDocument:=True
  ActiveDocument.FormFields("logo3").Enabled = False


  On Error Resume Next
  Selection.Goto What:=wdGoToBookmark, Name:="Start"
     
     
  
  End If

no_logo:
  Selection.Goto What:=wdGoToBookmark, Name:="Start"
  
  Set objUser = Nothing
  Set objFil = Nothing
  
  On Error Goto 0
  
End Sub

Grüsse
Bani58

Kommentar von Joseph banholzer am 01.02.2010 um 15:52

Hallo und guten Tag

Ich habe das Problem, dass ich in Word2000 per Makro JPG-Daten ab dem AD hole. Ich erhalte ein Array 0f Byte zurück. Ich wollte eigentlich diese Daten direkt in ein InlineShape übergeben. Anscheinend geht dies aber nicht. Ich brauche nun Ihr Beispiel wie folgt:
Im myArr stehen die JPG-Daten als ByteArray
Ich muss halt jetzt den Umweg über das speichern nehmen.

Dim LogoFile
LogoFile = strTempPfad & "\Filiallogo.jpg"

Open LogoFile For Binary Access Write As #1
Put #1, , myArr()
Close #1


If ActiveDocument.FormFields("logo").Enabled Then


' Logo erste Seite
Selection.GoTo What:=wdGoToBookmark, Name:="logo"
Selection.InlineShapes.AddPicture FileName:=LogoFile, _
LinkToFile:=False, SaveWithDocument:=True
ActiveDocument.FormFields("logo").Enabled = False

Danke für dieses Beispiel. Ich bin schon seit Wochen mit der Suche beschäftigt. Bis anhin hatte ich überhaupt keine Lösung.

Grüsse

J. Banholzer

Kommentar von Tobias Soltermann am 21.04.2006 um 16:50

Hallo.

Was macht man, wenn die Datei grösser als 35.536 KB (das ist as far as i know die Stringgrenze) ist?

Gruess, Tobias

Kommentar von Tiger am 04.04.2006 um 16:37

Hallo

wie kann ich aus einer Messwertedatei mit VB Splatenweise die werte einlesen und in verschiedenen Arrays ablegen
ZB:
12 14 2 3 5 ........
16 2.5 3 7 5.6......
19 1 5 8 9.5 ........
......................
.....................

vielen Dank im Voraus

Kommentar von Chris am 08.06.2005 um 18:54

Hallo mit welchem programm kann ich bin Dateien öffnen

Kommentar von ThomasK am 07.03.2005 um 03:03

Hm, gibt es da nicht einen besseren Ansatz als Input() und API-Call?

Hier ohne API:

Der folgende Code ist von irgendwoher gespeichert, also nicht von mir. Und es ist nur rudimentär zum Verständnis, man sollte auf jeden Fall prüfen ob die Datei schreibgeschützt ist vor dem Speichern usw.

' read
Dim file_name As String
Dim file_length As Long
Dim fnum As Integer
Dim bytes() As Byte

file_name = App.Path & "\" & Text1.Text
file_length = FileLen(file_name)

ReDim bytes(1 To file_length)

fnum = FreeFile
Open file_name For Binary As #fnum
Get #fnum, 1, bytes
Close fnum

' ...

' write
fnum = FreeFile
Open file_name For Binary As #fnum
Put #fnum, 1, bytes
Close fnum

Kommentar von Pawel am 04.12.2003 um 16:35

An Jacek

So einfach gehts:

Private Sub Button_Click()
Shell("D:\xxxx\yyy.exe")
End Sub

Oder mit ner API-Funktion, is aber in deinem Fall nicht nötig...

Pawel

Kommentar von Markus am 26.08.2003 um 21:39

Ähm,

also Binär einlesen würde ich ein wenig anders:
dim file as long
dim Buf() as byte
file = freefile
open "file" for binary as #file
redim Buf(lof(file)-1)
get #file,,buf

oder so ähnlich; hab grad keine ide ;(

Kommentar von Alex am 07.07.2002 um 00:16

Hi,
kennt jemand die API-Funktion, mit der man Gruppe von Zeichen in einer Datei löschen kann? Mit "reinen" VB-Befehlen muß man wohl immer den Umweg über das Einlesen in eine Variable gehen...

Kommentar von Andreas am 28.04.2002 um 21:26

ich würde gerne wissen wie ich dateien mit der endung .dcr öffnen kann. es wäre nett wenn mir jemand das sagen könnte

Kommentar von Dietrich am 19.04.2002 um 15:38

Mal eine blöde Frage:
Warum der Umweg über einen String?
B = InputB(LOF(1), #1)
... man beachte InputB !!
Dietrich

Kommentar von Uwe am 23.02.2002 um 22:59

Wie kann ich es erreichen, das aus dem String gewonnene Byte-Array direkt in eine PictureBox einzulesen, statt den Umweg über eine Datei zu gehen ?

Kommentar von Bernd am 31.10.2001 um 20:04

Wie kann man aus swf und dcr Dateien die Breite und Höhe auslesen und in Pixel umwandeln?
Bei swf Dateien stehen sie gleich in der 1. und am Anfang der 2.Zeile wenn man
die Datei im Hexeditor betrachtet.
(Ich habe leere Dateien unterschiedlicher Größe abgespeichert und dann verglichen.)
Also die position wäre nicht das Problem. Aber das Auslesen und Umwandeln. Da die Ausgabe in VB6 kein Problem ist. Aber die Spiele bzw Animationen unterschiedlich groß sind sähe es doch besser aus wenn die Ausgabe flexibel wäre!
Danke

Kommentar von a am 14.06.2001 um 14:04

s

Kommentar von Jacek am 28.05.2001 um 00:05

Hi
ich habe eine Frage an dich, die eigentlich ziemlich einfach ist aber ich erst einsteiger von visual basic bin.
Ich möchte mit einem Command Button eine exe datei öffnen.
Beispiel :
D:\xxxxx\yyy.exe
kannst du mir helfen?
Ciau