VB-Code für die Passphrase-Abfrage

Zurück

Die roten Stellen enthalten ggf. anzupassende Pfade. Das Programm führt einen belanglosen ssh-Befehl aus und erzwingt damit die Eingabe der Passphrase. Das Programm gehört deshalb in den autostart.

Option Explicit
Dim start, sshacid, wait_end As Integer
Private hShell, hProc, lExit As Long
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
Private Declare Function OpenProcess Lib "kernel32" _
    (ByVal dwDesiredAccess&, ByVal bInheritHandle&, ByVal dwProcessId&) _
    As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
    (ByVal hProcess As Long, lpExitCode As Long) _
    As Long

Private Sub tmrSek_Timer()
  If (wait_end = 0) Then
    If (start > 0) Then
      lblShowState.Caption = "Warte noch " + CStr(start) + " Sekunden ..."
      start = start - 1
    Else
      lblShowState.Caption = "Starte Passphrase-Abfrage ..."
      ' C:\Programme\SSH Communications Security\SSH Secure Shell steht nach der Installation
      ' im PATH des NT drin, sonst müßte hier der volle Pfad angegeben werden
      StartShell ("ssh2 -l root NODENAME pwd")
      wait_end = 1
    End If
  Else
    ' Prozeßinformationen auswerten ....
    GetExitCodeProcess hProc, lExit
    ' ....und überprüfen, ob der Prozeß noch aktiv ist
    If (lExit <> STILL_ACTIVE) Then
      tmrSek.Enabled = False      ' nein
      ende                        ' kille ssh und räume auf
    End If
  End If
End Sub

Sub StartShell(sCmd As String)
 '** Übergebenen Commandostring ausführen
 hShell = Shell(Environ$("Comspec") & " /c " & sCmd, vbNormal)
 '** Erzeugen der Prozeßinformationen, basierend auf dem Handle,
 '** welches von der Funktion Shell() zurückgeliefert wurde
 hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
End Sub

Private Sub ende()
  lblShowState.Caption = "Beende Anwendung ..."
  start = Timer
  Do While Timer < start + 1
    DoEvents
  Loop
  Unload Me     ' Ende
  End
End Sub

Private Sub Form_Load()
  Me.Show
  start = 10          ' 10 Sekunden Zeit zum Start von SSH Accession
  wait_end = 0        ' erst später aktivieren
  lblShowState.Caption = "Starte SSH-Accession Lite ..."
  ' ssh_accession starten
  sshacid = Shell("C:\Programme\SSH Communications Security\SSH Accession\ssh_accession.exe", vbNormalFocus)
  tmrSek.Enabled = True
End Sub

Zurück
Top