XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Programm per Tastendruck fernsteuern
Mit CtrlProg kann ein anderes Programm gesteuert werden. Das zu steuernde Programm
muß mit Tastencodes steuerbar sein!
Version 1.0  4.4.2004.       Das Programmbeispiel kann frei benutzt werden, für
Schäden kann keine Haftung übernommen werden.
Autor: Gerhard Putschalka
email: g.putschalka@web.de
homepage: http://members.telering.at/g.putschalka/index.html
Die in diesem Programm benutzte Prozedur ShutDown wurde von Andreas Miethe erstellt.
In Profan gibt es zwar einen Befehl ExitWindows, welcher zwar den PC niederfahren
kann aber den PC nicht abschaltet (die Hardwarefunktion vorausgesetzt!).
CtrlProg zeigt einen Dialog, in dem der Name des Programmfensters des zu steuernden
Programmes eingegeben werden kann. Ebenso kann die Start- und die Beendigungszeit des
zu steuernden Programmes eingegeben werden.
Mit drücken des Start-Buttons wird der Handle zum zu steuernden Programm gesucht
(das gesuchte Programm muß zu diesem Zeitpunkt bereits aktiv sein!).
Sodann wird bis zur Startzeit abgewartet (der Start kann auch sofort erfolgen wenn das
Eingabefeld Anfangsstunde leer bleibt).
Danach wird an dieses Programm ein Tastencode zum Starten gesendet.
Nach dem Erreichen der Endezeit wird an dieses Programm ein Tastencode zum Beenden der
Programmfunktion gesendet
Nach 5 Sekunden wird der Tastencode Alt + F4 gesendet und damit das Programm beendet.
Danach wird, je nach Auswahl:
- nichts weiter getan
- der PC niedergefahren und ausgeschaltet (der PC muß die Abschaltmöglichkeit haben!)
- der PC niedergefahren und wieder neu gestartet (Restart)
Anwendung (Beispiel): mit VirtualDub wird eine Fernsehsendung als Datei aufgezeichnet.
Mit CtrlProg wird in VirtualDub entsprechend der Startzeit die Aufzeichnung gestartet
und nach erreichen der Endezeit wird die Aufzeichnung beendet. Nach weiteren 5 Sekunden
wird VirtualDub beendet und wahlweise der PC abgeschaltet.
VirtualDub ist ein Freewareprogramm und kann Fernsehsendungen von einer im PC
eingebauten TV-Karte aufnehmen und als AVI Datei (DivX encoded) abspeichern.
(H.P. http://www.virtualdub.org/index )
VirtualDub ist VOR dem Aufruf von CtrlProg zu starten und alle notwendigen Optionen
einzugeben (Capture AVI, Anzahl Frames, Compression, Audio ...). Also alle Angaben die
VOR dem Start der Aufzeichnung erforderlich sind.
Der Tastencode zum Start der Aufzeichnung ist bei VirtualDub die F6 Taste
Der Tastencode zum Beenden der Aufzeichnung ist bei VirtualDub die Escape Taste
Der Tastencode zum Beenden von VirtualDub ist der Tastencode Alt + F4
Diese Steuerfunktionen für VirtualDub werden von CtrlProg vorgenommen.
Die Tastencodes F6 und Escape sind speziell für VirtualDub. Sollte CtrlProg zum
Steuern anderer Programme benutzt werden, sind diese Tastencodes entsprechend zu
ändern. Voraussetzung: das zu steuernde Programm reagiert auf Tastencodes!
Declare Anfang$,_dlg%,PTitel%,EinStd%,EinMin%,AusStd%,AusMin%,Start%,Abbr%
Declare PTitel$,Prog1&,Nichts%,PwOff%,ReBoot%,Term%,Anfang&,Ende&,Aktuell&,Diff1&
DEF Konv_to_Sekunden(3)  ((@%(1) * 3600) + (@%(2) * 60) + @%(3))
----   ShutDown Prozedur  -------
DEF GetCurrentProcess(0)     ! Kernel32,GetCurrentProcess
DEF OpenProcessToken(3)      ! advapi32,OpenProcessToken
DEF LookupPrivilegeValue(3)  ! advapi32,LookupPrivilegeValueA
DEF AdjustTokenPrivileges(6) ! advapi32,AdjustTokenPrivileges
DEF CloseHandle(1)           ! Kernel32,CloseHandle
DEF ExitWindowsEx(2)         ! User32,ExitWindowsEx
########################################################################################
ShutDown Prozedur von Andreas Miethe.
ExitWindowsEx funktioniert unter NT, 2000 und XP nur, wenn das aufrufenden Programm das
Recht besitzt den Rechner neu zu starten bzw. auszuschalten.
Das muss Windows aber erstmal mitgeteilt werden ! Erst wenn diese Vorarbeiten erledigt
sind, kann ExitWindowEx aufgerufen werden !
########################################################################################

Proc ShutDown

    Parameters Par&
    Declare TTokenPrivileges#,LUID#,hToken&,CP&,t$
    Werte für Par&:
    EWX_FORCE     = 4 Forces processes to terminate. When this flag is set, Windows does
    not send the messages WM_QUERYENDSESSION and WM_ENDSESSION to the
    applications currently running in the system. This can cause the
    applications to lose data. Therefore, you should only use this flag
    in an emergency.
    EWX_LOGOFF    = 0 Shuts down all processes running in the security context of the
    process that called the ExitWindowsEx function. Then it logs the user off.
    EWX_POWEROFF  = 8 Shuts down the system and turns off the power. The system must
    support the power-off feature. *)
    EWX_REBOOT    = 2 Shuts down the system and then restarts the system. *)
    EWX_SHUTDOWN  = 1 Shuts down the system to a point at which it is safe to turn off
    the power. All file buffers have been flushed to disk, and all
    running processes have stopped. *)
    *) Windows NT: The calling process must have the SE_SHUTDOWN_NAME privilege.
    To shut down or restart the system, the calling process must use the
    AdjustTokenPrivileges function to enable the SE_SHUTDOWN_NAME privilege.
    Dim TTokenPrivileges#,16
    Dim LUID#,8
    Da der zu ermittelnde LUID-Wert ein Large-Integer(64-Bit) ist,
    wird eine Bereichsvariable statt Structur benutzt !
    cp& = GetCurrentProcess()
    OpenProcessToken(cp&,40,addr(hToken&))   Prozess-Token ermitteln
    t$ = SeShutdownPrivilege
    Long TTokenPrivileges#,0 = 1             Anzahl der Privileges
    LookupPrivilegeValue(0,ADDR(t$),luid#)   LUID für SeShutdownPrivilege auslesen
    Long TTokenPrivileges#,4 = Long(luid#,0) 1.Wert der LUID in Privileges
    Long TTokenPrivileges#,8 = Long(luid#,4) 2.Wert der LUID in Privileges
    Long TTokenPrivileges#,12 = 2            SE_PRIVILEGE_ENABLED
    AdjustTokenPrivileges(hToken&, 0, TTokenPrivileges#, 0, 0, 0) Privileges setzen
    CloseHandle(hToken&)                     Token wird nicht mehr benötigt
    Dispose LUID#                            Speicher freigeben
    Dispose TTokenPrivileges#                Speicher freigeben
    ExitWindowsEx(Par&,2)                    Windows neustarten oder ausschalten
    Parameter: siehe Win32.Hlp

EndProc

------ ShutDown Prozedur Ende ------

PROC Schlafe   Verzögerungszeit wird in Sekunden übergeben

    Parameters N&
    Declare Ende%
    @SetFocus(AusMin%)
    SetTimer (N& * 1000)
    Let Ende% = 0

    WHILENOT Ende%

        WaitInput
        Case %wmTimer : Let Ende% = 1
        Case @Getfocus(Start%) : Ende% = 2

    ENDWHILE

    KillTimer
    Return Ende%

ENDPROC

=============
Programmstart
=============
SET(MessageMode,0)
WindowStyle 112
Window 0,0-0,0
_dlg%=@createdialog(%Hwnd,Programm starten, beenden, wahlweise PC niederfahren,
(%MaxX - 480),(%MaxY - 170),480,140)
@createtext(_dlg%,Fenster/Programmname:,16,4,170,18)
PTitel%=@createedit(_dlg%,,192,4,265,20)
@createtext(_dlg%,Einschaltzeit (hh:mm):,40,35,150,18)  1967046
EinStd% = @Control(EDIT,,$54012082,191,35,25,20,_dlg%,0,%hinstance,$0200)
@createtext(_dlg%,:,216,35,5,16)
EinMin% = @Control(EDIT,,$54012082,221,35,25,20,_dlg%,0,%hinstance,$0200)
@createtext(_dlg%,Ausschaltzeit (hh:mm):,250,35,150,18)  2753472
AusStd%= @Control(EDIT,,$54012082,402,35,25,20,_dlg%,0,%hinstance,$0200)
@createtext(_dlg%,:,428,35,5,16)
let AusMin%= @Control(EDIT,,$54012082,433,35,25,20,_dlg%,0,%hinstance,$0200)
Start%=@createbutton(_dlg%,Start,363,60,90,24)
let PwOff%=@createradiobutton(_dlg%,,40,65,12,10)
let ReBoot%=@createradiobutton(_dlg%,,40,80,12,10)
let Nichts%=@createradiobutton(_dlg%,,40,95,12,10)
@createtext(_dlg%,PC niederfahren,60,62,136,14)
@createtext(_dlg%,neustarten,60,76,136,14)
@createtext(_dlg%,eingeschaltet lassen,60,90,145,14)
@creategroupbox(_dlg%,,32,52,176,58)
setze Vorgabewerte
SetText EinMin%,00
SetText AusMin%,00
SetText PTitel%,VirtualDub  <======= Programmfenster Vorgabe
SetCheck Nichts%,1
@SetFocus(PTitel%)
schreibe Status
StartPaint _dlg%
TextColor @RGB(15,0,0),-1
UseBrush 1,@RGB(32,32,32)
Rectangle 215,90-470,108
DrawText 220,90,leere Ein-Stunde = sofort starten
EndPaint
warte bis Startbutton

WhileNot @Getfocus(Start%)

    WaitInput

Endwhile

SetText Start%,Abbruch  ändere Buttonbeschriftung
hole Handle zu VirtualDub-Fenster
PTitel$ = @GetText$(PTitel%)

IfNot @Equ$(PTitel$,)

    AddWindows PTitel$

    IfNot (%getcount < 0)

        PTitel$ = @ListBoxItem$(0)
        Let Prog1& = @FindWindow(PTitel$)

    EndIf

EndIf

beende wenn Fenster nicht gefunden wurde oder kein Fenstertitel eingegeben wurde.

If (Prog1& = 0)

    @Messagebox(Das Programmfenster wurde nicht gefunden,,32)
    End

EndIf

berechne die momentane Uhrzeit in Sekunden. Die Sekunden der momentanen Zeit werden
nicht mitgerechnet. Die Berechnung erfolgt nach Aktuell&
Anfang$=@Time$(0)
Anfang$=Anfang$;:;@Substr$(@Time$(1),1,.)
Aktuell& = @Konv_to_Sekunden(@Val(@Substr$(Anfang$,1,:)),
@Val(@Substr$(Anfang$,2,:)),@Val(@Substr$(Anfang$,3,:)))
setze Anfangszeit (entweder sofort oder angegebene Zeit)

If @Equ$(@GetText$(EinStd%),)      soll sofort starten

    Anfang& = Aktuell&

Else

    Anfang& = @Konv_to_Sekunden(@Val(@GetText$(EinStd%)),@Val(@GetText$(EinMin%)),0)
    Case (Anfang& < Aktuell&) : Anfang& = (Anfang& + 86400)  beginn nach 0 Uhr

EndIf

Diff1& = (Anfang& - Aktuell&)     Wartezeit bis zum Start
Case (Diff1& < 1) : Diff1& = 0
wenn Aktuelle Zeit nicht Startzeit ist warte

If (Diff1& > 0)

    StartPaint _dlg%
    TextColor @RGB(15,0,0),-1
    UseBrush 1,@RGB(32,32,32)
    Rectangle 215,90-470,108
    DrawText 220,90,*** wartet zum Programmstart ***
    EndPaint
    warte die vorgegebene Zeit ab
    Schlafe Diff1&
    Case (@%(0) = 2) : End    wenn 2: wurde Abbruch gedrückt, es wird sofort beendet

EndIf

Programm wird jetzt gestartet. Hole wieder die aktuelle Zeit und berechne die Lauf-
zeit bis zum Beenden des Programms
Anfang$=@Time$(0)
Anfang$=Anfang$;:;@Substr$(@Time$(1),1,.)
Aktuell& = @Konv_to_Sekunden(@Val(@Substr$(Anfang$,1,:)),
@Val(@Substr$(Anfang$,2,:)),@Val(@Substr$(Anfang$,3,:)))
Ende& =  @Konv_to_Sekunden(@Val(@GetText$(AusStd%)),@Val(@GetText$(AusMin%)),0)
Case (Ende& < Aktuell&) : Ende& = (Ende& + 86400)  Ende nach 0 Uhr
Diff1& = (Ende& - Aktuell&)     Wartezeit bis zum Beenden
Case (Diff1& < 1) : Diff1& = 0
Beep
starte VirtualDub mit Tastencode F6
@SendKey(Prog1&,117)  siehe Tastaturcodes unter SendString in der Profanhilfe
StartPaint _dlg%
TextColor @RGB(15,0,0),-1
UseBrush 1,@RGB(32,32,32)
Rectangle 215,90-470,108
DrawText 220,90,*** das Programm wurde gestartet ***
EndPaint
warte die vorgegebene Endezeit ab
Schlafe Diff1&
Let Term% = @%(0)    wenn 2: wurde Abbruch gedrückt, 1 = Endezeit erreicht
Case (Term% = 2) : End    wenn 2: wurde Abbruch gedrückt, es wird sofort beendet
stoppe Aufzeichnung mit Tastencode Escape
@SendKey(Prog1&,27)
StartPaint _dlg%
TextColor @RGB(15,0,0),-1
UseBrush 1,@RGB(32,32,32)
Rectangle 215,90-470,108
DrawText 220,90,*** das Programm wird beendet ***
EndPaint
warte 5 Sekunden und beende VirtualDub
Schlafe 5
SendString(Prog1&,%{F4})  beende Programm mit Alt + F4
SendString(Prog1&,%{F4})  beende Programm mit Alt + F4
wurde nicht Abbruch gedrückt, den PC entsprechend abschalten / reboot / nichts tun

If (Term% = 1)

    Case @GetCheck(PwOff%)  : ShutDown 8
    Case @GetCheck(ot%) : ShutDown 2

EndIf

Fin