PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

(META) Content Spy-BOT

https://www.purebasic.fr/english/viewtopic.php?t=15659

Page 1 of 1

(META) Content Spy-BOT

Posted: Mon Jun 20, 2005 6:00 pm
by Hroudtwolf
Code updated For 5.20+

The first Spy-BOT made in PB.
Please, feel free to expand it.

Code: Select all

Declare.s CopyURL(Url.s, OpenType.b)
Declare Searchlinks ()

NewList pagetext.s()

Enumeration
  #Window_0
EndEnumeration



Enumeration
  #ListIcon_0
  #String_0
  #Button_0
  #Frame3D_0
  #Listview_1
  #Button_1
EndEnumeration

Enumeration
  #StatusBar_0
EndEnumeration

If OpenWindow(#Window_0, 244, 136, 600, 401,"",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar )
  
  
  
  ListIconGadget(#ListIcon_0, 10, 10, 580, 170, "URL", 200)
  SendMessage_(GadgetID(#ListIcon_0), #EM_EXLIMITTEXT, 0, 122880)
  AddGadgetColumn(#ListIcon_0, 2, "Description", 375)
  StringGadget(#String_0, 10, 350, 460, 20, "http://www.linkplatz.de/")
  ButtonGadget(#Button_0, 480, 350, 50, 20, "Spy")
  FrameGadget(#Frame3D_0, 10, 190, 580, 150, "Jobs")
  ListViewGadget(#Listview_1, 20, 210, 560, 120)
  SendMessage_(GadgetID(#Listview_1), #EM_EXLIMITTEXT, 0, 122880)
  ButtonGadget(#Button_1, 540, 350, 50, 20, "Break")     
  
  
  Repeat
    event.l=WindowEvent()
    Select event.l
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Button_0
            AddGadgetItem (#Listview_1,-1,GetGadgetText(#String_0))
          Case #Button_1
            If anhalten.l=0 
              anhalten.l=1 
              
            Else
              anhalten.l=0
              
            EndIf
        EndSelect
        
    EndSelect
    
    If anhalten.l=0 And CountGadgetItems (#Listview_1)>0
      StatusBarText(0, 0, GetGadgetItemText(#Listview_1,0,0))
      CopyURL(GetGadgetItemText(#Listview_1,0,0), 1)
      SearchLinks()
      
    EndIf
    Delay (2)
    
  Until event.l=#PB_Event_CloseWindow
  CloseWindow (#Window_0)
  End
EndIf



Procedure.s CopyURL(Url.s, OpenType.b)
  
  
  isLoop.b=1
  INET_RELOAD.l=$80000000
  hInet.l=0: hURL.l=0: Bytes.l=0
  Buffer.s=Space(63000)
  
  hInet = InternetOpen_("PB-Lounge BOT", OpenType, #Null, #Null, 0)
  hURL = InternetOpenUrl_(hInet, Url, #Null, 0, INET_RELOAD, 0)
  DeleteFile ("temp.tmp")
  If CreateFile (1,"temp.tmp")
    Repeat
      
      Delay(1)
      InternetReadFile_(hURL, @Buffer, Len(Buffer), @Bytes)
      WriteData (1,@buffer.s,Bytes)
      
    Until Bytes = 0 
    CloseFile (1)
  EndIf
  InternetCloseHandle_(hURL)
  InternetCloseHandle_(hInet)
  buffer.s=""
EndProcedure



Procedure Searchlinks ()
  Shared pagetext()
  ClearList (pagetext())
  If OpenFile (1,"temp.tmp")
    While Eof(1)=0
      
      tmp.s=ReadString (1)
      AddElement (pagetext())
      pagetext()=tmp.s
      
    Wend
    
    CloseFile (1)
  EndIf
  Delay (5)
  
  
  ResetList (pagetext())
  While NextElement (pagetext())
    tmp.s=pagetext()
    If FindString(tmp.s,"href="+Chr(34),1) 
      tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+6,Len(tmp.s))
      link.s= Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
    EndIf
    If FindString(tmp.s,"href = "+Chr(34),1) 
      tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+8,Len(tmp.s))
      link.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
    EndIf 
    If FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)
      tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)+28,Len(tmp.s))
      content.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
    EndIf
    
    
    If Mid(link.s,1,7)="http://"
      hinzu.s=link.s
    Else
      weg.s=GetGadgetItemText(#Listview_1,0,0)
      If Mid(weg.s,Len(weg.s)-2,1)<>"/":weg.s=weg.s+"/":EndIf
      hinzu.s=weg.s+link.s
    EndIf   
    schonda.l=0
    For x=0 To CountGadgetItems(#Listview_1)-1
      If LCase (hinzu.s)=LCase (GetGadgetItemText (#Listview_1,x,0)):schonda.l=1:EndIf   
      If LCase (content.s)=LCase (GetGadgetItemText (#Listview_1,x,1)):schonda.l=1:EndIf   
    Next x
    brauchbar.l=0
    
    Restore filedisclaimer
    For x=1 To 9
      Read.s dt.s
      If  GetExtensionPart(hinzu.s)=dt.s
        brauchbar.l=1
      EndIf
    Next x
    
    If schonda.l=0 And brauchbar.l=0
      
      AddGadgetItem (#Listview_1,-1,hinzu.s)     
    EndIf
    
    
    If content.s<>"" And habs.l=0:habs.l=1:AddGadgetItem (#Listicon_0,-1,GetGadgetItemText (#Listview_1,0,0)+Chr(10)+content.s,0):EndIf
    content.s=""
    links.s=""
    WindowEvent()
  Wend   
  habs.l=0
  
  
  RemoveGadgetItem(#Listview_1,0)
EndProcedure


DataSection
  filedisclaimer:
  Data.s "exe"
  Data.s "zip"
  Data.s "mpg"
  Data.s "jpg"
  Data.s "png"
  Data.s "gif"
  Data.s "mid"
  Data.s "scw"
  Data.s "rar"
EndDataSection

Posted: Mon Jun 20, 2005 6:04 pm
by thefool
it works very nice here!
allthough the "break" button tends to be slow.

Posted: Mon Jun 20, 2005 11:04 pm
by Hroudtwolf
@ TheFool

Thanks for the BUG Report. ;-)


Updated:

- Filetype disclaimer added
- a lot of BUGs removed (also the break button repaired)
- faster searching

Code: Select all

Declare.s CopyURL(Url.s, OpenType.b) 
Declare Searchlinks ()


Global anhalten.l



NewList pagetext.s()

Enumeration
  #Window_0
EndEnumeration



Enumeration
  #ListIcon_0
  #String_0
  #Button_0
  #Frame3D_0
  #Listview_1
  #Button_1
EndEnumeration

Enumeration
  #StatusBar_0
EndEnumeration





  If OpenWindow(#Window_0, 244, 136, 600, 401,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar , "Pure BOT")
    If CreateStatusBar(#StatusBar_0, WindowID())
    EndIf
    
    If CreateGadgetList(WindowID())
      ListIconGadget(#ListIcon_0, 10, 10, 580, 170, "URL", 200)
      SendMessage_(GadgetID(#ListIcon_0), #EM_EXLIMITTEXT, 0, 122880)
      AddGadgetColumn(#ListIcon_0, 2, "Description", 375)
      StringGadget(#String_0, 10, 350, 460, 20, "http://www.linkplatz.de/")
      ButtonGadget(#Button_0, 480, 350, 50, 20, "Spy")
      Frame3DGadget(#Frame3D_0, 10, 190, 580, 150, "Jobs")
      ListViewGadget(#Listview_1, 20, 210, 560, 120)
      SendMessage_(GadgetID(#Listview_1), #EM_EXLIMITTEXT, 0, 122880)
      ButtonGadget(#Button_1, 540, 350, 50, 20, "Break")      
    EndIf
    
    
    Repeat
    event.l=WindowEvent()
    Select event.l
      Case #pb_event_gadget 
        Select EventGadgetID()
          Case #Button_0
            AddGadgetItem (#Listview_1,-1,GetGadgetText(#String_0))
          Case #Button_1

              ClearGadgetItemList (#Listview_1)

        

        EndSelect 
    
    EndSelect 
    
    If CountGadgetItems (#Listview_1)>0
    StatusBarText(0, 0, GetGadgetItemText(#Listview_1,0,0))
        CopyURL(GetGadgetItemText(#Listview_1,0,0), 1) 
        SearchLinks()
        
    EndIf 
    Delay (2)
    
    Until event.l=#pb_event_closewindow
    CloseWindow (#Window_0)
    End 
  EndIf



 Procedure.s CopyURL(Url.s, OpenType.b) 


  isLoop.b=1 
  INET_RELOAD.l=$80000000 
  hInet.l=0: hURL.l=0: Bytes.l=0 
  Buffer.s=Space(63000) 
  
  hInet = InternetOpen_("PBL@INET", OpenType, #NULL, #NULL, 0) 
  hURL = InternetOpenUrl_(hInet, Url, #NULL, 0, INET_RELOAD, 0) 
  DeleteFile ("temp.tmp")
  If CreateFile (1,"temp.tmp")
  Repeat 
    
    Delay(1) 
    InternetReadFile_(hURL, @Buffer, Len(Buffer), @Bytes) 
    WriteData (@buffer.s,Bytes)

 
   
  Until Bytes = 0  
  CloseFile (1)
  EndIf 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  buffer.s=""
EndProcedure 



Procedure Searchlinks ()
ClearList (pagetext())
  If OpenFile (1,"temp.tmp")
    While Eof(1)=0
    
      tmp.s=ReadString ()
      AddElement (pagetext())
      pagetext()=tmp.s
    
    Wend
    
  CloseFile (1)
  EndIf 
  Delay (5)
  
  
  ResetList (pagetext())
  While NextElement (pagetext()) and fertig=0
  tmp.s=pagetext()
        If FindString(tmp.s,"href="+Chr(34),1)  
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+6,Len(tmp.s))
          link.s= Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf 
      If FindString(tmp.s,"href = "+Chr(34),1)  
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+8,Len(tmp.s))
          link.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf  
      If FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)+28,Len(tmp.s))
          content.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf 
      
      
        If Mid(link.s,1,7)="http://"
        hinzu.s=link.s
        Else 
        weg.s=GetGadgetItemText(#Listview_1,0,0)
        If Mid(weg.s,Len(weg.s)-2,1)<>"/":weg.s=weg.s+"/":EndIf 
        hinzu.s=weg.s+link.s
        EndIf   
   schonda.l=0
    For x=0 To CountGadgetItems(#Listview_1)-1
     If LCase (hinzu.s)=LCase (GetGadgetItemText (#Listview_1,x,0)):schonda.l=1:EndIf   
     If LCase (content.s)=LCase (GetGadgetItemText (#Listview_1,x,1)):schonda.l=1:EndIf    
    Next x
    brauchbar.l=0

    Restore filedisclaimer
       For x=1 To 9
        Read dt.s
        If  GetExtensionPart(hinzu.s)=dt.s
          brauchbar.l=1
        EndIf
       Next x 
    
    If schonda.l=0 And brauchbar.l=0

      AddGadgetItem (#Listview_1,-1,hinzu.s)     
    EndIf 
    
    
    If content.s<>"" And habs.l=0:habs.l=1:AddGadgetItem (#Listicon_0,-1,GetGadgetItemText (#Listview_1,0,0)+Chr(10)+content.s,0):EndIf 
    content.s=""
    links.s=""
    event.l=WindowEvent()
    Select event.l
      Case #pb_event_gadget
        If EventGadgetID()=#Button_1:fertig=1:ClearGadgetItemList (#Listview_1):EndIf 
        
    EndSelect 
    Wend   
  habs.l=0
  fertig.l=0
  
  
  RemoveGadgetItem(#Listview_1,0)
EndProcedure 


DataSection
filedisclaimer:
Data.s "exe"
Data.s "zip"
Data.s "mpg"
Data.s "jpg"
Data.s "png"
Data.s "gif"
Data.s "mid"
Data.s "scw"
Data.s "rar"
EndDataSection

Posted: Mon Jun 20, 2005 11:18 pm
by Jimbo_H
Nice app! Thanks for sharing.

Is there any chance of....
1. Being able to maximise or expand the Window size? I have a screen res of 1280x1024 and it's not quite big enough.
2. For the program to clear the content of the top pane when a new search is started.
3. Export/save the results.

These aren't criticisms, just suggestions :)

Jim.

Posted: Mon Jun 20, 2005 11:30 pm
by Hroudtwolf
Thanx Jim. :-)

But I share it, that you expand it or use it by your own wishes.


I found a little BUG.....

FIXED :D

Code: Select all

Declare.s CopyURL(Url.s, OpenType.b) 
Declare Searchlinks ()


Global anhalten.l



NewList pagetext.s()

Enumeration
  #Window_0
EndEnumeration



Enumeration
  #ListIcon_0
  #String_0
  #Button_0
  #Frame3D_0
  #Listview_1
  #Button_1
EndEnumeration

Enumeration
  #StatusBar_0
EndEnumeration





  If OpenWindow(#Window_0, 244, 136, 600, 401,  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar , "Pure BOT")
    If CreateStatusBar(#StatusBar_0, WindowID())
    EndIf
    
    If CreateGadgetList(WindowID())
      ListIconGadget(#ListIcon_0, 10, 10, 580, 170, "URL", 200)
      SendMessage_(GadgetID(#ListIcon_0), #EM_EXLIMITTEXT, 0, 122880)
      AddGadgetColumn(#ListIcon_0, 2, "Description", 375)
      StringGadget(#String_0, 10, 350, 460, 20, "http://www.linkplatz.de/")
      ButtonGadget(#Button_0, 480, 350, 50, 20, "Spy")
      Frame3DGadget(#Frame3D_0, 10, 190, 580, 150, "Jobs")
      ListViewGadget(#Listview_1, 20, 210, 560, 120)
      SendMessage_(GadgetID(#Listview_1), #EM_EXLIMITTEXT, 0, 122880)
      ButtonGadget(#Button_1, 540, 350, 50, 20, "Break")      
    EndIf
    
    
    Repeat
    event.l=WindowEvent()
    Select event.l
      Case #pb_event_gadget 
        Select EventGadgetID()
          Case #Button_0
            AddGadgetItem (#Listview_1,-1,GetGadgetText(#String_0))
          Case #Button_1

              ClearGadgetItemList (#Listview_1)

        

        EndSelect 
    
    EndSelect 
    
    If CountGadgetItems (#Listview_1)>0
    StatusBarText(0, 0, GetGadgetItemText(#Listview_1,0,0))
        CopyURL(GetGadgetItemText(#Listview_1,0,0), 1) 
        SearchLinks()
        
    EndIf 
    Delay (2)
    
    Until event.l=#pb_event_closewindow
    CloseWindow (#Window_0)
    End 
  EndIf



 Procedure.s CopyURL(Url.s, OpenType.b) 


  isLoop.b=1 
  INET_RELOAD.l=$80000000 
  hInet.l=0: hURL.l=0: Bytes.l=0 
  Buffer.s=Space(63000) 
  
  hInet = InternetOpen_("PB-Lounge BOT", OpenType, #NULL, #NULL, 0) 
  hURL = InternetOpenUrl_(hInet, Url, #NULL, 0, INET_RELOAD, 0) 
  DeleteFile ("temp.tmp")
  If CreateFile (1,"temp.tmp")
  Repeat 
    
    Delay(1) 
    InternetReadFile_(hURL, @Buffer, Len(Buffer), @Bytes) 
    WriteData (@buffer.s,Bytes)

 
   
  Until Bytes = 0  
  CloseFile (1)
  EndIf 
  InternetCloseHandle_(hURL) 
  InternetCloseHandle_(hInet) 
  buffer.s=""
EndProcedure 



Procedure Searchlinks ()
ClearList (pagetext())
  If OpenFile (1,"temp.tmp")
    While Eof(1)=0
    
      tmp.s=ReadString ()
      AddElement (pagetext())
      pagetext()=tmp.s
    
    Wend
    
  CloseFile (1)
  EndIf 
  Delay (5)
  
  
  ResetList (pagetext())
  While NextElement (pagetext()) and fertig=0
  tmp.s=pagetext()
        If FindString(tmp.s,"href="+Chr(34),1)  
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+6,Len(tmp.s))
          link.s= Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf 
      If FindString(tmp.s,"href = "+Chr(34),1)  
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"href="+Chr(34),1)+8,Len(tmp.s))
          link.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf  
      If FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)
          tmp.s=Mid(tmp.s,FindString(LCase(tmp.s),"name="+Chr(34)+"description"+Chr(34)+" content="+Chr(34),1)+28,Len(tmp.s))
          content.s=Mid(tmp.s,1,FindString(tmp.s,Chr(34),1)-1)
      EndIf 
      
      
        If Mid(link.s,1,7)="http://"
        hinzu.s=link.s
        Else 
        weg.s=GetGadgetItemText(#Listview_1,0,0)
        If Mid(weg.s,Len(weg.s)-2,1)<>"/":weg.s=weg.s+"/":EndIf 
        hinzu.s=weg.s+link.s
        EndIf   
   schonda.l=0
    For x=0 To CountGadgetItems(#Listview_1)-1
     If LCase (hinzu.s)=LCase (GetGadgetItemText (#Listview_1,x,0)):schonda.l=1:EndIf   
       
    Next x
    brauchbar.l=0

    Restore filedisclaimer
       For x=1 To 9
        Read dt.s
        If  GetExtensionPart(hinzu.s)=dt.s
          brauchbar.l=1
        EndIf
       Next x 
    
    If schonda.l=0 And brauchbar.l=0

      AddGadgetItem (#Listview_1,-1,hinzu.s)     
    EndIf 
    
    auchda.l=0
    For x=0 To CountGadgetItems(#Listicon_0)-1
      If Trim(LCase (content.s))=Trim(LCase (GetGadgetItemText (#Listicon_0,x,1))):auchda.l=1:EndIf  
    Next x
    
    
    If content.s<>"" And auchda.l=0 And habs.l=0:habs.l=1:AddGadgetItem (#Listicon_0,-1,GetGadgetItemText (#Listview_1,0,0)+Chr(10)+content.s,0):EndIf 
    content.s=""
    links.s=""
    event.l=WindowEvent()
    Select event.l
      Case #pb_event_gadget
        If EventGadgetID()=#Button_1:fertig=1:ClearGadgetItemList (#Listview_1):EndIf 
        
    EndSelect 
    Wend   
  habs.l=0
  fertig.l=0
  
  
  RemoveGadgetItem(#Listview_1,0)
EndProcedure 


DataSection
filedisclaimer:
Data.s "exe"
Data.s "zip"
Data.s "mpg"
Data.s "jpg"
Data.s "png"
Data.s "gif"
Data.s "mid"
Data.s "scw"
Data.s "rar"
EndDataSection

Posted: Wed Jun 22, 2005 11:39 am
by GeoTrail
VERY kewl.
Great job Hroudtwolf :)

Posted: Wed Jun 22, 2005 2:39 pm
by Jimbo_H
Hroudtwolf wrote:Thanx Jim. :-)
But I share it, that you expand it or use it by your own wishes.
Yes, I should have thought of that myself before posting! I must have been having a blonde moment (but don't tell my wife I said that!) :D

Jim
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited