[VB6] SavePicture

Dieses Thema [VB6] SavePicture im Forum "Windows XP Forum" wurde erstellt von met, 16. Juni 2004.

Thema: [VB6] SavePicture Hallo, folgendes Programm will ich von Outlook ausführen lassen, wenn eine Nachricht mit dem Betreff Sende Daten...

  1. met
    met
    Hallo,
    folgendes Programm will ich von Outlook ausführen lassen, wenn eine Nachricht mit dem Betreff Sende Daten ankommt.

    Body ist z.B.:
    <CMD>
    dir > C:\Test.txt
    </CMD>

    <Screen>

    <Datei>C:\Test.txt</Datei>

    Wenn ich das Programm mit F8 ausführe (Schritt für Schritt) funkt alles einwandfrei, wenn ich es aber mit F5 ausführe oder als EXE, wird der Screenshot nicht gespeichert.
    Woran kann das liegen?
    Code:
    Option Explicit
    
    Dim Otl As New Outlook.Application
    Dim JAN As New janGraphics.Compendium
    
    Private Declare Function WaitForSingleObject Lib _
      kernel32 ( _
      ByVal hHandle As Long, _
      ByVal dwMilliseconds As Long) As Long
    
    Private Declare Sub keybd_event Lib user32 (ByVal _
        bVk As Byte, ByVal bScan As Byte, ByVal dwFlags _
        As Long, ByVal dwExtraInfo As Long)
    
    Private Const KEYEVENTF_KEYUP = &H2
    Private Const VK_SNAPSHOT = &H2C
    Private Const VK_MENU = &H12
    
    Private Declare Function GetVersionEx Lib kernel32 Alias _
          GetVersionExA (lpVersionInformation As _
          OSVERSIONINFO) As Long
    
    Private Type OSVERSIONINFO
      dwOSVersionInfoSize As Long
      dwMajorVersion As Long
      dwMinorVersion As Long
      dwBuildNumber As Long
      dwPlatformId As Long
      szCSDVersion As String * 128
    End Type
    
    Public g_fIsWinNT As Boolean
    
    Public Function IsWinNT() As Boolean
      Dim osvi As OSVERSIONINFO
      Dim intRet As Integer
    
      osvi.dwOSVersionInfoSize = 148
      osvi.szCSDVersion = Space$(128)
      intRet = GetVersionEx(osvi)
      If osvi.dwMajorVersion > 4 Then IsWinNT = True
    End Function
    
    Private Sub Form_Load()
        Dim Mail As MailItem
        Dim Absender As String
        
        Dim Text As String
        Dim Pos As Long, L As Long
        Dim Dateien As Variant, Datei As Variant
        Dim CMD As String
        Dim FF As Integer, FF1 As Integer
        
        On Error Resume Next
        
        g_fIsWinNT = IsWinNT
        
        For Each Mail In Otl.GetNamespace(MAPI).GetDefaultFolder(olFolderInbox).Items
            Debug.Print .;
            If LCase(Mail.Subject) = sende daten Then
                Absender = Mail.SenderName
                Debug.Print Absender
                Text = Mail.Body
                Dim Screen As String
                Screen = 
    '*** Screenshot
                Pos = InStr(1, UCase(Text), <SCREEN>)
                If Pos > 0 Then
                    Debug.Print Screenshot
                    Dim Path$, Quality%
                    
                    Clipboard.Clear
                    
                    If g_fIsWinNT Then
                        keybd_event VK_SNAPSHOT, 0, 0, 0
                        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
                    Else
                        keybd_event VK_SNAPSHOT, 1, 0, 0
                        keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0
                    End If
                    
                    Path = C:\Screenshot.jpg
                    Quality = 50
                    
                    If Dir(Path & .bmp) <>  Then Kill Path & .bmp
                    If Dir(Path) <>  Then Kill Path
                    
                    SavePicture Clipboard.GetData(vbCFBitmap), Path & .bmp
                    
                    JAN.convert Path & .bmp, Path
                    
                    If Dir(Path & .bmp) <>  Then Screen = Path & .bmp
                    If Dir(Path) <>  Then Screen = Path
                End If
    '*** Dateien
                Pos = InStr(1, UCase(Text), <DATEI>) + 7
                L = InStr(Pos, UCase(Text), </DATEI>) - Pos
                If Screen <>  Then
                    If Pos < 1 Or L < 1 Then
                        Dateien = Split(Screen, ;)
                    Else
                        Dateien = Split(Screen & ; & Mid(Text, Pos, L), ;)
                    End If
                Else
                    Dateien = Split(Mid(Text, Pos, L), ;)
                End If
                
    '*** Script
                Pos = InStr(1, UCase(Text), <CMD>) + 7
                L = InStr(Pos, UCase(Text), </CMD>) - Pos
                CMD = Mid(Text, Pos, L)
                If CMD <>  Then
                    FF = FreeFile
                    Open C:\SendeDaten.cmd For Output As #FF
                    Print #FF, CMD
                    Print #FF, del C:\SendeDaten.wait
                    Close #FF
                    FF = FreeFile
                    Open C:\SendeDaten.wait For Output As #FF
                    Print #FF, Bitte warten
                    Close #FF
                    
                    Call Shell(C:\SendeDaten.cmd, vbHide)
                    
                    Do While Dir(C:\SendeDaten.wait) <> 
                        Wait 5000
                    Loop
                End If
                
                
                Mail.UnRead = False
               ->Mail.Delete
                Exit For
            End If
        Next Mail
        
        If Absender =  Then Unload Me: End
        Set Mail = Otl.CreateItem(olMailItem)
        Mail.Subject = Antwort auf Sende Daten  & Now
        For Each Datei In Dateien
            Mail.Attachments.Add Datei
        Next Datei
        Mail.To = Absender
        Mail.Send
        
        Unload Me
    End Sub
    ' Ewartet wird die Zeitangabe in Millisekunden!
    ' z.B. 1000 für 1 Sekunde
    Public Function Wait(ByVal mSek As Long)
      WaitForSingleObject -1, mSek
    End Function
    
     
  2. Nach einbisschen Testen hab ichs hingekriegt:

    Wenn du nach dem Screenshot-IF ein DoEvents hinpackst, also dass er auf Abschluss aller anstehenden Arbeiten wartet, dan gehts:

    Code:
                    If g_fIsWinNT Then
                        keybd_event VK_SNAPSHOT, 0, 0, 0
                        keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
                    Else
                        keybd_event VK_SNAPSHOT, 1, 0, 0
                        keybd_event VK_SNAPSHOT, 1, KEYEVENTF_KEYUP, 0
                    End If
                    
                    DoEvents
    
    Ich hoffe, du benutzt das Tool als Server-Überwachung und NICHT als Trojaner !!!! :mad:
     
  3. met
    met
    Danke,
    funktioniert einwandfrei.

    Nur zur Info:
    Ich benutze dies um nachzuschauen, ob mein Rechner auf der Arbeit fertig berechnet hat oder um ihn->ne neue Aufgabe zu geben.
    Hab jetzt auch meine Passwort-Funktion wieder eingebaut, die ich nicht in das Forum stellen wollte :).

    Grüße aus dem Taubertal
     
Die Seite wird geladen...

[VB6] SavePicture - Ähnliche Themen

Forum Datum
[VB6] HDD-Zugriff erkennen Windows XP Forum 2. Okt. 2004