Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Screen
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003
Screen

Mam taki oto kod:

Private Sub Command4_Click()
Dim DeskhWnd, DeskDC As Long

DeskhWnd = GetDesktopWindow()
DeskDC = GetDC(DeskhWnd)

BitBlt Me.hdc, 0&, 0&, Screen.Width, Screen.Height, DeskDC, 0&, 0&, &HCC0020
SavePicture Me.Image, "C:\screen.bmp"

ReleaseDC hwnd, DC
SavePicture Me.Image, "C:\screen.bmp"

Picture1.Picture = LoadPicture("C:\screen.bmp"
End Sub

Na formatce pokazuje sie ładnie screen, ale plik już nie jest taki ładny - jest... cały szary.

17-11-2004 20:11
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Ustaw właściwość .AutoRedraw formy na True, inaczej nic w Image ci się nie zmieni.

Poza tym - po co to ReleaseDC? O_o


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

17-11-2004 21:02
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

Thx działa. Teraz jak to juz ze mną bywa (wciąż sie ucze) po rozwiązanym problemie jest następny.

Aplikacja wysyla screna:
Dim txtsource As String

txtsource = "C:\a.bmp"
FileContent = Space$(FileLen(txtsource))

FF = FreeFile
Open txtsource For Binary Access Read As #FF
Get #FF, , FileContent
Close #FF

sock.SendData FileContent

Aplikacja odbierajaca screena:
Private Sub sock_DataArrival(ByVal bytesTotal As Long)
Dim Buf() As Byte

Open "C:\b.bmp" For Binary Access Write As #1

sock.GetData Buf, 1, bytesTotal

Put #1, , Buf
Close #1

End Sub

Problem:
Plik ma tylko 8KB, a powinien ok 4MB,
Gdy klikam na odeprany plik pojawia sie: "podgląd niedostępny".

Są jakies metody aby przesylany screen nie maił 4MB a pare kilobajtow??

ReleaseDC jest po to aby zwolnć pamięć.

[Post edytowany dnia 18-11-2004 01:07 przez PAWKO]

18-11-2004 01:04
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Winsock może jednocześnie wysłać 8kB danych. Zresztą wysyłanie większej ilości jest poprostu niepotrzebne (sieć i tak tego tak szybko nie przepchnie). Spróbuj podzielić plik na mniejsze kawałki (np. 1kB) i wysyłać je kolejno. Pamiętaj o tym, że ostatni kawałek będzie miał inny rozmiar niż pozostałe, więc przy jego pobieraniu bufor do wczytania pliku (ten, który tworzysz Space$(...) ) musi być odpowiednio mniejszy, żeby nie wyjść za plik. Jak to zrobić? Najłatwiej w jednej zmiennej przechować ilosć pełnych (jednokilobajtowych) kawałków, a w drugiej - rozmiar ostatniego. Pierwszą watosc otrzymasz dzieląc rozmiar pliku przez 1024 i biorąc z tego tylko część całkowitą:
jakaszmienna = FileLen(twojplik) \ 1024
Zwróć uwagę na to, że użyłem znaku \, a nie /. Różnica jest taka, że \ to operator dzielenia całkowitego.
Do otrzymania długosci ostatniego fragmentu użyj operatora modulo:
jakaszmienna = FileLen(twojplik) mod 1024
To powinno wystarczyć. Pamiętaj też przy wysyłaniu o sprawdzeniu, czy przypadkiem ostatni fragment nie ma długości 0.. bo nie ma sensu wysyłać pustego Stringa .


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

18-11-2004 13:14
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

Dalej nic.
Kod wysyłający mam taki:

Private Sub Command3_Click()

Dim txtsource As String

txtsource = "C:\a.bmp"

CalychKawalkow = FileLen(txtsource) \ 1024
OstatniKawalek = FileLen(txtsource) Mod 1024

MsgBox CalychKawalkow

FF = FreeFile
Open txtsource For Binary Access Read As #FF

For a = 1 To CalychKawalkow
    FileContent = Space$(FileLen(txtsource) \ 1024)
    Get #1, , FileContent
    sock.SendData FileContent
        DoEvents

Label1.Caption = Label1.Caption + 1

Next

FileContent = Space$(FileLen(txtsource) Mod 1024)
Get #1, , FileContent
    sock.SendData FileContent


Close #1

Może jeszcze trzeba kod odbierający jakoś przerobić?

18-11-2004 18:42
Pokaż profil PAWKO  Wyślij email do PAWKO   
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

OK działa. Trzeba bylo:
1. zmodyfikować procedure odbierania tak aby nie otwierał za każdym razem i zamykał tylko otworzył odebrał wszystko a potem dopiero zamknął.

2. FileContent = Space$(FileLen(txtsource) \ 1024) zmienic na FileContent = Space(1024).

teraz mam taki kod wysyłaia:
Dim txtsource As String

txtsource = "C:\a.bmp"

CalychKawalkow = FileLen(txtsource) \ 1024
OstatniKawalek = FileLen(txtsource) Mod 1024


FF = FreeFile
Open txtsource For Binary Access Read As #FF

For a = 1 To CalychKawalkow
    FileContent = Space(1024)
    Get #1, , FileContent
    Label1.Caption = a

    sock.SendData FileContent
    DoEvents
Next

FileContent = Space(FileLen(txtsource) Mod 1024)
Get #1, , FileContent
    sock.SendData FileContent
Close #1

Czesto wyjeżdżam i dlatego pisze program do zdalnej administracji i sie zastanawiam jak zrobić zdalny pulpit w jak najmiejszym intervale. jak narazie to screen zajmuje 4MB wiec o przesyłaniu na necie nie ma mowy.

18-11-2004 19:30
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Może zapis jako JPEG (gdzieś pewnie można znaleźć biblioteki do tego). To znacznie zmniejszy rozmiar. I tak nie będzie to działało tak, jakby się siedziało przed monitorem, ale lepsze to niż nic.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

18-11-2004 20:35
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

Jak w takim razie pisane sa aplikacje typu RemoteAdministraor cz VNC?

19-11-2004 23:30
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Nie wiem, nie znam ich kodów źródłowych.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

19-11-2004 23:43
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

Mam jeszcze jeden pomysł: wysyłanie jedynie fragmentu grafiki, który się zmienił. przecież zadko zmienia sie cały ekran. Wystarczy zatem wykryć co sie zmieniło i tylko to wysłać razem z danymi informujacymi, gdzie to wkleić do dużeo obrazu. Oczywiscie - jest to znacznie trudniejsze w realizacji. W tej chwili nie mogę podać kompletnego kodu, bo sam dopiero nad tym pracuję (zresztą w podobnym zastosowaniu ) i poprostu go jeszcze nie stworzyłem.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

19-11-2004 23:55
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

Znalazłem Klasy do konwertowania bmp na jpg i dziala to nawwet dobrze. JPGi zajmują od 25-100kb w zaleznosci od jakosci. Przy przesylaniu pojedynczego screena dziala ok, ale jezeli parametr NaxtScreenShot mam True (patrz niżej) to pojawiaja sie jakies bledy:
Aplikacja klienta odbiera caly czas dane i screna nie wyswietla, lub pojawia sie błąd bad file number.

kod wysylający:
Public Sub SendDesktopPreview(QualityRequest As String)
   
    Quality = QualityRequest
   
    MakePreviewScreen
    DoEvents
    Convert
    DoEvents
    SendPreviewScreen
End Sub

Public Sub SendPreviewScreen()
Dim txtsource As String
Dim Data As String

Data = "ScreenPreview"

txtsource = "C:\Windows\screen.jpg"

CalychKawalkow = FileLen(txtsource) \ 1024
OstatniKawalek = FileLen(txtsource) Mod 1024

FF = FreeFile
Open txtsource For Binary Access Read As #2

Form1.wscDesktop.SendData Data
DoEvents

For a = 1 To CalychKawalkow
    FileContent = Space(1024)
    Get #2, , FileContent

    Form1.wscDesktop.SendData FileContent
Next

FileContent = Space(FileLen(txtsource) Mod 1024)
Get #2, , FileContent
    Form1.wscDesktop.SendData FileContent & "$END"
Close #2

DoEvents
DoEvents

If NextScreenShot = True Then SendDesktopPreview (Quality)

End Sub

i odbierajacy:
Public Sub GetDesktop(Data As String)
   
   
    If Right(Data, 4) = "$END" Then
       
        Put #1, , Data
        frmDesktop.Label1.Caption = "Koniec"
       
        Close #1
        frmDesktop.Image1.Picture = LoadPicture("C:\Windows\preview.jpg"
       
    ElseIf Data = "ScreenPreview" Then
        PreviewOpen

    Else
    GetPreviewFile (Data)
   
    End If
End Sub

Public Sub PreviewOpen()
    frmDesktop.Label1.Caption = "1"
    Open "C:\Windows\preview.jpg" For Binary Access Write As #1
End Sub

End Sub

Public Sub GetPreviewFile(Data As String)

Put #1, , Data
frmDesktop.Label1.Caption = frmDesktop.Label1.Caption + 1

End Sub

20-11-2004 12:12
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

1. Powiedz gdzie dokładnie pojawia ci się ten błąd (w której linii)
2. W linii 25 jest End Sub bez wcześniejszego Sub.
3. W tej samej prcedurze otwierasz plik i nie widzę, by gdziekolwiek był potem zamykany. To może powodować ten błąd.
4. Staraj się nie używać stałych numerów plików. Wtedy najłatwiej o takie błędy. Lepiej użyj zmiennej (dajmy na to fPlik), pobierz wolny nr. pliku (fPlik = Freefile) i otwórz plik podajac jako numer pliku tą zmienną.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

20-11-2004 12:20
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
PAWKO




Typ: neutral
Postów: 42
Zarejestrowany: Mar 2003

No wiec tak:
1.
Public Sub GetPreviewFile(Data As String)

Put #1, , Data
frmDesktop.Label1.Caption = frmDesktop.Label1.Caption + 1

End Sub

2. Pomylka przy wklejeniu w kodzie jest dobrze
3. jest w:
If Right(Data, 4) = "$END" Then
       
        Put #1, , Data
        frmDesktop.Label1.Caption = "Koniec"
       
        Close #1
        frmDesktop.Image1.Picture = LoadPicture("C:\Windows\preview.jpg"
4. Spróbuje i powiem czy jakies zmiany

21-11-2004 20:47
Pokaż profil PAWKO  Wyślij email do PAWKO   
marcin_an
Forumowicz




Typ: neutral
Postów: 1265
Zarejestrowany: Mar 2004

1. Jeśli występuje w tej linii, to prawdopodobnie ten plik poprostu nie jest otwary... sprawdź, czy go otworzyłeś wcześniej. Wiem, że w kodzie jest i Open i Close i reszta, ale sprawdź, czy są wykonywane. Z kodu raczej nie wynika w jakiej kolejności są wykonywane procedury, więc nie jestem w stanie ocenić tego tutaj. Uruchom poprostu u siebie i sprawdź, np. dodając:
Debug.Print "Open #1"
przed Open #1, podobnie przy close i put i zobacz, co i kiedy jest wykonywane.


_____________________________________________
Jedzonko dla Google'a:
Forum na temat Visual Basic, C, C++, Pascal, Programowanie, API, PHP, VBA, VB.NET, QBasic, VBScript, Komputery
Moja strona o wszystkim

21-11-2004 21:05
Pokaż profil marcin_an  Wyślij email do marcin_an   Odwiedź stronę marcin_an  
Wszystkich odpowiedzi: 13 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1