PureBasic

Code : Tout sélectionner

; Par Cyrille Landivier / LDV MULTIMEDIA - 2010
; Start 2 dec 2010 - PB 4.51
; Sniffeur de liens / Mini Navigateur

Declare  GestionCaret(Gadget) ;

If InitMouse()=0
  End
EndIf

Enumeration
  #LDV
  #ADD
  #ListView_1
  #BTCOPYALL
  #BTSNIFF
  #BTGO
  #BTPOPUP
  #Web
EndEnumeration

Global adr$,flag
Global html$,PageEnCours$
Global MSGpopup$
adr$="http://ldvmultimedia.com"

;- RECUPERATION DE LA SOURCE D'UNE PAGE WEB ----------------------------
ProcedureDLL.s Url2Text2(Url.s, OpenType.b,ProxyAndPort.s)
  ;/ Author : Pille
  isLoop.b=1
  INET_RELOAD.l = $80000000
  hInet.l=0
  hURL.l=0
  Bytes.l=0
  Buffer.s= Space (2048 )
  RES.s= ""
  hInet = InternetOpen_ ( "" , OpenType, ProxyAndPort, "" , 0)
  hURL = InternetOpenUrl_ (hInet, Url, #Null , 0, INET_RELOAD, 0)
  Repeat
    InternetReadFile_ (hURL,@Buffer, Len (Buffer), @Bytes)
    If Bytes = 0
      isLoop=0
    Else
      RES = RES + Left (Buffer, Bytes)
    EndIf
  Until isLoop=0
  InternetCloseHandle_ (hURL)
  InternetCloseHandle_ (hInet)
  ProcedureReturn RES
EndProcedure

ProcedureDLL.s Url2Text(Url.s)
  ProcedureReturn Url2Text2(Url,1, "" )
EndProcedure 
;--------------------------------------------------------------------


;- DETECTION DE LA POSITION DU CURSEUR ----------------
Procedure CursorDetection()
  ;Debug "x : "+Str(WindowMouseX(#LDV))+" y : "+Str(WindowMouseY(#LDV))
  If WindowMouseX(#LDV)>5 And WindowMouseX(#LDV)<605 And WindowMouseY(#LDV)>5 And WindowMouseY(#LDV)<25
  Select WaitWindowEvent()
    Case #WM_LBUTTONDBLCLK
        SetGadgetText(#ADD,"http://")
        GestionCaret(#ADD) 
    EndSelect
  EndIf
EndProcedure
;--------------------------------------------------------------------

;- GESTION DE LA POSITION DU POINTEUR APRES LE TEXTE DANS UN STRINGGADGET ------------------------------
Procedure GestionCaret(Gadget) ; Gestion du caret dans stringGadget 
	SendMessage_(GadgetID(Gadget), #EM_GETSEL, @Debut_Position, @Fin_position)     
	y = Debut_Position 
	Texte.s = GetGadgetText(Gadget) 
	x = Len(Texte) 
	Texte2.s = Left(Texte,y ) + Right(Texte,x-y) 
	SetGadgetText(Gadget,Texte2) 
	SendMessage_(GadgetID(Gadget), #EM_SETSEL, x, x)     
EndProcedure 
;--------------------------------------------------------------------


Procedure OpenWindow_LDV()
  If OpenWindow(#LDV, 450, 200, 613, 788, "WEB LINK SNIFFER", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_TitleBar)
    StringGadget(#ADD, 5, 5, 600, 25, adr$, #PB_String_LowerCase|#WS_BORDER)
    ListViewGadget(#ListView_1, 4, 65, 605, 276)
    ButtonGadget(#BTCOPYALL, 5, 345, 404, 40, "COPY ALL THE LIST", #BS_FLAT)
    
    ButtonGadget(#BTSNIFF, 109, 30, 502, 30, "SNIFF LINKS !")
    ButtonGadget(#BTGO, 5, 30, 103, 30, "GO")
    WebGadget(#Web, 1, 390, 600,350, adr$)
    
    SetGadgetAttribute(#Web, #PB_Web_BlockPopups, 1) ; bloque les popup
    MSGpopup$="Pop up bloquées"
    ButtonGadget(#BTPOPUP, 410, 345, 203, 40, MSGpopup$, #BS_FLAT)
    PureCOLOR_SetButtonColor(#BTPOPUP, RGB(0,0,0), RGB(245,0,0)) 
    
    SetTimer_(WindowID(#LDV),0,10,@CursorDetection())
    
  EndIf
EndProcedure

OpenWindow_LDV()

Repeat
  Select WaitWindowEvent()
      
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #ADD
        Case #ListView_1
        Case #BTCOPYALL
        
        ;-BLOQUEUR DE POPUP----------------------------------------  
        Case #BTPOPUP
          If GetGadgetAttribute(#Web,#PB_Web_BlockPopups)=1
            SetGadgetAttribute(#Web,#PB_Web_BlockPopups,0)
            MSGpopup$="Pop up autorisées"
            PureCOLOR_SetButtonColor(#BTPOPUP, RGB(0,0,0), RGB(0,255,0)) 
            
          Else
            SetGadgetAttribute(#Web,#PB_Web_BlockPopups,1)
            MSGpopup$="Pop up bloquées"
            PureCOLOR_SetButtonColor(#BTPOPUP, RGB(0,0,0), RGB(245,0,0)) 
          EndIf
          SetGadgetText(#BTPOPUP,MSGpopup$)
         ;-----------------------------------------------------------
          
        Case #BTGO
          adr$=GetGadgetText(#ADD)
          If Left(adr$,7)="http://" And Len(adr$)>7
            SetGadgetText(#Web, adr$)
            ClearGadgetItems(#ListView_1)
          Else
            MessageRequester("Error","Wrong adress",#MB_ICONHAND)
            If GetGadgetText(#Web)<>adr$
              SetGadgetText(#Web,GetGadgetText(#Web))
            EndIf
          EndIf
          
        Case #BTSNIFF
          PageEnCours$=GetGadgetText(#Web)
          adr$=GetGadgetText(#ADD)
          If adr$<>PageEnCours$
            SetGadgetText(#Web,adr$)
          EndIf
          
          html$=Url2Text(adr$)
          ;--- Formatage des liens = Filtre des ""
          html$=ReplaceString(html$,Chr(34)," ",#PB_String_NoCase,1)
          html$=RemoveString(html$,"<!doctype",#PB_String_NoCase)
          ; Debug "adress : "+adr$
          ; Debug "source : "+html$
          NbrLien=CountString(html$,"http:")
          Debug "Nbr de lien : "+Str(NbrLien)
          pos1=1
          For i=0 To NbrLien
            debut=FindString(html$,"http:",pos1)
            fin=FindString(html$," ",debut)
            lien$=Mid(html$,debut,fin-debut)
            Debug lien$
            pos1=fin
            AddGadgetItem(#ListView_1,-1,lien$)
          Next i  
          
        Case #Web 
          PageEnCours$=GetGadgetText(#Web)
          SetGadgetText(#ADD,PageEnCours$)
          adr$=GetGadgetText(#ADD)
          
      EndSelect
      
    Case #PB_Event_CloseWindow
      Select EventWindow()
        Case #LDV
          CloseWindow(#LDV)
          Break
      EndSelect
  EndSelect
ForEver